Commit 5dd9400e authored by Pietro Abate's avatar Pietro Abate

[r2007-06-12 12:58:41 by afrisch] starting to upgrade to OCaml 3.10

Original author: afrisch
Date: 2007-06-12 12:59:44+00:00
parent 36908774
......@@ -66,14 +66,14 @@ ifeq ($(NATIVE), true)
EXTENSION_LIB = cmxa
CAML=ocamlopt
COMPILE = $(CAMLOPT)
LINK = $(CAMLOPT) -linkpkg gramlib.cmxa camlp4.cmxa pr_o.cmx
LINK = $(CAMLOPT) -linkpkg camlp4lib.cmxa
SYNTAX += -symbol ocaml_compiler=\"native\"
else
EXTENSION = cmo
EXTENSION_LIB = cma
COMPILE = $(CAMLC)
CAML=ocamlc
LINK = $(CAMLC) -custom -linkpkg gramlib.cma camlp4.cma pr_o.cmo
LINK = $(CAMLC) -custom -linkpkg camlp4lib.cma
SYNTAX += -symbol ocaml_compiler=\"bytecode\"
endif
......@@ -131,7 +131,7 @@ CLEAN_DIRS = $(DIRS) tools tests
# Objects to build
OBJECTS = \
driver/config.cmo misc/stats.cmo misc/custom.cmo misc/encodings.cmo \
driver/cduce_config.cmo misc/stats.cmo misc/custom.cmo misc/encodings.cmo \
misc/upool.cmo misc/pretty.cmo misc/ns.cmo misc/imap.cmo misc/html.cmo \
\
types/compunit.cmo types/sortedList.cmo misc/bool.cmo types/ident.cmo \
......@@ -151,7 +151,7 @@ OBJECTS = \
compile/lambda.cmo \
runtime/run_dispatch.cmo runtime/explain.cmo runtime/eval.cmo \
\
parser/location.cmo parser/url.cmo \
parser/cduce_loc.cmo parser/url.cmo \
parser/ulexer.cmo parser/ast.cmo parser/parser.cmo \
\
typing/typed.cmo typing/typepat.cmo types/externals.cmo typing/typer.cmo \
......@@ -281,7 +281,7 @@ $(ALL_INTERFACES): misc/q_symbol.cmo
misc/q_symbol.cmo: misc/q_symbol.ml
@echo "Build $@"
$(HIDE)$(CAMLC) -c -pp 'camlp4o pa_extend.cmo q_MLast.cmo' $<
$(HIDE)$(CAMLC) -c -pp camlp4orf $<
.ml.cmo:
@echo "Build $@"
......
......@@ -174,7 +174,7 @@ let compile_rec_funs env funs =
(****************************************)
open Location
open Cduce_loc
let eval ~run ~show (tenv,cenv,codes) e =
let (e,t) = Typer.type_expr tenv e in
......
open Location
open Cduce_loc
type type_fun = Types.t -> bool -> Types.t
let register op arity typ eval =
......
open Location
open Cduce_loc
type type_fun = Types.t -> bool -> Types.t
val register:
......
This diff is collapsed.
open Location
open Cduce_loc
open Ident
let () = Stats.gettimeofday := Unix.gettimeofday
......@@ -79,8 +79,8 @@ let directive_help ppf =
let rec print_exn ppf = function
| Location (loc, w, exn) ->
Location.print_loc ppf (loc,w);
Location.html_hilight (loc,w);
Cduce_loc.print_loc ppf (loc,w);
Cduce_loc.html_hilight (loc,w);
print_exn ppf exn
| Value.CDuceExn v ->
Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@."
......@@ -121,9 +121,9 @@ let rec print_exn ppf = function
U.print (Librarian.name cu)
Ident.print x
| Ulexer.Error (i,j,s) ->
let loc = Location.loc_of_pos (i,j), `Full in
Location.print_loc ppf loc;
Location.html_hilight loc;
let loc = Cduce_loc.loc_of_pos (i,j), `Full in
Cduce_loc.print_loc ppf loc;
Cduce_loc.html_hilight loc;
Format.fprintf ppf "%s" s
| Parser.Error s | Stream.Error s ->
Format.fprintf ppf "Parsing error: %a@." print_protect s
......@@ -145,7 +145,7 @@ let rec print_exn ppf = function
Format.fprintf ppf "Invalid object file %s@." f
| Librarian.CannotOpen f ->
Format.fprintf ppf "Cannot open file %s@." f
| Location.Generic s ->
| Cduce_loc.Generic s ->
Format.fprintf ppf "%a@." print_protect s
| Ns.Label.Not_unique ((ns1,s1),(ns2,s2)) ->
Format.fprintf ppf "Collision on label hash: {%a}:%a, {%a}:%a"
......
......@@ -35,19 +35,19 @@ let () =
ignore (Unix.alarm 10);
Sys.set_signal Sys.sigalrm
(Sys.Signal_handle (fun _ -> raise (Cduce.Escape Timeout)));
let v = Location.get_viewport () in
let v = Cduce_loc.get_viewport () in
let ppf = Html.ppf v
and input = Stream.of_string src in
Format.pp_set_margin ppf 60;
Location.push_source (`String src);
Location.set_protected true;
Config.init_all ();
Cduce_loc.push_source (`String src);
Cduce_loc.set_protected true;
Cduce_config.init_all ();
let ok = Cduce.script ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
Html.get v
in
Location.set_viewport (Html.create true);
Cduce_loc.set_viewport (Html.create true);
let prog = Buffer.create 1024 in
(try while true do Buffer.add_string prog (read_line ()); Buffer.add_string prog "\n" done;
with End_of_file -> ());
......
open Location
open Cduce_loc
open Ident
......@@ -77,17 +77,17 @@ let show ppf id t v =
let compile verbose name src =
protect_op "Compile external file";
let ic =
if src = "" then (Location.push_source `Stream; stdin)
if src = "" then (Cduce_loc.push_source `Stream; stdin)
else
try Location.push_source (`File src); open_in src
try Cduce_loc.push_source (`File src); open_in src
with Sys_error _ -> raise (CannotOpen src) in
let input = Stream.of_channel ic in
let p =
try Parser.prog input
with
| Stdpp.Exc_located (_, (Location _ | Ulexer.Error _ as e)) -> raise e
| Stdpp.Exc_located ((i,j), e) ->
raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
| Ulexer.Loc.Exc_located (_, (Location _ | Ulexer.Error _ as e)) -> raise e
| Ulexer.Loc.Exc_located ((i,j), e) ->
raise_loc i j e
in
if src <> "" then close_in ic;
......
......@@ -15,7 +15,7 @@ let version () =
Printf.eprintf "built on %s\n" <:symbol<build_date>>;
Printf.eprintf "using OCaml %s compiler\n" <:symbol<ocaml_compiler>>;
Printf.eprintf "Supported features: \n";
List.iter (fun (n,d) -> Printf.eprintf "- %s: %s\n" n d) (Config.descrs ());
List.iter (fun (n,d) -> Printf.eprintf "- %s: %s\n" n d) (Cduce_config.descrs ());
exit 0
let specs =
......@@ -29,7 +29,7 @@ let specs =
"(for --compile) show types of exported values";
"--obj-dir", Arg.String (fun s -> out_dir := s :: !out_dir),
"(for --compile) directory for the compiled .cdo file";
"-I", Arg.String (fun s -> Location.obj_path := s::!Location.obj_path),
"-I", Arg.String (fun s -> Cduce_loc.obj_path := s::!Cduce_loc.obj_path),
" add one directory to the lookup path for .cdo/.cmi and include files";
"--stdin", Arg.Unit (fun () -> src := "" :: !src),
" read CDuce script on standard input";
......@@ -40,7 +40,7 @@ let specs =
src := s :: !src)
else args := s :: !args),
" the first argument after is the source, then the arguments";
"--no", Arg.String Config.inhibit,
"--no", Arg.String Cduce_config.inhibit,
" disable a feature (cduce -v to get a list of features)";
"--debug", Arg.Unit (fun () -> Stats.set_verbosity Stats.Summary),
" print profiling/debugging information";
......@@ -124,7 +124,7 @@ let toploop () =
Cduce.toplevel := true;
Librarian.run_loaded := true;
let buf_in = Buffer.create 1024 in
Location.push_source (`Buffer buf_in);
Cduce_loc.push_source (`Buffer buf_in);
let read _i =
if !bol then
if !Ulexer.in_comment then outflush "* " else outflush "> ";
......@@ -151,26 +151,26 @@ let argv args =
let main () =
at_exit (fun () -> Stats.dump Format.std_formatter);
Location.set_viewport (Html.create false);
Cduce_loc.set_viewport (Html.create false);
match mode () with
| `Toplevel args ->
Config.init_all ();
Cduce_config.init_all ();
Builtin.argv := argv args;
toploop ()
| `Script (f,args) ->
Config.init_all ();
Cduce_config.init_all ();
Builtin.argv := argv args;
Cduce.compile_run f
| `Compile (f,o) ->
Config.init_all ();
Cduce_config.init_all ();
Cduce.compile f o
| `Run (f,args) ->
Config.init_all ();
Cduce_config.init_all ();
Builtin.argv := argv args;
Cduce.run f
| `Mlstub f ->
Config.init_all ();
Cduce_config.init_all ();
Librarian.prepare_stub f
| `Topstub f ->
Config.init_all ();
Cduce_config.init_all ();
!Librarian.make_wrapper f
......@@ -129,11 +129,11 @@ let main (cgi : Netcgi.std_activation) =
let dialog content = html_form p content in
let exec src =
let v = Location.get_viewport () in
let v = Cduce_loc.get_viewport () in
let ppf = Html.ppf v
and input = Stream.of_string src in
Location.push_source (`String src);
Location.set_protected true;
Cduce_loc.push_source (`String src);
Cduce_loc.set_protected true;
let ok = Cduce.script ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
......@@ -144,7 +144,7 @@ let main (cgi : Netcgi.std_activation) =
dialog src
in
Location.set_viewport (Html.create true);
Cduce_loc.set_viewport (Html.create true);
html_header p;
let prog = cgi # argument_value "prog" in
(match cmd with
......
open Camlp4.PreCast
module Caml_syntax = Syntax
let symbols = ref []
let define s =
let i =
try String.index s '='
with Not_found -> failwith ("Invalid symbol definition :" ^ s) in
symbols :=
(String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1)) ::
!symbols
let symbol = String.sub s 0 i in
let value =
Gram.parse_string
Caml_syntax.expr (Loc.mk "<from-string>") (String.sub s (i + 1) (String.length s - i - 1))
in
symbols := (symbol, value) :: !symbols
EXTEND
GLOBAL: Pcaml.str_item;
EXTEND Caml_syntax.Gram
GLOBAL: Caml_syntax.str_item;
Pcaml.str_item: FIRST
Caml_syntax.str_item: FIRST
[ [ "ifdef"; c = UIDENT; "then"; e1 = SELF;
"else"; e2 = SELF ->
if List.mem_assoc c !symbols then e1 else e2
| "ifdef"; c = UIDENT; "then"; e1 = SELF ->
if List.mem_assoc c !symbols then e1 else <:str_item< declare end >>
if List.mem_assoc c !symbols then e1 else <:str_item<>>
| "ifndef"; c = UIDENT; "then"; e1 = SELF;
"else"; e2 = SELF ->
if List.mem_assoc c !symbols then e2 else e1
| "ifndef"; c = UIDENT; "then"; e1 = SELF ->
if List.mem_assoc c !symbols then <:str_item< declare end >> else e1
if List.mem_assoc c !symbols then <:str_item<>> else e1
] ];
END
let expr _ s =
let expr _ _ s =
try List.assoc s !symbols
with Not_found -> failwith ("No definition for symbol " ^ s)
let _ =
Quotation.add "symbol" (Quotation.ExStr expr);
Pcaml.add_option "-symbol" (Arg.String define)
Quotation.add "symbol" Quotation.DynAst.expr_tag expr;
Camlp4.Options.add "-symbol" (Arg.String define)
"<symbol=value> Define a symbol"
......@@ -516,29 +516,20 @@ let stub ty_env c_env exts values mk prolog =
let items_expr = List.map (fun (_,e,_) -> e) items in
let items_pat = List.map (fun (p,_,_) -> p) items in
let m =
[ <:str_item< open Cduce_lib >>;
<:str_item< Config.init_all () >>;
<:str_item<
value (types,set_externals,slots,run) =
Librarian.ocaml_stub $str:String.escaped raw$ >> ] @
(if g = [] then [] else [ <:str_item< value rec $list:g$ >> ]) @
[ <:str_item< set_externals [|$list:exts$|] >>;
<:str_item< run () >> ] @
(if items = [] then [] else [ <:str_item< value $list:items_def$ >> ]) in
let items_expr =
match items_expr with
| [] -> <:expr< () >>
| l -> <:expr< ($list:l$) >> in
let str_items =
[ <:str_item<
value ($list:items_pat$) =
let module C = struct
$list:m$
end in $items_expr$ >>, (Lexing.dummy_pos, Lexing.dummy_pos) ] in
<:str_item<
value ($paCom_of_list items_pat$) =
let module C = struct
open Cduce_lib;
Cduce_config.init_all ();
value (types,set_externals,slots,run) =
Librarian.ocaml_stub $str:String.escaped raw$;
value rec $biAnd_of_list g$;
set_externals [|$exSem_of_list exts$|];
run ();
value $biAnd_of_list items_def$;
end in ($exCom_of_list items_expr$) >> in
print_endline prolog;
!Pcaml.print_implem str_items
(* let exe = Filename.concat (Filename.dirname Sys.argv.(0)) "cdo2ml" in
......@@ -599,12 +590,12 @@ let wrapper values =
values in
let g = global_transl () in
let m = if g = [] then exts else <:str_item< value rec $list:g$ >>::exts in
let m = [ <:str_item< open Cduce_lib >>;
<:str_item< Config.init_all () >>] @ m in
<:str_item< declare $list:m$ end >>
<:str_item<
open Cduce_lib;
Cduce_config.init_all ();
value rec $biAnd_of_list g$;
$stSem_of_list exts$;
>>
let gen_wrapper vals =
try
......
(* Abstract syntax as produced by the parser *)
open Location
open Cduce_loc
open Ident
type ns_expr = [ `Uri of Ns.Uri.t | `Path of U.t list ]
......@@ -9,7 +9,7 @@ type pprog = pmodule_item list
and pmodule_item = pmodule_item' located
and pmodule_item' =
| TypeDecl of (Location.loc * U.t) * ppat
| TypeDecl of (Cduce_loc.loc * U.t) * ppat
| SchemaDecl of U.t * string
| LetDecl of ppat * pexpr
| FunDecl of pexpr
......@@ -86,7 +86,7 @@ and pexpr =
and label = U.t
and abstr = {
fun_name : (Location.loc * U.t) option;
fun_name : (Cduce_loc.loc * U.t) option;
fun_iface : (ppat * ppat) list;
fun_body : branches
}
......@@ -100,7 +100,7 @@ and ppat' =
| PatVar of U.t list
| Cst of pexpr
| NsT of U.t
| Recurs of ppat * (Location.loc * U.t * ppat) list
| Recurs of ppat * (Cduce_loc.loc * U.t * ppat) list
| Internal of Types.descr
| Or of ppat * ppat
| And of ppat * ppat
......@@ -123,7 +123,7 @@ and regexp =
| Alt of regexp * regexp
| Star of regexp
| WeakStar of regexp
| SeqCapture of Location.loc * U.t * regexp
| SeqCapture of Cduce_loc.loc * U.t * regexp
let pat_true = mknoloc (Internal Builtin_defs.true_type)
......
......@@ -11,7 +11,7 @@ let load_url s =
let () =
Config.register
Cduce_config.register
"curl"
"Load external URLs with curl"
(fun () -> Url.url_loader := load_url)
......@@ -108,7 +108,7 @@ let extr s i j =
try
let n = min (String.length s) j - i in
if n <= 0 then "" else String.sub s i n
with e -> failwith (Printf.sprintf "Location.extr len=%i i=%i j=%i"
with e -> failwith (Printf.sprintf "Cduce_loc.extr len=%i i=%i j=%i"
(String.length s) i j )
let dump_loc ((src,i,j),w) =
......@@ -152,7 +152,7 @@ let html_hilight ((src,i,j),w) =
type 'a located = { loc : loc; descr : 'a }
let mk (i,j) x = { loc = (!source,i,j); descr = x }
let mk_located (i,j) x = { loc = (!source,i,j); descr = x }
let mk_loc loc x = { loc = loc; descr = x }
let mknoloc x = { loc = noloc; descr = x }
let loc_of_pos (i,j) = (!source,i,j)
......@@ -178,3 +178,6 @@ let resolve_filename s =
Filename.concat p s
with Not_found -> s
else s
include Camlp4.PreCast.Loc
(* Locations in source file,
and presentation of results and errors *)
(* include Camlp4.Sig.Loc *)
type source =
[ `None | `File of string | `Stream | `String of string
| `Buffer of Buffer.t ]
......@@ -37,7 +39,7 @@ val dump_loc: loc * precise -> unit
val html_hilight: loc * precise -> unit
type 'a located = { loc : loc; descr : 'a }
val mk: int * int -> 'a -> 'a located
val mk_located: int * int -> 'a -> 'a located
val mk_loc: loc -> 'a -> 'a located
val mknoloc: 'a -> 'a located
......
......@@ -29,7 +29,7 @@ let load_url s =
error msg
let () =
Config.register
Cduce_config.register
"netclient"
"Load external URLs with netclient"
(fun () -> Url.url_loader := load_url)
#load "pa_extend.cmo";;
open Location
open Cduce_loc
(* let raise = Pervasives.raise *)
open Ast
open Ident
open Printf
open Ulexer
(*
let () = Grammar.error_verbose := true
*)
let tloc (i,j) = (i.Lexing.pos_cnum,j.Lexing.pos_cnum)
let nopos = (Lexing.dummy_pos, Lexing.dummy_pos)
let tloc (i,j) = (i,j)
let nopos = (-1,-1)
let mk loc x = Location.mk (tloc loc) x
let mk loc x = Cduce_loc.mk_located (tloc loc) x
exception Error of string
let error (i,j) s = Location.raise_loc i j (Error s)
let error (i,j) s = Cduce_loc.raise_loc i j (Error s)
let error loc s = error (tloc loc) s
let gram = Grammar.gcreate Ulexer.lex
module Gram = Camlp4.Struct.Grammar.Static.Make(Ulexer)
let id_dummy = U.mk "$$$"
......@@ -36,14 +38,14 @@ let ident s =
let label s = U.mk (ident s)
let ident s = U.mk (ident s)
let prog = Grammar.Entry.create gram "prog"
let top_phrases = Grammar.Entry.create gram "toplevel phrases"
let expr = Grammar.Entry.create gram "expression"
let pat = Grammar.Entry.create gram "type/pattern expression"
let regexp = Grammar.Entry.create gram "type/pattern regexp"
let keyword = Grammar.Entry.create gram "keyword"
let prog = Gram.Entry.mk "prog"
let top_phrases = Gram.Entry.mk "toplevel phrases"
let expr = Gram.Entry.mk "expression"
let pat = Gram.Entry.mk "type/pattern expression"
let regexp = Gram.Entry.mk "type/pattern regexp"
let keyword = Gram.Entry.mk "keyword"
let lop pos = loc_of_pos (tloc pos)
let lop pos = Cduce_loc.loc_of_pos (tloc pos)
let exp pos e = LocatedExpr (lop pos,e)
let rec multi_prod loc = function
......@@ -86,24 +88,26 @@ let protect_exn f g =
let localize_exn f =
try f ()
with
| Stdpp.Exc_located (_, (Location _ as e)) -> raise e
(* | Stdpp.Exc_located ((i,j), e) -> raise_loc i j e *)
| Stdpp.Exc_located ((i,j), e) -> raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
| Ulexer.Loc.Exc_located (_, (Location _ as e)) -> raise e
(* | Camlp4.PreCast.Loc.Exc_located ((i,j), e) -> raise_loc i j e *)
| Ulexer.Loc.Exc_located (loc, e) ->
let i, j = Ulexer.Loc.start_off loc, Ulexer.Loc.stop_off loc in
raise_loc i j e
let is_fun_decl =
Grammar.Entry.of_parser gram "[is_fun_decl]"
Gram.Entry.of_parser "[is_fun_decl]"
(fun strm ->
match Stream.npeek 3 strm with
| [ ("", "fun"); ("IDENT", _); ("", "(") ]
| [ ("IDENT", _) ; ("", "(") ; _ ] -> ()
| [ KEYWORD "fun", _; IDENT _, _; KEYWORD "(", _ ]
| [ IDENT _, _; KEYWORD "(", _; _ ] -> ()
| _ -> raise Stream.Failure
)
let is_capture =
Grammar.Entry.of_parser gram "[is_capture]"
Gram.Entry.of_parser "[is_capture]"
(fun strm ->
match Stream.npeek 2 strm with
| [ ("IDENT", _) ; ("", "::") ; _ ] -> ()
| [ IDENT _, _; KEYWORD "::", _; _ ] -> ()
| _ -> raise Stream.Failure
)
......@@ -123,7 +127,7 @@ let let_in e1 p e2 = Match (e1, [p,e2])
let seq e1 e2 = let_in e1 pat_nil e2
let concat e1 e2 = apply_op2_noloc "@" e1 e2
EXTEND
EXTEND Gram
GLOBAL: top_phrases prog expr pat regexp keyword;
top_phrases: [
......@@ -131,7 +135,7 @@ EXTEND
];
prog: [
[ l = LIST0 [ p = phrase ; OPT ";;" -> p ]; EOI -> List.flatten l ]
[ l = LIST0 [ p = phrase ; OPT ";;" -> p ]; `EOI -> List.flatten l ]
];
phrase: [
......@@ -141,9 +145,9 @@ EXTEND
| (_,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)) ]
| "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] ->
| "using"; name = IDENT; "="; cu = [ x = IDENT -> x | x = STRING2 -> x ] ->
[ mk _loc (Using (U.mk name, U.mk cu)) ]
| "open"; ids = LIST1 [ IDENT | keyword ] SEP "." ->
| "open"; ids = LIST1 ident_or_keyword SEP "." ->
let ids = List.map (fun x -> ident x) ids in
[ mk _loc (Open ids) ]
| "schema"; name = IDENT; "="; uri = STRING2 ->
......@@ -177,14 +181,14 @@ EXTEND
| "#"; IDENT "builtins" -> [ mk _loc (Directive `Builtins) ]
| "include"; s = STRING2 ->
protect_op "File inclusion";
let s = Location.resolve_filename s in
let s = Cduce_loc.resolve_filename s in
(* avoid looping; should issue an error ? *)
(* it is possible to have looping with x/../x/../x/.. ....
Need to canonicalize filename *)
if List.mem s !include_stack then []
else (
include_stack := s :: !include_stack;
Location.push_source (`File s);
Cduce_loc.push_source (`File s);
let saved_enc = !Ulexer.enc in
Ulexer.enc := Ulexing.Latin1;
protect_exn
......@@ -193,11 +197,11 @@ EXTEND
protect_exn
(fun () ->
let input = Stream.of_channel chan in
localize_exn (fun () -> Grammar.Entry.parse prog input))
localize_exn (fun () -> Gram.parse prog Ulexer.Loc.ghost input))
(fun () -> close_in chan))
(fun () ->
Ulexer.enc := saved_enc;
Location.pop_source ();
Cduce_loc.pop_source ();
include_stack := List.tl !include_stack)
)
] |
......@@ -228,6 +232,11 @@ EXTEND
]
];
ident_or_keyword: [
[ s = IDENT -> s
| s = keyword -> s ]
];
expr: [
"top" RIGHTA
[ "match"; e = SELF; "with"; b = branches ->
......@@ -281,7 +290,7 @@ EXTEND
|
[ 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 ] ->
| e = expr; "\\"; l = ident_or_keyword ->
exp _loc (RemoveField (e, label l))
]
|
......@@ -296,7 +305,7 @@ EXTEND
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] ->
| e = expr; "/@"; a = ident_or_keyword ->
(* transform e with <(Atom) {a=$$$}>_ -> [$$$] *)
let tag = mk _loc (Internal (Types.atom Atoms.any)) in
let any = mk _loc (Internal Types.any) in
......@@ -350,7 +359,7 @@ EXTEND
| "no_appl"
[ e = expr; "."; l = [IDENT | keyword ];
[ e = expr; "."; l = ident_or_keyword;
tyargs = [ "with"; "{"; tyargs = LIST0 pat; "}" -> Some tyargs
| -> None ] ->
let e = Dot (e,label l) in
......@@ -391,11 +400,11 @@ EXTEND
];
tag: [ [ a = [ IDENT | keyword ] -> exp _loc (Atom (ident a)) ] ];
tag: [ [ a = ident_or_keyword -> exp _loc (Atom (ident a)) ] ];
tag_type: [
[ "_" -> mk _loc (Internal (Types.atom Atoms.any))
| a = [ IDENT | keyword ] -> mk _loc (Cst (Atom (ident a)))
| a = ident_or_keyword -> mk _loc (Cst (Atom (ident a)))
| t = ANY_IN_NS -> mk _loc (NsT (ident t))
]
];
......@@ -412,7 +421,7 @@ EXTEND
namespace_binding: [
[ "namespace"; r = [
[ name =
[ name = [ IDENT | keyword ]; "=" -> ident name
[ name = ident_or_keyword; "=" -> ident name
| -> U.mk "" ];
ns = ns_expr -> `Prefix (name,ns)
| IDENT "on" -> `Keep true
......@@ -422,7 +431,7 @@ EXTEND
ns_expr: [
[ uri = STRING2 -> `Uri (Ns.Uri.mk (ident uri))
| ids = LIST1 [ IDENT | keyword ] SEP "." ->
| ids = LIST1 ident_or_keyword SEP "." ->
let ids = List.map (fun x -> ident x) ids in
`Path ids ]
];
......@@ -573,11 +582,11 @@ EXTEND
];
schema_ref: [
[ schema = IDENT; "."; typ = [ IDENT | keyword ] -> (U.mk schema, ident typ)
[ schema = IDENT; "."; typ = ident_or_keyword -> (U.mk schema, ident typ)
]
];
located_ident: [ [ a = [IDENT|keyword] -> (lop _loc,ident a) ] ];
located_ident: [ [ a = ident_or_keyword -> (lop _loc,ident a) ] ];
pat: [