Commit a4967d75 authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
parent bd51ba1e
0.4.0
- Adapted to OCaml 3.09.
- To build the OCaml/CDuce interface, OCaml sources are now needed.
0.3.92
- Tools:
......
......@@ -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
......
......@@ -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
......@@ -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;
......
......@@ -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;
......
......@@ -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
......
# 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
(*
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
let () =
let sg = Env.read_signature Sys.argv.(1) Sys.argv.(2) in
Printtyp.signature Format.std_formatter sg
let standard_library = "STDLIB"
let load_path = ref ([] : string list)
let cmi_magic_number = "Caml1999I010"
let bytecomp_c_compiler = ""
let bytecomp_c_linker = ""
open Lexing
type t = { loc_start: position; loc_end: position; loc_ghost: bool }
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 ();;"
......@@ -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 " ];;";
......
......@@ -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 ->
......
......@@ -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