[r2005-10-30 14:23:02 by afrisch] Moving to OCaml 3.09

Original author: afrisch
Date: 2005-10-30 14:23:04+00:00

CHANGES

+0.4.0
+
+- Adapted to OCaml 3.09.
+- To build the OCaml/CDuce interface, OCaml sources are now needed.
+
 0.3.92
 
 - Tools:

INSTALL

@@ -26,7 +26,7 @@ Mandatory packages:
 Before compiling CDuce, you need to install recent releases of the
 following packages:
 
-ocaml      >= 3.08.3
+ocaml      >= 3.09
   http://caml.inria.fr/ocaml/distrib.html
 findlib    >= 1.0.3 
   http://www.ocaml-programming.de/packages
@@ -150,39 +150,11 @@ You need a GNU Make (or equivalent). The Makefile defines the following goals:
 Building the CDuce/OCaml interface
 ------------------------------------------------------------------------------
 
-If you want to build the OCaml/CDuce interface, you will need some
-parts of the OCaml compilers which are not installed by default with
-OCaml. The files you need are the compiled units from the
-subdirectories utils/ parsing/ and typing/ of the OCaml standard
-distribution (the .cmi files, and either the corresponding .cmo or the
-.cmx+.o). If you still have the compiled OCaml source tree that you used
-to build the current version of ocamlc/ocamlopt, in, say
-$HOME/ocaml-3.07, you can activate the OCaml/CDuce interface with:
-
- ./configure --mliface=$HOME/ocaml-3.08
-
-Another option is to copy all the needed files (.cmi,.cmo/.cmx+.o)
-to a single directory, say $HOME/ocaml-modules. Then you can do:
-
- ./configure --mliface=$HOME/ocaml-modules
-
-(the configure script automatically detect whether the files
-are directly in the specified directory, or in utils/ parsing/ typing/
-subdirectories)
-
-Note for GODI users: 
-====================
-
-The GODI distribution provides the required files by default.
-The configure script will detect them automatically.
-
-
-Note for Debian users:
-======================
-
-The Debian package ocaml-compiler-libs provides the required files.
-The configure script will detect them automatically.
+If you want to build the OCaml/CDuce interface, you need a copy
+of the OCaml source tree matching your current OCaml version.
+You must pass the location of this tree to the configure script:
 
+ ./configure --mliface=$HOME/ocaml-3.09
 
 ------------------------------------------------------------------------------
 Note on XML parsers

Makefile.distrib

@@ -47,7 +47,7 @@ else
   CAMLOPT_P = ocamlopt -inline 10000
 endif
 
-OPT = -warn-error FPS
+OPT = -warn-error FPSXY
 ANNOT =
 INTERFACE =
 ifeq ($(ANNOT), true)
@@ -283,7 +283,7 @@ misc/q_symbol.cmo: misc/q_symbol.ml
 
 .ml.cmx:
 	@echo "Build $@"
-	$(HIDE)$(CAMLOPT) -c $(SYNTAX_PARSER) $(INCLUDES) $<
+	$(HIDE)$(CAMLOPT) -passopt -for-pack -passopt Cduce_lib -c $(SYNTAX_PARSER) $(INCLUDES) $<
 
 .mli.cmi:
 	@echo "Build $@"
@@ -317,10 +317,9 @@ install_doc: doc
 
 ocamliface/caml_cduce.cmo:
 	@cd ocamliface; \
-	$(MAKE) PREFIX=$(ML_MODULES) MODEL=$(ML_INTERFACE) \
-	        HIDE=$(HIDE) caml_cduce.cmo
+	$(MAKE) OCAML_SRC=$(OCAML_SRC) HIDE=$(HIDE) caml_cduce.cmo
 
 ocamliface/caml_cduce.cmx:
 	@cd ocamliface; \
-	$(MAKE) PREFIX=$(ML_MODULES) MODEL=$(ML_INTERFACE) \
-		HIDE=$(HIDE) caml_cduce.cmx
+	$(MAKE) OCAML_SRC=$(OCAML_SRC) HIDE=$(HIDE) caml_cduce.cmx
+

configure.ml

@@ -167,16 +167,7 @@ let exe = match Sys.os_type with
   | _ -> ""
 
 let check_mliface dir =
-  log ("Looking for ocaml modules in " ^ dir);
-  let file = if native then "types.cmx" else "types.cmo" in
-  if Sys.file_exists (Filename.concat dir file) 
-  then `flat
-  else
-    if Sys.file_exists 
-      (Filename.concat (Filename.concat dir "typing") file) then
-	`tree
-    else
-      `not_found
+  Sys.file_exists (Filename.concat dir "typing/types.ml") 
 
 let ocaml_stdlib () =
   if (Sys.command "ocamlc -where > ocaml_stdlib" <> 0) then
@@ -189,26 +180,19 @@ let ocaml_stdlib () =
 
 let ml_interface = 
   let dir1 = !(List.assoc "mliface" vars) in
-  let dirs = 
-    let std = ocaml_stdlib () in
-    Filename.concat (Filename.chop_suffix std "std-lib") "compiler-lib" :: 
-          (* GODI *)
-    Filename.concat std "compiler-libs" :: (* Debian *)
-    src_dirs in
+  let dirs = [] in
   let dirs = if dir1 = "" then dirs else dir1 :: dirs in
-  print "Looking for ocaml compiler modules ...";
+  print "ocaml sources... ";
   let rec loop = function
     | [] -> 
-	print "not found\n";
-	`no
+	print "not found (the interface will not be built)\n";
+	None
     | d::dirs ->
-	match check_mliface d with
-	  | `flat -> print ("flat model: " ^ d ^ "\n"); `flat d
-	  | `tree -> print ("tree model: " ^ d ^ "\n"); `tree d
-	  | `not_found -> loop dirs
+	if check_mliface d then
+	  (print ("found: " ^ d ^ "\n"); Some d)
+	else loop dirs
   in
   loop dirs
-
   
 let pxp = check_feature "pxp" (check_pkg "pxp")
 let expat = check_feature "expat" (check_pkg "expat")
@@ -260,9 +244,8 @@ let () =
   fprintf out "# This file has been generated by the configure script\n";
   fprintf out "NATIVE=%b\n" native;
   (match ml_interface with
-    | `no -> fprintf out "ML_INTERFACE=false\n"
-    | `flat d -> fprintf out "ML_INTERFACE=flat\nML_MODULES=%s\n" d
-    | `tree d -> fprintf out "ML_INTERFACE=tree\nML_MODULES=%s\n" d);
+    | Some d -> fprintf out "ML_INTERFACE=true\nOCAML_SRC=%s\n" d
+    | None -> fprintf out "ML_INTERFACE=false\n");
   fprintf out "PXP=%b\n" pxp;
   fprintf out "EXPAT=%b\n" expat;
   fprintf out "CURL=%b\n" curl;

driver/librarian.ml

@@ -249,7 +249,6 @@ let prepare_stub src =
 
 let ocaml_stub stub =
   let pools, types, (c : t) = Marshal.from_string stub 0 in
-  let i1,i2 = Compunit.get_hash c.descr in
   if Tbl.mem tbl c.name then
     failwith ("CDuce unit " ^ (U.get_str c.name) ^ " already loaded");
   Value.intract_all pools;

misc/encodings.ml

@@ -118,10 +118,10 @@ struct
 
   let advance s i =
     match s.[i] with
-      | '\000'..'\127' as c -> i + 1
-      | '\192'..'\223' as c -> i + 2
-      | '\224'..'\239' as c -> i + 3 
-      | '\240'..'\247' as c -> i + 4
+      | '\000'..'\127' -> i + 1
+      | '\192'..'\223' -> i + 2
+      | '\224'..'\239' -> i + 3 
+      | '\240'..'\247' -> i + 4
       | _ -> failwith "Malformed UTF-8 bufffer"
 (*
   let width = Array.create 256 1

ocamliface/Makefile

 # This Makefile generates caml_cduce.cmo/.cmx
-# 
-# We need the units such that typing/types.cmo  (.cmx)
-#
-# - If OCaml has been compiled in a directory DIR,
-#   you can do:
-#     make MODEL=tree PREFIX=DIR
-#   e.g.: make caml_cduce.cmo MODEL=tree PREFIX=$HOME/ocaml-3.07
-#
-# - If you have a (flat) directory DIR will all the compiled units 
-#   from utils/ parsing/ and typing/, you can do:
-#     make MODEL=flat PREFIX=DIR
-#   e.g.: make caml_cduce.cmo MODEL=flat PREFIX=$HOME/godi/lib/ocaml/compiler-lib
+# It must be called with an OCAML_SRC argument pointing to the root
+# of an OCaml source tree.
 
 
-OCAML_OBJECTS=$(patsubst %,$(PREFIX)/%, $(UNITS))
+all: caml_cduce.cmo caml_cduce.cmx
 
-OBJECTS=$(OCAML_OBJECTS)
-XOBJECTS=$(OBJECTS:.cmo=.cmx)
+STDLIB=$(shell ocamlc -where)
 
-ifeq ($(MODEL),flat)
-  UNITS= $(subst utils/,,$(UTILS)) \
-         $(subst parsing/,,$(PARSING)) \
-         $(subst typing/,,$(TYPING))
-  INCLUDES = -I $(PREFIX)
-  ASTTYPES = $(PREFIX)/asttypes.cmi
-else
-ifeq ($(MODEL),tree)
-  UNITS= $(UTILS) $(PARSING) $(TYPING)
-  INCLUDES = -I $(PREFIX)/utils -I $(PREFIX)/parsing -I $(PREFIX)/typing
-  ASTTYPES = $(PREFIX)/parsing/asttypes.cmi
-else
- $(error Set MODEL=flat or MODEL=tree)
-endif
-endif
+ocaml_files:
+	mkdir ocaml_files
+	$(HIDE)cp $(patsubst %,$(OCAML_SRC)/%, $(COPY_FILES)) ocaml_files/
+	cp location.ml ocaml_files
+	mv ocaml_files/asttypes.mli ocaml_files/asttypes.ml
+	sed s=STDLIB=$(STDLIB)= config.ml > ocaml_files/config.ml
 
-caml_cduce.cmo:
+caml_cduce.cmo: ocaml_files
 	@echo "Build $@"
-	$(HIDE)ocamlc -pack -o $@ $(INCLUDES) $(OBJECTS)
+	(cd ocaml_files; ocamlc -for-pack Cduce_lib.Caml_cduce $@ -c $(COMPILE_FILES);\
+	ocamlc -for-pack Cduce_lib -pack -o $@ $(OBJECTS); \
+	cp caml_cduce.cmo caml_cduce.cmi ..)
 
-caml_cduce.cmx:
+caml_cduce.cmx: ocaml_files
 	@echo "Build $@"
-	$(HIDE)ocamlopt -pack -o $@ $(INCLUDES) $(XOBJECTS)
-
-## Hack to rebuild asttypes.ml from asttypes.cmi
-## (because -pack needs .cmo in 3.07)
-
-.PHONY: asttypes.ml
-asttypes.ml: cmi2ml
-	@echo "Create $@"
-	$(HIDE)./cmi2ml Asttypes $(ASTTYPES) > asttypes.ml
-
-asttypes.mli: asttypes.ml
-	cp asttypes.ml asttypes.mli
-
-cmi2ml: cmi2ml.ml
-	@echo "Build $@"
-	$(HIDE)ocamlc -o $@ $(INCLUDES) $(OCAML_OBJECTS) $<
-
-
-UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
-  utils/clflags.cmo utils/consistbl.cmo utils/warnings.cmo utils/terminfo.cmo
-
-PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo parsing/asttypes.cmi
-
-TYPING=typing/ident.cmo typing/path.cmo \
-  typing/primitive.cmo typing/types.cmo \
-  typing/btype.cmo typing/oprint.cmo \
-  typing/subst.cmo typing/predef.cmo \
-  typing/datarepr.cmo typing/env.cmo \
-  typing/ctype.cmo typing/printtyp.cmo
-
+	(cd ocaml_files; ocamlopt -for-pack Cduce_lib.Caml_cduce $@ -c $(COMPILE_FILES);\
+	ocamlopt -for-pack Cduce_lib -pack -o $@ $(XOBJECTS); \
+	cp caml_cduce.cmx caml_cduce.o caml_cduce.cmi ..)
+
+clean:
+	rm -Rf ocaml_files *~ *.cm*
+
+COPY_FILES=\
+  utils/misc.ml utils/tbl.ml \
+  utils/consistbl.ml utils/warnings.ml utils/terminfo.ml utils/clflags.ml \
+  parsing/asttypes.mli parsing/longident.ml \
+  typing/ident.ml typing/path.ml \
+  typing/primitive.ml typing/types.ml \
+  typing/btype.ml typing/oprint.ml \
+  typing/subst.ml typing/predef.ml \
+  typing/datarepr.ml typing/env.ml \
+  typing/ctype.ml typing/ctype.mli typing/printtyp.ml
+
+COMPILE_FILES=\
+  config.ml misc.ml tbl.ml \
+  clflags.ml consistbl.ml warnings.ml terminfo.ml \
+  location.ml asttypes.ml longident.ml \
+  ident.ml path.ml \
+  primitive.ml types.ml \
+  btype.ml oprint.ml \
+  subst.ml predef.ml \
+  datarepr.ml env.ml ctype.mli ctype.ml printtyp.ml
+
+COMPILE_FILES_ML=$(filter %.ml,$(COMPILE_FILES))
+OBJECTS=$(COMPILE_FILES_ML:.ml=.cmo)
+XOBJECTS=$(COMPILE_FILES_ML:.ml=.cmx)
\ No newline at end of file

ocamliface/cdo2ml.ml

-(*
-let list_lit el =
-  List.fold_right (fun a e -> <:expr< [$a$ :: $e$] >>) el <:expr< [] >>
-*)
-
-let () =
-  let str_items = Marshal.from_channel stdin in
-  !Pcaml.print_implem str_items

ocamliface/cmi2ml.ml

-let () =
-  let sg = Env.read_signature Sys.argv.(1) Sys.argv.(2) in
-  Printtyp.signature Format.std_formatter sg

ocamliface/config.ml

+let standard_library = "STDLIB"
+let load_path = ref ([] : string list)
+let cmi_magic_number = "Caml1999I010"
+let bytecomp_c_compiler = ""
+let bytecomp_c_linker = ""

ocamliface/location.ml

+open Lexing
+type t = { loc_start: position; loc_end: position; loc_ghost: bool }

ocamliface/mlcduce_wrapper.ml

-let loc = (Lexing.dummy_pos, Lexing.dummy_pos)
-
-let usage =
-"Usage: mlcduce_wrapper [-I path ...] <primitive file>
-" 
-
-let err s = prerr_endline s; prerr_endline usage; exit 1
-
-
-let rec args = function
-  | "-I"::path::rest ->
-      Librarian.obj_path := path::!Librarian.obj_path;
-      args rest
-  | [p] -> p
-  | _ -> err "Invalid command line"
-
-
-let () =
-  let fn = args (List.tl (Array.to_list Sys.argv)) in
-  let ic = 
-    try open_in fn
-    with Sys_error s -> err s in
-  let v = ref [] in
-  (try while true do 
-     let s = input_line ic in
-     if s <> "" then
-       match s.[0] with
-	 | 'A'..'Z' -> v := s :: !v 
-	 | '#' -> ()
-	 | _ -> err "Names must start with a capitalized letter"
-   done 
-   with End_of_file -> ());
-  let s = Mlstub.gen_wrapper !v in
-  !Pcaml.print_implem [ s,loc ];
-  print_endline "let () = Librarian.obj_path := [";
-  List.iter (fun s -> Printf.printf "  %S;\n" s) !Librarian.obj_path;
-  print_endline " ];;";
-  print_endline "let () = Run.main ();;"
-

ocamliface/mlstub.ml

@@ -77,7 +77,7 @@ let mk_var _ =
 
 let mk_vars = List.map mk_var
 
-let loc = (Lexing.dummy_pos,Lexing.dummy_pos)
+let _loc = (Lexing.dummy_pos,Lexing.dummy_pos)
 
 let let_in p e body =
   <:expr< let $list:[ p, e ]$ in $body$ >>
@@ -348,7 +348,6 @@ and to_ml_descr e = function
 	 | "B",Some x -> `B (t(x))
 	 | _ -> assert false
       *)
-      let x = mk_var () in
       let cases = 
 	List.map 
 	  (function 
@@ -637,7 +636,7 @@ let make_wrapper fn =
    done 
    with End_of_file -> ());
   let s = gen_wrapper !v in
-  !Pcaml.print_implem [ s,loc ];
+  !Pcaml.print_implem [ s,_loc ];
   print_endline "let () = Librarian.obj_path := [";
   List.iter (fun s -> Printf.printf "  %S;\n" s) !Librarian.obj_path;
   print_endline " ];;";

ocamliface/mltypes.ml

@@ -2,8 +2,7 @@ exception Error of string
 
 module Loc = Location
 open Caml_cduce
-open Asttypes
-open Types
+open Caml_cduce.Types
 
 (* Unfolding of OCaml types *)
 
@@ -168,10 +167,10 @@ let rec unfold_constr env p args =
 	       let cstrs =
 		 List.map 
 		   (fun (cst,f) -> (cst,List.map (unfold env) f)) cstrs in
-	       Variant (prefix, cstrs, pub = Public)
+	       Variant (prefix, cstrs, pub = Caml_cduce.Asttypes.Public)
 	   | Type_record (f,_,pub), _ ->
 	       let f = List.map (fun (l,_,t) -> (l,unfold env t)) f in
-	       Record (prefix, f, pub = Public)
+	       Record (prefix, f, pub = Caml_cduce.Asttypes.Public)
 	   | Type_abstract, Some t ->
 	       Link (unfold env t)
 	   | Type_abstract, None ->

parser/parser.ml

@@ -136,45 +136,45 @@ EXTEND
 
   phrase: [
     [ (f,p,e) = let_binding -> 
-	if f then [ mk loc (FunDecl e) ] else
-	  [ mk loc (LetDecl (p,e)) ]
+	if f then [ mk _loc (FunDecl e) ] else
+	  [ mk _loc (LetDecl (p,e)) ]
     | (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
-        [ mk loc (EvalStatement (exp loc (let_in e1 p e2))) ]
-    | "type"; x = located_ident; "="; t = pat -> [ mk loc (TypeDecl (x,t)) ]
+        [ mk _loc (EvalStatement (exp _loc (let_in e1 p e2))) ]
+    | "type"; x = located_ident; "="; t = pat -> [ mk _loc (TypeDecl (x,t)) ]
     | "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] ->
-	[ mk loc (Using (U.mk name, U.mk cu)) ]
+	[ mk _loc (Using (U.mk name, U.mk cu)) ]
     | "open"; ids = LIST1 [ IDENT | keyword ] SEP "." -> 	  
 	let ids = List.map (fun x -> ident x) ids in
-	[ mk loc (Open ids) ]
+	[ mk _loc (Open ids) ]
     | "schema"; name = IDENT; "="; uri = STRING2 ->
 	protect_op "schema";
-        [ mk loc (SchemaDecl (U.mk name, uri)) ]
+        [ mk _loc (SchemaDecl (U.mk name, uri)) ]
     | n = namespace_binding ->
 	let d = match n with
 	    | `Prefix (name,ns) ->  Namespace (name, ns)
 	    | `Keep b -> KeepNs b in
-	[ mk loc d ]
+	[ mk _loc d ]
     | n = namespace_binding; "in"; e2 = expr LEVEL "top" ->
 	let e = 
 	  match n with
 	    | `Prefix (name,ns) -> NamespaceIn (name, ns, e2)
 	    | `Keep b -> KeepNsIn (b,e2)
 	in
-	[ mk loc (EvalStatement (exp loc e)) ]
-    | "debug"; d = debug_directive -> [ mk loc (Directive (`Debug d)) ]
-    | "#"; IDENT "verbose" -> [ mk loc (Directive `Verbose) ]
-    | "#"; IDENT "silent" -> [ mk loc (Directive `Silent) ]
+	[ mk _loc (EvalStatement (exp _loc e)) ]
+    | "debug"; d = debug_directive -> [ mk _loc (Directive (`Debug d)) ]
+    | "#"; IDENT "verbose" -> [ mk _loc (Directive `Verbose) ]
+    | "#"; IDENT "silent" -> [ mk _loc (Directive `Silent) ]
     | "#"; IDENT "utf8" -> Ulexer.enc := Ulexing.Utf8; [ ]
     | "#"; IDENT "latin1" -> Ulexer.enc := Ulexing.Latin1; [ ]
     | "#"; IDENT "ascii" -> Ulexer.enc := Ulexing.Ascii; [ ]
-    | "#"; IDENT "quit" -> [ mk loc (Directive `Quit) ]
-    | "#"; IDENT "env" -> [ mk loc (Directive `Env) ]
+    | "#"; IDENT "quit" -> [ mk _loc (Directive `Quit) ]
+    | "#"; IDENT "env" -> [ mk _loc (Directive `Env) ]
     | "#"; IDENT "print_type"; t = pat ->
-        [ mk loc (Directive (`Print_type t)) ]
-    | "#"; IDENT "dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
-    | "#"; IDENT "reinit_ns" -> [ mk loc (Directive `Reinit_ns) ]
-    | "#"; IDENT "help" -> [ mk loc (Directive `Help) ]
-    | "#"; IDENT "builtins" -> [ mk loc (Directive `Builtins) ]
+        [ mk _loc (Directive (`Print_type t)) ]
+    | "#"; IDENT "dump_value"; e = expr -> [ mk _loc (Directive (`Dump e)) ]
+    | "#"; IDENT "reinit_ns" -> [ mk _loc (Directive `Reinit_ns) ]
+    | "#"; IDENT "help" -> [ mk _loc (Directive `Help) ]
+    | "#"; IDENT "builtins" -> [ mk _loc (Directive `Builtins) ]
     | "include"; s = STRING2 ->
 	let s = 
 	  if Filename.is_relative s 
@@ -204,7 +204,7 @@ EXTEND
 	       include_stack := List.tl !include_stack)
 	)
     ] | 
-    [ e = expr -> [ mk loc (EvalStatement e) ]
+    [ e = expr -> [ mk _loc (EvalStatement e) ]
     ]
   ];
 
@@ -234,43 +234,43 @@ EXTEND
   expr: [
     "top" RIGHTA
     [ "match"; e = SELF; "with"; b = branches -> 
-	exp loc (Match (e,b))
+	exp _loc (Match (e,b))
     | "try"; e = SELF; "with"; b = branches -> 
-	exp loc (Try (e,b))
+	exp _loc (Try (e,b))
     | "map"; e = SELF; "with"; b = branches -> 
-	exp loc (Map (e,b))
+	exp _loc (Map (e,b))
     | "xtransform"; e = SELF; "with"; b = branches -> 
-	exp loc (Xtrans (e,b))
+	exp _loc (Xtrans (e,b))
     | "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
-	exp loc (if_then_else e e1 e2)
+	exp _loc (if_then_else e e1 e2)
     | "transform"; e = SELF; "with"; b = branches -> 
-	exp loc (Transform (e,b))
+	exp _loc (Transform (e,b))
     | "validate"; e = SELF; "with"; (schema, typ) = schema_ref ->
-        exp loc (Validate (e, [schema;typ]))
+        exp _loc (Validate (e, [schema;typ]))
     | "select"; e = SELF; "from"; 
       l = LIST1 [ x = pat ; "in"; e = expr -> (x,e)] SEP "," ;
       cond = [ "where"; c = LIST1 [ expr ] SEP "and" -> c 
-	     | -> [] ] -> exp loc (SelectFW (e,l,cond)) 
+	     | -> [] ] -> exp _loc (SelectFW (e,l,cond)) 
     | "fun"; (f,a,b) = fun_decl ->
-	exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
+	exp _loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
     | (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
-        exp loc (let_in e1 p e2)
+        exp _loc (let_in e1 p e2)
     | n = namespace_binding; "in"; e2 = expr LEVEL "top" ->
 	(match n with
-	   | `Prefix (name,ns) -> exp loc (NamespaceIn (name, ns, e2))
-	   | `Keep f -> exp loc (KeepNsIn (f,e2)))
+	   | `Prefix (name,ns) -> exp _loc (NamespaceIn (name, ns, e2))
+	   | `Keep f -> exp _loc (KeepNsIn (f,e2)))
     | e = expr; ":"; p = pat ->
-	exp loc (Forget (e,p))
+	exp _loc (Forget (e,p))
     | e = expr; ":"; "?"; p = pat ->
-	exp loc (Check (e,p))
+	exp _loc (Check (e,p))
     | e1 = expr; ";"; e2 = expr ->
-	exp loc (seq e1 e2) 
+	exp _loc (seq e1 e2) 
     | "ref"; p = pat; e = expr ->
-	exp loc (Ref (e,p))
-    | "not"; e = expr -> exp loc (logical_not e)
+	exp _loc (Ref (e,p))
+    | "not"; e = expr -> exp _loc (logical_not e)
     ]
     |
-    [ e1 = expr; ":="; e2 = expr -> exp loc (set_ref e1 e2)
+    [ e1 = expr; ":="; e2 = expr -> exp _loc (set_ref e1 e2)
     ]
     | 
     [ e1 = expr; op = ["=" | "<=" | "<<" | ">>" | ">=" ]; e2 = expr -> 
@@ -278,38 +278,38 @@ EXTEND
 	  | "<<" -> "<"
 	  | ">>" -> ">"
 	  | s -> s in
-	apply_op2 loc op e1 e2
+	apply_op2 _loc op e1 e2
     ]
 
     | 
-    [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr -> apply_op2 loc op e1 e2
-    | e1 = expr; ["||" | "or"]; e2 = expr -> exp loc (logical_or e1 e2)
+    [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr -> apply_op2 _loc op e1 e2
+    | e1 = expr; ["||" | "or"]; e2 = expr -> exp _loc (logical_or e1 e2)
     | e = expr; "\\"; l = [IDENT | keyword ] -> 
-	exp loc (RemoveField (e, label l)) 
+	exp _loc (RemoveField (e, label l)) 
     ]
     |
-    [ e1 = expr; op = ["*"]; e2 = expr -> apply_op2 loc op e1 e2
-    | e1 = expr; "&&"; e2 = expr -> exp loc (logical_and e1 e2)
+    [ e1 = expr; op = ["*"]; e2 = expr -> apply_op2 _loc op e1 e2
+    | e1 = expr; "&&"; e2 = expr -> exp _loc (logical_and e1 e2)
     | e = expr; op = "/"; p = pat LEVEL "simple" ->
 	(* transform e with <(Atom)>[($$$::t|_)*] -> [$$$] *)
-	let tag = mk loc (Internal (Types.atom (Atoms.any))) in
-	let att = mk loc (Internal Types.Record.any) in
-	let any = mk loc (Internal Types.any) in
+	let tag = mk _loc (Internal (Types.atom (Atoms.any))) in
+	let att = mk _loc (Internal Types.Record.any) in
+	let any = mk _loc (Internal Types.any) in
 	let re = Star(Alt(SeqCapture(noloc,id_dummy,Elem p), Elem any)) in
-	let ct = mk loc (Regexp re) in
-        let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
-	exp loc (Transform (e,[p, Var id_dummy]))
+	let ct = mk _loc (Regexp re) in
+        let p = mk _loc (XmlT (tag, multi_prod _loc [att;ct])) in
+	exp _loc (Transform (e,[p, Var id_dummy]))
     | e = expr; "/@"; a = [IDENT|keyword] ->
 	(* transform e with <(Atom) {a=$$$}>_ -> [$$$] *)
-        let tag = mk loc (Internal (Types.atom Atoms.any)) in
-        let any = mk loc (Internal Types.any) in
-        let att = mk loc (Record
+        let tag = mk _loc (Internal (Types.atom Atoms.any)) in
+        let any = mk _loc (Internal Types.any) in
+        let att = mk _loc (Record
 			    (true, [(label a,
-				     (mk loc (PatVar [id_dummy]),
+				     (mk _loc (PatVar [id_dummy]),
 				      None))])) in
-        let p = mk loc (XmlT (tag, multi_prod loc [att;any])) in
+        let p = mk _loc (XmlT (tag, multi_prod _loc [att;any])) in
         let t = (