diff options
Diffstat (limited to 'camlp4/ocaml_src')
27 files changed, 2334 insertions, 1169 deletions
diff --git a/camlp4/ocaml_src/camlp4/Makefile b/camlp4/ocaml_src/camlp4/Makefile index 7ea191f41..7d770e626 100644 --- a/camlp4/ocaml_src/camlp4/Makefile +++ b/camlp4/ocaml_src/camlp4/Makefile @@ -5,7 +5,7 @@ include ../../config/Makefile SHELL=/bin/sh INCLUDES=-I ../odyl -I ../../boot -I $(OTOP)/utils -I $(OTOP)/parsing -I $(OTOP)/otherlibs/dynlink -OCAMLCFLAGS= $(INCLUDES) -warn-error A +OCAMLCFLAGS= $(INCLUDES) -warn-error A $(INCLUDES) LINKFLAGS=$(INCLUDES) INTERFACES=-I $(OLIBDIR) Arg Array ArrayLabels Buffer Callback CamlinternalOO Char Complex Digest Filename Format Gc Genlex Hashtbl Int32 Int64 Lazy Lexing List ListLabels Map Marshal MoreLabels Nativeint Obj Oo Parsing Pervasives Printexc Printf Queue Random Scanf Set Sort Stack StdLabels Stream String StringLabels Sys Weak -I ../../boot Extfold Extfun Fstream Gramext Grammar Plexer Stdpp Token -I $(OTOP)/utils Config Warnings -I $(OTOP)/parsing Asttypes Location Longident Parsetree -I . Ast2pt MLast Pcaml Quotation Spretty CAMLP4_INTF=$(OTOP)/utils/config.cmi $(OTOP)/utils/warnings.cmi $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmi $(OTOP)/parsing/longident.cmi $(OTOP)/parsing/parsetree.cmi ast2pt.cmi mLast.cmi pcaml.cmi spretty.cmi quotation.cmi @@ -36,14 +36,9 @@ camlp4.cma: $(CAMLP4_OBJS) camlp4.cmxa: $(CAMLP4_XOBJS) $(OCAMLOPT) $(LINKFLAGS) $(CAMLP4_XOBJS) -a -o camlp4.cmxa -crc.cmo: $(CAMLP4_INTF) - @OTOP=$(OTOP) EXE=$(EXE) ../tools/extract_crc.sh $(INTERFACES) > crc.ml - echo "let _ = Dynlink.add_available_units crc_unit_list" >> crc.ml - $(OCAMLC) $(OCAMLCFLAGS) -c crc.ml - clean:: rm -f *.cm* *.pp[io] *.o *.bak .*.bak *.out *.opt - rm -f $(CAMLP4) crc.ml + rm -f $(CAMLP4) depend: cp .depend .depend.bak @@ -62,11 +57,15 @@ compare: done install: - -$(MKDIR) $(BINDIR) - -$(MKDIR) $(LIBDIR)/camlp4 - cp $(CAMLP4) $(BINDIR)/. - cp mLast.mli quotation.mli ast2pt.mli pcaml.mli spretty.mli $(LIBDIR)/camlp4/. - cp mLast.cmi quotation.cmi ast2pt.cmi pcaml.cmi spretty.cmi $(LIBDIR)/camlp4/. + -$(MKDIR) "$(BINDIR)" + -$(MKDIR) "$(LIBDIR)/camlp4" + cp $(CAMLP4) "$(BINDIR)/." + cp mLast.mli quotation.mli ast2pt.mli pcaml.mli spretty.mli "$(LIBDIR)/camlp4/." + cp mLast.cmi quotation.cmi ast2pt.cmi pcaml.cmi spretty.cmi "$(LIBDIR)/camlp4/." cp camlp4.cma $(LIBDIR)/camlp4/. + if [ -f camlp4.cmxa ]; \ + then cp camlp4.cmxa camlp4.a $(LIBDIR)/camlp4/.; \ + else : ; \ + fi include .depend diff --git a/camlp4/ocaml_src/camlp4/Makefile.Mac b/camlp4/ocaml_src/camlp4/Makefile.Mac index 438a744ca..b7561d8cb 100644 --- a/camlp4/ocaml_src/camlp4/Makefile.Mac +++ b/camlp4/ocaml_src/camlp4/Makefile.Mac @@ -45,13 +45,8 @@ all Ä {CAMLP4} camlp4.cma Ä {CAMLP4_OBJS} {OCAMLC} {LINKFLAGS} {CAMLP4_OBJS} -a -o camlp4.cma -crc.cmo Ä {CAMLP4_INTF} - ::tools:extract_crc.mpw {INTERFACES} > crc.ml - echo "let _ = Dynlink.add_available_units crc_unit_list" >> crc.ml - {OCAMLC} {OCAMLCFLAGS} -c crc.ml - clean ÄÄ - delete -i {CAMLP4} crc.ml extract_crc + delete -i {CAMLP4} {dependrule} diff --git a/camlp4/ocaml_src/camlp4/argl.ml b/camlp4/ocaml_src/camlp4/argl.ml index 4e73fcdc0..0f6ac98ce 100644 --- a/camlp4/ocaml_src/camlp4/argl.ml +++ b/camlp4/ocaml_src/camlp4/argl.ml @@ -3,9 +3,21 @@ open Printf;; -let action_arg s sl = +let rec action_arg s sl = function Arg.Unit f -> if s = "" then begin f (); Some sl end else None + | Arg.Bool f -> + if s = "" then + match sl with + s :: sl -> + begin try f (bool_of_string s); Some sl with + Invalid_argument "bool_of_string" -> None + end + | [] -> None + else + begin try f (bool_of_string s); Some sl with + Invalid_argument "bool_of_string" -> None + end | Arg.Set r -> if s = "" then begin r := true; Some sl end else None | Arg.Clear r -> if s = "" then begin r := false; Some sl end else None | Arg.Rest f -> List.iter f (s :: sl); Some [] @@ -57,11 +69,21 @@ let action_arg s sl = s :: sl -> r := float_of_string s; Some sl | [] -> None else begin r := float_of_string s; Some sl end + | Arg.Tuple specs -> + let rec action_args s sl = + function + [] -> Some sl + | spec :: spec_list -> + match action_arg s sl spec with + None -> action_args "" [] spec_list + | Some (s :: sl) -> action_args s sl spec_list + | Some sl -> action_args "" sl spec_list + in + action_args s sl specs | Arg.Symbol (syms, f) -> - begin match if s = "" then sl else s :: sl with + match if s = "" then sl else s :: sl with s :: sl when List.mem s syms -> f s; Some sl - | _ -> None end - | _ -> assert false + | _ -> None ;; let common_start s1 s2 = @@ -104,14 +126,14 @@ let loc_fmt = let print_location loc = if !(Pcaml.input_file) <> "-" then - let (line, bp, ep) = Stdpp.line_of_loc !(Pcaml.input_file) loc in + let (fname, line, bp, ep) = Stdpp.line_of_loc !(Pcaml.input_file) loc in eprintf loc_fmt !(Pcaml.input_file) line bp ep else eprintf "At location %d-%d\n" (fst loc) (snd loc) ;; let print_warning loc s = print_location loc; eprintf "%s\n" s;; -let process pa pr getdir = +let rec parse_file pa getdir useast = let name = !(Pcaml.input_file) in Pcaml.warning := print_warning; let ic = if name = "-" then stdin else open_in_bin name in @@ -122,30 +144,44 @@ let process pa pr getdir = let rec loop () = let (pl, stopped_at_directive) = pa cs in if stopped_at_directive then - begin - begin match getdir (List.rev pl) with + let pl = + let rpl = List.rev pl in + match getdir rpl with Some x -> begin match x with loc, "load", Some (MLast.ExStr (_, s)) -> - Odyl_main.loadfile s + Odyl_main.loadfile s; pl | loc, "directory", Some (MLast.ExStr (_, s)) -> - Odyl_main.directory s + Odyl_main.directory s; pl + | loc, "use", Some (MLast.ExStr (_, s)) -> + List.rev_append rpl + [useast loc s (use_file pa getdir useast s), loc] | loc, _, _ -> Stdpp.raise_with_loc loc (Stream.Error "bad directive") end - | None -> () - end; - pl @ loop () - end + | None -> pl + in + pl @ loop () else pl in loop () with x -> clear (); raise x in - clear (); pr phr + clear (); phr +and use_file pa getdir useast s = + let clear = + let v_input_file = !(Pcaml.input_file) in + fun () -> Pcaml.input_file := v_input_file + in + Pcaml.input_file := s; + try let r = parse_file pa getdir useast in clear (); r with + e -> clear (); raise e ;; +let process pa pr getdir useast = pr (parse_file pa getdir useast);; + + let gind = function (MLast.SgDir (loc, n, dp), _) :: _ -> Some (loc, n, dp) @@ -158,11 +194,14 @@ let gimd = | _ -> None ;; +let usesig loc fname ast = MLast.SgUse (loc, fname, ast);; +let usestr loc fname ast = MLast.StUse (loc, fname, ast);; + let process_intf () = - process !(Pcaml.parse_interf) !(Pcaml.print_interf) gind + process !(Pcaml.parse_interf) !(Pcaml.print_interf) gind usesig ;; let process_impl () = - process !(Pcaml.parse_implem) !(Pcaml.print_implem) gimd + process !(Pcaml.parse_implem) !(Pcaml.print_implem) gimd usestr ;; type file_kind = @@ -232,6 +271,24 @@ let print_usage_list l = l ;; +let make_symlist l = + match l with + [] -> "<none>" + | h :: t -> List.fold_left (fun x y -> x ^ "|" ^ y) ("{" ^ h) t ^ "}" +;; + +let print_usage_list l = + List.iter + (fun (key, spec, doc) -> + match spec with + Arg.Symbol (symbs, _) -> + let s = make_symlist symbs in + let synt = key ^ " " ^ s in + eprintf " %s %s\n" synt (align_doc synt doc) + | _ -> eprintf " %s %s\n" key (align_doc key doc)) + l +;; + let usage ini_sl ext_sl = eprintf "\ Usage: camlp4 [load-options] [--] [other-options] diff --git a/camlp4/ocaml_src/camlp4/ast2pt.ml b/camlp4/ocaml_src/camlp4/ast2pt.ml index fe0e08873..5f9211765 100644 --- a/camlp4/ocaml_src/camlp4/ast2pt.ml +++ b/camlp4/ocaml_src/camlp4/ast2pt.ml @@ -37,9 +37,11 @@ let string_of_string_token loc s = Failure _ as exn -> raise_with_loc loc exn ;; +let glob_fname = ref "";; + let mkloc (bp, ep) = let loc_at n = - {Lexing.pos_fname = ""; Lexing.pos_lnum = 1; Lexing.pos_bol = 0; + {Lexing.pos_fname = !glob_fname; Lexing.pos_lnum = 1; Lexing.pos_bol = 0; Lexing.pos_cnum = n} in {Location.loc_start = loc_at bp; Location.loc_end = loc_at ep; @@ -237,6 +239,33 @@ let option f = | None -> None ;; +let expr_of_lab loc lab = + function + Some e -> e + | None -> ExLid (loc, lab) +;; + +let patt_of_lab loc lab = + function + Some p -> p + | None -> PaLid (loc, lab) +;; + +let paolab loc lab peoo = + let lab = + match lab, peoo with + "", Some ((PaLid (_, i) | PaTyc (_, PaLid (_, i), _)), _) -> i + | "", _ -> error loc "bad ast" + | _ -> lab + in + let (p, eo) = + match peoo with + Some peo -> peo + | None -> PaLid (loc, lab), None + in + lab, p, eo +;; + let rec same_type_expr ct ce = match ct, ce with TyLid (_, s1), ExLid (_, s2) -> s1 = s2 @@ -396,7 +425,7 @@ let rec patt = | PaFlo (loc, s) -> mkpat loc (Ppat_constant (Const_float s)) | PaLab (loc, _, _) -> error loc "labeled pattern not allowed here" | PaLid (loc, s) -> mkpat loc (Ppat_var s) - | PaOlb (loc, _, _, _) -> error loc "labeled pattern not allowed here" + | PaOlb (loc, _, _) -> error loc "labeled pattern not allowed here" | PaOrp (loc, p1, p2) -> mkpat loc (Ppat_or (patt p1, patt p2)) | PaRng (loc, p1, p2) -> begin match p1, p2 with @@ -456,6 +485,12 @@ let class_info class_expr ci = pci_variance = variance} ;; +let apply_with_var v x f = + let vx = !v in + try v := x; let r = f () in v := vx; r with + e -> v := vx; raise e +;; + let rec expr = function ExAcc (loc, x, ExLid (_, "val")) -> @@ -550,9 +585,12 @@ let rec expr = let e3 = ExSeq (loc, el) in let df = if df then Upto else Downto in mkexp loc (Pexp_for (i, expr e1, expr e2, df, expr e3)) - | ExFun (loc, [PaLab (_, lab, p), w, e]) -> - mkexp loc (Pexp_function (lab, None, [patt p, when_expr e w])) - | ExFun (loc, [PaOlb (_, lab, p, eo), w, e]) -> + | ExFun (loc, [PaLab (_, lab, po), w, e]) -> + mkexp loc + (Pexp_function + (lab, None, [patt (patt_of_lab loc lab po), when_expr e w])) + | ExFun (loc, [PaOlb (_, lab, peoo), w, e]) -> + let (lab, p, eo) = paolab loc lab peoo in mkexp loc (Pexp_function (("?" ^ lab), option expr eo, [patt p, when_expr e w])) | ExFun (loc, pel) -> @@ -572,12 +610,14 @@ let rec expr = | ExOlb (loc, _, _) -> error loc "labeled expression not allowed here" | ExOvr (loc, iel) -> mkexp loc (Pexp_override (List.map mkideexp iel)) | ExRec (loc, lel, eo) -> - let eo = - match eo with - Some e -> Some (expr e) - | None -> None - in - mkexp loc (Pexp_record (List.map mklabexp lel, eo)) + if lel = [] then error loc "empty record" + else + let eo = + match eo with + Some e -> Some (expr e) + | None -> None + in + mkexp loc (Pexp_record (List.map mklabexp lel, eo)) | ExSeq (loc, el) -> let rec loop = function @@ -608,8 +648,8 @@ let rec expr = let e2 = ExSeq (loc, el) in mkexp loc (Pexp_while (expr e1, expr e2)) and label_expr = function - ExLab (loc, lab, e) -> lab, expr e - | ExOlb (loc, lab, e) -> "?" ^ lab, expr e + ExLab (loc, lab, eo) -> lab, expr (expr_of_lab loc lab eo) + | ExOlb (loc, lab, eo) -> "?" ^ lab, expr (expr_of_lab loc lab eo) | e -> "", expr e and mkpe (p, e) = patt p, expr e and mkpwe (p, w, e) = patt p, when_expr e w @@ -664,6 +704,9 @@ and sig_item s l = | SgOpn (loc, id) -> mksig loc (Psig_open (long_id_of_string_list loc id)) :: l | SgTyp (loc, tdl) -> mksig loc (Psig_type (List.map mktype_decl tdl)) :: l + | SgUse (loc, fn, sl) -> + apply_with_var glob_fname fn + (fun () -> List.fold_right (fun (si, _) -> sig_item si) sl l) | SgVal (loc, n, t) -> mksig loc (Psig_value (n, mkvalue_desc t [])) :: l and module_expr = function @@ -702,6 +745,9 @@ and str_item s l = | StOpn (loc, id) -> mkstr loc (Pstr_open (long_id_of_string_list loc id)) :: l | StTyp (loc, tdl) -> mkstr loc (Pstr_type (List.map mktype_decl tdl)) :: l + | StUse (loc, fn, sl) -> + apply_with_var glob_fname fn + (fun () -> List.fold_right (fun (si, _) -> str_item si) sl l) | StVal (loc, rf, pel) -> mkstr loc (Pstr_value (mkrf rf, List.map mkpe pel)) :: l and class_type = @@ -742,15 +788,12 @@ and class_expr = mkpcl loc (Pcl_apply (class_expr ce, el)) | CeCon (loc, id, tl) -> mkpcl loc (Pcl_constr (long_id_of_string_list loc id, List.map ctyp tl)) - | CeFun (loc, PaLab (_, lab, p), ce) -> - mkpcl loc (Pcl_fun (lab, None, patt p, class_expr ce)) - | CeFun (loc, PaOlb (_, lab, p, eo), ce) -> - let eo = - match eo with - Some e -> Some (expr e) - | None -> None - in - mkpcl loc (Pcl_fun (("?" ^ lab), eo, patt p, class_expr ce)) + | CeFun (loc, PaLab (_, lab, po), ce) -> + mkpcl loc + (Pcl_fun (lab, None, patt (patt_of_lab loc lab po), class_expr ce)) + | CeFun (loc, PaOlb (_, lab, peoo), ce) -> + let (lab, p, eo) = paolab loc lab peoo in + mkpcl loc (Pcl_fun (("?" ^ lab), option expr eo, patt p, class_expr ce)) | CeFun (loc, p, ce) -> mkpcl loc (Pcl_fun ("", None, patt p, class_expr ce)) | CeLet (loc, rf, pel, ce) -> diff --git a/camlp4/ocaml_src/camlp4/mLast.mli b/camlp4/ocaml_src/camlp4/mLast.mli index e357b9757..7ab3d467c 100644 --- a/camlp4/ocaml_src/camlp4/mLast.mli +++ b/camlp4/ocaml_src/camlp4/mLast.mli @@ -5,14 +5,19 @@ (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) (* This file has been generated by program: do not edit! *) -(* Module [MLast]: abstract syntax tree *) +(* Module [MLast]: abstract syntax tree + + This is undocumented because the AST is not supposed to be used + directly; the good usage is to use the quotations representing + these values in concrete syntax (see the Camlp4 documentation). + See also the file q_MLast.ml in Camlp4 sources. *) type loc = int * int;; @@ -58,9 +63,9 @@ type patt = | PaChr of loc * string | PaInt of loc * string | PaFlo of loc * string - | PaLab of loc * string * patt + | PaLab of loc * string * patt option | PaLid of loc * string - | PaOlb of loc * string * patt * expr option + | PaOlb of loc * string * (patt * expr option) option | PaOrp of loc * patt * patt | PaRng of loc * patt * patt | PaRec of loc * (patt * patt) list @@ -86,14 +91,14 @@ and expr = | ExFun of loc * (patt * expr option * expr) list | ExIfe of loc * expr * expr * expr | ExInt of loc * string - | ExLab of loc * string * expr + | ExLab of loc * string * expr option | ExLaz of loc * expr | ExLet of loc * bool * (patt * expr) list * expr | ExLid of loc * string | ExLmd of loc * string * module_expr * expr | ExMat of loc * expr * (patt * expr option * expr) list | ExNew of loc * string list - | ExOlb of loc * string * expr + | ExOlb of loc * string * expr option | ExOvr of loc * (string * expr) list | ExRec of loc * (patt * expr) list * expr option | ExSeq of loc * expr list @@ -127,6 +132,7 @@ and sig_item = | SgMty of loc * string * module_type | SgOpn of loc * string list | SgTyp of loc * type_decl list + | SgUse of loc * string * (sig_item * loc) list | SgVal of loc * string * ctyp and with_constr = WcTyp of loc * string list * (string * (bool * bool)) list * ctyp @@ -151,6 +157,7 @@ and str_item = | StMty of loc * string * module_type | StOpn of loc * string list | StTyp of loc * type_decl list + | StUse of loc * string * (str_item * loc) list | StVal of loc * bool * (patt * expr) list and type_decl = (loc * string) * (string * (bool * bool)) list * ctyp * (ctyp * ctyp) list diff --git a/camlp4/ocaml_src/camlp4/pcaml.ml b/camlp4/ocaml_src/camlp4/pcaml.ml index bd0d6ca20..7258fa070 100644 --- a/camlp4/ocaml_src/camlp4/pcaml.ml +++ b/camlp4/ocaml_src/camlp4/pcaml.ml @@ -14,12 +14,14 @@ let version = Sys.ocaml_version;; +let syntax_name = ref "";; + let gram = Grammar.gcreate {Token.tok_func = (fun _ -> failwith "no loaded parsing module"); Token.tok_using = (fun _ -> ()); Token.tok_removing = (fun _ -> ()); - Token.tok_match = (fun _ -> raise (Match_failure ("pcaml.ml", 21, 23))); - Token.tok_text = fun _ -> ""} + Token.tok_match = (fun _ -> raise (Match_failure ("pcaml.ml", 23, 23))); + Token.tok_text = (fun _ -> ""); Token.tok_comm = None} ;; let interf = Grammar.Entry.create gram "interf";; @@ -34,6 +36,7 @@ let expr = Grammar.Entry.create gram "expr";; let patt = Grammar.Entry.create gram "patt";; let ctyp = Grammar.Entry.create gram "type";; let let_binding = Grammar.Entry.create gram "let_binding";; +let type_declaration = Grammar.Entry.create gram "type_declaration";; let class_sig_item = Grammar.Entry.create gram "class_sig_item";; let class_str_item = Grammar.Entry.create gram "class_str_item";; @@ -54,6 +57,18 @@ let sync = ref skip_to_eol;; let input_file = ref "";; let output_file = ref None;; +let warning_default_function (bp, ep) txt = + Printf.eprintf "<W> loc %d %d: %s\n" bp ep txt; flush stderr +;; + +let warning = ref warning_default_function;; + +let apply_with_var v x f = + let vx = !v in + try v := x; let r = f () in v := vx; r with + e -> v := vx; raise e +;; + List.iter (fun (n, f) -> Quotation.add n f) ["id", Quotation.ExStr (fun _ s -> "$0:" ^ s ^ "$"); "string", Quotation.ExStr (fun _ s -> "\"" ^ String.escaped s ^ "\"")];; @@ -69,13 +84,19 @@ type err_ctx = exception Qerror of string * err_ctx * exn;; let expand_quotation loc expander shift name str = - try expander str with - Stdpp.Exc_located ((p1, p2), exc) -> - let exc1 = Qerror (name, Expanding, exc) in - raise (Stdpp.Exc_located ((shift + p1, shift + p2), exc1)) - | exc -> - let exc1 = Qerror (name, Expanding, exc) in - raise (Stdpp.Exc_located (loc, exc1)) + let new_warning = + let warn = !warning in + fun (bp, ep) txt -> warn (shift + bp, shift + ep) txt + in + apply_with_var warning new_warning + (fun () -> + try expander str with + Stdpp.Exc_located ((p1, p2), exc) -> + let exc1 = Qerror (name, Expanding, exc) in + raise (Stdpp.Exc_located ((shift + p1, shift + p2), exc1)) + | exc -> + let exc1 = Qerror (name, Expanding, exc) in + raise (Stdpp.Exc_located (loc, exc1))) ;; let parse_quotation_result entry loc shift name str = @@ -167,6 +188,8 @@ let handle_patt_locate loc x = handle_locate loc patt_eoi patt_anti x;; let expr_reloc = Reloc.expr;; let patt_reloc = Reloc.patt;; +let rename_id = ref (fun x -> x);; + let find_line (bp, ep) str = let rec find i line col = if i == String.length str then line, 0, col @@ -247,16 +270,23 @@ let print_format str = Format.open_box 2; loop 0 0; Format.close_box () ;; +let print_file_failed file line char = + Format.print_string ", file \""; + Format.print_string file; + Format.print_string "\", line "; + Format.print_int line; + Format.print_string ", char "; + Format.print_int char +;; + let print_exn = function Out_of_memory -> Format.print_string "Out of memory\n" + | Assert_failure (file, line, char) -> + Format.print_string "Assertion failed"; print_file_failed file line char | Match_failure (file, line, char) -> - Format.print_string "Pattern matching failed, file "; - Format.print_string file; - Format.print_string ", line "; - Format.print_int line; - Format.print_string ", char "; - Format.print_int char + Format.print_string "Pattern matching failed"; + print_file_failed file line char | Stream.Error str -> print_format ("Parse error: " ^ str) | Stream.Failure -> Format.print_string "Parse failure" | Token.Error str -> @@ -278,7 +308,7 @@ let print_exn = let arg = Obj.field (Obj.repr x) i in if not (Obj.is_block arg) then Format.print_int (Obj.magic arg : int) - else if Obj.tag arg = 252 then + else if Obj.tag arg = Obj.tag (Obj.repr "a") then begin Format.print_char '\"'; Format.print_string (Obj.magic arg : string); @@ -302,12 +332,6 @@ let report_error exn = | e -> print_exn exn ;; -let warning_default_function (bp, ep) txt = - Printf.eprintf "<W> loc %d %d: %s\n" bp ep txt; flush stderr -;; - -let warning = ref warning_default_function;; - let no_constructors_arity = Ast2pt.no_constructors_arity;; (*value no_assert = ref False;*) @@ -336,46 +360,55 @@ and kont = pretty Stream.t ;; let pr_str_item = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 349, 30))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 385, 30))); pr_levels = []} ;; let pr_sig_item = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 350, 30))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 386, 30))); + pr_levels = []} +;; +let pr_module_type = + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 387, 33))); + pr_levels = []} +;; +let pr_module_expr = + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 388, 33))); pr_levels = []} ;; let pr_expr = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 351, 26))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 389, 26))); pr_levels = []} ;; let pr_patt = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 352, 26))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 390, 26))); pr_levels = []} ;; let pr_ctyp = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 353, 26))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 391, 26))); + pr_levels = []} +;; +let pr_class_sig_item = + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 392, 36))); pr_levels = []} ;; let pr_class_str_item = - {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 354, 36))); + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 393, 36))); pr_levels = []} ;; -let pr_expr_fun_args = ref Extfun.empty;; - -let not_impl name x = - let desc = - if Obj.is_block (Obj.repr x) then - "tag = " ^ string_of_int (Obj.tag (Obj.repr x)) - else "int_val = " ^ string_of_int (Obj.magic x) - in - HVbox - (Stream.lsing - (fun _ -> S (NO, ("<pr_fun: not impl: " ^ name ^ "; " ^ desc ^ ">")))) +let pr_class_type = + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 394, 32))); + pr_levels = []} +;; +let pr_class_expr = + {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 395, 32))); + pr_levels = []} ;; +let pr_expr_fun_args = ref Extfun.empty;; let pr_fun name pr lab = let rec loop app = function - [] -> (fun x dg k -> not_impl name x) + [] -> (fun x dg k -> failwith ("unable to print " ^ name)) | lev :: levl -> if app || lev.pr_label = lab then let next = loop true levl in @@ -388,10 +421,15 @@ let pr_fun name pr lab = pr_str_item.pr_fun <- pr_fun "str_item" pr_str_item;; pr_sig_item.pr_fun <- pr_fun "sig_item" pr_sig_item;; +pr_module_type.pr_fun <- pr_fun "module_type" pr_module_type;; +pr_module_expr.pr_fun <- pr_fun "module_expr" pr_module_expr;; pr_expr.pr_fun <- pr_fun "expr" pr_expr;; pr_patt.pr_fun <- pr_fun "patt" pr_patt;; pr_ctyp.pr_fun <- pr_fun "ctyp" pr_ctyp;; +pr_class_sig_item.pr_fun <- pr_fun "class_sig_item" pr_class_sig_item;; pr_class_str_item.pr_fun <- pr_fun "class_str_item" pr_class_str_item;; +pr_class_type.pr_fun <- pr_fun "class_type" pr_class_type;; +pr_class_expr.pr_fun <- pr_fun "class_expr" pr_class_expr;; let rec find_pr_level lab = function @@ -411,4 +449,16 @@ let top_printer pr x = Format.print_string " >>" ;; +let buff = Buffer.create 73;; +let buffer_char = Buffer.add_char buff;; +let buffer_string = Buffer.add_string buff;; +let buffer_newline () = Buffer.add_char buff '\n';; + +let string_of pr x = + Buffer.clear buff; + Spretty.print_pretty buffer_char buffer_string buffer_newline "" "" 78 + (fun _ _ -> "", 0, 0, 0) 0 (pr.pr_fun "top" x "" Stream.sempty); + Buffer.contents buff +;; + let inter_phrases = ref None;; diff --git a/camlp4/ocaml_src/camlp4/pcaml.mli b/camlp4/ocaml_src/camlp4/pcaml.mli index 05415844e..8f8eacaf2 100644 --- a/camlp4/ocaml_src/camlp4/pcaml.mli +++ b/camlp4/ocaml_src/camlp4/pcaml.mli @@ -17,14 +17,29 @@ Hold variables to be set by language syntax extensions. Some of them are provided for quotations management. *) +val syntax_name : string ref;; + (** {6 Parsers} *) val parse_interf : (char Stream.t -> (MLast.sig_item * MLast.loc) list * bool) ref;; val parse_implem : (char Stream.t -> (MLast.str_item * MLast.loc) list * bool) ref;; + (** Called when parsing an interface (mli file) or an implementation + (ml file) to build the syntax tree; the returned list contains the + phrases (signature items or structure items) and their locations; + the boolean tells that the parser has encountered a directive; in + this case, since the directive may change the syntax, the parsing + stops, the directive is evaluated, and this function is called + again. + These functions are references, because they can be changed to + use another technology than the Camlp4 extended grammars. By + default, they use the grammars entries [implem] and [interf] + defined below. *) val gram : Grammar.g;; + (** Grammar variable of the OCaml language *) + val interf : ((MLast.sig_item * MLast.loc) list * bool) Grammar.Entry.e;; val implem : ((MLast.str_item * MLast.loc) list * bool) Grammar.Entry.e;; val top_phrase : MLast.str_item option Grammar.Entry.e;; @@ -37,12 +52,12 @@ val expr : MLast.expr Grammar.Entry.e;; val patt : MLast.patt Grammar.Entry.e;; val ctyp : MLast.ctyp Grammar.Entry.e;; val let_binding : (MLast.patt * MLast.expr) Grammar.Entry.e;; +val type_declaration : MLast.type_decl Grammar.Entry.e;; val class_sig_item : MLast.class_sig_item Grammar.Entry.e;; val class_str_item : MLast.class_str_item Grammar.Entry.e;; val class_expr : MLast.class_expr Grammar.Entry.e;; val class_type : MLast.class_type Grammar.Entry.e;; - (** Some grammar and entries of the language, set by [pa_o.cmo] and - [pa_r.cmo]. *) + (** Some entries of the language, set by [pa_o.cmo] and [pa_r.cmo]. *) val input_file : string ref;; (** The file currently being parsed. *) @@ -76,6 +91,10 @@ val handle_patt_locate : MLast.loc -> int * string -> MLast.patt;; val expr_reloc : (MLast.loc -> MLast.loc) -> int -> MLast.expr -> MLast.expr;; val patt_reloc : (MLast.loc -> MLast.loc) -> int -> MLast.patt -> MLast.patt;; +(** To possibly rename identifiers; parsers may call this function + when generating their identifiers; default = identity *) +val rename_id : (string -> string) ref;; + (** Allow user to catch exceptions in quotations *) type err_ctx = Finding @@ -107,18 +126,25 @@ and 'a next = 'a -> string -> kont -> pretty and kont = pretty Stream.t ;; -val pr_str_item : MLast.str_item printer_t;; val pr_sig_item : MLast.sig_item printer_t;; +val pr_str_item : MLast.str_item printer_t;; +val pr_module_type : MLast.module_type printer_t;; +val pr_module_expr : MLast.module_expr printer_t;; val pr_expr : MLast.expr printer_t;; val pr_patt : MLast.patt printer_t;; val pr_ctyp : MLast.ctyp printer_t;; +val pr_class_sig_item : MLast.class_sig_item printer_t;; val pr_class_str_item : MLast.class_str_item printer_t;; +val pr_class_type : MLast.class_type printer_t;; +val pr_class_expr : MLast.class_expr printer_t;; + val pr_expr_fun_args : (MLast.expr, (MLast.patt list * MLast.expr)) Extfun.t ref;; val find_pr_level : string -> 'a pr_level list -> 'a pr_level;; val top_printer : 'a printer_t -> 'a -> unit;; +val string_of : 'a printer_t -> 'a -> string;; val inter_phrases : string option ref;; diff --git a/camlp4/ocaml_src/camlp4/reloc.ml b/camlp4/ocaml_src/camlp4/reloc.ml index bb85b5bc2..fc1f23fae 100644 --- a/camlp4/ocaml_src/camlp4/reloc.ml +++ b/camlp4/ocaml_src/camlp4/reloc.ml @@ -76,10 +76,13 @@ let rec patt floc sh = | PaChr (loc, x1) -> PaChr (floc loc, x1) | PaInt (loc, x1) -> PaInt (floc loc, x1) | PaFlo (loc, x1) -> PaFlo (floc loc, x1) - | PaLab (loc, x1, x2) -> PaLab (floc loc, x1, self x2) + | PaLab (loc, x1, x2) -> PaLab (floc loc, x1, option_map self x2) | PaLid (loc, x1) -> PaLid (floc loc, x1) - | PaOlb (loc, x1, x2, x3) -> - PaOlb (floc loc, x1, self x2, option_map (expr floc sh) x3) + | PaOlb (loc, x1, x2) -> + PaOlb + (floc loc, x1, + option_map (fun (x1, x2) -> self x1, option_map (expr floc sh) x2) + x2) | PaOrp (loc, x1, x2) -> PaOrp (floc loc, self x1, self x2) | PaRng (loc, x1, x2) -> PaRng (floc loc, self x1, self x2) | PaRec (loc, x1) -> @@ -120,7 +123,7 @@ and expr floc sh = x1) | ExIfe (loc, x1, x2, x3) -> ExIfe (floc loc, self x1, self x2, self x3) | ExInt (loc, x1) -> ExInt (floc loc, x1) - | ExLab (loc, x1, x2) -> ExLab (floc loc, x1, self x2) + | ExLab (loc, x1, x2) -> ExLab (floc loc, x1, option_map self x2) | ExLaz (loc, x1) -> ExLaz (floc loc, self x1) | ExLet (loc, x1, x2, x3) -> ExLet @@ -137,7 +140,7 @@ and expr floc sh = patt floc sh x1, option_map self x2, self x3) x2) | ExNew (loc, x1) -> ExNew (floc loc, x1) - | ExOlb (loc, x1, x2) -> ExOlb (floc loc, x1, self x2) + | ExOlb (loc, x1, x2) -> ExOlb (floc loc, x1, option_map self x2) | ExOvr (loc, x1) -> ExOvr (floc loc, List.map (fun (x1, x2) -> x1, self x2) x1) | ExRec (loc, x1, x2) -> @@ -200,6 +203,7 @@ and sig_item floc sh = List.map (fun (x1, x2) -> ctyp floc sh x1, ctyp floc sh x2) x4) x1) + | SgUse (loc, x1, x2) -> SgUse (loc, x1, x2) | SgVal (loc, x1, x2) -> SgVal (floc loc, x1, ctyp floc sh x2) in self @@ -248,6 +252,7 @@ and str_item floc sh = List.map (fun (x1, x2) -> ctyp floc sh x1, ctyp floc sh x2) x4) x1) + | StUse (loc, x1, x2) -> StUse (loc, x1, x2) | StVal (loc, x1, x2) -> StVal (floc loc, x1, diff --git a/camlp4/ocaml_src/lib/Makefile b/camlp4/ocaml_src/lib/Makefile index 524831704..d587e7446 100644 --- a/camlp4/ocaml_src/lib/Makefile +++ b/camlp4/ocaml_src/lib/Makefile @@ -36,17 +36,17 @@ compare: done install: - -$(MKDIR) $(LIBDIR)/camlp4 - cp $(TARGET) *.mli $(LIBDIR)/camlp4/. - cp *.cmi $(LIBDIR)/camlp4/. - if test -f $(TARGET:.cma=.cmxa); then $(MAKE) installopt LIBDIR=$(LIBDIR); fi + -$(MKDIR) "$(LIBDIR)/camlp4" + cp $(TARGET) *.mli "$(LIBDIR)/camlp4/." + cp *.cmi "$(LIBDIR)/camlp4/." + if test -f $(TARGET:.cma=.cmxa); then $(MAKE) installopt LIBDIR="$(LIBDIR)"; fi installopt: - cp $(TARGET:.cma=.cmxa) *.cmx $(LIBDIR)/camlp4/. + cp $(TARGET:.cma=.cmxa) *.cmx "$(LIBDIR)/camlp4/." if test -f $(TARGET:.cma=.lib); then \ - cp $(TARGET:.cma=.lib) $(LIBDIR)/camlp4/.; \ + cp $(TARGET:.cma=.lib) "$(LIBDIR)/camlp4/."; \ else \ - tar cf - $(TARGET:.cma=.a) | (cd $(LIBDIR)/camlp4/.; tar xf -); \ + tar cf - $(TARGET:.cma=.a) | (cd "$(LIBDIR)/camlp4/."; tar xf -); \ fi include .depend diff --git a/camlp4/ocaml_src/lib/grammar.ml b/camlp4/ocaml_src/lib/grammar.ml index 66e7d3580..196a6b954 100644 --- a/camlp4/ocaml_src/lib/grammar.ml +++ b/camlp4/ocaml_src/lib/grammar.ml @@ -120,7 +120,71 @@ let print_entry ppf e = Dlevels elev -> print_levels ppf elev | Dparser _ -> fprintf ppf "<parser>" end; - fprintf ppf " ]@]@." + fprintf ppf " ]@]" +;; + +let iter_entry f e = + let treated = ref [] in + let rec do_entry e = + if List.memq e !treated then () + else + begin + treated := e :: !treated; + f e; + match e.edesc with + Dlevels ll -> List.iter do_level ll + | Dparser _ -> () + end + and do_level lev = do_tree lev.lsuffix; do_tree lev.lprefix + and do_tree = + function + Node n -> do_node n + | LocAct (_, _) | DeadEnd -> () + and do_node n = do_symbol n.node; do_tree n.son; do_tree n.brother + and do_symbol = + function + Smeta (_, sl, _) -> List.iter do_symbol sl + | Snterm e | Snterml (e, _) -> do_entry e + | Slist0 s | Slist1 s | Sopt s -> do_symbol s + | Slist0sep (s1, s2) | Slist1sep (s1, s2) -> do_symbol s1; do_symbol s2 + | Stree t -> do_tree t + | Sself | Snext | Stoken _ -> () + in + do_entry e +;; + +let fold_entry f e init = + let treated = ref [] in + let rec do_entry accu e = + if List.memq e !treated then accu + else + begin + treated := e :: !treated; + let accu = f e accu in + match e.edesc with + Dlevels ll -> List.fold_left do_level accu ll + | Dparser _ -> accu + end + and do_level accu lev = + let accu = do_tree accu lev.lsuffix in do_tree accu lev.lprefix + and do_tree accu = + function + Node n -> do_node accu n + | LocAct (_, _) | DeadEnd -> accu + and do_node accu n = + let accu = do_symbol accu n.node in + let accu = do_tree accu n.son in do_tree accu n.brother + and do_symbol accu = + function + Smeta (_, sl, _) -> List.fold_left do_symbol accu sl + | Snterm e | Snterml (e, _) -> do_entry accu e + | Slist0 s | Slist1 s | Sopt s -> do_symbol accu s + | Slist0sep (s1, s2) | Slist1sep (s1, s2) -> + let accu = do_symbol accu s1 in do_symbol accu s2 + | Stree t -> do_tree accu t + | Sself | Snext | Stoken _ -> accu + in + do_entry init e ;; type g = Token.t Gramext.grammar;; @@ -774,7 +838,7 @@ let glexer_of_lexer lexer = {Token.tok_func = lexer.Token.func; Token.tok_using = lexer.Token.using; Token.tok_removing = lexer.Token.removing; Token.tok_match = tematch lexer.Token.tparse; - Token.tok_text = lexer.Token.text} + Token.tok_text = lexer.Token.text; Token.tok_comm = None} ;; let create lexer = gcreate (glexer_of_lexer lexer);; @@ -933,12 +997,12 @@ module Entry = edesc = Dparser (Obj.magic p)} ;; external obj : 'a e -> te Gramext.g_entry = "%identity";; - let print e = print_entry std_formatter (obj e);; + let print e = printf "%a@." print_entry (obj e);; let find e s = find_entry (obj e) s;; end ;; -let gen_tokens g con = +let tokens g con = let list = ref [] in Hashtbl.iter (fun (p_con, p_prm) c -> if p_con = con then list := (p_prm, !c) :: !list) @@ -946,7 +1010,7 @@ let gen_tokens g con = !list ;; -let tokens g = gen_tokens (grammar_obj g);; +let glexer g = g.glexer;; let warning_verbose = Gramext.warning_verbose;; @@ -960,6 +1024,7 @@ module type S = type parsable;; val parsable : char Stream.t -> parsable;; val tokens : string -> (string * int) list;; + val glexer : te Token.glexer;; module Entry : sig type 'a e;; @@ -998,7 +1063,8 @@ module GGMake (R : ReinitType) (L : GLexerType) = type parsable = char Stream.t * (te Stream.t * Token.location_function);; let gram = gcreate L.lexer;; let parsable cs = cs, L.lexer.Token.tok_func cs;; - let tokens = gen_tokens gram;; + let tokens = tokens gram;; + let glexer = glexer gram;; module Entry = struct type 'a e = te g_entry;; @@ -1020,7 +1086,7 @@ module GGMake (R : ReinitType) (L : GLexerType) = (fun _ _ _ (strm__ : _ Stream.t) -> raise Stream.Failure); edesc = Dparser (Obj.magic p)} ;; - let print e = print_entry std_formatter (obj e);; + let print e = printf "%a@." print_entry (obj e);; end ;; module Unsafe = diff --git a/camlp4/ocaml_src/lib/grammar.mli b/camlp4/ocaml_src/lib/grammar.mli index c29e8f8a7..d38b449f9 100644 --- a/camlp4/ocaml_src/lib/grammar.mli +++ b/camlp4/ocaml_src/lib/grammar.mli @@ -35,6 +35,8 @@ val tokens : g -> string -> (string * int) list;; list. - The call [Grammar.token g "IDENT"] returns the list of all usages of the pattern "IDENT" in the [EXTEND] statements. *) +val glexer : g -> Token.t Token.glexer;; + (** Return the lexer used by the grammar *) module Entry : sig @@ -100,6 +102,7 @@ module type S = type parsable;; val parsable : char Stream.t -> parsable;; val tokens : string -> (string * int) list;; + val glexer : te Token.glexer;; module Entry : sig type 'a e;; @@ -156,6 +159,20 @@ val strict_parsing : bool ref;; val print_entry : Format.formatter -> 'te Gramext.g_entry -> unit;; (** General printer for all kinds of entries (obj entries) *) +val iter_entry : + ('te Gramext.g_entry -> unit) -> 'te Gramext.g_entry -> unit;; + (** [Grammar.iter_entry f e] applies [f] to the entry [e] and + transitively all entries called by [e]. The order in which + the entries are passed to [f] is the order they appear in + each entry. Each entry is passed only once. *) + +val fold_entry : + ('te Gramext.g_entry -> 'a -> 'a) -> 'te Gramext.g_entry -> 'a -> 'a;; + (** [Grammar.fold_entry f e init] computes [(f eN .. (f e2 (f e1 init)))], + where [e1 .. eN] are [e] and transitively all entries called by [e]. + The order in which the entries are passed to [f] is the order they + appear in each entry. Each entry is passed only once. *) + (**/**) (*** deprecated since version 3.05; use rather the functor GMake *) diff --git a/camlp4/ocaml_src/lib/plexer.ml b/camlp4/ocaml_src/lib/plexer.ml index 718e17b4f..20471597e 100644 --- a/camlp4/ocaml_src/lib/plexer.ml +++ b/camlp4/ocaml_src/lib/plexer.ml @@ -36,6 +36,16 @@ let get_buff len = String.sub !buff 0 len;; (* The lexer *) +let stream_peek_nth n strm = + let rec loop n = + function + [] -> None + | [x] -> if n == 1 then Some x else None + | _ :: l -> loop (n - 1) l + in + loop n (Stream.npeek n strm) +;; + let rec ident len (strm__ : _ Stream.t) = match Stream.peek strm__ with Some @@ -132,21 +142,359 @@ and end_exponent_part_under len (strm__ : _ Stream.t) = let error_on_unknown_keywords = ref false;; let err loc msg = raise_with_loc loc (Token.Error msg);; -let next_token_fun dfa find_kwd = +(* +value next_token_fun dfa find_kwd = + let keyword_or_error loc s = + try (("", find_kwd s), loc) with + [ Not_found -> + if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) + else (("", s), loc) ] + in + let rec next_token = + parser bp + [ [: `' ' | '\010' | '\013' | '\t' | '\026' | '\012'; s :] -> + next_token s + | [: `'('; s :] -> left_paren bp s + | [: `'#'; s :] -> do { spaces_tabs s; linenum bp s } + | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) + | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) + | [: `('1'..'9' as c); s :] -> + let tok = number (store 0 c) s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'0'; s :] -> + let tok = base_number (store 0 '0') s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'''; s :] -> + match Stream.npeek 3 s with + [ [_; '''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '''] -> + let tok = ("CHAR", get_buff (char bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | _ -> keyword_or_error (bp, Stream.count s) "'" ] + | [: `'"'; s :] -> + let tok = ("STRING", get_buff (string bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'$'; s :] -> + let tok = dollar bp 0 s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); + s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id + | [: `('~' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> + (("TILDEIDENT", get_buff len), (bp, ep)) + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `('?' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> + (("QUESTIONIDENT", get_buff len), (bp, ep)) + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `'<'; s :] -> less bp s + | [: `(':' as c1); + len = + parser + [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('>' | '|' as c1); + len = + parser + [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 + | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('[' | '{' as c1); s :] -> + let len = + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> store 0 c1 + | _ -> + match s with parser + [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] ] + in + let ep = Stream.count s in + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `'.'; + id = + parser + [ [: `'.' :] -> ".." + | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> + keyword_or_error (bp, ep) id + | [: `';'; + id = + parser + [ [: `';' :] -> ";;" + | [: :] -> ";" ] :] ep -> + keyword_or_error (bp, ep) id + | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep)) + | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) + | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ] + and less bp strm = + if no_quotations.val then + match strm with parser + [ [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + else + match strm with parser + [ [: `'<'; len = quotation bp 0 :] ep -> + (("QUOTATION", ":" ^ get_buff len), (bp, ep)) + | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; + `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> + (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)) + | [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + and string bp len = + parser + [ [: `'"' :] -> len + | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s + | [: `c; s :] -> string bp (store len c) s + | [: :] ep -> err (bp, ep) "string not terminated" ] + and char bp len = + parser + [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len + | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s + | [: `c; s :] -> char bp (store len c) s + | [: :] ep -> err (bp, ep) "char not terminated" ] + and dollar bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: s :] -> + if dfa then + match s with parser + [ [: `c :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + else ("", get_buff (ident2 (store 0 '$') s)) ] + and maybe_locate bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and antiquot bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> + antiquot bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and locate_or_antiquot_rest bp len = + parser + [ [: `'$' :] -> get_buff len + | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and quotation bp len = + parser + [ [: `'>'; s :] -> maybe_end_quotation bp len s + | [: `'<'; s :] -> + quotation bp (maybe_nested_quotation bp (store len '<') s) s + | [: `'\\'; + len = + parser + [ [: `('>' | '<' | '\\' as c) :] -> store len c + | [: :] -> store len '\\' ]; + s :] -> + quotation bp len s + | [: `c; s :] -> quotation bp (store len c) s + | [: :] ep -> err (bp, ep) "quotation not terminated" ] + and maybe_nested_quotation bp len = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: `':'; len = ident (store len ':'); + a = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: :] -> len ] :] -> + a + | [: :] -> len ] + and maybe_end_quotation bp len = + parser + [ [: `'>' :] -> len + | [: a = quotation bp (store len '>') :] -> a ] + and left_paren bp = + parser + [ [: `'*'; _ = comment bp; a = next_token True :] -> a + | [: :] ep -> keyword_or_error (bp, ep) "(" ] + and comment bp = + parser + [ [: `'('; s :] -> left_paren_in_comment bp s + | [: `'*'; s :] -> star_in_comment bp s + | [: `'"'; _ = string bp 0; s :] -> comment bp s + | [: `'''; s :] -> quote_in_comment bp s + | [: `c; s :] -> comment bp s + | [: :] ep -> err (bp, ep) "comment not terminated" ] + and quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\013'; s :] -> quote_cr_in_comment bp s + | [: `'\\'; s :] -> quote_antislash_in_comment bp s + | [: `'('; s :] -> quote_left_paren_in_comment bp s + | [: `'*'; s :] -> quote_star_in_comment bp s + | [: `'"'; s :] -> quote_doublequote_in_comment bp s + | [: `_; s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and quote_any_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> comment bp s ] + and quote_cr_in_comment bp = + parser + [ [: `'\010'; s :] -> quote_any_in_comment bp s + | [: s :] -> quote_any_in_comment bp s ] + and quote_left_paren_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> left_paren_in_comment bp s ] + and quote_star_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> star_in_comment bp s ] + and quote_doublequote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: _ = string bp 0; s :] -> comment bp s ] + and quote_antislash_in_comment bp = + parser + [ [: `'''; s :] -> quote_antislash_quote_in_comment bp s + | [: `('\\' | '"' | 'n' | 't' | 'b' | 'r'); s :] -> + quote_any_in_comment bp s + | [: `('0'..'9'); s :] -> quote_antislash_digit_in_comment bp s + | [: `'x'; s :] -> quote_antislash_x_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> quote_in_comment bp s ] + and quote_antislash_digit_in_comment bp = + parser + [ [: `('0'..'9'); s :] -> quote_antislash_digit2_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_digit2_in_comment bp = + parser + [ [: `('0'..'9'); s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_x_in_comment bp = + parser + [ [: _ = hexa; s :] -> quote_antislash_x_digit_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_x_digit_in_comment bp = + parser + [ [: _ = hexa; s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and left_paren_in_comment bp = + parser + [ [: `'*'; s :] -> do { comment bp s; comment bp s } + | [: a = comment bp :] -> a ] + and star_in_comment bp = + parser + [ [: `')' :] -> () + | [: a = comment bp :] -> a ] + and linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] + and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] + and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] + and any_to_nl = + parser + [ [: `'\013' | '\010' :] ep -> bolpos.val := ep + | [: `_; s :] -> any_to_nl s + | [: :] -> () ] + in + fun cstrm -> + try + let glex = glexr.val in + let comm_bp = Stream.count cstrm in + let r = next_token False cstrm in + do { + match glex.tok_comm with + [ Some list -> + if fst (snd r) > comm_bp then + let comm_loc = (comm_bp, fst (snd r)) in + glex.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + r + } + with + [ Stream.Error str -> + err (Stream.count cstrm, Stream.count cstrm + 1) str ] +; +*) + +let next_token_fun dfa ssd find_kwd bolpos glexr = let keyword_or_error loc s = try ("", find_kwd s), loc with Not_found -> if !error_on_unknown_keywords then err loc ("illegal token: " ^ s) else ("", s), loc in - let rec next_token (strm__ : _ Stream.t) = + let rec next_token after_space (strm__ : _ Stream.t) = let bp = Stream.count strm__ in match Stream.peek strm__ with - Some (' ' | '\010' | '\013' | '\t' | '\026' | '\012') -> - Stream.junk strm__; next_token strm__ + Some ('\010' | '\013') -> + Stream.junk strm__; + let s = strm__ in + let ep = Stream.count strm__ in bolpos := ep; next_token true s + | Some (' ' | '\t' | '\026' | '\012') -> + Stream.junk strm__; next_token true strm__ + | Some '#' when bp = !bolpos -> + Stream.junk strm__; + let s = strm__ in + if linedir 1 s then begin any_to_nl s; next_token true s end + else keyword_or_error (bp, bp + 1) "#" | Some '(' -> Stream.junk strm__; left_paren bp strm__ - | Some '#' -> - Stream.junk strm__; let s = strm__ in spaces_tabs s; linenum bp s | Some ('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c) -> Stream.junk strm__; let s = strm__ in @@ -174,8 +522,8 @@ let next_token_fun dfa find_kwd = | Some '\'' -> Stream.junk strm__; let s = strm__ in - begin match Stream.npeek 3 s with - [_; '\''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '\''] -> + begin match Stream.npeek 2 s with + [_; '\''] | ['\\'; _] -> let tok = "CHAR", get_buff (char bp 0 s) in let loc = bp, Stream.count s in tok, loc | _ -> keyword_or_error (bp, Stream.count s) "'" @@ -276,7 +624,7 @@ let next_token_fun dfa find_kwd = try match Stream.peek strm__ with Some '.' -> Stream.junk strm__; ".." - | _ -> "." + | _ -> if ssd && after_space then " ." else "." with Stream.Failure -> raise (Stream.Error "") in @@ -511,7 +859,7 @@ let next_token_fun dfa find_kwd = try comment bp strm__ with Stream.Failure -> raise (Stream.Error "") in - begin try next_token strm__ with + begin try next_token true strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> let ep = Stream.count strm__ in keyword_or_error (bp, ep) "(" @@ -533,47 +881,26 @@ let next_token_fun dfa find_kwd = and quote_in_comment bp (strm__ : _ Stream.t) = match Stream.peek strm__ with Some '\'' -> Stream.junk strm__; comment bp strm__ - | Some '\013' -> Stream.junk strm__; quote_cr_in_comment bp strm__ - | Some '\\' -> Stream.junk strm__; quote_antislash_in_comment bp strm__ - | Some '(' -> Stream.junk strm__; quote_left_paren_in_comment bp strm__ - | Some '*' -> Stream.junk strm__; quote_star_in_comment bp strm__ - | Some '\"' -> Stream.junk strm__; quote_doublequote_in_comment bp strm__ - | Some _ -> Stream.junk strm__; quote_any_in_comment bp strm__ - | _ -> comment bp strm__ + | Some '\\' -> Stream.junk strm__; quote_antislash_in_comment bp 0 strm__ + | _ -> + let s = strm__ in + begin match Stream.npeek 2 s with + [_; '\''] -> Stream.junk s; Stream.junk s + | _ -> () + end; + comment bp s and quote_any_in_comment bp (strm__ : _ Stream.t) = match Stream.peek strm__ with Some '\'' -> Stream.junk strm__; comment bp strm__ | _ -> comment bp strm__ - and quote_cr_in_comment bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\010' -> Stream.junk strm__; quote_any_in_comment bp strm__ - | _ -> quote_any_in_comment bp strm__ - and quote_left_paren_in_comment bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\'' -> Stream.junk strm__; comment bp strm__ - | _ -> left_paren_in_comment bp strm__ - and quote_star_in_comment bp (strm__ : _ Stream.t) = + and quote_antislash_in_comment bp len (strm__ : _ Stream.t) = match Stream.peek strm__ with Some '\'' -> Stream.junk strm__; comment bp strm__ - | _ -> star_in_comment bp strm__ - and quote_doublequote_in_comment bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\'' -> Stream.junk strm__; comment bp strm__ - | _ -> let _ = string bp 0 strm__ in comment bp strm__ - and quote_antislash_in_comment bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\'' -> - Stream.junk strm__; quote_antislash_quote_in_comment bp strm__ | Some ('\\' | '\"' | 'n' | 't' | 'b' | 'r') -> Stream.junk strm__; quote_any_in_comment bp strm__ | Some ('0'..'9') -> Stream.junk strm__; quote_antislash_digit_in_comment bp strm__ - | Some 'x' -> Stream.junk strm__; quote_antislash_x_in_comment bp strm__ | _ -> comment bp strm__ - and quote_antislash_quote_in_comment bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\'' -> Stream.junk strm__; comment bp strm__ - | _ -> quote_in_comment bp strm__ and quote_antislash_digit_in_comment bp (strm__ : _ Stream.t) = match Stream.peek strm__ with Some ('0'..'9') -> @@ -583,20 +910,6 @@ let next_token_fun dfa find_kwd = match Stream.peek strm__ with Some ('0'..'9') -> Stream.junk strm__; quote_any_in_comment bp strm__ | _ -> comment bp strm__ - and quote_antislash_x_in_comment bp (strm__ : _ Stream.t) = - match - try Some (hexa strm__) with - Stream.Failure -> None - with - Some _ -> quote_antislash_x_digit_in_comment bp strm__ - | _ -> comment bp strm__ - and quote_antislash_x_digit_in_comment bp (strm__ : _ Stream.t) = - match - try Some (hexa strm__) with - Stream.Failure -> None - with - Some _ -> quote_any_in_comment bp strm__ - | _ -> comment bp strm__ and left_paren_in_comment bp (strm__ : _ Stream.t) = match Stream.peek strm__ with Some '*' -> @@ -606,54 +919,54 @@ let next_token_fun dfa find_kwd = match Stream.peek strm__ with Some ')' -> Stream.junk strm__; () | _ -> comment bp strm__ - and linenum bp (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9') -> - Stream.junk strm__; - let _ = - try digits strm__ with - Stream.Failure -> raise (Stream.Error "") - in - let _ = - try spaces_tabs strm__ with - Stream.Failure -> raise (Stream.Error "") - in - begin match Stream.peek strm__ with - Some '\"' -> - Stream.junk strm__; - let _ = - try any_to_nl strm__ with - Stream.Failure -> raise (Stream.Error "") - in - next_token strm__ - | _ -> raise (Stream.Error "") - end - | _ -> keyword_or_error (bp, bp + 1) "#" - and spaces_tabs (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some (' ' | '\t') -> Stream.junk strm__; spaces_tabs strm__ - | _ -> () - and digits (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9') -> Stream.junk strm__; digits strm__ - | _ -> () + and linedir n s = + match stream_peek_nth n s with + Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> false + and linedir_digits n s = + match stream_peek_nth n s with + Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s + and linedir_quote n s = + match stream_peek_nth n s with + Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '\"' -> true + | _ -> false and any_to_nl (strm__ : _ Stream.t) = match Stream.peek strm__ with - Some ('\013' | '\010') -> Stream.junk strm__; () + Some ('\013' | '\010') -> + Stream.junk strm__; let ep = Stream.count strm__ in bolpos := ep | Some _ -> Stream.junk strm__; any_to_nl strm__ | _ -> () in fun cstrm -> - try next_token cstrm with + try + let glex = !glexr in + let comm_bp = Stream.count cstrm in + let r = next_token false cstrm in + begin match glex.tok_comm with + Some list -> + if fst (snd r) > comm_bp then + let comm_loc = comm_bp, fst (snd r) in + glex.tok_comm <- Some (comm_loc :: list) + | None -> () + end; + r + with Stream.Error str -> err (Stream.count cstrm, Stream.count cstrm + 1) str ;; + let dollar_for_antiquotation = ref true;; +let specific_space_dot = ref false;; -let func kwd_table = +let func kwd_table glexr = + let bolpos = ref 0 in let find = Hashtbl.find kwd_table in let dfa = !dollar_for_antiquotation in - Token.lexer_func_of_parser (next_token_fun dfa find) + let ssd = !specific_space_dot in + Token.lexer_func_of_parser (next_token_fun dfa ssd find bolpos glexr) ;; let rec check_keyword_stream (strm__ : _ Stream.t) = @@ -862,9 +1175,22 @@ let tok_match = let gmake () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in - {tok_func = func kwd_table; tok_using = using_token kwd_table id_table; - tok_removing = removing_token kwd_table id_table; tok_match = tok_match; - tok_text = text} + let glexr = + ref + {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 952, 17))); + tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 952, 37))); + tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 952, 60))); + tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 953, 18))); + tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 953, 37))); + tok_comm = None} + in + let glex = + {tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + glexr := glex; glex ;; let tparse = @@ -883,6 +1209,15 @@ let tparse = let make () = let kwd_table = Hashtbl.create 301 in let id_table = Hashtbl.create 301 in - {func = func kwd_table; using = using_token kwd_table id_table; + let glexr = + ref + {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 981, 17))); + tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 981, 37))); + tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 981, 60))); + tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 982, 18))); + tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 982, 37))); + tok_comm = None} + in + {func = func kwd_table glexr; using = using_token kwd_table id_table; removing = removing_token kwd_table id_table; tparse = tparse; text = text} ;; diff --git a/camlp4/ocaml_src/lib/plexer.mli b/camlp4/ocaml_src/lib/plexer.mli index d682f83ae..19bc0ce1b 100644 --- a/camlp4/ocaml_src/lib/plexer.mli +++ b/camlp4/ocaml_src/lib/plexer.mli @@ -54,6 +54,12 @@ val dollar_for_antiquotation : bool ref;; lexer where the dollar sign is used for antiquotations. If False, the dollar sign can be used as token. *) +val specific_space_dot : bool ref;; + (** When False (default), the next call to [Plexer.make ()] returns a + lexer where the dots can be preceded by spaces. If True, dots + preceded by spaces return the keyword " ." (space dot), otherwise + return the keyword "." (dot). *) + val no_quotations : bool ref;; (** When True, all lexers built by [Plexer.make ()] do not lex the quotation syntax any more. Default is False (quotations are diff --git a/camlp4/ocaml_src/lib/stdpp.ml b/camlp4/ocaml_src/lib/stdpp.ml index 0830e6842..d91ee78c0 100644 --- a/camlp4/ocaml_src/lib/stdpp.ml +++ b/camlp4/ocaml_src/lib/stdpp.ml @@ -23,23 +23,77 @@ let raise_with_loc loc exc = let line_of_loc fname (bp, ep) = try let ic = open_in_bin fname in - let rec loop lin col cnt = - if cnt < bp then - let (lin, col) = - match input_char ic with - '\n' -> lin + 1, 0 - | _ -> lin, col + 1 - in - loop lin col (cnt + 1) - else lin, col, col + ep - bp + let strm = Stream.of_channel ic in + let rec loop fname lin = + let rec not_a_line_dir col (strm__ : _ Stream.t) = + let cnt = Stream.count strm__ in + match Stream.peek strm__ with + Some c -> + Stream.junk strm__; + let s = strm__ in + if cnt < bp then + if c = '\n' then loop fname (lin + 1) + else not_a_line_dir (col + 1) s + else let col = col - (cnt - bp) in fname, lin, col, col + ep - bp + | _ -> raise Stream.Failure + in + let rec a_line_dir str n col (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\n' -> Stream.junk strm__; loop str n + | Some _ -> Stream.junk strm__; a_line_dir str n (col + 1) strm__ + | _ -> raise Stream.Failure + in + let rec spaces col (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ' ' -> Stream.junk strm__; spaces (col + 1) strm__ + | _ -> col + in + let rec check_string str n col (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\"' -> + Stream.junk strm__; + let col = + try spaces (col + 1) strm__ with + Stream.Failure -> raise (Stream.Error "") + in + a_line_dir str n col strm__ + | Some c when c <> '\n' -> + Stream.junk strm__; + check_string (str ^ String.make 1 c) n (col + 1) strm__ + | _ -> not_a_line_dir col strm__ + in + let check_quote n col (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\"' -> Stream.junk strm__; check_string "" n (col + 1) strm__ + | _ -> not_a_line_dir col strm__ + in + let rec check_num n col (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; + check_num (10 * n + Char.code c - Char.code '0') (col + 1) strm__ + | _ -> let col = spaces col strm__ in check_quote n col strm__ + in + let begin_line (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '#' -> + Stream.junk strm__; + let col = + try spaces 1 strm__ with + Stream.Failure -> raise (Stream.Error "") + in + check_num 0 col strm__ + | _ -> not_a_line_dir 0 strm__ + in + begin_line strm in let r = - try loop 1 0 0 with - End_of_file -> 1, bp, ep + try loop fname 1 with + Stream.Failure -> fname, 1, bp, ep in close_in ic; r with - Sys_error _ -> 1, bp, ep + Sys_error _ -> fname, 1, bp, ep ;; let loc_name = ref "loc";; diff --git a/camlp4/ocaml_src/lib/stdpp.mli b/camlp4/ocaml_src/lib/stdpp.mli index 5afd1b2db..68c0cb6ad 100644 --- a/camlp4/ocaml_src/lib/stdpp.mli +++ b/camlp4/ocaml_src/lib/stdpp.mli @@ -25,10 +25,12 @@ val raise_with_loc : int * int -> exn -> 'a;; (** [raise_with_loc loc e], if [e] is already the exception [Exc_located], re-raise it, else raise the exception [Exc_located loc e]. *) -val line_of_loc : string -> int * int -> int * int * int;; +val line_of_loc : string -> int * int -> string * int * int * int;; (** [line_of_loc fname loc] reads the file [fname] up to the - location [loc] and returns the line number and the characters - location in the line *) + location [loc] and returns the real input file, the line number + and the characters location in the line; the real input file + can be different from [fname] because of possibility of line + directives typically generated by /lib/cpp. *) val loc_name : string ref;; (** Name of the location variable used in grammars and in the predefined diff --git a/camlp4/ocaml_src/lib/token.ml b/camlp4/ocaml_src/lib/token.ml index 63f09bc19..67aaffdec 100644 --- a/camlp4/ocaml_src/lib/token.ml +++ b/camlp4/ocaml_src/lib/token.ml @@ -26,7 +26,8 @@ type 'te glexer = tok_using : pattern -> unit; tok_removing : pattern -> unit; tok_match : pattern -> 'te -> string; - tok_text : pattern -> string } + tok_text : pattern -> string; + mutable tok_comm : location list option } ;; type lexer = { func : t lexer_func; diff --git a/camlp4/ocaml_src/lib/token.mli b/camlp4/ocaml_src/lib/token.mli index 4e14469d6..e561e28e8 100644 --- a/camlp4/ocaml_src/lib/token.mli +++ b/camlp4/ocaml_src/lib/token.mli @@ -47,7 +47,8 @@ type 'te glexer = tok_using : pattern -> unit; tok_removing : pattern -> unit; tok_match : pattern -> 'te -> string; - tok_text : pattern -> string } + tok_text : pattern -> string; + mutable tok_comm : location list option } ;; (** The type for a lexer used by Camlp4 grammars. - The field [tok_func] is the main lexer function. See [lexer_func] @@ -66,7 +67,9 @@ type 'te glexer = efficency, write it as a function returning functions according to the values of the pattern, not a function with two parameters. - The field [tok_text] returns the name of some token pattern, - used in error messages. *) + used in error messages. +- The field [tok_comm] if not None asks the lexer to record the + locations of the comments. *) val lexer_text : pattern -> string;; (** A simple [tok_text] function for lexers *) diff --git a/camlp4/ocaml_src/meta/Makefile b/camlp4/ocaml_src/meta/Makefile index aac0f0abd..a7cd03d73 100644 --- a/camlp4/ocaml_src/meta/Makefile +++ b/camlp4/ocaml_src/meta/Makefile @@ -4,7 +4,7 @@ include ../../config/Makefile INCLUDES=-I ../camlp4 -I ../../boot -I $(OTOP)/utils OCAMLCFLAGS=-warn-error A $(INCLUDES) -OBJS=q_MLast.cmo pa_r.cmo pa_rp.cmo pa_extend.cmo pa_extend_m.cmo pa_ifdef.cmo pr_dump.cmo +OBJS=q_MLast.cmo pa_r.cmo pa_rp.cmo pa_extend.cmo pa_extend_m.cmo pa_macro.cmo pr_dump.cmo CAMLP4RM=pa_r.cmo pa_rp.cmo pr_dump.cmo CAMLP4RMX=pa_r.cmx pa_rp.cmx pr_dump.cmx SHELL=/bin/sh @@ -42,10 +42,10 @@ compare: done install: - -$(MKDIR) $(LIBDIR)/camlp4 $(BINDIR) - cp $(OBJS) $(LIBDIR)/camlp4/. - cp pa_ifdef.cmi pa_extend.cmi $(LIBDIR)/camlp4/. - cp camlp4r$(EXE) $(BINDIR)/. - if test -f $(COPT); then cp $(COPT) $(BINDIR)/.; fi + -$(MKDIR) "$(LIBDIR)/camlp4" "$(BINDIR)" + cp $(OBJS) "$(LIBDIR)/camlp4/." + cp pa_macro.cmi pa_extend.cmi "$(LIBDIR)/camlp4/." + cp camlp4r$(EXE) "$(BINDIR)/." + if test -f $(COPT); then cp $(COPT) "$(BINDIR)/."; fi include .depend diff --git a/camlp4/ocaml_src/meta/Makefile.Mac.depend b/camlp4/ocaml_src/meta/Makefile.Mac.depend index e48bfb7f6..29675238e 100644 --- a/camlp4/ocaml_src/meta/Makefile.Mac.depend +++ b/camlp4/ocaml_src/meta/Makefile.Mac.depend @@ -2,8 +2,8 @@ pa_extend.cmoÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmi pa_extend.cmxÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmx pa_extend_m.cmoÄ ::camlp4:mLast.cmi pa_extend.cmo pa_extend_m.cmxÄ ::camlp4:mLast.cmi pa_extend.cmx -pa_ifdef.cmoÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmi -pa_ifdef.cmxÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmx +pa_macro.cmoÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmi +pa_macro.cmxÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmx pa_r.cmoÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmi pa_r.cmxÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmx pa_rp.cmoÄ ::camlp4:mLast.cmi ::camlp4:pcaml.cmi diff --git a/camlp4/ocaml_src/meta/pa_extend.ml b/camlp4/ocaml_src/meta/pa_extend.ml index ea822c6b3..d68baf8d5 100644 --- a/camlp4/ocaml_src/meta/pa_extend.ml +++ b/camlp4/ocaml_src/meta/pa_extend.ml @@ -693,7 +693,7 @@ let rec quot_expr e = (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")), MLast.ExStr (loc, c)), mklistexp loc al) - | MLast.ExAcc (_, _, MLast.ExUid (_, c)) -> + | MLast.ExAcc (_, MLast.ExUid (_, "MLast"), MLast.ExUid (_, c)) -> let al = List.map quot_expr al in MLast.ExApp (loc, @@ -703,6 +703,16 @@ let rec quot_expr e = (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")), MLast.ExStr (loc, c)), mklistexp loc al) + | MLast.ExAcc (_, MLast.ExUid (_, m), MLast.ExUid (_, c)) -> + let al = List.map quot_expr al in + MLast.ExApp + (loc, + MLast.ExApp + (loc, + MLast.ExAcc + (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")), + MLast.ExStr (loc, (m ^ "." ^ c))), + mklistexp loc al) | MLast.ExLid (_, f) -> let al = List.map quot_expr al in List.fold_left (fun f e -> MLast.ExApp (loc, f, e)) @@ -736,7 +746,7 @@ let rec quot_expr e = if s = !(Stdpp.loc_name) then MLast.ExAcc (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Loc")) else e - | MLast.ExAcc (_, _, MLast.ExUid (_, s)) -> + | MLast.ExAcc (_, MLast.ExUid (_, "MLast"), MLast.ExUid (_, s)) -> MLast.ExApp (loc, MLast.ExApp @@ -745,6 +755,15 @@ let rec quot_expr e = (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")), MLast.ExStr (loc, s)), MLast.ExUid (loc, "[]")) + | MLast.ExAcc (_, MLast.ExUid (_, m), MLast.ExUid (_, s)) -> + MLast.ExApp + (loc, + MLast.ExApp + (loc, + MLast.ExAcc + (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")), + MLast.ExStr (loc, (m ^ "." ^ s))), + MLast.ExUid (loc, "[]")) | MLast.ExUid (_, s) -> MLast.ExApp (loc, @@ -1442,6 +1461,20 @@ let text_of_functorial_extend loc gmod gl el = open Pcaml;; let symbol = Grammar.Entry.create gram "symbol";; +let semi_sep = + if !syntax_name = "Scheme" then + Grammar.Entry.of_parser gram "'/'" + (fun (strm__ : _ Stream.t) -> + match Stream.peek strm__ with + Some ("", "/") -> Stream.junk strm__; () + | _ -> raise Stream.Failure) + else + Grammar.Entry.of_parser gram "';'" + (fun (strm__ : _ Stream.t) -> + match Stream.peek strm__ with + Some ("", ";") -> Stream.junk strm__; () + | _ -> raise Stream.Failure) +;; Grammar.extend (let _ = (expr : 'expr Grammar.Entry.e) @@ -1516,7 +1549,8 @@ Grammar.extend (Gramext.srules [[Gramext.Snterm (Grammar.Entry.obj (entry : 'entry Grammar.Entry.e)); - Gramext.Stoken ("", ";")], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))], Gramext.action (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__1))])], Gramext.action @@ -1533,7 +1567,8 @@ Grammar.extend (Gramext.srules [[Gramext.Snterm (Grammar.Entry.obj (entry : 'entry Grammar.Entry.e)); - Gramext.Stoken ("", ";")], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))], Gramext.action (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__2))])], Gramext.action @@ -1548,7 +1583,8 @@ Grammar.extend Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e)), - Gramext.Stoken ("", ";"))], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))], Gramext.action (fun (sl : 'symbol list) _ (n : 'name) (loc : int * int) -> (let (e, b) = expr_of_delete_rule loc "Grammar" n sl in @@ -1572,7 +1608,8 @@ Grammar.extend Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e)), - Gramext.Stoken ("", ";"))], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))], Gramext.action (fun (sl : 'symbol list) _ (n : 'name) (g : string) (loc : int * int) -> @@ -1598,7 +1635,8 @@ Grammar.extend 'efunction)); [Gramext.Stoken ("UIDENT", "FUNCTION"); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e)); - Gramext.Stoken ("", ";")], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))], Gramext.action (fun _ (f : 'qualid) _ _ (loc : int * int) -> (f : 'efunction))]]; Grammar.Entry.obj (global : 'global Grammar.Entry.e), None, @@ -1606,7 +1644,8 @@ Grammar.extend [[Gramext.Stoken ("UIDENT", "GLOBAL"); Gramext.Stoken ("", ":"); Gramext.Slist1 (Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e))); - Gramext.Stoken ("", ";")], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))], Gramext.action (fun _ (sl : 'name list) _ _ (loc : int * int) -> (sl : 'global))]]; Grammar.Entry.obj (entry : 'entry Grammar.Entry.e), None, @@ -1731,14 +1770,16 @@ Grammar.extend [[Gramext.Slist0sep (Gramext.Snterm (Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e)), - Gramext.Stoken ("", ";"))], + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))], Gramext.action (fun (psl : 'psymbol list) (loc : int * int) -> ({prod = psl; action = None} : 'rule)); [Gramext.Slist0sep (Gramext.Snterm (Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e)), - Gramext.Stoken ("", ";")); + Gramext.Snterm + (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))); Gramext.Stoken ("", "->"); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action diff --git a/camlp4/ocaml_src/meta/pa_macro.ml b/camlp4/ocaml_src/meta/pa_macro.ml new file mode 100644 index 000000000..599608f9f --- /dev/null +++ b/camlp4/ocaml_src/meta/pa_macro.ml @@ -0,0 +1,392 @@ +(* camlp4r *) +(* This file has been generated by program: do not edit! *) + +(* +Added statements: + + At toplevel (structure item): + + DEFINE <uident> + DEFINE <uident> = <expression> + DEFINE <uident> (<parameters>) = <expression> + IFDEF <uident> THEN <structure_items> END + IFDEF <uident> THEN <structure_items> ELSE <structure_items> END + IFNDEF <uident> THEN <structure_items> END + IFNDEF <uident> THEN <structure_items> ELSE <structure_items> END + + In expressions: + + IFDEF <uident> THEN <expression> ELSE <expression> END + IFNDEF <uident> THEN <expression> ELSE <expression> END + __FILE__ + __LOCATION__ + + In patterns: + + IFDEF <uident> THEN <pattern> ELSE <pattern> END + IFNDEF <uident> THEN <pattern> ELSE <pattern> END + + As Camlp4 options: + + -D<uident> + -U<uident> + + After having used a DEFINE <uident> followed by "= <expression>", you + can use it in expressions *and* in patterns. If the expression defining + the macro cannot be used as a pattern, there is an error message if + it is used in a pattern. + + The expression __FILE__ returns the current compiled file name. + The expression __LOCATION__ returns the current location of itself. + +*) + +(* #load "pa_extend.cmo" *) +(* #load "q_MLast.cmo" *) + +open Pcaml;; + +type 'a item_or_def = + SdStr of 'a + | SdDef of string * (string list * MLast.expr) option + | SdUnd of string + | SdNop +;; + +let rec list_remove x = + function + (y, _) :: l when y = x -> l + | d :: l -> d :: list_remove x l + | [] -> [] +;; + +let defined = ref [];; + +let is_defined i = List.mem_assoc i !defined;; + +let loc = 0, 0;; + +let subst mloc env = + let rec loop = + function + MLast.ExLet (_, rf, pel, e) -> + let pel = List.map (fun (p, e) -> p, loop e) pel in + MLast.ExLet (loc, rf, pel, loop e) + | MLast.ExIfe (_, e1, e2, e3) -> + MLast.ExIfe (loc, loop e1, loop e2, loop e3) + | MLast.ExApp (_, e1, e2) -> MLast.ExApp (loc, loop e1, loop e2) + | MLast.ExLid (_, x) | MLast.ExUid (_, x) as e -> + begin try MLast.ExAnt (loc, List.assoc x env) with + Not_found -> e + end + | MLast.ExTup (_, x) -> MLast.ExTup (loc, List.map loop x) + | MLast.ExRec (_, pel, None) -> + let pel = List.map (fun (p, e) -> p, loop e) pel in + MLast.ExRec (loc, pel, None) + | e -> e + in + loop +;; + +let substp mloc env = + let rec loop = + function + MLast.ExApp (_, e1, e2) -> MLast.PaApp (loc, loop e1, loop e2) + | MLast.ExLid (_, x) -> + begin try MLast.PaAnt (loc, List.assoc x env) with + Not_found -> MLast.PaLid (loc, x) + end + | MLast.ExUid (_, x) -> + begin try MLast.PaAnt (loc, List.assoc x env) with + Not_found -> MLast.PaUid (loc, x) + end + | MLast.ExInt (_, x) -> MLast.PaInt (loc, x) + | MLast.ExTup (_, x) -> MLast.PaTup (loc, List.map loop x) + | MLast.ExRec (_, pel, None) -> + let ppl = List.map (fun (p, e) -> p, loop e) pel in + MLast.PaRec (loc, ppl) + | x -> + Stdpp.raise_with_loc mloc + (Failure + "this macro cannot be used in a pattern (see its definition)") + in + loop +;; + +let incorrect_number loc l1 l2 = + Stdpp.raise_with_loc loc + (Failure + (Printf.sprintf "expected %d parameters; found %d" (List.length l2) + (List.length l1))) +;; + +let define eo x = + begin match eo with + Some ([], e) -> + Grammar.extend + [Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), + Some (Gramext.Level "simple"), + [None, None, + [[Gramext.Stoken ("UIDENT", x)], + Gramext.action + (fun _ (loc : int * int) -> + (Pcaml.expr_reloc (fun _ -> loc) 0 e : 'expr))]]; + Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), + Some (Gramext.Level "simple"), + [None, None, + [[Gramext.Stoken ("UIDENT", x)], + Gramext.action + (fun _ (loc : int * int) -> + (let p = substp loc [] e in + Pcaml.patt_reloc (fun _ -> loc) 0 p : + 'patt))]]] + | Some (sl, e) -> + Grammar.extend + [Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), + Some (Gramext.Level "apply"), + [None, None, + [[Gramext.Stoken ("UIDENT", x); Gramext.Sself], + Gramext.action + (fun (param : 'expr) _ (loc : int * int) -> + (let el = + match param with + MLast.ExTup (_, el) -> el + | e -> [e] + in + if List.length el = List.length sl then + let env = List.combine sl el in + let e = subst loc env e in + Pcaml.expr_reloc (fun _ -> loc) 0 e + else incorrect_number loc el sl : + 'expr))]]; + Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), + Some (Gramext.Level "simple"), + [None, None, + [[Gramext.Stoken ("UIDENT", x); Gramext.Sself], + Gramext.action + (fun (param : 'patt) _ (loc : int * int) -> + (let pl = + match param with + MLast.PaTup (_, pl) -> pl + | p -> [p] + in + if List.length pl = List.length sl then + let env = List.combine sl pl in + let p = substp loc env e in + Pcaml.patt_reloc (fun _ -> loc) 0 p + else incorrect_number loc pl sl : + 'patt))]]] + | None -> () + end; + defined := (x, eo) :: !defined +;; + +let undef x = + try + let eo = List.assoc x !defined in + begin match eo with + Some ([], _) -> + Grammar.delete_rule expr [Gramext.Stoken ("UIDENT", x)]; + Grammar.delete_rule patt [Gramext.Stoken ("UIDENT", x)] + | Some (_, _) -> + Grammar.delete_rule expr + [Gramext.Stoken ("UIDENT", x); Gramext.Sself]; + Grammar.delete_rule patt [Gramext.Stoken ("UIDENT", x); Gramext.Sself] + | None -> () + end; + defined := list_remove x !defined + with + Not_found -> () +;; + +Grammar.extend + (let _ = (expr : 'expr Grammar.Entry.e) + and _ = (patt : 'patt Grammar.Entry.e) + and _ = (str_item : 'str_item Grammar.Entry.e) + and _ = (sig_item : 'sig_item Grammar.Entry.e) in + let grammar_entry_create s = + Grammar.Entry.create (Grammar.of_entry expr) s + in + let macro_def : 'macro_def Grammar.Entry.e = + grammar_entry_create "macro_def" + and str_item_or_macro : 'str_item_or_macro Grammar.Entry.e = + grammar_entry_create "str_item_or_macro" + and opt_macro_value : 'opt_macro_value Grammar.Entry.e = + grammar_entry_create "opt_macro_value" + and uident : 'uident Grammar.Entry.e = grammar_entry_create "uident" in + [Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), + Some Gramext.First, + [None, None, + [[Gramext.Snterm + (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))], + Gramext.action + (fun (x : 'macro_def) (loc : int * int) -> + (match x with + SdStr [si] -> si + | SdStr sil -> MLast.StDcl (loc, sil) + | SdDef (x, eo) -> define eo x; MLast.StDcl (loc, []) + | SdUnd x -> undef x; MLast.StDcl (loc, []) + | SdNop -> MLast.StDcl (loc, []) : + 'str_item))]]; + Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "IFNDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "ELSE"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (d2 : 'str_item_or_macro) _ (d1 : 'str_item_or_macro) _ + (i : 'uident) _ (loc : int * int) -> + (if is_defined i then d2 else d1 : 'macro_def)); + [Gramext.Stoken ("", "IFNDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _ (loc : int * int) -> + (if is_defined i then SdNop else d : 'macro_def)); + [Gramext.Stoken ("", "IFDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "ELSE"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (d2 : 'str_item_or_macro) _ (d1 : 'str_item_or_macro) _ + (i : 'uident) _ (loc : int * int) -> + (if is_defined i then d1 else d2 : 'macro_def)); + [Gramext.Stoken ("", "IFDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); + Gramext.Snterm + (Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)); + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _ (loc : int * int) -> + (if is_defined i then d else SdNop : 'macro_def)); + [Gramext.Stoken ("", "UNDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e))], + Gramext.action + (fun (i : 'uident) _ (loc : int * int) -> (SdUnd i : 'macro_def)); + [Gramext.Stoken ("", "DEFINE"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj + (opt_macro_value : 'opt_macro_value Grammar.Entry.e))], + Gramext.action + (fun (def : 'opt_macro_value) (i : 'uident) _ (loc : int * int) -> + (SdDef (i, def) : 'macro_def))]]; + Grammar.Entry.obj + (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e), + None, + [None, None, + [[Gramext.Slist1 + (Gramext.Snterm + (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e)))], + Gramext.action + (fun (si : 'str_item list) (loc : int * int) -> + (SdStr si : 'str_item_or_macro)); + [Gramext.Snterm + (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))], + Gramext.action + (fun (d : 'macro_def) (loc : int * int) -> + (d : 'str_item_or_macro))]]; + Grammar.Entry.obj (opt_macro_value : 'opt_macro_value Grammar.Entry.e), + None, + [None, None, + [[], Gramext.action (fun (loc : int * int) -> (None : 'opt_macro_value)); + [Gramext.Stoken ("", "="); + Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], + Gramext.action + (fun (e : 'expr) _ (loc : int * int) -> + (Some ([], e) : 'opt_macro_value)); + [Gramext.Stoken ("", "("); + Gramext.Slist1sep + (Gramext.Stoken ("LIDENT", ""), Gramext.Stoken ("", ",")); + Gramext.Stoken ("", ")"); Gramext.Stoken ("", "="); + Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], + Gramext.action + (fun (e : 'expr) _ _ (pl : string list) _ (loc : int * int) -> + (Some (pl, e) : 'opt_macro_value))]]; + Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), + Some (Gramext.Level "top"), + [None, None, + [[Gramext.Stoken ("", "IFNDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); Gramext.Sself; + Gramext.Stoken ("", "ELSE"); Gramext.Sself; + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _ + (loc : int * int) -> + (if is_defined i then e2 else e1 : 'expr)); + [Gramext.Stoken ("", "IFDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); Gramext.Sself; + Gramext.Stoken ("", "ELSE"); Gramext.Sself; + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _ + (loc : int * int) -> + (if is_defined i then e1 else e2 : 'expr))]]; + Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), + Some (Gramext.Level "simple"), + [None, None, + [[Gramext.Stoken ("LIDENT", "__LOCATION__")], + Gramext.action + (fun _ (loc : int * int) -> + (let bp = string_of_int (fst loc) in + let ep = string_of_int (snd loc) in + MLast.ExTup + (loc, [MLast.ExInt (loc, bp); MLast.ExInt (loc, ep)]) : + 'expr)); + [Gramext.Stoken ("LIDENT", "__FILE__")], + Gramext.action + (fun _ (loc : int * int) -> + (MLast.ExStr (loc, !(Pcaml.input_file)) : 'expr))]]; + Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "IFNDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); Gramext.Sself; + Gramext.Stoken ("", "ELSE"); Gramext.Sself; + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _ + (loc : int * int) -> + (if is_defined i then p2 else p1 : 'patt)); + [Gramext.Stoken ("", "IFDEF"); + Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e)); + Gramext.Stoken ("", "THEN"); Gramext.Sself; + Gramext.Stoken ("", "ELSE"); Gramext.Sself; + Gramext.Stoken ("", "END")], + Gramext.action + (fun _ (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _ + (loc : int * int) -> + (if is_defined i then p1 else p2 : 'patt))]]; + Grammar.Entry.obj (uident : 'uident Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("UIDENT", "")], + Gramext.action + (fun (i : string) (loc : int * int) -> (i : 'uident))]]]);; + +Pcaml.add_option "-D" (Arg.String (define None)) + "<string> Define for IFDEF instruction.";; +Pcaml.add_option "-U" (Arg.String undef) + "<string> Undefine for IFDEF instruction.";; diff --git a/camlp4/ocaml_src/meta/pa_r.ml b/camlp4/ocaml_src/meta/pa_r.ml index 05e18e8ce..fc26cb351 100644 --- a/camlp4/ocaml_src/meta/pa_r.ml +++ b/camlp4/ocaml_src/meta/pa_r.ml @@ -51,6 +51,7 @@ Grammar.Unsafe.clear_entry expr; Grammar.Unsafe.clear_entry patt; Grammar.Unsafe.clear_entry ctyp; Grammar.Unsafe.clear_entry let_binding; +Grammar.Unsafe.clear_entry type_declaration; Grammar.Unsafe.clear_entry class_type; Grammar.Unsafe.clear_entry class_expr; Grammar.Unsafe.clear_entry class_sig_item; @@ -79,19 +80,22 @@ let mkmatchcase loc p aso w e = in p, w, e ;; + +let neg_string n = + let len = String.length n in + if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1) else "-" ^ n +;; let mkumin loc f arg = match arg with - MLast.ExInt (_, n) when int_of_string n > 0 -> - let n = "-" ^ n in MLast.ExInt (loc, n) - | MLast.ExFlo (_, n) when float_of_string n > 0.0 -> - let n = "-" ^ n in MLast.ExFlo (loc, n) + MLast.ExInt (_, n) -> MLast.ExInt (loc, neg_string n) + | MLast.ExFlo (_, n) -> MLast.ExFlo (loc, neg_string n) | _ -> let f = "~" ^ f in MLast.ExApp (loc, MLast.ExLid (loc, f), arg) ;; let mkuminpat loc f is_int n = - if is_int then MLast.PaInt (loc, ("-" ^ n)) - else MLast.PaFlo (loc, ("-" ^ n)) + if is_int then MLast.PaInt (loc, neg_string n) + else MLast.PaFlo (loc, neg_string n) ;; let mklistexp loc last = @@ -160,26 +164,27 @@ Pcaml.sync.val := sync; *) let ipatt = Grammar.Entry.create gram "ipatt";; +let with_constr = Grammar.Entry.create gram "with_constr";; +let row_field = Grammar.Entry.create gram "row_field";; let not_yet_warned_variant = ref true;; -let warn_variant () = +let warn_variant loc = if !not_yet_warned_variant then begin not_yet_warned_variant := false; - Printf.eprintf "\ -*** warning: use of syntax of variants types deprecated since version 3.05\n"; - flush stderr + !(Pcaml.warning) loc + (Printf.sprintf + "use of syntax of variants types deprecated since version 3.05") end ;; let not_yet_warned = ref true;; -let warn_sequence () = +let warn_sequence loc = if !not_yet_warned then begin not_yet_warned := false; - Printf.eprintf "\ -*** warning: use of syntax of sequences deprecated since version 3.01.1\n"; - flush stderr + !(Pcaml.warning) loc + "use of syntax of sequences deprecated since version 3.01.1" end ;; Pcaml.add_option "-no_warn_seq" (Arg.Clear not_yet_warned) @@ -198,7 +203,10 @@ Grammar.extend and _ = (class_sig_item : 'class_sig_item Grammar.Entry.e) and _ = (class_str_item : 'class_str_item Grammar.Entry.e) and _ = (let_binding : 'let_binding Grammar.Entry.e) - and _ = (ipatt : 'ipatt Grammar.Entry.e) in + and _ = (type_declaration : 'type_declaration Grammar.Entry.e) + and _ = (ipatt : 'ipatt Grammar.Entry.e) + and _ = (with_constr : 'with_constr Grammar.Entry.e) + and _ = (row_field : 'row_field Grammar.Entry.e) in let grammar_entry_create s = Grammar.Entry.create (Grammar.of_entry sig_item) s in @@ -208,8 +216,6 @@ Grammar.extend grammar_entry_create "module_binding" and module_declaration : 'module_declaration Grammar.Entry.e = grammar_entry_create "module_declaration" - and with_constr : 'with_constr Grammar.Entry.e = - grammar_entry_create "with_constr" and cons_expr_opt : 'cons_expr_opt Grammar.Entry.e = grammar_entry_create "cons_expr_opt" and dummy : 'dummy Grammar.Entry.e = grammar_entry_create "dummy" @@ -235,8 +241,6 @@ Grammar.extend grammar_entry_create "patt_label_ident" and label_ipatt : 'label_ipatt Grammar.Entry.e = grammar_entry_create "label_ipatt" - and type_declaration : 'type_declaration Grammar.Entry.e = - grammar_entry_create "type_declaration" and type_patt : 'type_patt Grammar.Entry.e = grammar_entry_create "type_patt" and constrain : 'constrain Grammar.Entry.e = @@ -260,11 +264,13 @@ Grammar.extend grammar_entry_create "class_fun_def" and class_structure : 'class_structure Grammar.Entry.e = grammar_entry_create "class_structure" - and class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e = - grammar_entry_create "class_self_patt_opt" - and as_lident_opt : 'as_lident_opt Grammar.Entry.e = - grammar_entry_create "as_lident_opt" - and cvalue : 'cvalue Grammar.Entry.e = grammar_entry_create "cvalue" + and class_self_patt : 'class_self_patt Grammar.Entry.e = + grammar_entry_create "class_self_patt" + and as_lident : 'as_lident Grammar.Entry.e = + grammar_entry_create "as_lident" + and polyt : 'polyt Grammar.Entry.e = grammar_entry_create "polyt" + and cvalue_binding : 'cvalue_binding Grammar.Entry.e = + grammar_entry_create "cvalue_binding" and label : 'label Grammar.Entry.e = grammar_entry_create "label" and class_self_type : 'class_self_type Grammar.Entry.e = grammar_entry_create "class_self_type" @@ -272,10 +278,8 @@ Grammar.extend grammar_entry_create "class_description" and class_type_declaration : 'class_type_declaration Grammar.Entry.e = grammar_entry_create "class_type_declaration" - and field_expr_list : 'field_expr_list Grammar.Entry.e = - grammar_entry_create "field_expr_list" - and meth_list : 'meth_list Grammar.Entry.e = - grammar_entry_create "meth_list" + and field_expr : 'field_expr Grammar.Entry.e = + grammar_entry_create "field_expr" and field : 'field Grammar.Entry.e = grammar_entry_create "field" and typevar : 'typevar Grammar.Entry.e = grammar_entry_create "typevar" and clty_longident : 'clty_longident Grammar.Entry.e = @@ -284,16 +288,14 @@ Grammar.extend grammar_entry_create "class_longident" and row_field_list : 'row_field_list Grammar.Entry.e = grammar_entry_create "row_field_list" - and row_field : 'row_field Grammar.Entry.e = - grammar_entry_create "row_field" and name_tag : 'name_tag Grammar.Entry.e = grammar_entry_create "name_tag" - and rec_flag : 'rec_flag Grammar.Entry.e = grammar_entry_create "rec_flag" + and patt_tcon : 'patt_tcon Grammar.Entry.e = + grammar_entry_create "patt_tcon" + and ipatt_tcon : 'ipatt_tcon Grammar.Entry.e = + grammar_entry_create "ipatt_tcon" + and eq_expr : 'eq_expr Grammar.Entry.e = grammar_entry_create "eq_expr" and direction_flag : 'direction_flag Grammar.Entry.e = grammar_entry_create "direction_flag" - and mutable_flag : 'mutable_flag Grammar.Entry.e = - grammar_entry_create "mutable_flag" - and virtual_flag : 'virtual_flag Grammar.Entry.e = - grammar_entry_create "virtual_flag" and warning_variant : 'warning_variant Grammar.Entry.e = grammar_entry_create "warning_variant" and warning_sequence : 'warning_sequence Grammar.Entry.e = @@ -356,15 +358,15 @@ Grammar.extend (fun (e : 'expr) (loc : int * int) -> (MLast.StExp (loc, e) : 'str_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.Sopt (Gramext.Stoken ("", "rec")); Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e)), Gramext.Stoken ("", "and"))], Gramext.action - (fun (l : 'let_binding list) (r : 'rec_flag) _ (loc : int * int) -> - (MLast.StVal (loc, r, l) : 'str_item)); + (fun (l : 'let_binding list) (r : string option) _ + (loc : int * int) -> + (MLast.StVal (loc, o2b r, l) : 'str_item)); [Gramext.Stoken ("", "type"); Gramext.Slist1sep (Gramext.Snterm @@ -736,28 +738,25 @@ Grammar.extend (fun (e : 'expr) _ (mb : 'module_binding) (m : string) _ _ (loc : int * int) -> (MLast.ExLmd (loc, m, mb, e) : 'expr)); - [Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + [Gramext.Stoken ("", "let"); Gramext.Sopt (Gramext.Stoken ("", "rec")); Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e)), Gramext.Stoken ("", "and")); Gramext.Stoken ("", "in"); Gramext.Sself], Gramext.action - (fun (x : 'expr) _ (l : 'let_binding list) (r : 'rec_flag) _ + (fun (x : 'expr) _ (l : 'let_binding list) (r : string option) _ (loc : int * int) -> - (MLast.ExLet (loc, r, l, x) : 'expr))]; + (MLast.ExLet (loc, o2b r, l, x) : 'expr))]; Some "where", None, [[Gramext.Sself; Gramext.Stoken ("", "where"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.Sopt (Gramext.Stoken ("", "rec")); Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e))], Gramext.action - (fun (lb : 'let_binding) (rf : 'rec_flag) _ (e : 'expr) + (fun (lb : 'let_binding) (rf : string option) _ (e : 'expr) (loc : int * int) -> - (MLast.ExLet (loc, rf, [lb], e) : 'expr))]; + (MLast.ExLet (loc, o2b rf, [lb], e) : 'expr))]; Some ":=", Some Gramext.NonA, [[Gramext.Sself; Gramext.Stoken ("", ":="); Gramext.Sself; Gramext.Snterm (Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e))], @@ -1086,9 +1085,7 @@ Grammar.extend Gramext.action (fun (el : 'sequence) _ (e : 'expr) (loc : int * int) -> (e :: el : 'sequence)); - [Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + [Gramext.Stoken ("", "let"); Gramext.Sopt (Gramext.Stoken ("", "rec")); Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e)), @@ -1100,9 +1097,9 @@ Grammar.extend Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__5))]; Gramext.Sself], Gramext.action - (fun (el : 'sequence) _ (l : 'let_binding list) (rf : 'rec_flag) _ + (fun (el : 'sequence) _ (l : 'let_binding list) (rf : string option) _ (loc : int * int) -> - ([MLast.ExLet (loc, rf, l, mksequence loc el)] : 'sequence))]]; + ([MLast.ExLet (loc, o2b rf, l, mksequence loc el)] : 'sequence))]]; Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e), None, [None, None, [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)); @@ -1539,13 +1536,12 @@ Grammar.extend None, [None, None, [[Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); + Gramext.Sopt (Gramext.Stoken ("", "mutable")); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) (mf : 'mutable_flag) _ (i : string) + (fun (t : 'ctyp) (mf : string option) _ (i : string) (loc : int * int) -> - (loc, i, mf, t : 'label_declaration))]]; + (loc, i, o2b mf, t : 'label_declaration))]]; Grammar.Entry.obj (ident : 'ident Grammar.Entry.e), None, [None, None, [[Gramext.Stoken ("UIDENT", "")], @@ -1611,8 +1607,7 @@ Grammar.extend (class_declaration : 'class_declaration Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.Sopt (Gramext.Stoken ("", "virtual")); Gramext.Stoken ("LIDENT", ""); Gramext.Snterm (Grammar.Entry.obj @@ -1622,8 +1617,8 @@ Grammar.extend (class_fun_binding : 'class_fun_binding Grammar.Entry.e))], Gramext.action (fun (cfb : 'class_fun_binding) (ctp : 'class_type_parameters) - (i : string) (vf : 'virtual_flag) (loc : int * int) -> - ({MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + (i : string) (vf : string option) (loc : int * int) -> + ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = i; MLast.ciExp = cfb} : 'class_declaration))]]; Grammar.Entry.obj @@ -1681,18 +1676,16 @@ Grammar.extend (MLast.CeFun (loc, p, ce) : 'class_fun_def))]]; Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), None, [Some "top", None, - [[Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + [[Gramext.Stoken ("", "let"); Gramext.Sopt (Gramext.Stoken ("", "rec")); Gramext.Slist1sep (Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e)), Gramext.Stoken ("", "and")); Gramext.Stoken ("", "in"); Gramext.Sself], Gramext.action - (fun (ce : 'class_expr) _ (lb : 'let_binding list) (rf : 'rec_flag) _ - (loc : int * int) -> - (MLast.CeLet (loc, rf, lb, ce) : 'class_expr)); + (fun (ce : 'class_expr) _ (lb : 'let_binding list) + (rf : string option) _ (loc : int * int) -> + (MLast.CeLet (loc, o2b rf, lb, ce) : 'class_expr)); [Gramext.Stoken ("", "fun"); Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)); Gramext.Snterm @@ -1704,7 +1697,7 @@ Grammar.extend Some "apply", Some Gramext.NonA, [[Gramext.Sself; Gramext.Snterml - (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "simple")], + (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "label")], Gramext.action (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) -> (MLast.CeApp (loc, ce, e) : 'class_expr))]; @@ -1720,15 +1713,16 @@ Grammar.extend (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ (loc : int * int) -> (MLast.CeTyc (loc, ce, ct) : 'class_expr)); [Gramext.Stoken ("", "object"); - Gramext.Snterm - (Grammar.Entry.obj - (class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj + (class_self_patt : 'class_self_patt Grammar.Entry.e))); Gramext.Snterm (Grammar.Entry.obj (class_structure : 'class_structure Grammar.Entry.e)); Gramext.Stoken ("", "end")], Gramext.action - (fun _ (cf : 'class_structure) (cspo : 'class_self_patt_opt) _ + (fun _ (cf : 'class_structure) (cspo : 'class_self_patt option) _ (loc : int * int) -> (MLast.CeStr (loc, cspo, cf) : 'class_expr)); [Gramext.Snterm @@ -1764,26 +1758,22 @@ Grammar.extend Gramext.action (fun (cf : 'e__6 list) (loc : int * int) -> (cf : 'class_structure))]]; - Grammar.Entry.obj - (class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e), + Grammar.Entry.obj (class_self_patt : 'class_self_patt Grammar.Entry.e), None, [None, None, - [[], - Gramext.action (fun (loc : int * int) -> (None : 'class_self_patt_opt)); - [Gramext.Stoken ("", "("); + [[Gramext.Stoken ("", "("); Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ")")], Gramext.action (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) -> - (Some (MLast.PaTyc (loc, p, t)) : 'class_self_patt_opt)); + (MLast.PaTyc (loc, p, t) : 'class_self_patt)); [Gramext.Stoken ("", "("); Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (p : 'patt) _ (loc : int * int) -> - (Some p : 'class_self_patt_opt))]]; + (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'class_self_patt))]]; Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e), None, [None, None, @@ -1800,65 +1790,45 @@ Grammar.extend (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) -> (MLast.CrCtr (loc, t1, t2) : 'class_str_item)); [Gramext.Stoken ("", "method"); + Gramext.Sopt (Gramext.Stoken ("", "private")); Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e))); Gramext.Snterm (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))], Gramext.action - (fun (fb : 'fun_binding) (l : 'label) _ (loc : int * int) -> - (MLast.CrMth (loc, l, false, fb, None) : 'class_str_item)); - [Gramext.Stoken ("", "method"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], - Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) _ (loc : int * int) -> - (MLast.CrMth (loc, l, false, e, Some t) : 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))], - Gramext.action - (fun (fb : 'fun_binding) (l : 'label) _ _ (loc : int * int) -> - (MLast.CrMth (loc, l, true, fb, None) : 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], - Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (MLast.CrMth (loc, l, true, e, Some t) : 'class_str_item)); + (fun (e : 'fun_binding) (topt : 'polyt option) (l : 'label) + (pf : string option) _ (loc : int * int) -> + (MLast.CrMth (loc, l, o2b pf, e, topt) : 'class_str_item)); [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); + Gramext.Sopt (Gramext.Stoken ("", "private")); Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (MLast.CrVir (loc, l, false, t) : 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ _ (loc : int * int) -> - (MLast.CrVir (loc, l, true, t) : 'class_str_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _ + (loc : int * int) -> + (MLast.CrVir (loc, l, o2b pf, t) : 'class_str_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm (Grammar.Entry.obj (cvalue : 'cvalue Grammar.Entry.e))], + Gramext.Sopt (Gramext.Stoken ("", "mutable")); + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj + (cvalue_binding : 'cvalue_binding Grammar.Entry.e))], Gramext.action - (fun (lab, mf, e : 'cvalue) _ (loc : int * int) -> - (MLast.CrVal (loc, lab, mf, e) : 'class_str_item)); + (fun (e : 'cvalue_binding) (lab : 'label) (mf : string option) _ + (loc : int * int) -> + (MLast.CrVal (loc, lab, o2b mf, e) : 'class_str_item)); [Gramext.Stoken ("", "inherit"); Gramext.Snterm (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj - (as_lident_opt : 'as_lident_opt Grammar.Entry.e))], + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e)))], Gramext.action - (fun (pb : 'as_lident_opt) (ce : 'class_expr) _ (loc : int * int) -> + (fun (pb : 'as_lident option) (ce : 'class_expr) _ + (loc : int * int) -> (MLast.CrInh (loc, ce, pb) : 'class_str_item)); [Gramext.Stoken ("", "declare"); Gramext.Slist0 @@ -1874,58 +1844,46 @@ Grammar.extend Gramext.action (fun _ (st : 'e__7 list) _ (loc : int * int) -> (MLast.CrDcl (loc, st) : 'class_str_item))]]; - Grammar.Entry.obj (as_lident_opt : 'as_lident_opt Grammar.Entry.e), None, + Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e), None, [None, None, - [[], Gramext.action (fun (loc : int * int) -> (None : 'as_lident_opt)); - [Gramext.Stoken ("", "as"); Gramext.Stoken ("LIDENT", "")], + [[Gramext.Stoken ("", "as"); Gramext.Stoken ("LIDENT", "")], Gramext.action - (fun (i : string) _ (loc : int * int) -> (Some i : 'as_lident_opt))]]; - Grammar.Entry.obj (cvalue : 'cvalue Grammar.Entry.e), None, + (fun (i : string) _ (loc : int * int) -> (i : 'as_lident))]]; + Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":>"); + [[Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action (fun (t : 'ctyp) _ (loc : int * int) -> (t : 'polyt))]]; + Grammar.Entry.obj (cvalue_binding : 'cvalue_binding Grammar.Entry.e), + None, + [None, None, + [[Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (l, mf, MLast.ExCoe (loc, e, None, t) : 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); + (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) -> + (MLast.ExCoe (loc, e, None, t) : 'cvalue_binding)); + [Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (l : 'label) - (mf : 'mutable_flag) (loc : int * int) -> - (l, mf, MLast.ExCoe (loc, e, Some t, t2) : 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); + (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (loc : int * int) -> + (MLast.ExCoe (loc, e, Some t, t2) : 'cvalue_binding)); + [Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (l, mf, MLast.ExTyc (loc, e, t) : 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); + (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) -> + (MLast.ExTyc (loc, e, t) : 'cvalue_binding)); + [Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (l, mf, e : 'cvalue))]]; + (fun (e : 'expr) _ (loc : int * int) -> (e : 'cvalue_binding))]]; Grammar.Entry.obj (label : 'label Grammar.Entry.e), None, [None, None, [[Gramext.Stoken ("LIDENT", "")], @@ -1993,44 +1951,32 @@ Grammar.extend (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) -> (MLast.CgCtr (loc, t1, t2) : 'class_sig_item)); [Gramext.Stoken ("", "method"); + Gramext.Sopt (Gramext.Stoken ("", "private")); Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ (loc : int * int) -> - (MLast.CgMth (loc, l, false, t) : 'class_sig_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (MLast.CgMth (loc, l, true, t) : 'class_sig_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (MLast.CgVir (loc, l, false, t) : 'class_sig_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ + (loc : int * int) -> + (MLast.CgMth (loc, l, o2b pf, t) : 'class_sig_item)); [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Stoken ("", "private"); + Gramext.Sopt (Gramext.Stoken ("", "private")); Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ _ (loc : int * int) -> - (MLast.CgVir (loc, l, true, t) : 'class_sig_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _ + (loc : int * int) -> + (MLast.CgVir (loc, l, o2b pf, t) : 'class_sig_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); + Gramext.Sopt (Gramext.Stoken ("", "mutable")); Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) _ + (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _ (loc : int * int) -> - (MLast.CgVal (loc, l, mf, t) : 'class_sig_item)); + (MLast.CgVal (loc, l, o2b mf, t) : 'class_sig_item)); [Gramext.Stoken ("", "inherit"); Gramext.Snterm (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], @@ -2055,8 +2001,7 @@ Grammar.extend (class_description : 'class_description Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.Sopt (Gramext.Stoken ("", "virtual")); Gramext.Stoken ("LIDENT", ""); Gramext.Snterm (Grammar.Entry.obj @@ -2066,16 +2011,15 @@ Grammar.extend (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], Gramext.action (fun (ct : 'class_type) _ (ctp : 'class_type_parameters) (n : string) - (vf : 'virtual_flag) (loc : int * int) -> - ({MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + (vf : string option) (loc : int * int) -> + ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = ct} : 'class_description))]]; Grammar.Entry.obj (class_type_declaration : 'class_type_declaration Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.Sopt (Gramext.Stoken ("", "virtual")); Gramext.Stoken ("LIDENT", ""); Gramext.Snterm (Grammar.Entry.obj @@ -2085,8 +2029,8 @@ Grammar.extend (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], Gramext.action (fun (cs : 'class_type) _ (ctp : 'class_type_parameters) (n : string) - (vf : 'virtual_flag) (loc : int * int) -> - ({MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + (vf : string option) (loc : int * int) -> + ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; MLast.ciNam = n; MLast.ciExp = cs} : 'class_type_declaration))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), @@ -2111,16 +2055,14 @@ Grammar.extend Some (Gramext.Level "simple"), [None, None, [[Gramext.Stoken ("", "{<"); - Gramext.Snterm - (Grammar.Entry.obj - (field_expr_list : 'field_expr_list Grammar.Entry.e)); + Gramext.Slist0sep + (Gramext.Snterm + (Grammar.Entry.obj (field_expr : 'field_expr Grammar.Entry.e)), + Gramext.Stoken ("", ";")); Gramext.Stoken ("", ">}")], Gramext.action - (fun _ (fel : 'field_expr_list) _ (loc : int * int) -> + (fun _ (fel : 'field_expr list) _ (loc : int * int) -> (MLast.ExOvr (loc, fel) : 'expr)); - [Gramext.Stoken ("", "{<"); Gramext.Stoken ("", ">}")], - Gramext.action - (fun _ _ (loc : int * int) -> (MLast.ExOvr (loc, []) : 'expr)); [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ")")], @@ -2135,43 +2077,25 @@ Grammar.extend Gramext.action (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) -> (MLast.ExCoe (loc, e, Some t, t2) : 'expr))]]; - Grammar.Entry.obj (field_expr_list : 'field_expr_list Grammar.Entry.e), - None, + Grammar.Entry.obj (field_expr : 'field_expr Grammar.Entry.e), None, [None, None, [[Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action (fun (e : 'expr) _ (l : 'label) (loc : int * int) -> - ([l, e] : 'field_expr_list)); - [Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ";")], - Gramext.action - (fun _ (e : 'expr) _ (l : 'label) (loc : int * int) -> - ([l, e] : 'field_expr_list)); - [Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ";"); Gramext.Sself], - Gramext.action - (fun (fel : 'field_expr_list) _ (e : 'expr) _ (l : 'label) - (loc : int * int) -> - ((l, e) :: fel : 'field_expr_list))]]; + (l, e : 'field_expr))]]; Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, - [[Gramext.Stoken ("", "<"); Gramext.Stoken ("", ">")], - Gramext.action - (fun _ _ (loc : int * int) -> (MLast.TyObj (loc, [], false) : 'ctyp)); - [Gramext.Stoken ("", "<"); - Gramext.Snterm - (Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e)); - Gramext.Stoken ("", ">")], + [[Gramext.Stoken ("", "<"); + Gramext.Slist0sep + (Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)), + Gramext.Stoken ("", ";")); + Gramext.Sopt (Gramext.Stoken ("", "..")); Gramext.Stoken ("", ">")], Gramext.action - (fun _ (ml, v : 'meth_list) _ (loc : int * int) -> - (MLast.TyObj (loc, ml, v) : 'ctyp)); + (fun _ (v : string option) (ml : 'field list) _ (loc : int * int) -> + (MLast.TyObj (loc, ml, o2b v) : 'ctyp)); [Gramext.Stoken ("", "#"); Gramext.Snterm (Grammar.Entry.obj @@ -2179,22 +2103,6 @@ Grammar.extend Gramext.action (fun (id : 'class_longident) _ (loc : int * int) -> (MLast.TyCls (loc, id) : 'ctyp))]]; - Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("", "..")], - Gramext.action (fun _ (loc : int * int) -> ([], true : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e))], - Gramext.action - (fun (f : 'field) (loc : int * int) -> ([f], false : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)); - Gramext.Stoken ("", ";")], - Gramext.action - (fun _ (f : 'field) (loc : int * int) -> ([f], false : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)); - Gramext.Stoken ("", ";"); Gramext.Sself], - Gramext.action - (fun (ml, v : 'meth_list) _ (f : 'field) (loc : int * int) -> - (f :: ml, v : 'meth_list))]]; Grammar.Entry.obj (field : 'field Grammar.Entry.e), None, [None, None, [[Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", ":"); @@ -2323,66 +2231,41 @@ Grammar.extend Some (Gramext.Level "simple"), [None, None, [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e))); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (i : string) _ _ + (fun _ (eo : 'eq_expr option) (p : 'patt_tcon) _ _ (loc : int * int) -> - (MLast.PaOlb - (loc, i, MLast.PaTyc (loc, MLast.PaLid (loc, i), t), Some e) : - 'patt)); - [Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (i : string) _ _ (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), Some e) : 'patt)); + (MLast.PaOlb (loc, "", Some (p, eo)) : 'patt)); [Gramext.Stoken ("QUESTIONIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), None) : 'patt)); + (MLast.PaOlb (loc, i, None) : 'patt)); [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + Gramext.Stoken ("", "("); + Gramext.Snterm + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e))); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (p : 'patt) _ _ (i : string) + (fun _ (eo : 'eq_expr option) (p : 'patt_tcon) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), Some e) : 'patt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (t : 'ctyp) _ (p : 'patt) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), None) : 'patt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (p : 'patt) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, p, Some e) : 'patt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (p : 'patt) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, p, None) : 'patt)); + (MLast.PaOlb (loc, i, Some (p, eo)) : 'patt)); [Gramext.Stoken ("TILDEIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.PaLab (loc, i, MLast.PaLid (loc, i)) : 'patt)); + (MLast.PaLab (loc, i, None) : 'patt)); [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (p : 'patt) _ (i : string) (loc : int * int) -> - (MLast.PaLab (loc, i, p) : 'patt)); + (MLast.PaLab (loc, i, Some p) : 'patt)); [Gramext.Stoken ("", "#"); Gramext.Snterm (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))], @@ -2394,92 +2277,92 @@ Grammar.extend Gramext.action (fun (s : 'ident) _ (loc : int * int) -> (MLast.PaVrn (loc, s) : 'patt))]]; + Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e), None, + [None, None, + [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))], + Gramext.action (fun (p : 'patt) (loc : int * int) -> (p : 'patt_tcon)); + [Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action + (fun (t : 'ctyp) _ (p : 'patt) (loc : int * int) -> + (MLast.PaTyc (loc, p, t) : 'patt_tcon))]]; Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None, [None, None, [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e))); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (i : string) _ _ + (fun _ (eo : 'eq_expr option) (p : 'ipatt_tcon) _ _ (loc : int * int) -> - (MLast.PaOlb - (loc, i, MLast.PaTyc (loc, MLast.PaLid (loc, i), t), Some e) : - 'ipatt)); - [Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (i : string) _ _ (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), Some e) : 'ipatt)); + (MLast.PaOlb (loc, "", Some (p, eo)) : 'ipatt)); [Gramext.Stoken ("QUESTIONIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), None) : 'ipatt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (p : 'ipatt) _ _ (i : string) - (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), Some e) : 'ipatt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (t : 'ctyp) _ (p : 'ipatt) _ _ (i : string) - (loc : int * int) -> - (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), None) : 'ipatt)); + (MLast.PaOlb (loc, i, None) : 'ipatt)); [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + Gramext.Stoken ("", "("); + Gramext.Snterm + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e)); + Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e))); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (p : 'ipatt) _ _ (i : string) + (fun _ (eo : 'eq_expr option) (p : 'ipatt_tcon) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, p, Some e) : 'ipatt)); - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); - Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (p : 'ipatt) _ _ (i : string) (loc : int * int) -> - (MLast.PaOlb (loc, i, p, None) : 'ipatt)); + (MLast.PaOlb (loc, i, Some (p, eo)) : 'ipatt)); [Gramext.Stoken ("TILDEIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.PaLab (loc, i, MLast.PaLid (loc, i)) : 'ipatt)); + (MLast.PaLab (loc, i, None) : 'ipatt)); [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (p : 'ipatt) _ (i : string) (loc : int * int) -> - (MLast.PaLab (loc, i, p) : 'ipatt))]]; + (MLast.PaLab (loc, i, Some p) : 'ipatt))]]; + Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e), None, + [None, None, + [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))], + Gramext.action + (fun (p : 'ipatt) (loc : int * int) -> (p : 'ipatt_tcon)); + [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)); + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action + (fun (t : 'ctyp) _ (p : 'ipatt) (loc : int * int) -> + (MLast.PaTyc (loc, p, t) : 'ipatt_tcon))]]; + Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "="); + Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], + Gramext.action + (fun (e : 'expr) _ (loc : int * int) -> (e : 'eq_expr))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.After "apply"), [Some "label", Some Gramext.NonA, [[Gramext.Stoken ("QUESTIONIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.ExOlb (loc, i, MLast.ExLid (loc, i)) : 'expr)); + (MLast.ExOlb (loc, i, None) : 'expr)); [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (e : 'expr) _ (i : string) (loc : int * int) -> - (MLast.ExOlb (loc, i, e) : 'expr)); + (MLast.ExOlb (loc, i, Some e) : 'expr)); [Gramext.Stoken ("TILDEIDENT", "")], Gramext.action (fun (i : string) (loc : int * int) -> - (MLast.ExLab (loc, i, MLast.ExLid (loc, i)) : 'expr)); + (MLast.ExLab (loc, i, None) : 'expr)); [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (e : 'expr) _ (i : string) (loc : int * int) -> - (MLast.ExLab (loc, i, e) : 'expr))]]; + (MLast.ExLab (loc, i, Some e) : 'expr))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, @@ -2488,11 +2371,6 @@ Grammar.extend Gramext.action (fun (s : 'ident) _ (loc : int * int) -> (MLast.ExVrn (loc, s) : 'expr))]]; - Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e), None, - [None, None, - [[], Gramext.action (fun (loc : int * int) -> (false : 'rec_flag)); - [Gramext.Stoken ("", "rec")], - Gramext.action (fun _ (loc : int * int) -> (true : 'rec_flag))]]; Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e), None, [None, None, @@ -2500,16 +2378,6 @@ Grammar.extend Gramext.action (fun _ (loc : int * int) -> (false : 'direction_flag)); [Gramext.Stoken ("", "to")], Gramext.action (fun _ (loc : int * int) -> (true : 'direction_flag))]]; - Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e), None, - [None, None, - [[], Gramext.action (fun (loc : int * int) -> (false : 'mutable_flag)); - [Gramext.Stoken ("", "mutable")], - Gramext.action (fun _ (loc : int * int) -> (true : 'mutable_flag))]]; - Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e), None, - [None, None, - [[], Gramext.action (fun (loc : int * int) -> (false : 'virtual_flag)); - [Gramext.Stoken ("", "virtual")], - Gramext.action (fun _ (loc : int * int) -> (true : 'virtual_flag))]]; Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, @@ -2570,7 +2438,7 @@ Grammar.extend [None, None, [[], Gramext.action - (fun (loc : int * int) -> (warn_variant () : 'warning_variant))]]; + (fun (loc : int * int) -> (warn_variant loc : 'warning_variant))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.Level "top"), [None, None, @@ -2632,7 +2500,7 @@ Grammar.extend [[], Gramext.action (fun (loc : int * int) -> - (warn_sequence () : 'warning_sequence))]]]);; + (warn_sequence loc : 'warning_sequence))]]]);; Grammar.extend (let _ = (interf : 'interf Grammar.Entry.e) diff --git a/camlp4/ocaml_src/meta/pr_dump.ml b/camlp4/ocaml_src/meta/pr_dump.ml index af7744b6a..db4228531 100644 --- a/camlp4/ocaml_src/meta/pr_dump.ml +++ b/camlp4/ocaml_src/meta/pr_dump.ml @@ -21,8 +21,9 @@ let open_out_file () = let interf ast = let pt = Ast2pt.interf (List.map fst ast) in let oc = open_out_file () in + let fname = !(Pcaml.input_file) in output_string oc Config.ast_intf_magic_number; - output_value oc !(Pcaml.input_file); + output_value oc (if fname = "-" then "" else fname); output_value oc pt; flush oc; match !(Pcaml.output_file) with @@ -33,8 +34,9 @@ let interf ast = let implem ast = let pt = Ast2pt.implem (List.map fst ast) in let oc = open_out_file () in + let fname = !(Pcaml.input_file) in output_string oc Config.ast_impl_magic_number; - output_value oc !(Pcaml.input_file); + output_value oc (if fname = "-" then "" else fname); output_value oc pt; flush oc; match !(Pcaml.output_file) with diff --git a/camlp4/ocaml_src/meta/q_MLast.ml b/camlp4/ocaml_src/meta/q_MLast.ml index f5a41f5c0..7045185f4 100644 --- a/camlp4/ocaml_src/meta/q_MLast.ml +++ b/camlp4/ocaml_src/meta/q_MLast.ml @@ -140,6 +140,9 @@ let class_str_item = Grammar.Entry.create gram "class structure item";; let ipatt = Grammar.Entry.create gram "ipatt";; let let_binding = Grammar.Entry.create gram "let_binding";; +let type_declaration = Grammar.Entry.create gram "type_declaration";; +let with_constr = Grammar.Entry.create gram "with_constr";; +let row_field = Grammar.Entry.create gram "row_field";; let a_list = Grammar.Entry.create gram "a_list";; let a_opt = Grammar.Entry.create gram "a_opt";; @@ -175,13 +178,18 @@ let mkmatchcase _ p aso w e = Qast.Tuple [p; w; e] ;; +let neg_string n = + let len = String.length n in + if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1) else "-" ^ n +;; + let mkumin _ f arg = match arg with Qast.Node ("ExInt", [Qast.Loc; Qast.Str n]) when int_of_string n > 0 -> - let n = "-" ^ n in Qast.Node ("ExInt", [Qast.Loc; Qast.Str n]) + let n = neg_string n in Qast.Node ("ExInt", [Qast.Loc; Qast.Str n]) | Qast.Node ("ExFlo", [Qast.Loc; Qast.Str n]) when float_of_string n > 0.0 -> - let n = "-" ^ n in Qast.Node ("ExFlo", [Qast.Loc; Qast.Str n]) + let n = neg_string n in Qast.Node ("ExFlo", [Qast.Loc; Qast.Str n]) | _ -> match f with Qast.Str f -> @@ -193,6 +201,11 @@ let mkumin _ f arg = ;; let mkuminpat _ f is_int s = + let s = + match s with + Qast.Str s -> Qast.Str (neg_string s) + | s -> failwith "bad unary minus" + in match is_int with Qast.Bool true -> Qast.Node ("PaInt", [Qast.Loc; s]) | Qast.Bool false -> Qast.Node ("PaFlo", [Qast.Loc; s]) @@ -264,25 +277,36 @@ let mkassert _ e = let append_elem el e = Qast.Apply ("@", [el; Qast.List [e]]);; +let not_yet_warned_antiq = ref true;; +let warn_antiq loc vers = + if !not_yet_warned_antiq then + begin + not_yet_warned_antiq := false; + !(Pcaml.warning) loc + (Printf.sprintf + "use of antiquotation syntax deprecated since version %s" vers) + end +;; + let not_yet_warned_variant = ref true;; -let warn_variant () = +let warn_variant _ = if !not_yet_warned_variant then begin not_yet_warned_variant := false; - Printf.eprintf "\ -*** warning: use of syntax of variants types deprecated since version 3.05\n"; - flush stderr + !(Pcaml.warning) (0, 1) + (Printf.sprintf + "use of syntax of variants types deprecated since version 3.05") end ;; -let not_yet_warned = ref true;; -let warn_sequence () = - if !not_yet_warned then +let not_yet_warned_seq = ref true;; +let warn_sequence _ = + if !not_yet_warned_seq then begin - not_yet_warned := false; - Printf.eprintf "\ -*** warning: use of syntax of sequences deprecated since version 3.01.1\n"; - flush stderr + not_yet_warned_seq := false; + !(Pcaml.warning) (0, 1) + (Printf.sprintf + "use of syntax of sequences deprecated since version 3.01.1") end ;; @@ -299,7 +323,10 @@ Grammar.extend and _ = (class_sig_item : 'class_sig_item Grammar.Entry.e) and _ = (class_str_item : 'class_str_item Grammar.Entry.e) and _ = (let_binding : 'let_binding Grammar.Entry.e) - and _ = (ipatt : 'ipatt Grammar.Entry.e) in + and _ = (type_declaration : 'type_declaration Grammar.Entry.e) + and _ = (ipatt : 'ipatt Grammar.Entry.e) + and _ = (with_constr : 'with_constr Grammar.Entry.e) + and _ = (row_field : 'row_field Grammar.Entry.e) in let grammar_entry_create s = Grammar.Entry.create (Grammar.of_entry sig_item) s in @@ -309,8 +336,6 @@ Grammar.extend grammar_entry_create "module_binding" and module_declaration : 'module_declaration Grammar.Entry.e = grammar_entry_create "module_declaration" - and with_constr : 'with_constr Grammar.Entry.e = - grammar_entry_create "with_constr" and cons_expr_opt : 'cons_expr_opt Grammar.Entry.e = grammar_entry_create "cons_expr_opt" and dummy : 'dummy Grammar.Entry.e = grammar_entry_create "dummy" @@ -329,8 +354,6 @@ Grammar.extend grammar_entry_create "label_patt" and label_ipatt : 'label_ipatt Grammar.Entry.e = grammar_entry_create "label_ipatt" - and type_declaration : 'type_declaration Grammar.Entry.e = - grammar_entry_create "type_declaration" and type_patt : 'type_patt Grammar.Entry.e = grammar_entry_create "type_patt" and constrain : 'constrain Grammar.Entry.e = @@ -352,7 +375,13 @@ Grammar.extend grammar_entry_create "class_fun_def" and class_structure : 'class_structure Grammar.Entry.e = grammar_entry_create "class_structure" - and cvalue : 'cvalue Grammar.Entry.e = grammar_entry_create "cvalue" + and class_self_patt : 'class_self_patt Grammar.Entry.e = + grammar_entry_create "class_self_patt" + and as_lident : 'as_lident Grammar.Entry.e = + grammar_entry_create "as_lident" + and polyt : 'polyt Grammar.Entry.e = grammar_entry_create "polyt" + and cvalue_binding : 'cvalue_binding Grammar.Entry.e = + grammar_entry_create "cvalue_binding" and label : 'label Grammar.Entry.e = grammar_entry_create "label" and class_self_type : 'class_self_type Grammar.Entry.e = grammar_entry_create "class_self_type" @@ -360,15 +389,18 @@ Grammar.extend grammar_entry_create "class_description" and class_type_declaration : 'class_type_declaration Grammar.Entry.e = grammar_entry_create "class_type_declaration" - and field_expr_list : 'field_expr_list Grammar.Entry.e = - grammar_entry_create "field_expr_list" + and field_expr : 'field_expr Grammar.Entry.e = + grammar_entry_create "field_expr" and field : 'field Grammar.Entry.e = grammar_entry_create "field" and typevar : 'typevar Grammar.Entry.e = grammar_entry_create "typevar" and row_field_list : 'row_field_list Grammar.Entry.e = grammar_entry_create "row_field_list" - and row_field : 'row_field Grammar.Entry.e = - grammar_entry_create "row_field" and name_tag : 'name_tag Grammar.Entry.e = grammar_entry_create "name_tag" + and patt_tcon : 'patt_tcon Grammar.Entry.e = + grammar_entry_create "patt_tcon" + and ipatt_tcon : 'ipatt_tcon Grammar.Entry.e = + grammar_entry_create "ipatt_tcon" + and eq_expr : 'eq_expr Grammar.Entry.e = grammar_entry_create "eq_expr" and warning_variant : 'warning_variant Grammar.Entry.e = grammar_entry_create "warning_variant" and warning_sequence : 'warning_sequence Grammar.Entry.e = @@ -382,23 +414,12 @@ Grammar.extend grammar_entry_create "when_expr_opt" and mod_ident : 'mod_ident Grammar.Entry.e = grammar_entry_create "mod_ident" - and class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e = - grammar_entry_create "class_self_patt_opt" - and as_lident_opt : 'as_lident_opt Grammar.Entry.e = - grammar_entry_create "as_lident_opt" - and meth_list : 'meth_list Grammar.Entry.e = - grammar_entry_create "meth_list" and clty_longident : 'clty_longident Grammar.Entry.e = grammar_entry_create "clty_longident" and class_longident : 'class_longident Grammar.Entry.e = grammar_entry_create "class_longident" - and rec_flag : 'rec_flag Grammar.Entry.e = grammar_entry_create "rec_flag" and direction_flag : 'direction_flag Grammar.Entry.e = grammar_entry_create "direction_flag" - and mutable_flag : 'mutable_flag Grammar.Entry.e = - grammar_entry_create "mutable_flag" - and virtual_flag : 'virtual_flag Grammar.Entry.e = - grammar_entry_create "virtual_flag" in [Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e), None, [None, None, @@ -470,8 +491,20 @@ Grammar.extend (fun (e : 'expr) (loc : int * int) -> (Qast.Node ("StExp", [Qast.Loc; e]) : 'str_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "rec")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__3))])], + Gramext.action + (fun (a : 'e__3 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.srules [[Gramext.Slist1sep (Gramext.Snterm @@ -486,8 +519,8 @@ Grammar.extend Gramext.action (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]], Gramext.action - (fun (l : 'a_list) (r : 'rec_flag) _ (loc : int * int) -> - (Qast.Node ("StVal", [Qast.Loc; r; l]) : 'str_item)); + (fun (l : 'a_list) (r : 'a_opt) _ (loc : int * int) -> + (Qast.Node ("StVal", [Qast.Loc; o2b r; l]) : 'str_item)); [Gramext.Stoken ("", "type"); Gramext.srules [[Gramext.Slist1sep @@ -571,7 +604,7 @@ Grammar.extend Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3 | _ -> match () with - _ -> raise (Match_failure ("q_MLast.ml", 274, 19)) + _ -> raise (Match_failure ("q_MLast.ml", 300, 19)) in Qast.Node ("StExc", [Qast.Loc; c; tl; b]) : 'str_item)); @@ -675,9 +708,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (s : 'sig_item) (loc : int * int) -> - (s : 'e__3))])], + (s : 'e__4))])], Gramext.action - (fun (a : 'e__3 list) (loc : int * int) -> + (fun (a : 'e__4 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -807,7 +840,7 @@ Grammar.extend Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3 | _ -> match () with - _ -> raise (Match_failure ("q_MLast.ml", 326, 19)) + _ -> raise (Match_failure ("q_MLast.ml", 352, 19)) in Qast.Node ("SgExc", [Qast.Loc; c; tl]) : 'sig_item)); @@ -821,9 +854,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (s : 'sig_item) (loc : int * int) -> - (s : 'e__4))])], + (s : 'e__5))])], Gramext.action - (fun (a : 'e__4 list) (loc : int * int) -> + (fun (a : 'e__5 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -1022,8 +1055,20 @@ Grammar.extend (loc : int * int) -> (Qast.Node ("ExLmd", [Qast.Loc; m; mb; e]) : 'expr)); [Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "rec")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__6))])], + Gramext.action + (fun (a : 'e__6 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.srules [[Gramext.Slist1sep (Gramext.Snterm @@ -1039,19 +1084,31 @@ Grammar.extend (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; Gramext.Stoken ("", "in"); Gramext.Sself], Gramext.action - (fun (x : 'expr) _ (l : 'a_list) (r : 'rec_flag) _ - (loc : int * int) -> - (Qast.Node ("ExLet", [Qast.Loc; r; l; x]) : 'expr))]; + (fun (x : 'expr) _ (l : 'a_list) (r : 'a_opt) _ (loc : int * int) -> + (Qast.Node ("ExLet", [Qast.Loc; o2b r; l; x]) : 'expr))]; Some "where", None, [[Gramext.Sself; Gramext.Stoken ("", "where"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "rec")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__7))])], + Gramext.action + (fun (a : 'e__7 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e))], Gramext.action - (fun (lb : 'let_binding) (rf : 'rec_flag) _ (e : 'expr) + (fun (lb : 'let_binding) (rf : 'a_opt) _ (e : 'expr) (loc : int * int) -> - (Qast.Node ("ExLet", [Qast.Loc; rf; Qast.List [lb]; e]) : 'expr))]; + (Qast.Node ("ExLet", [Qast.Loc; o2b rf; Qast.List [lb]; e]) : + 'expr))]; Some ":=", Some Gramext.NonA, [[Gramext.Sself; Gramext.Stoken ("", ":="); Gramext.Sself; Gramext.Snterm (Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e))], @@ -1612,8 +1669,20 @@ Grammar.extend (fun (el : 'sequence) _ (e : 'expr) (loc : int * int) -> (Qast.Cons (e, el) : 'sequence)); [Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "rec")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__8))])], + Gramext.action + (fun (a : 'e__8 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.srules [[Gramext.Slist1sep (Gramext.Snterm @@ -1629,16 +1698,16 @@ Grammar.extend (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; Gramext.srules [[Gramext.Stoken ("", ";")], - Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__5)); + Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__9)); [Gramext.Stoken ("", "in")], - Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__5))]; + Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__9))]; Gramext.Sself], Gramext.action - (fun (el : 'sequence) _ (l : 'a_list) (rf : 'rec_flag) _ + (fun (el : 'sequence) _ (l : 'a_list) (rf : 'a_opt) _ (loc : int * int) -> (Qast.List [Qast.Node - ("ExLet", [Qast.Loc; rf; l; mksequence Qast.Loc el])] : + ("ExLet", [Qast.Loc; o2b rf; l; mksequence Qast.Loc el])] : 'sequence))]]; Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e), None, [None, None, @@ -2238,13 +2307,24 @@ Grammar.extend [[Gramext.Snterm (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); Gramext.Stoken ("", ":"); - Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "mutable")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__10))])], + Gramext.action + (fun (a : 'e__10 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) (mf : 'mutable_flag) _ (i : 'a_LIDENT) - (loc : int * int) -> - (Qast.Tuple [Qast.Loc; i; mf; t] : 'label_declaration))]]; + (fun (t : 'ctyp) (mf : 'a_opt) _ (i : 'a_LIDENT) (loc : int * int) -> + (Qast.Tuple [Qast.Loc; i; o2b mf; t] : 'label_declaration))]]; Grammar.Entry.obj (ident : 'ident Grammar.Entry.e), None, [None, None, [[Gramext.Snterm @@ -2350,8 +2430,20 @@ Grammar.extend (class_declaration : 'class_declaration Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "virtual")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__11))])], + Gramext.action + (fun (a : 'e__11 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); Gramext.Snterm @@ -2362,9 +2454,9 @@ Grammar.extend (class_fun_binding : 'class_fun_binding Grammar.Entry.e))], Gramext.action (fun (cfb : 'class_fun_binding) (ctp : 'class_type_parameters) - (i : 'a_LIDENT) (vf : 'virtual_flag) (loc : int * int) -> + (i : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) -> (Qast.Record - ["ciLoc", Qast.Loc; "ciVir", vf; "ciPrm", ctp; "ciNam", i; + ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", i; "ciExp", cfb] : 'class_declaration))]]; Grammar.Entry.obj @@ -2432,8 +2524,20 @@ Grammar.extend Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), None, [Some "top", None, [[Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "rec")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__12))])], + Gramext.action + (fun (a : 'e__12 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.srules [[Gramext.Slist1sep (Gramext.Snterm @@ -2449,9 +2553,9 @@ Grammar.extend (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; Gramext.Stoken ("", "in"); Gramext.Sself], Gramext.action - (fun (ce : 'class_expr) _ (lb : 'a_list) (rf : 'rec_flag) _ + (fun (ce : 'class_expr) _ (lb : 'a_list) (rf : 'a_opt) _ (loc : int * int) -> - (Qast.Node ("CeLet", [Qast.Loc; rf; lb; ce]) : 'class_expr)); + (Qast.Node ("CeLet", [Qast.Loc; o2b rf; lb; ce]) : 'class_expr)); [Gramext.Stoken ("", "fun"); Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)); Gramext.Snterm @@ -2463,7 +2567,7 @@ Grammar.extend Some "apply", Some Gramext.NonA, [[Gramext.Sself; Gramext.Snterml - (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "simple")], + (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "label")], Gramext.action (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) -> (Qast.Node ("CeApp", [Qast.Loc; ce; e]) : 'class_expr))]; @@ -2479,16 +2583,24 @@ Grammar.extend (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ (loc : int * int) -> (Qast.Node ("CeTyc", [Qast.Loc; ce; ct]) : 'class_expr)); [Gramext.Stoken ("", "object"); - Gramext.Snterm - (Grammar.Entry.obj - (class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj + (class_self_patt : 'class_self_patt Grammar.Entry.e)))], + Gramext.action + (fun (a : 'class_self_patt option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (class_structure : 'class_structure Grammar.Entry.e)); Gramext.Stoken ("", "end")], Gramext.action - (fun _ (cf : 'class_structure) (cspo : 'class_self_patt_opt) _ - (loc : int * int) -> + (fun _ (cf : 'class_structure) (cspo : 'a_opt) _ (loc : int * int) -> (Qast.Node ("CeStr", [Qast.Loc; cspo; cf]) : 'class_expr)); [Gramext.Snterm (Grammar.Entry.obj @@ -2528,9 +2640,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (cf : 'class_str_item) (loc : int * int) -> - (cf : 'e__6))])], + (cf : 'e__13))])], Gramext.action - (fun (a : 'e__6 list) (loc : int * int) -> + (fun (a : 'e__13 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -2538,28 +2650,22 @@ Grammar.extend (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]], Gramext.action (fun (cf : 'a_list) (loc : int * int) -> (cf : 'class_structure))]]; - Grammar.Entry.obj - (class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e), + Grammar.Entry.obj (class_self_patt : 'class_self_patt Grammar.Entry.e), None, [None, None, - [[], - Gramext.action - (fun (loc : int * int) -> (Qast.Option None : 'class_self_patt_opt)); - [Gramext.Stoken ("", "("); + [[Gramext.Stoken ("", "("); Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ")")], Gramext.action (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) -> - (Qast.Option (Some (Qast.Node ("PaTyc", [Qast.Loc; p; t]))) : - 'class_self_patt_opt)); + (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'class_self_patt)); [Gramext.Stoken ("", "("); Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); Gramext.Stoken ("", ")")], Gramext.action - (fun _ (p : 'patt) _ (loc : int * int) -> - (Qast.Option (Some p) : 'class_self_patt_opt))]]; + (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'class_self_patt))]]; Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e), None, [None, None, @@ -2576,86 +2682,101 @@ Grammar.extend (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) -> (Qast.Node ("CrCtr", [Qast.Loc; t1; t2]) : 'class_str_item)); [Gramext.Stoken ("", "method"); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "private")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__17))])], + Gramext.action + (fun (a : 'e__17 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e)))], + Gramext.action + (fun (a : 'polyt option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))], Gramext.action - (fun (fb : 'fun_binding) (l : 'label) _ (loc : int * int) -> - (Qast.Node - ("CrMth", - [Qast.Loc; l; Qast.Bool false; fb; Qast.Option None]) : - 'class_str_item)); - [Gramext.Stoken ("", "method"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], - Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) _ (loc : int * int) -> - (Qast.Node - ("CrMth", - [Qast.Loc; l; Qast.Bool false; e; Qast.Option (Some t)]) : - 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))], - Gramext.action - (fun (fb : 'fun_binding) (l : 'label) _ _ (loc : int * int) -> - (Qast.Node - ("CrMth", [Qast.Loc; l; Qast.Bool true; fb; Qast.Option None]) : - 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], - Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (Qast.Node - ("CrMth", - [Qast.Loc; l; Qast.Bool true; e; Qast.Option (Some t)]) : - 'class_str_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (Qast.Node ("CrVir", [Qast.Loc; l; Qast.Bool false; t]) : + (fun (e : 'fun_binding) (topt : 'a_opt) (l : 'label) (pf : 'a_opt) _ + (loc : int * int) -> + (Qast.Node ("CrMth", [Qast.Loc; l; o2b pf; e; topt]) : 'class_str_item)); [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Stoken ("", "private"); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "private")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__16))])], + Gramext.action + (fun (a : 'e__16 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ _ (loc : int * int) -> - (Qast.Node ("CrVir", [Qast.Loc; l; Qast.Bool true; t]) : - 'class_str_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _ (loc : int * int) -> + (Qast.Node ("CrVir", [Qast.Loc; l; o2b pf; t]) : 'class_str_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm (Grammar.Entry.obj (cvalue : 'cvalue Grammar.Entry.e))], + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "mutable")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__15))])], + Gramext.action + (fun (a : 'e__15 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj + (cvalue_binding : 'cvalue_binding Grammar.Entry.e))], Gramext.action - (fun (labmfe : 'cvalue) _ (loc : int * int) -> - (let (lab, mf, e) = - match labmfe with - Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3 - | _ -> - match () with - _ -> raise (Match_failure ("q_MLast.ml", 868, 19)) - in - Qast.Node ("CrVal", [Qast.Loc; lab; mf; e]) : + (fun (e : 'cvalue_binding) (lab : 'label) (mf : 'a_opt) _ + (loc : int * int) -> + (Qast.Node ("CrVal", [Qast.Loc; lab; o2b mf; e]) : 'class_str_item)); [Gramext.Stoken ("", "inherit"); Gramext.Snterm (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj - (as_lident_opt : 'as_lident_opt Grammar.Entry.e))], + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj + (as_lident : 'as_lident Grammar.Entry.e)))], + Gramext.action + (fun (a : 'as_lident option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]], Gramext.action - (fun (pb : 'as_lident_opt) (ce : 'class_expr) _ (loc : int * int) -> + (fun (pb : 'a_opt) (ce : 'class_expr) _ (loc : int * int) -> (Qast.Node ("CrInh", [Qast.Loc; ce; pb]) : 'class_str_item)); [Gramext.Stoken ("", "declare"); Gramext.srules @@ -2667,9 +2788,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (s : 'class_str_item) (loc : int * int) -> - (s : 'e__7))])], + (s : 'e__14))])], Gramext.action - (fun (a : 'e__7 list) (loc : int * int) -> + (fun (a : 'e__14 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -2679,70 +2800,50 @@ Grammar.extend Gramext.action (fun _ (st : 'a_list) _ (loc : int * int) -> (Qast.Node ("CrDcl", [Qast.Loc; st]) : 'class_str_item))]]; - Grammar.Entry.obj (as_lident_opt : 'as_lident_opt Grammar.Entry.e), None, + Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e), None, [None, None, - [[], - Gramext.action - (fun (loc : int * int) -> (Qast.Option None : 'as_lident_opt)); - [Gramext.Stoken ("", "as"); + [[Gramext.Stoken ("", "as"); Gramext.Snterm (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))], Gramext.action - (fun (i : 'a_LIDENT) _ (loc : int * int) -> - (Qast.Option (Some i) : 'as_lident_opt))]]; - Grammar.Entry.obj (cvalue : 'cvalue Grammar.Entry.e), None, + (fun (i : 'a_LIDENT) _ (loc : int * int) -> (i : 'as_lident))]]; + Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":>"); + [[Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action (fun (t : 'ctyp) _ (loc : int * int) -> (t : 'polyt))]]; + Grammar.Entry.obj (cvalue_binding : 'cvalue_binding Grammar.Entry.e), + None, + [None, None, + [[Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (Qast.Tuple - [l; mf; - Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option None; t])] : - 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); + (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) -> + (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option None; t]) : + 'cvalue_binding)); + [Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (l : 'label) - (mf : 'mutable_flag) (loc : int * int) -> - (Qast.Tuple - [l; mf; - Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option (Some t); t2])] : - 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); + (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (loc : int * int) -> + (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option (Some t); t2]) : + 'cvalue_binding)); + [Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (Qast.Tuple [l; mf; Qast.Node ("ExTyc", [Qast.Loc; e; t])] : - 'cvalue)); - [Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); + (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) -> + (Qast.Node ("ExTyc", [Qast.Loc; e; t]) : 'cvalue_binding)); + [Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action - (fun (e : 'expr) _ (l : 'label) (mf : 'mutable_flag) - (loc : int * int) -> - (Qast.Tuple [l; mf; e] : 'cvalue))]]; + (fun (e : 'expr) _ (loc : int * int) -> (e : 'cvalue_binding))]]; Grammar.Entry.obj (label : 'label Grammar.Entry.e), None, [None, None, [[Gramext.Snterm @@ -2773,9 +2874,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (csf : 'class_sig_item) (loc : int * int) -> - (csf : 'e__8))])], + (csf : 'e__18))])], Gramext.action - (fun (a : 'e__8 list) (loc : int * int) -> + (fun (a : 'e__18 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -2836,48 +2937,68 @@ Grammar.extend (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) -> (Qast.Node ("CgCtr", [Qast.Loc; t1; t2]) : 'class_sig_item)); [Gramext.Stoken ("", "method"); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "private")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__22))])], + Gramext.action + (fun (a : 'e__22 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ (loc : int * int) -> - (Qast.Node ("CgMth", [Qast.Loc; l; Qast.Bool false; t]) : - 'class_sig_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "private"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (Qast.Node ("CgMth", [Qast.Loc; l; Qast.Bool true; t]) : - 'class_sig_item)); - [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], - Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ (loc : int * int) -> - (Qast.Node ("CgVir", [Qast.Loc; l; Qast.Bool false; t]) : - 'class_sig_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ (loc : int * int) -> + (Qast.Node ("CgMth", [Qast.Loc; l; o2b pf; t]) : 'class_sig_item)); [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual"); - Gramext.Stoken ("", "private"); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "private")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__21))])], + Gramext.action + (fun (a : 'e__21 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) _ _ _ (loc : int * int) -> - (Qast.Node ("CgVir", [Qast.Loc; l; Qast.Bool true; t]) : - 'class_sig_item)); + (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _ (loc : int * int) -> + (Qast.Node ("CgVir", [Qast.Loc; l; o2b pf; t]) : 'class_sig_item)); [Gramext.Stoken ("", "value"); - Gramext.Snterm - (Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "mutable")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__20))])], + Gramext.action + (fun (a : 'e__20 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun (t : 'ctyp) _ (l : 'label) (mf : 'mutable_flag) _ - (loc : int * int) -> - (Qast.Node ("CgVal", [Qast.Loc; l; mf; t]) : 'class_sig_item)); + (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ (loc : int * int) -> + (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; t]) : 'class_sig_item)); [Gramext.Stoken ("", "inherit"); Gramext.Snterm (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], @@ -2894,9 +3015,9 @@ Grammar.extend Gramext.Stoken ("", ";")], Gramext.action (fun _ (s : 'class_sig_item) (loc : int * int) -> - (s : 'e__9))])], + (s : 'e__19))])], Gramext.action - (fun (a : 'e__9 list) (loc : int * int) -> + (fun (a : 'e__19 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -2910,8 +3031,20 @@ Grammar.extend (class_description : 'class_description Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "virtual")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__23))])], + Gramext.action + (fun (a : 'e__23 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); Gramext.Snterm @@ -2922,17 +3055,29 @@ Grammar.extend (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], Gramext.action (fun (ct : 'class_type) _ (ctp : 'class_type_parameters) - (n : 'a_LIDENT) (vf : 'virtual_flag) (loc : int * int) -> + (n : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) -> (Qast.Record - ["ciLoc", Qast.Loc; "ciVir", vf; "ciPrm", ctp; "ciNam", n; + ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", n; "ciExp", ct] : 'class_description))]]; Grammar.Entry.obj (class_type_declaration : 'class_type_declaration Grammar.Entry.e), None, [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e)); + [[Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "virtual")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__24))])], + Gramext.action + (fun (a : 'e__24 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Snterm (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); Gramext.Snterm @@ -2943,9 +3088,9 @@ Grammar.extend (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], Gramext.action (fun (cs : 'class_type) _ (ctp : 'class_type_parameters) - (n : 'a_LIDENT) (vf : 'virtual_flag) (loc : int * int) -> + (n : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) -> (Qast.Record - ["ciLoc", Qast.Loc; "ciVir", vf; "ciPrm", ctp; "ciNam", n; + ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", n; "ciExp", cs] : 'class_type_declaration))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), @@ -2970,17 +3115,23 @@ Grammar.extend Some (Gramext.Level "simple"), [None, None, [[Gramext.Stoken ("", "{<"); - Gramext.Snterm - (Grammar.Entry.obj - (field_expr_list : 'field_expr_list Grammar.Entry.e)); + Gramext.srules + [[Gramext.Slist0sep + (Gramext.Snterm + (Grammar.Entry.obj + (field_expr : 'field_expr Grammar.Entry.e)), + Gramext.Stoken ("", ";"))], + Gramext.action + (fun (a : 'field_expr list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; Gramext.Stoken ("", ">}")], Gramext.action - (fun _ (fel : 'field_expr_list) _ (loc : int * int) -> + (fun _ (fel : 'a_list) _ (loc : int * int) -> (Qast.Node ("ExOvr", [Qast.Loc; fel]) : 'expr)); - [Gramext.Stoken ("", "{<"); Gramext.Stoken ("", ">}")], - Gramext.action - (fun _ _ (loc : int * int) -> - (Qast.Node ("ExOvr", [Qast.Loc; Qast.List []]) : 'expr)); [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":>"); Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); Gramext.Stoken ("", ")")], @@ -2996,53 +3147,48 @@ Grammar.extend (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) -> (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option (Some t); t2]) : 'expr))]]; - Grammar.Entry.obj (field_expr_list : 'field_expr_list Grammar.Entry.e), - None, + Grammar.Entry.obj (field_expr : 'field_expr Grammar.Entry.e), None, [None, None, [[Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); Gramext.Stoken ("", "="); Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], Gramext.action (fun (e : 'expr) _ (l : 'label) (loc : int * int) -> - (Qast.List [Qast.Tuple [l; e]] : 'field_expr_list)); - [Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ";")], - Gramext.action - (fun _ (e : 'expr) _ (l : 'label) (loc : int * int) -> - (Qast.List [Qast.Tuple [l; e]] : 'field_expr_list)); - [Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ";"); Gramext.Sself], - Gramext.action - (fun (fel : 'field_expr_list) _ (e : 'expr) _ (l : 'label) - (loc : int * int) -> - (Qast.Cons (Qast.Tuple [l; e], fel) : 'field_expr_list))]]; + (Qast.Tuple [l; e] : 'field_expr))]]; Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, - [[Gramext.Stoken ("", "<"); Gramext.Stoken ("", ">")], - Gramext.action - (fun _ _ (loc : int * int) -> - (Qast.Node ("TyObj", [Qast.Loc; Qast.List []; Qast.Bool false]) : - 'ctyp)); - [Gramext.Stoken ("", "<"); - Gramext.Snterm - (Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e)); + [[Gramext.Stoken ("", "<"); + Gramext.srules + [[Gramext.Slist0sep + (Gramext.Snterm + (Grammar.Entry.obj (field : 'field Grammar.Entry.e)), + Gramext.Stoken ("", ";"))], + Gramext.action + (fun (a : 'field list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.srules + [[Gramext.Sopt + (Gramext.srules + [[Gramext.Stoken ("", "..")], + Gramext.action + (fun (x : string) (loc : int * int) -> + (Qast.Str x : 'e__25))])], + Gramext.action + (fun (a : 'e__25 option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Stoken ("", ">")], Gramext.action - (fun _ (mlv : 'meth_list) _ (loc : int * int) -> - (let (ml, v) = - match mlv with - Qast.Tuple [xx1; xx2] -> xx1, xx2 - | _ -> - match () with - _ -> raise (Match_failure ("q_MLast.ml", 982, 19)) - in - Qast.Node ("TyObj", [Qast.Loc; ml; v]) : - 'ctyp)); + (fun _ (v : 'a_opt) (ml : 'a_list) _ (loc : int * int) -> + (Qast.Node ("TyObj", [Qast.Loc; ml; o2b v]) : 'ctyp)); [Gramext.Stoken ("", "#"); Gramext.Snterm (Grammar.Entry.obj @@ -3050,34 +3196,6 @@ Grammar.extend Gramext.action (fun (id : 'class_longident) _ (loc : int * int) -> (Qast.Node ("TyCls", [Qast.Loc; id]) : 'ctyp))]]; - Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("", "..")], - Gramext.action - (fun _ (loc : int * int) -> - (Qast.Tuple [Qast.List []; Qast.Bool true] : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e))], - Gramext.action - (fun (f : 'field) (loc : int * int) -> - (Qast.Tuple [Qast.List [f]; Qast.Bool false] : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)); - Gramext.Stoken ("", ";")], - Gramext.action - (fun _ (f : 'field) (loc : int * int) -> - (Qast.Tuple [Qast.List [f]; Qast.Bool false] : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)); - Gramext.Stoken ("", ";"); Gramext.Sself], - Gramext.action - (fun (mlv : 'meth_list) _ (f : 'field) (loc : int * int) -> - (let (ml, v) = - match mlv with - Qast.Tuple [xx1; xx2] -> xx1, xx2 - | _ -> - match () with - _ -> raise (Match_failure ("q_MLast.ml", 993, 19)) - in - Qast.Tuple [Qast.Cons (f, ml); v] : - 'meth_list))]]; Grammar.Entry.obj (field : 'field Grammar.Entry.e), None, [None, None, [[Gramext.Snterm @@ -3228,9 +3346,9 @@ Grammar.extend [[Gramext.Stoken ("", "&")], Gramext.action (fun (x : string) (loc : int * int) -> - (Qast.Str x : 'e__10))])], + (Qast.Str x : 'e__26))])], Gramext.action - (fun (a : 'e__10 option) (loc : int * int) -> + (fun (a : 'e__26 option) (loc : int * int) -> (Qast.Option a : 'a_opt)); [Gramext.Snterm (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], @@ -3268,111 +3386,69 @@ Grammar.extend [None, None, [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); Gramext.Snterm - (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (i : 'a_LIDENT) _ _ - (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; - Qast.Node - ("PaTyc", - [Qast.Loc; Qast.Node ("PaLid", [Qast.Loc; i]); t]); - Qast.Option (Some e)]) : - 'patt)); - [Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Snterm - (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], + Gramext.action + (fun (a : 'eq_expr option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (i : 'a_LIDENT) _ _ (loc : int * int) -> + (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ _ (loc : int * int) -> (Qast.Node ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i]); - Qast.Option (Some e)]) : + [Qast.Loc; Qast.Str ""; + Qast.Option (Some (Qast.Tuple [p; eo]))]) : 'patt)); [Gramext.Snterm (Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i]); - Qast.Option None]) : - 'patt)); - [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (p : 'patt) _ _ - (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaTyc", [Qast.Loc; p; t]); - Qast.Option (Some e)]) : - 'patt)); + (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'patt)); [Gramext.Snterm (Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); + Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); + Gramext.Snterm + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], + Gramext.action + (fun (a : 'eq_expr option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Stoken ("", ")")], Gramext.action - (fun _ (t : 'ctyp) _ (p : 'patt) _ _ (i : 'a_QUESTIONIDENT) + (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> (Qast.Node ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaTyc", [Qast.Loc; p; t]); - Qast.Option None]) : - 'patt)); - [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (p : 'patt) _ _ (i : 'a_QUESTIONIDENT) - (loc : int * int) -> - (Qast.Node ("PaOlb", [Qast.Loc; i; p; Qast.Option (Some e)]) : + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) : 'patt)); [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (p : 'patt) _ _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node ("PaOlb", [Qast.Loc; i; p; Qast.Option None]) : 'patt)); - [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node - ("PaLab", [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i])]) : - 'patt)); + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'patt)); [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (p : 'patt) _ (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node ("PaLab", [Qast.Loc; i; p]) : 'patt)); + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) : + 'patt)); [Gramext.Stoken ("", "#"); Gramext.Snterm (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))], @@ -3384,116 +3460,100 @@ Grammar.extend Gramext.action (fun (s : 'ident) _ (loc : int * int) -> (Qast.Node ("PaVrn", [Qast.Loc; s]) : 'patt))]]; - Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None, + Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e), None, [None, None, - [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); - Gramext.Snterm - (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); + [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))], + Gramext.action (fun (p : 'patt) (loc : int * int) -> (p : 'patt_tcon)); + [Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)); Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (i : 'a_LIDENT) _ _ - (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; - Qast.Node - ("PaTyc", - [Qast.Loc; Qast.Node ("PaLid", [Qast.Loc; i]); t]); - Qast.Option (Some e)]) : - 'ipatt)); - [Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); + (fun (t : 'ctyp) _ (p : 'patt) (loc : int * int) -> + (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'patt_tcon))]]; + Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "("); Gramext.Snterm - (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], + Gramext.action + (fun (a : 'eq_expr option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Stoken ("", ")")], Gramext.action - (fun _ (e : 'expr) _ (i : 'a_LIDENT) _ _ (loc : int * int) -> + (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ _ (loc : int * int) -> (Qast.Node ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i]); - Qast.Option (Some e)]) : + [Qast.Loc; Qast.Str ""; + Qast.Option (Some (Qast.Tuple [p; eo]))]) : 'ipatt)); [Gramext.Snterm (Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i]); - Qast.Option None]) : - 'ipatt)); - [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (t : 'ctyp) _ (p : 'ipatt) _ _ - (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node - ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaTyc", [Qast.Loc; p; t]); - Qast.Option (Some e)]) : - 'ipatt)); + (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt)); [Gramext.Snterm (Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ":"); - Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)); + Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); + Gramext.Snterm + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e)); + Gramext.srules + [[Gramext.Sopt + (Gramext.Snterm + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], + Gramext.action + (fun (a : 'eq_expr option) (loc : int * int) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; Gramext.Stoken ("", ")")], Gramext.action - (fun _ (t : 'ctyp) _ (p : 'ipatt) _ _ (i : 'a_QUESTIONIDENT) + (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> (Qast.Node ("PaOlb", - [Qast.Loc; i; Qast.Node ("PaTyc", [Qast.Loc; p; t]); - Qast.Option None]) : - 'ipatt)); - [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", "="); - Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (e : 'expr) _ (p : 'ipatt) _ _ (i : 'a_QUESTIONIDENT) - (loc : int * int) -> - (Qast.Node ("PaOlb", [Qast.Loc; i; p; Qast.Option (Some e)]) : - 'ipatt)); - [Gramext.Snterm - (Grammar.Entry.obj - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); - Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself; - Gramext.Stoken ("", ")")], - Gramext.action - (fun _ (p : 'ipatt) _ _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node ("PaOlb", [Qast.Loc; i; p; Qast.Option None]) : + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) : 'ipatt)); [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node - ("PaLab", [Qast.Loc; i; Qast.Node ("PaLid", [Qast.Loc; i])]) : - 'ipatt)); + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'ipatt)); [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (p : 'ipatt) _ (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node ("PaLab", [Qast.Loc; i; p]) : 'ipatt))]]; + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) : + 'ipatt))]]; + Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e), None, + [None, None, + [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))], + Gramext.action + (fun (p : 'ipatt) (loc : int * int) -> (p : 'ipatt_tcon)); + [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)); + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action + (fun (t : 'ctyp) _ (p : 'ipatt) (loc : int * int) -> + (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'ipatt_tcon))]]; + Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "="); + Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))], + Gramext.action + (fun (e : 'expr) _ (loc : int * int) -> (e : 'eq_expr))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.After "apply"), [Some "label", Some Gramext.NonA, @@ -3502,29 +3562,27 @@ Grammar.extend (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node - ("ExOlb", [Qast.Loc; i; Qast.Node ("ExLid", [Qast.Loc; i])]) : - 'expr)); + (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr)); [Gramext.Snterm (Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (e : 'expr) _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> - (Qast.Node ("ExOlb", [Qast.Loc; i; e]) : 'expr)); + (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) : + 'expr)); [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))], Gramext.action (fun (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node - ("ExLab", [Qast.Loc; i; Qast.Node ("ExLid", [Qast.Loc; i])]) : - 'expr)); + (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option None]) : 'expr)); [Gramext.Snterm (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); Gramext.Stoken ("", ":"); Gramext.Sself], Gramext.action (fun (e : 'expr) _ (i : 'a_TILDEIDENT) (loc : int * int) -> - (Qast.Node ("ExLab", [Qast.Loc; i; e]) : 'expr))]]; + (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) : + 'expr))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, @@ -3533,13 +3591,6 @@ Grammar.extend Gramext.action (fun (s : 'ident) _ (loc : int * int) -> (Qast.Node ("ExVrn", [Qast.Loc; s]) : 'expr))]]; - Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e), None, - [None, None, - [[], - Gramext.action (fun (loc : int * int) -> (Qast.Bool false : 'rec_flag)); - [Gramext.Stoken ("", "rec")], - Gramext.action - (fun _ (loc : int * int) -> (Qast.Bool true : 'rec_flag))]]; Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e), None, [None, None, @@ -3549,22 +3600,6 @@ Grammar.extend [Gramext.Stoken ("", "to")], Gramext.action (fun _ (loc : int * int) -> (Qast.Bool true : 'direction_flag))]]; - Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e), None, - [None, None, - [[], - Gramext.action - (fun (loc : int * int) -> (Qast.Bool false : 'mutable_flag)); - [Gramext.Stoken ("", "mutable")], - Gramext.action - (fun _ (loc : int * int) -> (Qast.Bool true : 'mutable_flag))]]; - Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e), None, - [None, None, - [[], - Gramext.action - (fun (loc : int * int) -> (Qast.Bool false : 'virtual_flag)); - [Gramext.Stoken ("", "virtual")], - Gramext.action - (fun _ (loc : int * int) -> (Qast.Bool true : 'virtual_flag))]]; Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, @@ -3644,7 +3679,8 @@ Grammar.extend [None, None, [[], Gramext.action - (fun (loc : int * int) -> (warn_variant () : 'warning_variant))]]; + (fun (loc : int * int) -> + (warn_variant Qast.Loc : 'warning_variant))]]; Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), Some (Gramext.Level "top"), [None, None, @@ -3656,9 +3692,9 @@ Grammar.extend (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); Gramext.Stoken ("", ";")], Gramext.action - (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__13))])], + (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__29))])], Gramext.action - (fun (a : 'e__13 list) (loc : int * int) -> + (fun (a : 'e__29 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -3686,9 +3722,9 @@ Grammar.extend (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); Gramext.Stoken ("", ";")], Gramext.action - (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__12))])], + (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__28))])], Gramext.action - (fun (a : 'e__12 list) (loc : int * int) -> + (fun (a : 'e__28 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -3710,9 +3746,9 @@ Grammar.extend (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)); Gramext.Stoken ("", ";")], Gramext.action - (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__11))])], + (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__27))])], Gramext.action - (fun (a : 'e__11 list) (loc : int * int) -> + (fun (a : 'e__27 list) (loc : int * int) -> (Qast.List a : 'a_list)); [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], @@ -3731,7 +3767,8 @@ Grammar.extend [None, None, [[], Gramext.action - (fun (loc : int * int) -> (warn_sequence () : 'warning_sequence))]]; + (fun (loc : int * int) -> + (warn_sequence Qast.Loc : 'warning_sequence))]]; Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e), None, [None, None, [[Gramext.Stoken ("ANTIQUOT", "list")], @@ -3763,35 +3800,6 @@ Grammar.extend Gramext.action (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'mod_ident))]]; - Grammar.Entry.obj - (class_self_patt_opt : 'class_self_patt_opt Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("ANTIQUOT", "")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "" loc a : 'class_self_patt_opt)); - [Gramext.Stoken ("ANTIQUOT", "opt")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "opt" loc a : 'class_self_patt_opt))]]; - Grammar.Entry.obj (as_lident_opt : 'as_lident_opt Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("ANTIQUOT", "as")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "as" loc a : 'as_lident_opt))]]; - Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e), None, - [None, None, - [[Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e)); - Gramext.Stoken ("ANTIQUOT", "")], - Gramext.action - (fun (b : string) (a : 'a_list) (loc : int * int) -> - (Qast.Tuple [a; antiquot "" loc b] : 'meth_list)); - [Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], - Gramext.action - (fun (a : 'a_list) (loc : int * int) -> - (Qast.Tuple [a; Qast.Bool false] : 'meth_list))]]; Grammar.Entry.obj (clty_longident : 'clty_longident Grammar.Entry.e), None, [None, None, @@ -3804,12 +3812,6 @@ Grammar.extend [[Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], Gramext.action (fun (a : 'a_list) (loc : int * int) -> (a : 'class_longident))]]; - Grammar.Entry.obj (rec_flag : 'rec_flag Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("ANTIQUOT", "rec")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "rec" loc a : 'rec_flag))]]; Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e), None, [None, None, @@ -3817,30 +3819,205 @@ Grammar.extend Gramext.action (fun (a : string) (loc : int * int) -> (antiquot "to" loc a : 'direction_flag))]]; - Grammar.Entry.obj (mutable_flag : 'mutable_flag Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("ANTIQUOT", "mut")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "mut" loc a : 'mutable_flag))]]; - Grammar.Entry.obj (virtual_flag : 'virtual_flag Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("ANTIQUOT", "virt")], - Gramext.action - (fun (a : string) (loc : int * int) -> - (antiquot "virt" loc a : 'virtual_flag))]]; Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), Some (Gramext.Level "simple"), [None, None, [[Gramext.Stoken ("", "object"); Gramext.Stoken ("ANTIQUOT", ""); + Gramext.Stoken ("", ";"); + Gramext.srules + [[Gramext.Slist0 + (Gramext.srules + [[Gramext.Snterm + (Grammar.Entry.obj + (class_str_item : 'class_str_item Grammar.Entry.e)); + Gramext.Stoken ("", ";")], + Gramext.action + (fun _ (cf : 'class_str_item) (loc : int * int) -> + (cf : 'e__30))])], + Gramext.action + (fun (a : 'e__30 list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.Stoken ("", "end")], + Gramext.action + (fun _ (csl : 'a_list) _ (x : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.05" in + Qast.Node + ("CeStr", + [Qast.Loc; Qast.Option None; + Qast.Cons (antiquot "" loc x, csl)]) : + 'class_expr)); + [Gramext.Stoken ("", "object"); Gramext.Stoken ("ANTIQUOT", ""); Gramext.Snterm (Grammar.Entry.obj (class_structure : 'class_structure Grammar.Entry.e)); Gramext.Stoken ("", "end")], Gramext.action - (fun _ (cf : 'class_structure) (cspo : string) _ (loc : int * int) -> - (Qast.Node ("CeStr", [Qast.Loc; antiquot "" loc cspo; cf]) : - 'class_expr))]]]);; + (fun _ (cf : 'class_structure) (x : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.05" in + Qast.Node ("CeStr", [Qast.Loc; antiquot "" loc x; cf]) : + 'class_expr))]]; + Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e), None, + [None, None, + [[Gramext.Stoken ("", "object"); Gramext.Stoken ("ANTIQUOT", ""); + Gramext.Stoken ("", ";"); + Gramext.srules + [[Gramext.Slist0 + (Gramext.srules + [[Gramext.Snterm + (Grammar.Entry.obj + (class_sig_item : 'class_sig_item Grammar.Entry.e)); + Gramext.Stoken ("", ";")], + Gramext.action + (fun _ (csf : 'class_sig_item) (loc : int * int) -> + (csf : 'e__32))])], + Gramext.action + (fun (a : 'e__32 list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.Stoken ("", "end")], + Gramext.action + (fun _ (csf : 'a_list) _ (x : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.05" in + Qast.Node + ("CtSig", + [Qast.Loc; Qast.Option None; + Qast.Cons (antiquot "" loc x, csf)]) : + 'class_type)); + [Gramext.Stoken ("", "object"); Gramext.Stoken ("ANTIQUOT", ""); + Gramext.srules + [[Gramext.Slist0 + (Gramext.srules + [[Gramext.Snterm + (Grammar.Entry.obj + (class_sig_item : 'class_sig_item Grammar.Entry.e)); + Gramext.Stoken ("", ";")], + Gramext.action + (fun _ (csf : 'class_sig_item) (loc : int * int) -> + (csf : 'e__31))])], + Gramext.action + (fun (a : 'e__31 list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.Stoken ("", "end")], + Gramext.action + (fun _ (csf : 'a_list) (x : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.05" in + Qast.Node ("CtSig", [Qast.Loc; antiquot "" loc x; csf]) : + 'class_type))]]; + Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), + Some (Gramext.Level "top"), + [None, None, + [[Gramext.Stoken ("", "let"); Gramext.Stoken ("ANTIQUOT", "rec"); + Gramext.srules + [[Gramext.Slist1sep + (Gramext.Snterm + (Grammar.Entry.obj + (let_binding : 'let_binding Grammar.Entry.e)), + Gramext.Stoken ("", "and"))], + Gramext.action + (fun (a : 'let_binding list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.Stoken ("", "in"); Gramext.Sself], + Gramext.action + (fun (x : 'expr) _ (l : 'a_list) (r : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("ExLet", [Qast.Loc; antiquot "rec" loc r; l; x]) : + 'expr))]]; + Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), + Some (Gramext.Level "top"), + [None, None, + [[Gramext.Stoken ("", "value"); Gramext.Stoken ("ANTIQUOT", "rec"); + Gramext.srules + [[Gramext.Slist1sep + (Gramext.Snterm + (Grammar.Entry.obj + (let_binding : 'let_binding Grammar.Entry.e)), + Gramext.Stoken ("", "and"))], + Gramext.action + (fun (a : 'let_binding list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]], + Gramext.action + (fun (l : 'a_list) (r : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("StVal", [Qast.Loc; antiquot "rec" loc r; l]) : + 'str_item))]]; + Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), + Some (Gramext.Level "top"), + [None, None, + [[Gramext.Stoken ("", "let"); Gramext.Stoken ("ANTIQUOT", "rec"); + Gramext.srules + [[Gramext.Slist1sep + (Gramext.Snterm + (Grammar.Entry.obj + (let_binding : 'let_binding Grammar.Entry.e)), + Gramext.Stoken ("", "and"))], + Gramext.action + (fun (a : 'let_binding list) (loc : int * int) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm + (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))], + Gramext.action + (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]; + Gramext.Stoken ("", "in"); Gramext.Sself], + Gramext.action + (fun (ce : 'class_expr) _ (lb : 'a_list) (r : string) _ + (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("CeLet", [Qast.Loc; antiquot "rec" loc r; lb; ce]) : + 'class_expr))]]; + Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e), + None, + [None, None, + [[Gramext.Stoken ("", "value"); Gramext.Stoken ("ANTIQUOT", "mut"); + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Snterm + (Grammar.Entry.obj + (cvalue_binding : 'cvalue_binding Grammar.Entry.e))], + Gramext.action + (fun (e : 'cvalue_binding) (lab : 'label) (mf : string) _ + (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("CrVal", [Qast.Loc; lab; antiquot "mut" loc mf; e]) : + 'class_str_item)); + [Gramext.Stoken ("", "inherit"); + Gramext.Snterm + (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e)); + Gramext.Stoken ("ANTIQUOT", "as")], + Gramext.action + (fun (pb : string) (ce : 'class_expr) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("CrInh", [Qast.Loc; ce; antiquot "as" loc pb]) : + 'class_str_item))]]; + Grammar.Entry.obj (class_sig_item : 'class_sig_item Grammar.Entry.e), + None, + [None, None, + [[Gramext.Stoken ("", "value"); Gramext.Stoken ("ANTIQUOT", "mut"); + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action + (fun (t : 'ctyp) _ (l : 'label) (mf : string) _ (loc : int * int) -> + (let _ = warn_antiq loc "3.06+18" in + Qast.Node ("CgVal", [Qast.Loc; l; antiquot "mut" loc mf; t]) : + 'class_sig_item))]]]);; Grammar.extend (let _ = (str_item : 'str_item Grammar.Entry.e) @@ -4294,3 +4471,27 @@ Grammar.extend (fun _ (x : 'class_str_item) (loc : int * int) -> (x : 'class_str_item_eoi))]]]; Quotation.add "class_str_item" (apply_entry class_str_item_eoi);; + +let with_constr_eoi = Grammar.Entry.create gram "with constr" in +Grammar.extend + [Grammar.Entry.obj (with_constr_eoi : 'with_constr_eoi Grammar.Entry.e), + None, + [None, None, + [[Gramext.Snterm + (Grammar.Entry.obj (with_constr : 'with_constr Grammar.Entry.e)); + Gramext.Stoken ("EOI", "")], + Gramext.action + (fun _ (x : 'with_constr) (loc : int * int) -> + (x : 'with_constr_eoi))]]]; +Quotation.add "with_constr" (apply_entry with_constr_eoi);; + +let row_field_eoi = Grammar.Entry.create gram "row_field" in +Grammar.extend + [Grammar.Entry.obj (row_field_eoi : 'row_field_eoi Grammar.Entry.e), None, + [None, None, + [[Gramext.Snterm + (Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e)); + Gramext.Stoken ("EOI", "")], + Gramext.action + (fun _ (x : 'row_field) (loc : int * int) -> (x : 'row_field_eoi))]]]; +Quotation.add "row_field" (apply_entry row_field_eoi);; diff --git a/camlp4/ocaml_src/odyl/Makefile b/camlp4/ocaml_src/odyl/Makefile index 016a2f65e..8e8d8c268 100644 --- a/camlp4/ocaml_src/odyl/Makefile +++ b/camlp4/ocaml_src/odyl/Makefile @@ -31,7 +31,8 @@ odyl_main.cmx: odyl_main.ml odyl_config.ml: echo "let standard_library =" > odyl_config.ml echo " try Sys.getenv \"CAMLP4LIB\" with" >> odyl_config.ml - echo " Not_found -> \"$(LIBDIR)/camlp4\"" >> odyl_config.ml + echo " Not_found -> \"$(LIBDIR)/camlp4\"" | \ + sed -e 's|\\|/|g' >> odyl_config.ml clean:: rm -f *.cm* *.pp[io] *.o *.bak .*.bak *.out *.opt *.a @@ -51,7 +52,7 @@ promote: compare: install: - -$(MKDIR) $(LIBDIR)/camlp4 $(BINDIR) - cp odyl.cmo odyl.cma $(LIBDIR)/camlp4/. + -$(MKDIR) "$(LIBDIR)/camlp4" "$(BINDIR)" + cp odyl.cmo odyl.cma "$(LIBDIR)/camlp4/." include .depend diff --git a/camlp4/ocaml_src/odyl/odyl_main.ml b/camlp4/ocaml_src/odyl/odyl_main.ml index 6fbdb1490..22e5e65d9 100644 --- a/camlp4/ocaml_src/odyl/odyl_main.ml +++ b/camlp4/ocaml_src/odyl/odyl_main.ml @@ -1,4 +1,4 @@ -(* camlp4r pa_ifdef.cmo *) +(* camlp4r pa_macro.cmo *) (***********************************************************************) (* *) (* Camlp4 *) diff --git a/camlp4/ocaml_src/tools/extract_crc.sh b/camlp4/ocaml_src/tools/extract_crc.sh index e711fe10c..e69de29bb 100755 --- a/camlp4/ocaml_src/tools/extract_crc.sh +++ b/camlp4/ocaml_src/tools/extract_crc.sh @@ -1,6 +0,0 @@ -#!/bin/sh -e -COMM="ocamlrun$EXE $OTOP/otherlibs/dynlink/extract_crc" -if test "`basename $OTOP`" != "ocaml_stuff"; then - COMM="$OTOP/boot/$COMM" -fi -$COMM $* |