From a9d7988f1a6df4fc6cbdbf60e0ba72cc5ce4a5d2 Mon Sep 17 00:00:00 2001 From: tobil4sk Date: Wed, 11 Dec 2024 06:33:31 +0000 Subject: [PATCH] Replace camlp5 with ppx_parser (#11860) * Use ppx_parser instead of camlp5 * Port camlp5 parser to ppx_parser * Add git url for ppx_parser * Replace instances of Stream.Error "" ppx_parser's default message is "Parse error." * Remove unnecessarily added match expression This previously did not have a match expression and it is not necessary * remove some [%s s] noise --------- Co-authored-by: Simon Krajewski --- haxe.opam | 7 +- src/dune | 1 + src/syntax/dune | 5 - src/syntax/{grammar.mly => grammar.ml} | 1349 ++++++++++++------------ src/syntax/parser.ml | 4 +- 5 files changed, 682 insertions(+), 684 deletions(-) delete mode 100644 src/syntax/dune rename src/syntax/{grammar.mly => grammar.ml} (53%) diff --git a/haxe.opam b/haxe.opam index ce732431bc3..03950c8248b 100644 --- a/haxe.opam +++ b/haxe.opam @@ -19,8 +19,7 @@ build: [ install: [make "install" "INSTALL_DIR=%{prefix}%"] remove: [make "uninstall" "INSTALL_DIR=%{prefix}%"] depends: [ - ("ocaml" {>= "5.0"} & ("camlp5" {build})) - | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00.03"})) + "ocaml" "ocamlfind" {build} "dune" {>= "1.11" & < "3.16"} "sedlex" {>= "2.0"} @@ -28,6 +27,7 @@ depends: [ "extlib" {>= "1.7.8"} "sha" "camlp-streams" + "ppx_parser" "conf-libpcre2-8" "conf-zlib" "conf-neko" @@ -35,3 +35,6 @@ depends: [ "ipaddr" "terminal_size" ] +pin-depends: [ + ["ppx_parser.dev" "git+https://github.com/tobil4sk/ppx_parser#relax-ocaml-constraint"] +] diff --git a/src/dune b/src/dune index bc6821e2680..8a305946162 100644 --- a/src/dune +++ b/src/dune @@ -26,6 +26,7 @@ (modules (:standard \ haxe)) (preprocess (per_module ((pps sedlex.ppx) json lexer) + ((pps ppx_parser) grammar) )) (wrapped false) ) diff --git a/src/syntax/dune b/src/syntax/dune deleted file mode 100644 index 53619bb2e79..00000000000 --- a/src/syntax/dune +++ /dev/null @@ -1,5 +0,0 @@ -(rule - (targets grammar.ml) - (deps grammar.mly) - (action (run %{bin:camlp5o} -impl grammar.mly -o %{targets})) -) \ No newline at end of file diff --git a/src/syntax/grammar.mly b/src/syntax/grammar.ml similarity index 53% rename from src/syntax/grammar.mly rename to src/syntax/grammar.ml index 3f2b2712fd3..6b20dae7596 100644 --- a/src/syntax/grammar.mly +++ b/src/syntax/grammar.ml @@ -22,33 +22,33 @@ open Reification open Parser open DisplayPosition -let popt f = parser - | [< v = f >] -> Some v - | [< >] -> None - -let rec plist f = parser - | [< v = f; l = plist f >] -> v :: l - | [< >] -> [] - -let psep_nonempty sep f = parser - | [< v = f; s >] -> - let rec loop = parser - | [< '(sep2,_) when sep2 = sep; v = f; l = loop >] -> v :: l - | [< >] -> [] +let popt f = function%parser + | [ f as v ] -> Some v + | [ ] -> None + +let rec plist f = function%parser + | [ f as v; [%let l = plist f] ] -> v :: l + | [ ] -> [] + +let psep_nonempty sep f = function%parser + | [ f as v; [%s s] ] -> + let rec loop = function%parser + | [ (sep2,_); f as v; loop as l ] when sep2 = sep -> v :: l + | [ ] -> [] in v :: loop s -let psep sep f = parser - | [< r = psep_nonempty sep f >] -> r - | [< >] -> [] +let psep sep f = function%parser + | [ [%let r = psep_nonempty sep f] ] -> r + | [ ] -> [] -let rec psep_trailing sep f = parser - | [< v = f; s >] -> - begin match s with parser - | [< '(sep2,_) when sep2 = sep; l = psep_trailing sep f >] -> v :: l - | [< >] -> [v] +let rec psep_trailing sep f = function%parser + | [ f as v; [%s s] ] -> + begin match%parser s with + | [ (sep2,_); [%let l = psep_trailing sep f] ] when sep2 = sep -> v :: l + | [ ] -> [v] end - | [< >] -> [] + | [ ] -> [] let pignore f = try @@ -63,36 +63,36 @@ let expect_unless_resume_p t s = match Stream.peek s with | _ -> syntax_error (Expected [s_token t]) s (next_pos s) -let ident = parser - | [< '(Const (Ident i),p) >] -> i,p +let ident = function%parser + | [ (Const (Ident i),p) ] -> i,p -let dollar_ident = parser - | [< '(Const (Ident i),p) >] -> i,p - | [< '(Dollar i,p) >] -> ("$" ^ i),p +let dollar_ident = function%parser + | [ (Const (Ident i),p) ] -> i,p + | [ (Dollar i,p) ] -> ("$" ^ i),p -let dollar_ident_macro pack = parser - | [< '(Const (Ident i),p) >] -> i,p - | [< '(Dollar i,p) >] -> ("$" ^ i),p - | [< '(Kwd Macro,p) when pack <> [] >] -> "macro", p - | [< '(Kwd Extern,p) when pack <> [] >] -> "extern", p - | [< '(Kwd Function,p) when pack <> [] >] -> "function", p +let dollar_ident_macro pack = function%parser + | [ (Const (Ident i),p) ] -> i,p + | [ (Dollar i,p) ] -> ("$" ^ i),p + | [ (Kwd Macro,p) ] when pack <> [] -> "macro", p + | [ (Kwd Extern,p) ] when pack <> [] -> "extern", p + | [ (Kwd Function,p) ] when pack <> [] -> "function", p -let lower_ident_or_macro = parser - | [< '(Const (Ident i),p) when is_lower_ident i >] -> i - | [< '(Kwd Macro,_) >] -> "macro" - | [< '(Kwd Extern,_) >] -> "extern" - | [< '(Kwd Function,_) >] -> "function" +let lower_ident_or_macro = function%parser + | [ (Const (Ident i),p) ] when is_lower_ident i -> i + | [ (Kwd Macro,_) ] -> "macro" + | [ (Kwd Extern,_) ] -> "extern" + | [ (Kwd Function,_) ] -> "function" -let property_ident = parser - | [< i,p = ident >] -> i,p - | [< '(Kwd Dynamic,p) >] -> "dynamic",p - | [< '(Kwd Default,p) >] -> "default",p - | [< '(Kwd Null,p) >] -> "null",p +let property_ident = function%parser + | [ ident as i ] -> i + | [ (Kwd Dynamic,p) ] -> "dynamic",p + | [ (Kwd Default,p) ] -> "default",p + | [ (Kwd Null,p) ] -> "null",p let questionable_dollar_ident s = - let po = match s with parser - | [< '(Question,p) >] -> Some p - | [< >] -> None + let po = match%parser s with + | [ (Question,p) ] -> Some p + | [ ] -> None in let name,p = dollar_ident s in match po with @@ -102,45 +102,45 @@ let questionable_dollar_ident s = if p.pmin <> p'.pmax then syntax_error (Custom (Printf.sprintf "Invalid usage of ?, use ?%s instead" name)) s ~pos:(Some p') (); true,(name,p) -let question_mark = parser - | [< '(Question,p) >] -> p +let question_mark = function%parser + | [ (Question,p) ] -> p let semicolon s = if fst (last_token s) = BrClose then - match s with parser - | [< '(Semicolon,p) >] -> p - | [< >] -> snd (last_token s) + match%parser s with + | [ (Semicolon,p) ] -> p + | [ ] -> snd (last_token s) else - match s with parser - | [< '(Semicolon,p) >] -> p - | [< s >] -> + match%parser s with + | [ (Semicolon,p) ] -> p + | [ ] -> syntax_error Missing_semicolon s (next_pos s) -let check_redundant_var p1 = parser - | [< '(Kwd Var),p2; s >] -> +let check_redundant_var p1 = function%parser + | [ (Kwd Var),p2; [%s s] ] -> syntax_error (Custom "`final var` is not supported, use `final` instead") ~pos:(Some (punion p1 p2)) s (); - | [< >] -> + | [ ] -> () let parsing_macro_cond = ref false let rec parse_file s = last_doc := None; - match s with parser - | [< '(Kwd Package,_); pack = parse_package; s >] -> - begin match s with parser - | [< '(Const(Ident _),p) when pack = [] >] -> error (Custom "Package name must start with a lowercase character") p - | [< psem = semicolon; l = parse_type_decls TCAfterImport psem.pmax pack [] >] -> pack , l + match%parser s with + | [ (Kwd Package,_); parse_package as pack ] -> + begin match%parser s with + | [ (Const(Ident _),p) ] when pack = [] -> error (Custom "Package name must start with a lowercase character") p + | [ semicolon as psem; [%let l = parse_type_decls TCAfterImport psem.pmax pack []] ] -> pack , l end - | [< l = parse_type_decls TCBeforePackage (-1) [] [] >] -> [] , l + | [ [%let l = parse_type_decls TCBeforePackage (-1) [] []] ] -> [] , l and parse_type_decls mode pmax pack acc s = check_type_decl_completion mode pmax s; let result = try - begin match s with parser - | [< cff = parse_type_decl mode >] -> Success cff - | [< '(Eof,p) >] -> End p - | [< >] -> Error "" + begin match%parser s with + | [ [%let cff = parse_type_decl mode] ] -> Success cff + | [ (Eof,p) ] -> End p + | [ ] -> Error "Parse error." end with | TypePath ([],Some (name,false),b,p) -> @@ -171,11 +171,11 @@ and parse_type_decls mode pmax pack acc s = ignore(resume false false s); parse_type_decls mode (last_pos s).pmax pack acc s -and parse_abstract doc meta flags p1 = parser - | [< name = type_name; tl = parse_constraint_params; st = parse_abstract_subtype; sl = plist parse_abstract_relations; s >] -> - let fl,p2 = match s with parser - | [< '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] -> fl,p2 - | [< >] -> syntax_error (Expected ["{";"to";"from"]) s ([],last_pos s) +and parse_abstract doc meta flags p1 = function%parser + | [ type_name as name; parse_constraint_params as tl; parse_abstract_subtype as st; [%let sl = plist parse_abstract_relations]; [%s s] ] -> + let fl,p2 = match%parser s with + | [ (BrOpen,_); [%let fl, p2 = parse_class_fields false p1] ] -> fl,p2 + | [ ] -> syntax_error (Expected ["{";"to";"from"]) s ([],last_pos s) in let flags = (match st with None -> flags | Some t -> AbOver t :: flags) in ({ @@ -195,23 +195,23 @@ and parse_class_content doc meta flags n p1 s = if not had_display && !in_display_file && !display_mode = DMDefault && display_position#enclosed_in p1 then syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) None (display_position#with_pos p1) in - match s with parser - | [< '(Kwd Extends,p1); ptp,b = parse_type_path_or_resume p1 >] -> + match%parser s with + | [ (Kwd Extends,p1); [%let ptp,b = parse_type_path_or_resume p1] ] -> check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; let p0 = ptp.pos_full in (* If we don't have type parameters, we have to offset by one so to not complete `extends` and `implements` after the identifier. *) let p0 = {p0 with pmax = p0.pmax + (if ptp.path.tparams = [] then 1 else 0)} in loop (had_display || b) p0 ((HExtends ptp) :: acc) - | [< '(Kwd Implements,p1); ptp,b = parse_type_path_or_resume p1 >] -> + | [ (Kwd Implements,p1); [%let ptp,b = parse_type_path_or_resume p1] ] -> check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; let p0 = ptp.pos_full in let p0 = {p0 with pmax = p0.pmax + (if ptp.path.tparams = [] then 1 else 0)} in loop (had_display || b) p0 ((HImplements ptp) :: acc) - | [< '(BrOpen,p1) >] -> + | [ (BrOpen,p1) ] -> check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; List.rev acc - | [< >] -> + | [ ] -> begin match Stream.peek s with | Some((Const(Ident name),p)) when display_position#enclosed_in p -> syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) (Some name) p @@ -232,18 +232,18 @@ and parse_class_content doc meta flags n p1 s = }, punion p1 p2) and parse_type_decl mode s = - match s with parser - | [< '(Kwd Import,p1) >] -> parse_import s p1 - | [< '(Kwd Using,p1) >] -> parse_using s p1 - | [< doc = get_doc; meta = parse_meta; c = parse_common_flags; s >] -> - match s with parser - | [< '(Kwd Function,p1); name = dollar_ident; pl = parse_constraint_params; '(POpen,_); args = psep_trailing Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] -> - let e, p2 = (match s with parser - | [< e = expr; s >] -> + match%parser s with + | [ (Kwd Import,p1) ] -> parse_import s p1 + | [ (Kwd Using,p1) ] -> parse_using s p1 + | [ get_doc as doc; parse_meta as meta; parse_common_flags as c ] -> + match%parser s with + | [ (Kwd Function,p1); dollar_ident as name; parse_constraint_params as pl; (POpen,_); [%let args = psep_trailing Comma parse_fun_param]; (PClose,_); [%let t = popt parse_type_hint] ] -> + let e, p2 = (match%parser s with + | [ expr as e ] -> ignore(semicolon s); Some e, pos e - | [< p = semicolon >] -> None, p - | [< >] -> serror() + | [ semicolon as p ] -> None, p + | [ ] -> serror() ) in let f = { f_params = pl; @@ -259,14 +259,14 @@ and parse_type_decl mode s = d_flags = ExtList.List.filter_map decl_flag_to_module_field_flag c; d_data = FFun f; }, punion p1 p2) - | [< '(Kwd Var,p1); name = dollar_ident; s >] -> + | [ (Kwd Var,p1); dollar_ident as name ] -> let p2,t = - match s with parser - | [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_) >] -> + match%parser s with + | [ (POpen,_); property_ident as i1; (Comma,_); property_ident as i2; (PClose,_) ] -> let t = popt parse_type_hint s in let e,p2 = parse_var_field_assignment s in p2,FProp (i1,i2,t,e) - | [< t = popt parse_type_hint; s >] -> + | [ [%let t = popt parse_type_hint] ] -> let e,p2 = parse_var_field_assignment s in p2,FVar (t,e) in @@ -278,11 +278,11 @@ and parse_type_decl mode s = d_flags = ExtList.List.filter_map decl_flag_to_module_field_flag c; d_data = t; }, punion p1 p2) - | [< '(Kwd Enum,p1) >] -> - begin match s with parser - | [< '(Kwd Abstract,p1); a,p = parse_abstract doc meta (AbEnum :: (convert_abstract_flags c)) p1 >] -> + | [ (Kwd Enum,p1) ] -> + begin match%parser s with + | [ (Kwd Abstract,p1); [%let a,p = parse_abstract doc meta (AbEnum :: (convert_abstract_flags c)) p1] ] -> (EAbstract a,p) - | [< name = type_name; tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> + | [ type_name as name; parse_constraint_params as tl; (BrOpen,_); [%let l = plist parse_enum]; (BrClose,p2) ] -> (EEnum { d_name = name; d_doc = doc_from_string_opt doc; @@ -292,12 +292,12 @@ and parse_type_decl mode s = d_data = l }, punion p1 p2) end - | [< n , p1 = parse_class_flags >] -> + | [ [%let n, p1 = parse_class_flags] ] -> parse_class_content doc meta c n p1 s - | [< '(Kwd Typedef,p1); name = type_name; tl = parse_constraint_params; '(Binop OpAssign,p2); t = parse_complex_type_at p2; s >] -> - (match s with parser - | [< '(Semicolon,_) >] -> () - | [< >] -> ()); + | [ (Kwd Typedef,p1); type_name as name; parse_constraint_params as tl; (Binop OpAssign,p2); [%let t = parse_complex_type_at p2] ] -> + (match%parser s with + | [ (Semicolon,_) ] -> () + | [ ] -> ()); (ETypedef { d_name = name; d_doc = doc_from_string_opt doc; @@ -306,24 +306,24 @@ and parse_type_decl mode s = d_flags = ExtList.List.filter_map decl_flag_to_typedef_flag c; d_data = t; }, punion p1 (pos t)) - | [< '(Kwd Abstract,p1) >] -> - begin match s with parser - | [< a,p = parse_abstract doc meta (convert_abstract_flags c) p1 >] -> + | [ (Kwd Abstract,p1) ] -> + begin match%parser s with + | [ [%let a,p = parse_abstract doc meta (convert_abstract_flags c) p1] ] -> EAbstract a,p - | [< >] -> + | [ ] -> let c2 = parse_common_flags s in - begin match s with parser - | [< flags,_ = parse_class_flags >] -> + begin match%parser s with + | [ [%let flags,_p = parse_class_flags ] ] -> parse_class_content doc meta (c @ c2) (HAbstract :: flags) p1 s - | [< >] -> + | [ ] -> serror() end end - | [< >] -> + | [ ] -> match List.rev c with | (DFinal,p1) :: crest -> - (match s with parser - | [< name = dollar_ident; t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] -> + (match%parser s with + | [ dollar_ident as name; [%let t = popt parse_type_hint]; [%let e,p2 = parse_var_field_assignment] ] -> (EStatic { d_name = name; d_doc = doc_from_string_opt doc; @@ -332,15 +332,15 @@ and parse_type_decl mode s = d_flags = (ExtList.List.filter_map decl_flag_to_module_field_flag (List.rev crest)) @ [AFinal,p1]; d_data = FVar(t,e); }, punion p1 p2) - | [< >] -> check_type_decl_flag_completion mode c s) + | [ ] -> check_type_decl_flag_completion mode c s) | _ -> check_type_decl_flag_completion mode c s and parse_class doc meta cflags need_name s = let opt_name = if need_name then type_name else (fun s -> match popt type_name s with None -> "",null_pos | Some n -> n) in - match s with parser - | [< n , p1 = parse_class_flags; name = opt_name; tl = parse_constraint_params; hl = plist parse_class_herit; '(BrOpen,_); fl, p2 = parse_class_fields (not need_name) p1 >] -> + match%parser s with + | [ [%let n,p1 = parse_class_flags]; opt_name as name; parse_constraint_params as tl; [%let hl = plist parse_class_herit]; (BrOpen,_); [%let fl, p2 = parse_class_fields (not need_name) p1] ] -> (EClass { d_name = name; d_doc = doc; @@ -352,37 +352,37 @@ and parse_class doc meta cflags need_name s = and parse_import' s p1 = let rec loop pn acc = - match s with parser - | [< '(Dot,p) >] -> + match%parser s with + | [ (Dot,p) ] -> let resume() = type_path (List.map fst acc) true (punion pn p) in check_resume p resume (fun () -> ()); - begin match s with parser - | [< '(Const (Ident k),p) >] -> + begin match%parser s with + | [ (Const (Ident k),p) ] -> loop pn ((k,p) :: acc) - | [< '(Kwd Macro,p) >] -> + | [ (Kwd Macro,p) ] -> loop pn (("macro",p) :: acc) - | [< '(Kwd Extern,p) >] -> + | [ (Kwd Extern,p) ] -> loop pn (("extern",p) :: acc) - | [< '(Kwd Function,p) >] -> + | [ (Kwd Function,p) ] -> loop pn (("function",p) :: acc) - | [< '(Binop OpMult,_) >] -> + | [ (Binop OpMult,_) ] -> List.rev acc, IAll - | [< >] -> + | [ ] -> ignore(popt semicolon s); syntax_error (Expected ["identifier"]) s (List.rev acc,INormal) end - | [< '(Kwd In,_); '(Const (Ident name),pname) >] -> + | [ (Kwd In,_); (Const (Ident name),pname) ] -> List.rev acc, IAsName(name,pname) - | [< '(Const (Ident "as"),_); '(Const (Ident name),pname) >] -> + | [ (Const (Ident "as"),_); (Const (Ident name),pname) ] -> List.rev acc, IAsName(name,pname) - | [< >] -> + | [ ] -> List.rev acc,INormal in - let path, mode = (match s with parser - | [< '(Const (Ident name),p) >] -> loop p [name,p] - | [< >] -> + let path, mode = (match%parser s with + | [ (Const (Ident name),p) ] -> loop p [name,p] + | [ ] -> if would_skip_display_position p1 true s then ([],INormal) else @@ -392,10 +392,10 @@ and parse_import' s p1 = and parse_import s p1 = let (path,mode) = parse_import' s p1 in - let p2 = match s with parser - | [< '(Semicolon,p2) >] -> + let p2 = match%parser s with + | [ (Semicolon,p2) ] -> p2 - | [< >] -> + | [ ] -> if would_skip_display_position p1 true s then display_position#with_pos p1 else @@ -405,27 +405,27 @@ and parse_import s p1 = and parse_using' s p1 = let rec loop pn acc = - match s with parser - | [< '(Dot,p) >] -> + match%parser s with + | [ (Dot,p) ] -> check_resume p (fun () -> type_path (List.map fst acc) false (punion pn p)) (fun () -> ()); - begin match s with parser - | [< '(Const (Ident k),p) >] -> + begin match%parser s with + | [ (Const (Ident k),p) ] -> loop pn ((k,p) :: acc) - | [< '(Kwd Macro,p) >] -> + | [ (Kwd Macro,p) ] -> loop pn (("macro",p) :: acc) - | [< '(Kwd Extern,p) >] -> + | [ (Kwd Extern,p) ] -> loop pn (("extern",p) :: acc) - | [< '(Kwd Function,p) >] -> + | [ (Kwd Function,p) ] -> loop pn (("function",p) :: acc) - | [< >] -> + | [ ] -> syntax_error (Expected ["identifier"]) s (List.rev acc); end - | [< >] -> + | [ ] -> List.rev acc in - match s with parser - | [< '(Const (Ident name),p) >] -> loop p [name,p] - | [< >] -> + match%parser s with + | [ (Const (Ident name),p) ] -> loop p [name,p] + | [ ] -> if would_skip_display_position p1 true s then [] else @@ -433,10 +433,10 @@ and parse_using' s p1 = and parse_using s p1 = let path = parse_using' s p1 in - let p2 = match s with parser - | [< '(Semicolon,p2) >] -> + let p2 = match%parser s with + | [ (Semicolon,p2) ] -> p2 - | [< >] -> + | [ ] -> if would_skip_display_position p1 true s then display_position#with_pos p1 else @@ -444,7 +444,7 @@ and parse_using s p1 = in (EUsing path,punion p1 p2) -and parse_abstract_relations s = +and parse_abstract_relations = let check_display p1 (ct,p2) = if !in_display_file && p1.pmax < (display_position#get).pmin && p2.pmin >= (display_position#get).pmax then (* This means we skipped the display position between the to/from and the type-hint we parsed. @@ -453,16 +453,15 @@ and parse_abstract_relations s = else (ct,p2) in - match s with parser - | [< '(Const (Ident "to"),p1); t = parse_complex_type_at p1 >] -> (AbTo (check_display p1 t)) - | [< '(Const (Ident "from"),p1); t = parse_complex_type_at p1 >] -> AbFrom (check_display p1 t) + function%parser + | [ (Const (Ident "to"),p1); [%let t = parse_complex_type_at p1] ] -> (AbTo (check_display p1 t)) + | [ (Const (Ident "from"),p1); [%let t = parse_complex_type_at p1] ] -> AbFrom (check_display p1 t) -and parse_abstract_subtype s = - match s with parser - | [< '(POpen, _); t = parse_complex_type; '(PClose,_) >] -> Some t - | [< >] -> None +and parse_abstract_subtype = function%parser + | [ (POpen, _); parse_complex_type as t; (PClose,_) ] -> Some t + | [ ] -> None -and parse_package s = psep Dot lower_ident_or_macro s +and parse_package = psep Dot lower_ident_or_macro and resume tdecl fdecl s = (* look for next variable/function or next type declaration *) @@ -528,10 +527,10 @@ and resume tdecl fdecl s = and parse_class_field_resume acc tdecl s = let result = try - begin match s with parser - | [< cff = parse_class_field tdecl >] -> Success cff - | [< '(BrClose,p) >] -> End p - | [< >] -> Error "" + begin match%parser s with + | [ [%let cff = parse_class_field tdecl] ] -> Success cff + | [ (BrClose,p) ] -> End p + | [ ] -> Error "Parse error." end with Stream.Error msg -> Error msg @@ -551,25 +550,25 @@ and parse_class_field_resume acc tdecl s = and parse_class_fields tdecl p1 s = if not (!in_display_file) then begin let acc = plist (parse_class_field tdecl) s in - let p2 = (match s with parser - | [< '(BrClose,p2) >] -> p2 - | [< >] -> error (Expected ["}"]) (next_pos s) + let p2 = (match%parser s with + | [ (BrClose,p2) ] -> p2 + | [ ] -> error (Expected ["}"]) (next_pos s) ) in acc,p2 end else parse_class_field_resume [] tdecl s -and parse_common_flags = parser - | [< '(Kwd Private,p); l = parse_common_flags >] -> (DPrivate,p) :: l - | [< '(Kwd Extern,p); l = parse_common_flags >] -> (DExtern,p) :: l - | [< '(Kwd Final,p); l = parse_common_flags >] -> (DFinal,p) :: l - | [< '(Kwd Macro,p); l = parse_common_flags >] -> (DMacro,p) :: l - | [< '(Kwd Dynamic,p); l = parse_common_flags >] -> (DDynamic,p) :: l - | [< '(Kwd Inline,p); l = parse_common_flags >] -> (DInline,p) :: l - | [< '(Kwd Public,p); l = parse_common_flags >] -> (DPublic,p) :: l - | [< '(Kwd Static,p); l = parse_common_flags >] -> (DStatic,p) :: l - | [< '(Kwd Overload,p); l = parse_common_flags >] -> (DOverload,p) :: l - | [< >] -> [] +and parse_common_flags = function%parser + | [ (Kwd Private,p); parse_common_flags as l ] -> (DPrivate,p) :: l + | [ (Kwd Extern,p); parse_common_flags as l ] -> (DExtern,p) :: l + | [ (Kwd Final,p); parse_common_flags as l ] -> (DFinal,p) :: l + | [ (Kwd Macro,p); parse_common_flags as l ] -> (DMacro,p) :: l + | [ (Kwd Dynamic,p); parse_common_flags as l ] -> (DDynamic,p) :: l + | [ (Kwd Inline,p); parse_common_flags as l ] -> (DInline,p) :: l + | [ (Kwd Public,p); parse_common_flags as l ] -> (DPublic,p) :: l + | [ (Kwd Static,p); parse_common_flags as l ] -> (DStatic,p) :: l + | [ (Kwd Overload,p); parse_common_flags as l ] -> (DOverload,p) :: l + | [ ] -> [] and parse_meta_argument_expr s = let e = expr s in @@ -584,60 +583,60 @@ and parse_meta_argument_expr s = e end -and parse_meta_params pname s = match s with parser - | [< '(POpen,p) when p.pmin = pname.pmax; params = psep_trailing Comma parse_meta_argument_expr; >] -> +and parse_meta_params pname s = match%parser s with + | [ (POpen,p); [%let params = psep_trailing Comma parse_meta_argument_expr]; ] when p.pmin = pname.pmax -> ignore(expect_unless_resume_p PClose s); params - | [< >] -> [] + | [ ] -> [] -and parse_meta_entry = parser - [< '(At,p1); s >] -> +and parse_meta_entry = function%parser + [ (At,p1); [%s s] ] -> let meta = check_resume p1 (fun () -> Some (Meta.HxCompletion,[],p1)) (fun () -> None) in - match s with parser - | [< name,p = parse_meta_name p1; params = parse_meta_params p >] -> (name,params,punion p1 p) - | [< >] -> match meta with None -> serror() | Some meta -> meta + match%parser s with + | [ [%let name,p = parse_meta_name p1]; [%let params = parse_meta_params p] ] -> (name,params,punion p1 p) + | [ ] -> match meta with None -> serror() | Some meta -> meta -and parse_meta = parser - | [< entry = parse_meta_entry; s >] -> +and parse_meta = function%parser + | [ parse_meta_entry as entry; [%s s] ] -> entry :: parse_meta s - | [< >] -> [] + | [ ] -> [] and parse_meta_name_2 p1 acc s = - let part,p = match s with parser - | [< '(Const (Ident i),p) when p.pmin = p1.pmax >] -> i,p - | [< '(Kwd k,p) when p.pmin = p1.pmax >] -> s_keyword k,p + let part,p = match%parser s with + | [ (Const (Ident i),p) ] when p.pmin = p1.pmax -> i,p + | [ (Kwd k,p) ] when p.pmin = p1.pmax -> s_keyword k,p in let acc = part :: acc in - match s with parser - | [< '(Dot,p1); part,p2 = parse_meta_name_2 p1 acc >] -> part,punion p p2 - | [< >] -> acc,punion p1 p + match%parser s with + | [ (Dot,p1); [%let part,p2 = parse_meta_name_2 p1 acc] ] -> part,punion p p2 + | [ ] -> acc,punion p1 p -and parse_meta_name p1 = parser - | [< '(DblDot,p) when p.pmin = p1.pmax; s >] -> +and parse_meta_name p1 s = match%parser s with + | [ (DblDot,p) ] when p.pmin = p1.pmax -> let meta = check_resume p (fun () -> Some (Meta.HxCompletion,p)) (fun() -> None) in - begin match s with parser - | [< name,p2 = parse_meta_name_2 p [] >] -> (Meta.parse (rev_concat "." name)),p2 - | [< >] -> match meta with None -> raise Stream.Failure | Some meta -> meta + begin match%parser s with + | [ [%let name,p2 = parse_meta_name_2 p []] ] -> (Meta.parse (rev_concat "." name)),p2 + | [ ] -> match meta with None -> raise Stream.Failure | Some meta -> meta end - | [< name,p2 = parse_meta_name_2 p1 [] >] -> (Meta.Custom (rev_concat "." name)),p2 + | [ [%let name,p2 = parse_meta_name_2 p1 []] ] -> (Meta.Custom (rev_concat "." name)),p2 -and parse_enum_flags = parser - | [< '(Kwd Enum,p) >] -> [] , p +and parse_enum_flags = function%parser + | [ (Kwd Enum,p) ] -> [] , p -and parse_class_flags = parser - | [< '(Kwd Class,p) >] -> [] , p - | [< '(Kwd Interface,p) >] -> [HInterface] , p +and parse_class_flags = function%parser + | [ (Kwd Class,p) ] -> [] , p + | [ (Kwd Interface,p) ] -> [HInterface] , p -and parse_complex_type_at p = parser - | [< t = parse_complex_type >] -> t - | [< s >] -> +and parse_complex_type_at p s = match%parser s with + | [ parse_complex_type as t ] -> t + | [ ] -> if would_skip_display_position p false s then (magic_type_th (display_position#with_pos p)) else serror() -and parse_type_hint = parser - | [< '(DblDot,p1); s >] -> +and parse_type_hint = function%parser + | [ (DblDot,p1); [%s s] ] -> let f () = parse_complex_type_at p1 s in check_resume_range p1 s (fun p2 -> @@ -646,14 +645,14 @@ and parse_type_hint = parser ) f -and parse_type_opt = parser - | [< t = parse_type_hint >] -> Some t - | [< >] -> None +and parse_type_opt = function%parser + | [ parse_type_hint as t ] -> Some t + | [ ] -> None and parse_complex_type s = parse_complex_type_maybe_named false s -and parse_complex_type_maybe_named allow_named = parser - | [< '(POpen,p1); tl = psep_trailing Comma (parse_complex_type_maybe_named true); '(PClose,p2); s >] -> +and parse_complex_type_maybe_named allow_named = function%parser + | [ (POpen,p1); [%let tl = psep_trailing Comma (parse_complex_type_maybe_named true)]; (PClose,p2); [%s s] ] -> begin match tl with | [] | [(CTNamed _,_)] -> (* it was () or (a:T) - clearly a new function type syntax, proceed with parsing return type *) @@ -666,44 +665,44 @@ and parse_complex_type_maybe_named allow_named = parser (* it was multiple arguments - clearly a new function type syntax, proceed with parsing return type *) parse_function_type_next tl p1 s end - | [< s >] -> + | [ [%s s] ] -> let t = parse_complex_type_inner allow_named s in parse_complex_type_next t s -and parse_structural_extension = parser - | [< '(Binop OpGt,p1); s >] -> - match s with parser - | [< t = parse_type_path >] -> - begin match s with parser - | [< '(Comma,_) >] -> t - | [< >] -> syntax_error (Expected [","]) s t +and parse_structural_extension = function%parser + | [ (Binop OpGt,p1); [%s s] ] -> + match%parser s with + | [ parse_type_path as t ] -> + begin match%parser s with + | [ (Comma,_) ] -> t + | [ ] -> syntax_error (Expected [","]) s t end; - | [< >] -> + | [ ] -> if would_skip_display_position p1 false s then begin - begin match s with parser - | [< '(Comma,_) >] -> () - | [< >] -> () + begin match%parser s with + | [ (Comma,_) ] -> () + | [ ] -> () end; let p = display_position#with_pos p1 in make_ptp magic_type_path p end else raise Stream.Failure -and parse_complex_type_inner allow_named = parser - | [< '(POpen,p1); t = parse_complex_type; '(PClose,p2) >] -> CTParent t,punion p1 p2 - | [< '(BrOpen,p1); s >] -> - (match s with parser - | [< l,p2 = parse_type_anonymous >] -> CTAnonymous l,punion p1 p2 - | [< t = parse_structural_extension; s>] -> +and parse_complex_type_inner allow_named s = match%parser s with + | [ (POpen,p1); parse_complex_type as t; (PClose,p2) ] -> CTParent t,punion p1 p2 + | [ (BrOpen,p1) ] -> + (match%parser s with + | [ [%let l,p2 = parse_type_anonymous] ] -> CTAnonymous l,punion p1 p2 + | [ parse_structural_extension as t ] -> let tl = t :: plist parse_structural_extension s in - (match s with parser - | [< l,p2 = parse_type_anonymous >] -> CTExtend (tl,l),punion p1 p2 - | [< l,p2 = parse_class_fields true p1 >] -> CTExtend (tl,l),punion p1 p2) - | [< l,p2 = parse_class_fields true p1 >] -> CTAnonymous l,punion p1 p2 - | [< >] -> serror()) - | [< '(Question,p1); t,p2 = parse_complex_type_inner allow_named >] -> + (match%parser s with + | [ [%let l,p2 = parse_type_anonymous] ] -> CTExtend (tl,l),punion p1 p2 + | [ [%let l,p2 = parse_class_fields true p1] ] -> CTExtend (tl,l),punion p1 p2) + | [ [%let l,p2 = parse_class_fields true p1] ] -> CTAnonymous l,punion p1 p2 + | [ ] -> serror()) + | [ (Question,p1); [%let t,p2 = parse_complex_type_inner allow_named] ] -> CTOptional (t,p2),punion p1 p2 - | [< '(Spread,p1); t,p2 = parse_complex_type_inner allow_named >] -> + | [ (Spread,p1); [%let t,p2 = parse_complex_type_inner allow_named] ] -> let hint = match t with | CTNamed (_,hint) -> hint @@ -711,23 +710,23 @@ and parse_complex_type_inner allow_named = parser in let p = punion p1 p2 in CTPath (make_ptp (mk_type_path ~params:[TPType hint] (["haxe"],"Rest")) p),p - | [< n = dollar_ident; s >] -> - (match s with parser - | [< '(DblDot,_) when allow_named; t = parse_complex_type >] -> + | [ dollar_ident as n ] -> + (match%parser s with + | [ (DblDot,_); parse_complex_type as t ] when allow_named-> let p1 = snd n in let p2 = snd t in CTNamed (n,t),punion p1 p2 - | [< s >] -> + | [ [%s s] ] -> let n,p = n in let ptp = parse_type_path2 None [] n p s in CTPath ptp,ptp.pos_full) - | [< ptp = parse_type_path >] -> + | [ parse_type_path as ptp ] -> CTPath ptp,ptp.pos_full and parse_type_path s = parse_type_path1 None [] s -and parse_type_path1 p0 pack = parser - | [< name, p1 = dollar_ident_macro pack; s >] -> +and parse_type_path1 p0 pack = function%parser + | [ [%let name, p1 = dollar_ident_macro pack]; [%s s] ] -> parse_type_path2 p0 pack name p1 s and parse_type_path2 p0 pack name p1 s : placed_type_path = @@ -742,59 +741,59 @@ and parse_type_path2 p0 pack name p1 s : placed_type_path = f() in if is_lower_ident name then - (match s with parser - | [< '(Dot,p) >] -> + (match%parser s with + | [ (Dot,p) ] -> check_resume p (fun () -> raise (TypePath (List.rev (name :: pack),None,false,punion (match p0 with None -> p1 | Some p0 -> p0) p))) (fun () -> parse_type_path1 (match p0 with None -> Some p1 | Some _ -> p0) (name :: pack) s) - | [< '(Semicolon,_) >] -> + | [ (Semicolon,_) ] -> check_display (fun () -> error (Custom "Type name should start with an uppercase letter") p1) - | [< >] -> + | [ ] -> check_display serror) else - let sub,p2 = (match s with parser - | [< '(Dot,p); s >] -> + let sub,p2 = (match%parser s with + | [ (Dot,p) ] -> (check_resume p (fun () -> raise (TypePath (List.rev pack,Some (name,false),false,punion (match p0 with None -> p1 | Some p0 -> p0) p))) - (fun () -> match s with parser - | [< '(Const (Ident name),p2) when not (is_lower_ident name) >] -> Some name,p2 - | [< >] -> serror())) - | [< >] -> None,p1 + (fun () -> match%parser s with + | [ (Const (Ident name),p2) ] when not (is_lower_ident name) -> Some name,p2 + | [ ] -> serror())) + | [ ] -> None,p1 ) in let p1 = match p0 with None -> p1 | Some p -> p in let p_path = punion p1 p2 in - let params,p2 = (match s with parser - | [< '(Binop OpLt,plt); l = psep Comma (parse_type_path_or_const plt) >] -> - begin match s with parser - | [<'(Binop OpGt,p2) >] -> l,p2 - | [< >] -> + let params,p2 = (match%parser s with + | [ (Binop OpLt,plt); [%let l = psep Comma (parse_type_path_or_const plt)] ] -> + begin match%parser s with + | [ (Binop OpGt,p2) ] -> l,p2 + | [ ] -> syntax_error (Expected [">"]) s (l,pos (last_token s)) end - | [< >] -> [],p2 + | [ ] -> [],p2 ) in let tp = mk_type_path ~params ?sub (List.rev pack,name) and p_full = punion p1 p2 in make_ptp tp ~p_path p_full -and type_name = parser - | [< '(Const (Ident name),p); s >] -> +and type_name = function%parser + | [ (Const (Ident name),p); [%s s] ] -> if is_lower_ident name then syntax_error (Custom "Type name should start with an uppercase letter") ~pos:(Some p) s (name,p) else name,p - | [< '(Dollar name,p) >] -> "$" ^ name,p + | [ (Dollar name,p) ] -> "$" ^ name,p -and parse_type_path_or_const plt = parser +and parse_type_path_or_const plt = function%parser (* we can't allow (expr) here *) - | [< '(BkOpen,p1); e = parse_array_decl p1 >] -> TPExpr (e) - | [< t = parse_complex_type >] -> TPType t - | [< '(Unop op,p1); '(Const c,p2) >] -> TPExpr (make_unop op (EConst c,p2) p1) - | [< '(Binop OpSub,p1); '(Const c,p2) >] -> TPExpr (make_unop Neg (EConst c,p2) p1) - | [< '(Const c,p) >] -> TPExpr (EConst c,p) - | [< '(Kwd True,p) >] -> TPExpr (EConst (Ident "true"),p) - | [< '(Kwd False,p) >] -> TPExpr (EConst (Ident "false"),p) - | [< e = expr >] -> TPExpr e - | [< s >] -> + | [ (BkOpen,p1); [%let e = parse_array_decl p1] ] -> TPExpr (e) + | [ parse_complex_type as t ] -> TPType t + | [ (Unop op,p1); (Const c,p2) ] -> TPExpr (make_unop op (EConst c,p2) p1) + | [ (Binop OpSub,p1); (Const c,p2) ] -> TPExpr (make_unop Neg (EConst c,p2) p1) + | [ (Const c,p) ] -> TPExpr (EConst c,p) + | [ (Kwd True,p) ] -> TPExpr (EConst (Ident "true"),p) + | [ (Kwd False,p) ] -> TPExpr (EConst (Ident "false"),p) + | [ expr as e ] -> TPExpr e + | [ [%s s] ] -> if !in_display_file then begin if would_skip_display_position plt false s then begin TPType (magic_type_th (display_position#with_pos plt)) @@ -816,42 +815,42 @@ and parse_complex_type_next (t : type_hint) s = | _ -> CTIntersection ([t;t2,p2]),punion (pos t) p2 in - match s with parser - | [< '(Arrow,pa); s >] -> - begin match s with parser - | [< t2,p2 = parse_complex_type >] -> make_fun t2 p2 - | [< >] -> + match%parser s with + | [ (Arrow,pa) ] -> + begin match%parser s with + | [ [%let t2,p2 = parse_complex_type] ] -> make_fun t2 p2 + | [ ] -> if would_skip_display_position pa false s then begin let p = display_position#with_pos pa in make_fun (magic_type_ct p) p end else serror() end - | [< '(Binop OpAnd,pa); s >] -> - begin match s with parser - | [< t2,p2 = parse_complex_type >] -> make_intersection t2 p2 - | [< >] -> + | [ (Binop OpAnd,pa) ] -> + begin match%parser s with + | [ [%let t2,p2 = parse_complex_type] ] -> make_intersection t2 p2 + | [ ] -> if would_skip_display_position pa false s then begin let p = display_position#with_pos pa in make_intersection (magic_type_ct p) p end else serror() end - | [< >] -> t + | [ ] -> t -and parse_function_type_next tl p1 = parser - | [< '(Arrow,pa); s >] -> - begin match s with parser - | [< tret = parse_complex_type_inner false >] -> CTFunction (tl,tret), punion p1 (snd tret) - | [< >] -> if would_skip_display_position pa false s then begin +and parse_function_type_next tl p1 = function%parser + | [ (Arrow,pa); [%s s] ] -> + begin match%parser s with + | [ [%let tret = parse_complex_type_inner false] ] -> CTFunction (tl,tret), punion p1 (snd tret) + | [ ] -> if would_skip_display_position pa false s then begin let ct = magic_type_th (display_position#with_pos pa) in CTFunction (tl,ct), punion p1 pa end else serror() end - | [< >] -> serror () + | [ ] -> serror () and parse_type_anonymous s = let p0 = popt question_mark s in - match s with parser - | [< name, p1 = dollar_ident; t = parse_type_hint; s >] -> + match%parser s with + | [ [%let name, p1 = dollar_ident]; parse_type_hint as t ] -> let opt,p1 = match p0 with | Some p -> true,punion p p1 | None -> false,p1 @@ -867,32 +866,32 @@ and parse_type_anonymous s = cff_pos = punion p1 p2; } :: acc in - begin match s with parser - | [< '(BrClose,p2) >] -> next [],p2 - | [< '(Comma,p2) >] -> - (match s with parser - | [< '(BrClose,p2) >] -> next [],p2 - | [< l,p2 = parse_type_anonymous >] -> next l,punion p1 p2 - | [< >] -> serror()); - | [< >] -> + begin match%parser s with + | [ (BrClose,p2) ] -> next [],p2 + | [ (Comma,p2) ] -> + (match%parser s with + | [ (BrClose,p2) ] -> next [],p2 + | [ [%let l,p2 = parse_type_anonymous] ] -> next l,punion p1 p2 + | [ ] -> serror()); + | [ ] -> syntax_error (Expected [",";"}"]) s (next [],p2) end - | [< >] -> + | [ ] -> if p0 = None then raise Stream.Failure else serror() and parse_enum s = let doc = get_doc s in let meta = parse_meta s in - match s with parser - | [< name, p1 = ident; params = parse_constraint_params; s >] -> - let args = (match s with parser - | [< '(POpen,_); l = psep_trailing Comma parse_enum_param; '(PClose,_) >] -> l - | [< >] -> [] + match%parser s with + | [ [%let name, p1 = ident]; parse_constraint_params as params ] -> + let args = (match%parser s with + | [ (POpen,_); [%let l = psep_trailing Comma parse_enum_param]; (PClose,_) ] -> l + | [ ] -> [] ) in let t = popt parse_type_hint s in - let p2 = (match s with parser - | [< p = semicolon >] -> p - | [< >] -> serror() + let p2 = (match%parser s with + | [ semicolon as p ] -> p + | [ ] -> serror() ) in { ec_name = name,p1; @@ -904,18 +903,18 @@ and parse_enum s = ec_pos = punion p1 p2; } -and parse_enum_param = parser - | [< '(Question,_); name, _ = ident; t = parse_type_hint >] -> (name,true,t) - | [< name, _ = ident; t = parse_type_hint >] -> (name,false,t) +and parse_enum_param = function%parser + | [ (Question,_); [%let name,_p = ident]; parse_type_hint as t ] -> (name,true,t) + | [ [%let name,_p = ident]; parse_type_hint as t ] -> (name,false,t) -and parse_function_field doc meta al = parser - | [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_constraint_params; '(POpen,_); args = psep_trailing Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] -> - let e, p2 = (match s with parser - | [< e = expr; s >] -> +and parse_function_field doc meta al = function%parser + | [ (Kwd Function,p1); parse_fun_name as name; parse_constraint_params as pl; (POpen,_); [%let args = psep_trailing Comma parse_fun_param]; (PClose,_); [%let t = popt parse_type_hint]; [%s s] ] -> + let e, p2 = (match%parser s with + | [ expr as e ] -> ignore(semicolon s); Some e, pos e - | [< p = semicolon >] -> None, p - | [< >] -> serror() + | [ semicolon as p ] -> None, p + | [ ] -> serror() ) in let f = { f_params = pl; @@ -925,28 +924,28 @@ and parse_function_field doc meta al = parser } in name,punion p1 p2,FFun f,al,meta -and parse_var_field_assignment = parser - | [< '(Binop OpAssign,_); s >] -> - begin match s with parser - | [< '(Binop OpLt,p1); s >] -> +and parse_var_field_assignment = function%parser + | [ (Binop OpAssign,_); [%s s] ] -> + begin match%parser s with + | [ (Binop OpLt,p1) ] -> let e = handle_xml_literal p1 in (* accept but don't expect semicolon *) - let p2 = match s with parser - | [< '(Semicolon,p) >] -> p - | [< >] -> pos e + let p2 = match%parser s with + | [ (Semicolon,p) ] -> p + | [ ] -> pos e in Some e,p2 - | [< e = expr; p2 = semicolon >] -> Some e , p2 - | [< >] -> serror() + | [ expr as e; semicolon as p2 ] -> Some e , p2 + | [ ] -> serror() end - | [< p2 = semicolon >] -> None , p2 - | [< >] -> serror() + | [ semicolon as p2 ] -> None , p2 + | [ ] -> serror() and parse_class_field tdecl s = let doc = get_doc s in let meta = parse_meta s in - match s with parser - | [< al = plist parse_cf_rights; s >] -> + match%parser s with + | [ [%let al = plist parse_cf_rights] ] -> let check_optional opt name = if opt then begin if not tdecl then syntax_error (Custom "?var syntax is only allowed in structures") ~pos:(Some (pos name)) s (); @@ -954,38 +953,38 @@ and parse_class_field tdecl s = end else meta in - let name,pos,k,al,meta = (match s with parser - | [< '(Kwd Var,p1); opt,name = questionable_dollar_ident; s >] -> + let name,pos,k,al,meta = (match%parser s with + | [ (Kwd Var,p1); [%let opt,name = questionable_dollar_ident] ] -> let meta = check_optional opt name in - begin match s with parser - | [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_) >] -> + begin match%parser s with + | [ (POpen,_); property_ident as i1; (Comma,_); property_ident as i2; (PClose,_) ] -> let t = popt parse_type_hint s in let e,p2 = parse_var_field_assignment s in name,punion p1 p2,FProp (i1,i2,t,e),al,meta - | [< t = popt parse_type_hint; s >] -> + | [ [%let t = popt parse_type_hint] ] -> let e,p2 = parse_var_field_assignment s in name,punion p1 p2,FVar (t,e),al,meta end - | [< '(Kwd Final,p1) >] -> + | [ (Kwd Final,p1) ] -> check_redundant_var p1 s; - begin match s with parser - | [< opt,name = questionable_dollar_ident; s >] -> - begin match s with parser - | [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] -> + begin match%parser s with + | [ [%let opt,name = questionable_dollar_ident]] -> + begin match%parser s with + | [(POpen,_); property_ident as i1; (Comma,_); property_ident as i2; (PClose,_); [%let t = popt parse_type_hint]; [%let e, p2 = parse_var_field_assignment] ] -> let meta = check_optional opt name in name,punion p1 p2,FProp(i1,i2,t,e),(al @ [AFinal,p1]),meta - | [< t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] -> + | [ [%let t = popt parse_type_hint]; [%let e,p2 = parse_var_field_assignment]] -> let meta = check_optional opt name in name,punion p1 p2,FVar(t,e),(al @ [AFinal,p1]),meta end - | [< al2 = plist parse_cf_rights; f = parse_function_field doc meta (al @ ((AFinal,p1) :: al2)) >] -> + | [ [%let al2 = plist parse_cf_rights]; [%let f = parse_function_field doc meta (al @ ((AFinal,p1) :: al2))] ] -> f - | [< >] -> + | [ ] -> serror() end - | [< f = parse_function_field doc meta al >] -> + | [ [%let f = parse_function_field doc meta al] ] -> f - | [< >] -> + | [ ] -> begin match List.rev al with | [] -> raise Stream.Failure | (AOverride,po) :: _ -> @@ -1021,70 +1020,70 @@ and parse_class_field tdecl s = cff_kind = k; } -and parse_cf_rights = parser - | [< '(Kwd Static,p) >] -> AStatic,p - | [< '(Kwd Macro,p) >] -> AMacro,p - | [< '(Kwd Public,p) >] -> APublic,p - | [< '(Kwd Private,p) >] -> APrivate,p - | [< '(Kwd Override,p) >] -> AOverride,p - | [< '(Kwd Dynamic,p) >] -> ADynamic,p - | [< '(Kwd Inline,p) >] -> AInline,p - | [< '(Kwd Extern,p) >] -> AExtern,p - | [< '(Kwd Abstract,p) >] -> AAbstract,p - | [< '(Kwd Overload,p) >] -> AOverload,p - -and parse_fun_name = parser - | [< name,p = dollar_ident >] -> name,p - | [< '(Kwd New,p) >] -> "new",p +and parse_cf_rights = function%parser + | [ (Kwd Static,p) ] -> AStatic,p + | [ (Kwd Macro,p) ] -> AMacro,p + | [ (Kwd Public,p) ] -> APublic,p + | [ (Kwd Private,p) ] -> APrivate,p + | [ (Kwd Override,p) ] -> AOverride,p + | [ (Kwd Dynamic,p) ] -> ADynamic,p + | [ (Kwd Inline,p) ] -> AInline,p + | [ (Kwd Extern,p) ] -> AExtern,p + | [ (Kwd Abstract,p) ] -> AAbstract,p + | [ (Kwd Overload,p) ] -> AOverload,p + +and parse_fun_name = function%parser + | [ [%let i = dollar_ident] ] -> i + | [ (Kwd New,p) ] -> "new",p and parse_fun_param s = let meta = parse_meta s in - match s with parser - | [< '(Question,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),true,meta,t,c) - | [< name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),false,meta,t,c) - | [< '(Spread,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> + match%parser s with + | [ (Question,_); [%let name, pn = dollar_ident]; [%let t = popt parse_type_hint]; parse_fun_param_value as c ] -> ((name,pn),true,meta,t,c) + | [ [%let name, pn = dollar_ident]; [%let t = popt parse_type_hint]; parse_fun_param_value as c ] -> ((name,pn),false,meta,t,c) + | [ (Spread,_); [%let name, pn = dollar_ident]; [%let t = popt parse_type_hint]; parse_fun_param_value as c ] -> let t = match t with Some t -> t | None -> (ct_mono,null_pos) in let t = CTPath (make_ptp (mk_type_path ~params:[TPType t] (["haxe"],"Rest")) (snd t)),(snd t) in ((name,pn),false,meta,Some t,c) -and parse_fun_param_value = parser - | [< '(Binop OpAssign,_); e = expr >] -> Some e - | [< >] -> None - -and parse_fun_param_type = parser - | [< '(Question,_); name = ident; t = parse_type_hint >] -> (name,true,t) - | [< name = ident; t = parse_type_hint >] -> (name,false,t) - -and parse_constraint_params = parser - | [< '(Binop OpLt,p); s >] -> - begin match s with parser - | [< l = psep_nonempty Comma parse_constraint_param; '(Binop OpGt,_) >] -> l - | [< >] -> - let pos = match s with parser - | [< '(Binop OpGt,p) >] -> Some p (* junk > so we don't get weird follow-up errors *) - | [< >] -> None +and parse_fun_param_value = function%parser + | [ (Binop OpAssign,_); expr as e ] -> Some e + | [ ] -> None + +and parse_fun_param_type = function%parser + | [ (Question,_); ident as name; parse_type_hint as t ] -> (name,true,t) + | [ ident as name; parse_type_hint as t ] -> (name,false,t) + +and parse_constraint_params = function%parser + | [ (Binop OpLt,p); [%s s] ] -> + begin match%parser s with + | [ [%let l = psep_nonempty Comma parse_constraint_param]; (Binop OpGt,_) ] -> l + | [ ] -> + let pos = match%parser s with + | [ (Binop OpGt,p) ] -> Some p (* junk > so we don't get weird follow-up errors *) + | [ ] -> None in syntax_error (Expected ["type parameter"]) ~pos s []; end - | [< >] -> [] + | [ ] -> [] and parse_constraint_param s = let meta = parse_meta s in - match s with parser - | [< name = type_name; s >] -> - let cto = (match s with parser - | [< '(DblDot,_); s >] -> - (match s with parser - | [< t = parse_complex_type >] -> Some t - | [< >] -> serror()) - | [< >] -> None + match%parser s with + | [ type_name as name ] -> + let cto = (match%parser s with + | [ (DblDot,_) ] -> + (match%parser s with + | [ parse_complex_type as t ] -> Some t + | [ ] -> serror()) + | [ ] -> None ) in - let default = (match s with parser - | [< '(Binop OpAssign,_); s >] -> - (match s with parser - | [< t = parse_complex_type >] -> Some t - | [< >] -> serror()) - | [< >] -> None + let default = (match%parser s with + | [ (Binop OpAssign,_) ] -> + (match%parser s with + | [ parse_complex_type as t ] -> Some t + | [ ] -> serror()) + | [ ] -> None ) in { tp_name = name; @@ -1093,7 +1092,7 @@ and parse_constraint_param s = tp_default = default; tp_meta = meta; } - | [< >] -> + | [ ] -> (* If we have a metadata but no name afterwards, we have to fail hard. *) if meta <> [] then syntax_error (Expected ["type name"]) s (); raise Stream.Failure; @@ -1111,21 +1110,21 @@ and parse_type_path_or_resume p1 s = t,false with Stream.Failure | Stream.Error _ as exc -> check_resume exc -and parse_class_herit = parser - | [< '(Kwd Extends,p1); t,_ = parse_type_path_or_resume p1 >] -> HExtends t - | [< '(Kwd Implements,p1); t,_ = parse_type_path_or_resume p1 >] -> HImplements t +and parse_class_herit = function%parser + | [ (Kwd Extends,p1); [%let t,_p = parse_type_path_or_resume p1] ] -> HExtends t + | [ (Kwd Implements,p1); [%let t,_p = parse_type_path_or_resume p1] ] -> HImplements t -and block1 = parser - | [< name,p = dollar_ident; s >] -> block2 (name,p,NoQuotes) (Ident name) p s - | [< '(Const (String(name,qs)),p); s >] -> block2 (name,p,DoubleQuotes) (String(name,qs)) p s (* STRINGTODO: qs... hmm *) - | [< b = block [] >] -> EBlock b +and block1 s = match%parser s with + | [ [%let name, p = dollar_ident] ] -> block2 (name,p,NoQuotes) (Ident name) p s + | [ (Const (String(name,qs)),p) ] -> block2 (name,p,DoubleQuotes) (String(name,qs)) p s (* STRINGTODO: qs... hmm *) + | [ [%let b = block []] ] -> EBlock b and block2 name ident p s = - match s with parser - | [< '(DblDot,_) >] -> + match%parser s with + | [ (DblDot,_) ] -> let e = secure_expr s in fst (parse_obj_decl name e p s) - | [< >] -> + | [ ] -> let f s = let e = expr_next (EConst ident,p) s in let _ = semicolon s in @@ -1152,65 +1151,65 @@ and block_with_pos' acc f p s = and block_with_pos acc p s = block_with_pos' acc parse_block_elt p s -and parse_block_var = parser - | [< '(Kwd Var,p1); vl = parse_var_decls false p1; p2 = semicolon >] -> +and parse_block_var = function%parser + | [ (Kwd Var,p1); [%let vl = parse_var_decls false p1]; semicolon as p2 ] -> (vl,punion p1 p2) - | [< '(Kwd Final,p1); s >] -> + | [ (Kwd Final,p1); [%s s] ] -> check_redundant_var p1 s; - match s with parser - | [< vl = parse_var_decls true p1; p2 = semicolon >] -> + match%parser s with + | [ [%let vl = parse_var_decls true p1]; semicolon as p2 ] -> (vl,punion p1 p2) - | [< >] -> + | [ ] -> serror(); -and parse_block_elt = parser - | [< (vl,p) = parse_block_var >] -> +and parse_block_elt s = match%parser s with + | [ [%let vl,p = parse_block_var] ] -> (EVars vl,p) - | [< '(Kwd Inline,p1); s >] -> - begin match s with parser - | [< '(Kwd Function,_); e = parse_function p1 true; _ = semicolon >] -> e - | [< e = secure_expr; _ = semicolon >] -> make_meta Meta.Inline [] e p1 - | [< >] -> serror() + | [ (Kwd Inline,p1) ] -> + begin match%parser s with + | [ (Kwd Function,_); [%let e = parse_function p1 true]; semicolon as _s ] -> e + | [ secure_expr as e; semicolon as _s ] -> make_meta Meta.Inline [] e p1 + | [ ] -> serror() end - | [< '(Kwd Static,p); s >] -> - begin match s with parser - | [< (vl,p) = parse_block_var >] -> + | [ (Kwd Static,p) ] -> + begin match%parser s with + | [ [%let vl,p = parse_block_var] ] -> let vl = List.map (fun ev -> {ev with ev_static = true}) vl in (EVars vl,p) - | [<>] -> syntax_error (Expected ["var";"final"]) s (mk_null_expr p) + | [] -> syntax_error (Expected ["var";"final"]) s (mk_null_expr p) end - | [< '(Binop OpLt,p1); s >] -> + | [ (Binop OpLt,p1) ] -> let e = handle_xml_literal p1 in (* accept but don't expect semicolon *) - begin match s with parser - | [< '(Semicolon,_) >] -> () - | [< >] -> () + begin match%parser s with + | [ (Semicolon,_) ] -> () + | [ ] -> () end; e - | [< e = expr; _ = semicolon >] -> e + | [ expr as e; semicolon as _s ] -> e and parse_obj_decl name e p0 s = let make_obj_decl el p1 = EObjectDecl (List.rev el),punion p0 p1 in - let rec loop p_end acc = match s with parser - | [< '(Comma,p1); s >] -> + let rec loop p_end acc = match%parser s with + | [ (Comma,p1) ] -> let next_expr key = let e = secure_expr s in loop (pos e) ((key,e) :: acc) in - let next key = match s with parser - | [< '(DblDot,_) >] -> + let next key = match%parser s with + | [ (DblDot,_) ] -> next_expr key - | [< >] -> + | [ ] -> syntax_error (Expected [":"]) s (next_expr key) in - begin match s with parser - | [< name,p = ident >] -> next (name,p,NoQuotes) - | [< '(Const (String(name,qs)),p) >] -> next (name,p,DoubleQuotes) (* STRINGTODO: use qs? *) - | [< >] -> acc,p_end + begin match%parser s with + | [ [%let name, p = ident] ] -> next (name,p,NoQuotes) + | [ (Const (String(name,qs)),p) ] -> next (name,p,DoubleQuotes) (* STRINGTODO: use qs? *) + | [ ] -> acc,p_end end - | [< >] -> acc,p_end + | [ ] -> acc,p_end in let el,p_end = loop p0 [name,e] in let e = make_obj_decl el p_end in @@ -1223,37 +1222,37 @@ and parse_array_decl p1 s = [mk_null_expr p],p ) in - let el,p2 = match s with parser - | [< '(BkClose,p2) >] -> [],p2 - | [< e0 = secure_expr >] -> - let rec loop acc = match s with parser - | [< '(Comma,pk) >] -> - begin match s with parser - | [< '(BkClose,p2) >] -> acc,p2 - | [< e = secure_expr >] -> loop (e :: acc) - | [< >] -> + let el,p2 = match%parser s with + | [ (BkClose,p2) ] -> [],p2 + | [ secure_expr as e0 ] -> + let rec loop acc = match%parser s with + | [ (Comma,pk) ] -> + begin match%parser s with + | [ (BkClose,p2) ] -> acc,p2 + | [ secure_expr as e ] -> loop (e :: acc) + | [ ] -> syntax_error (Expected ["expr";"]"]) s (acc,pk) end - | [< '(BkClose,p2) >] -> acc,p2 - | [< >] -> + | [ (BkClose,p2) ] -> acc,p2 + | [ ] -> syntax_error (Expected [",";"]"]) s (acc,next_pos s) in loop [e0] - | [< >] -> resume_or_fail p1 + | [ ] -> resume_or_fail p1 in EArrayDecl (List.rev el),punion p1 p2 and parse_var_decl_head final s = let meta = parse_meta s in - match s with parser - | [< name, p = dollar_ident; >] -> - begin match s with parser - | [< t = popt parse_type_hint >] -> + match%parser s with + | [ [%let name, p = dollar_ident] ] -> + begin match%parser s with + | [ [%let t = popt parse_type_hint] ] -> (meta,name,final,t,p) - | [< '(POpen,p1); _ = property_ident; '(Comma,_); _ = property_ident; '(PClose,p2); t = popt parse_type_hint >] -> + | [ (POpen,p1); property_ident as _p1; (Comma,_); property_ident as _p2; (PClose,p2); [%let t = popt parse_type_hint] ] -> syntax_error (Custom "Cannot define property accessors for local vars") ~pos:(Some (punion p1 p2)) s (meta,name,final,t,p) end - | [< >] -> + | [ ] -> (* This nonsense is here for the var @ case in issue #9639 *) let rec loop meta = match meta with | (Meta.HxCompletion,_,p) :: _ -> (meta,"",false,None,null_pos) @@ -1262,66 +1261,66 @@ and parse_var_decl_head final s = in loop meta -and parse_var_assignment = parser - | [< '(Binop OpAssign,p1); s >] -> +and parse_var_assignment = function%parser + | [ (Binop OpAssign,p1); [%s s] ] -> Some (secure_expr s) - | [< >] -> None + | [ ] -> None and parse_var_assignment_resume final vl name pn t meta s = let eo = parse_var_assignment s in mk_evar ~final ?t ?eo ~meta (name,pn) -and parse_var_decls_next final vl = parser - | [< '(Comma,p1); meta,name,final,t,pn = parse_var_decl_head final; s >] -> +and parse_var_decls_next final vl = function%parser + | [ (Comma,p1); [%let meta,name,final,t,pn = parse_var_decl_head final]; [%s s] ] -> let v_decl = parse_var_assignment_resume final vl name pn t meta s in parse_var_decls_next final (v_decl :: vl) s - | [< >] -> + | [ ] -> vl -and parse_var_decls final p1 = parser - | [< meta,name,final,t,pn = parse_var_decl_head final; s >] -> +and parse_var_decls final p1 = function%parser + | [ [%let meta,name,final,t,pn = parse_var_decl_head final]; [%s s] ] -> let v_decl = parse_var_assignment_resume final [] name pn t meta s in List.rev (parse_var_decls_next final [v_decl] s) - | [< >] -> error (Custom "Missing variable identifier") p1 + | [ ] -> error (Custom "Missing variable identifier") p1 -and parse_var_decl final = parser - | [< meta,name,final,t,pn = parse_var_decl_head final; v_decl = parse_var_assignment_resume final [] name pn t meta >] -> v_decl +and parse_var_decl final = function%parser + | [ [%let meta,name,final,t,pn = parse_var_decl_head final]; [%let v_decl = parse_var_assignment_resume final [] name pn t meta] ] -> v_decl -and inline_function = parser - | [< '(Kwd Inline,_); '(Kwd Function,p1) >] -> true, p1 - | [< '(Kwd Function,p1) >] -> false, p1 +and inline_function = function%parser + | [ (Kwd Inline,_); (Kwd Function,p1) ] -> true, p1 + | [ (Kwd Function,p1) ] -> false, p1 -and parse_macro_expr p = parser - | [< '(DblDot,_); t = parse_complex_type >] -> +and parse_macro_expr p = function%parser + | [ (DblDot,_); parse_complex_type as t ] -> let _, to_type, _ = reify !in_macro in let t = to_type t p in let ct = make_ptp_ct_null (mk_type_path ~sub:"ComplexType" (["haxe";"macro"],"Expr")) in (ECheckType (t,(ct,p)),p) - | [< '(Kwd Var,p1); vl = psep Comma (parse_var_decl false) >] -> + | [ (Kwd Var,p1); [%let vl = psep Comma (parse_var_decl false)] ] -> reify_expr (EVars vl,p1) !in_macro - | [< '(Kwd Final,p1); s >] -> + | [ (Kwd Final,p1); [%s s] ] -> check_redundant_var p1 s; - begin match s with parser - | [< vl = psep Comma (parse_var_decl true) >] -> + begin match%parser s with + | [ [%let vl = psep Comma (parse_var_decl true)] ] -> reify_expr (EVars vl,p1) !in_macro - | [< >] -> + | [ ] -> serror() end - | [< d = parse_class None [] [] false >] -> + | [ [%let d = parse_class None [] [] false] ] -> let _,_,to_type = reify !in_macro in let ct = make_ptp_ct_null (mk_type_path ~sub:"TypeDefinition" (["haxe";"macro"],"Expr")) in (ECheckType (to_type d,(ct,null_pos)),p) - | [< e = secure_expr >] -> + | [ secure_expr as e ] -> reify_expr e !in_macro and parse_function p1 inl s = - let name = match s with parser - | [< name = dollar_ident >] -> Some name - | [< >] -> None + let name = match%parser s with + | [ dollar_ident as name ] -> Some name + | [ ] -> None in let pl = parse_constraint_params s in - match s with parser - | [< '(POpen,_); al = psep_trailing Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] -> + match%parser s with + | [ (POpen,_); [%let al = psep_trailing Comma parse_fun_param]; (PClose,_); [%let t = popt parse_type_hint] ] -> let make e = let f = { f_params = pl; @@ -1332,7 +1331,7 @@ and parse_function p1 inl s = EFunction ((match name with None -> FKAnonymous | Some (name,pn) -> FKNamed ((name,pn),inl)),f), punion p1 (pos e) in make (secure_expr s) - | [< >] -> + | [ ] -> (* Generate pseudo function to avoid toplevel-completion (issue #10691). We check against p1 here in order to cover cases like `function a|b` *) if would_skip_display_position p1 false s then begin @@ -1351,9 +1350,9 @@ and parse_function p1 inl s = end else serror() -and arrow_expr = parser - | [< '(Arrow,_); e = expr >] -> e - | [< >] -> serror() +and arrow_expr = function%parser + | [ (Arrow,_); expr as e ] -> e + | [ ] -> serror() and arrow_function p1 al er s = let make e = @@ -1386,8 +1385,8 @@ and arrow_first_param e s = | _ -> serror()) -and expr = parser - | [< (name,params,p) = parse_meta_entry; s >] -> +and expr s = match%parser s with + | [ [%let name,params,p = parse_meta_entry] ] -> begin try make_meta name params (secure_expr s) p with @@ -1395,14 +1394,14 @@ and expr = parser let e = EConst (Ident "null"),null_pos in make_meta name params e p end - | [< '(Binop OpLt,p1) >] -> + | [ (Binop OpLt,p1) ] -> handle_xml_literal p1 - | [< '(BrOpen,p1); s >] -> - (match s with parser - | [< b = block1; s >] -> - let p2 = match s with parser - | [< '(BrClose,p2) >] -> p2 - | [< >] -> + | [ (BrOpen,p1) ] -> + (match%parser s with + | [ block1 as b ] -> + let p2 = match%parser s with + | [ (BrClose,p2) ] -> p2 + | [ ] -> (* Ignore missing } if we are resuming and "guess" the last position. *) syntax_error (Expected ["}"]) s (pos (next_token s)) in @@ -1410,112 +1409,112 @@ and expr = parser (match b with | EObjectDecl _ -> expr_next e s | _ -> e) - | [< >] -> + | [ ] -> check_resume p1 (fun() -> (EDisplay ((EObjectDecl [],p1),DKStructure),p1)) serror; ) - | [< '(Kwd k,p) when !parsing_macro_cond; s >] -> + | [ (Kwd k,p) ] when !parsing_macro_cond -> expr_next (EConst (Ident (s_keyword k)), p) s - | [< '(Kwd Macro,p); s >] -> - begin match s with parser - | [< '(Dot,pd); e = parse_field (EConst (Ident "macro"),p) EFNormal pd >] -> e - | [< e = parse_macro_expr p >] -> e - | [< >] -> serror() + | [ (Kwd Macro,p) ] -> + begin match%parser s with + | [ (Dot,pd); [%let e = parse_field (EConst (Ident "macro"),p) EFNormal pd] ] -> e + | [ [%let e = parse_macro_expr p] ] -> e + | [ ] -> serror() end - | [< '(Kwd Var,p1); v = parse_var_decl false >] -> (EVars [v],p1) - | [< '(Kwd Final,p1); s >] -> + | [ (Kwd Var,p1); [%let v = parse_var_decl false] ] -> (EVars [v],p1) + | [ (Kwd Final,p1) ] -> check_redundant_var p1 s; - begin match s with parser - | [< v = parse_var_decl true >] -> + begin match%parser s with + | [ [%let v = parse_var_decl true] ] -> (EVars [v],p1) - | [< >] -> + | [ ] -> serror() end - | [< '(Const c,p); s >] -> expr_next (EConst c,p) s - | [< '(Kwd This,p); s >] -> expr_next (EConst (Ident "this"),p) s - | [< '(Kwd Abstract,p); s >] -> expr_next (EConst (Ident "abstract"),p) s - | [< '(Kwd True,p); s >] -> expr_next (EConst (Ident "true"),p) s - | [< '(Kwd False,p); s >] -> expr_next (EConst (Ident "false"),p) s - | [< '(Kwd Null,p); s >] -> expr_next (EConst (Ident "null"),p) s - | [< '(Kwd Cast,p1); s >] -> - (match s with parser - | [< '(POpen,pp); e = expr; s >] -> - (match s with parser - | [< '(Comma,pc); t = parse_complex_type; '(PClose,p2); s >] -> expr_next (ECast (e,Some t),punion p1 p2) s - | [< t,pt = parse_type_hint; '(PClose,p2); s >] -> + | [ (Const c,p) ] -> expr_next (EConst c,p) s + | [ (Kwd This,p) ] -> expr_next (EConst (Ident "this"),p) s + | [ (Kwd Abstract,p) ] -> expr_next (EConst (Ident "abstract"),p) s + | [ (Kwd True,p) ] -> expr_next (EConst (Ident "true"),p) s + | [ (Kwd False,p) ] -> expr_next (EConst (Ident "false"),p) s + | [ (Kwd Null,p) ] -> expr_next (EConst (Ident "null"),p) s + | [ (Kwd Cast,p1) ] -> + (match%parser s with + | [ (POpen,pp); expr as e ] -> + (match%parser s with + | [ (Comma,pc); parse_complex_type as t; (PClose,p2) ] -> expr_next (ECast (e,Some t),punion p1 p2) s + | [ [%let t,pt = parse_type_hint]; (PClose,p2) ] -> let ep = EParenthesis (ECheckType(e,(t,pt)),punion p1 p2), punion p1 p2 in expr_next (ECast (ep,None),punion p1 (pos ep)) s - | [< '(PClose,p2); s >] -> + | [ (PClose,p2) ] -> let ep = expr_next (EParenthesis(e),punion pp p2) s in expr_next (ECast (ep,None),punion p1 (pos ep)) s - | [< >] -> serror()) - | [< e = secure_expr >] -> expr_next (ECast (e,None),punion p1 (pos e)) s) - | [< '(Kwd Throw,p); e = expr >] -> (EThrow e,p) - | [< '(Kwd New,p1); t,_ = parse_type_path_or_resume p1; s >] -> - begin match s with parser - | [< '(POpen,po); e = parse_call_params (fun el p2 -> (ENew(t,el)),punion p1 p2) po >] -> expr_next e s - | [< >] -> + | [ ] -> serror()) + | [ secure_expr as e ] -> expr_next (ECast (e,None),punion p1 (pos e)) s) + | [ (Kwd Throw,p); expr as e ] -> (EThrow e,p) + | [ (Kwd New,p1); [%let t,_p = parse_type_path_or_resume p1] ] -> + begin match%parser s with + | [ (POpen,po); [%let e = parse_call_params (fun el p2 -> (ENew(t,el)),punion p1 p2) po] ] -> expr_next e s + | [ ] -> syntax_error (Expected ["("]) s (ENew(t,[]),punion p1 t.pos_full) end - | [< '(POpen,p1); s >] -> (match s with parser - | [< '(PClose,p2); er = arrow_expr; >] -> + | [ (POpen,p1) ] -> (match%parser s with + | [ (PClose,p2); arrow_expr as er; ] -> arrow_function p1 [] er s - | [< '(Question,p2); al = psep_trailing Comma parse_fun_param; '(PClose,_); er = arrow_expr; >] -> + | [ (Question,p2); [%let al = psep_trailing Comma parse_fun_param]; (PClose,_); arrow_expr as er; ] -> let al = (match al with | (np,_,_,topt,e) :: al -> (np,true,[],topt,e) :: al | _ -> die "" __LOC__ ) in arrow_function p1 al er s - | [< e = expr; s >] -> (match s with parser - | [< '(PClose,p2); s >] -> expr_next (EParenthesis e, punion p1 p2) s - | [< '(Comma,pc); al = psep_trailing Comma parse_fun_param; '(PClose,_); er = arrow_expr; >] -> + | [ expr as e ] -> (match%parser s with + | [ (PClose,p2) ] -> expr_next (EParenthesis e, punion p1 p2) s + | [ (Comma,pc); [%let al = psep_trailing Comma parse_fun_param]; (PClose,_); arrow_expr as er; ] -> arrow_function p1 ((arrow_first_param e s) :: al) er s - | [< t,pt = parse_type_hint; s >] -> (match s with parser - | [< '(PClose,p2); s >] -> expr_next (EParenthesis (ECheckType(e,(t,pt)),punion p1 p2), punion p1 p2) s - | [< '(Comma,pc); al = psep_trailing Comma parse_fun_param; '(PClose,_); er = arrow_expr; >] -> + | [ [%let t,pt = parse_type_hint] ] -> (match%parser s with + | [ (PClose,p2) ] -> expr_next (EParenthesis (ECheckType(e,(t,pt)),punion p1 p2), punion p1 p2) s + | [ (Comma,pc); [%let al = psep_trailing Comma parse_fun_param]; (PClose,_); arrow_expr as er; ] -> let (np,_) = arrow_ident_checktype e in arrow_function p1 ((np,false,[],(Some(t,pt)),None) :: al) er s - | [< '((Binop OpAssign),p2); ea1 = expr; s >] -> + | [ ((Binop OpAssign),p2); expr as ea1 ] -> let with_args al er = (match fst e with | EConst(Ident n) -> arrow_function p1 (((n,snd e),true,[],(Some(t,pt)),(Some ea1)) :: al) er s | _ -> serror()) in - (match s with parser - | [< '(PClose,p2); er = arrow_expr; >] -> + (match%parser s with + | [ (PClose,p2); arrow_expr as er; ] -> with_args [] er - | [< '(Comma,pc); al = psep_trailing Comma parse_fun_param; '(PClose,_); er = arrow_expr; >] -> + | [ (Comma,pc); [%let al = psep_trailing Comma parse_fun_param]; (PClose,_); arrow_expr as er; ] -> with_args al er - | [< >] -> serror()) - | [< >] -> serror()) - | [< >] -> + | [ ] -> serror()) + | [ ] -> serror()) + | [ ] -> syntax_error (Expected [")";",";":"]) s (expr_next (EParenthesis e, punion p1 (pos e)) s)) ) - | [< '(BkOpen,p1); e = parse_array_decl p1; s >] -> expr_next e s - | [< '(Kwd Function,p1); e = parse_function p1 false; >] -> e - | [< '(Unop op,p1); e = expr >] -> make_unop op e p1 - | [< '(Spread,p1); e = expr >] -> make_unop Spread e (punion p1 (pos e)) - | [< '(Binop OpSub,p1); e = expr >] -> + | [ (BkOpen,p1); [%let e = parse_array_decl p1] ] -> expr_next e s + | [ (Kwd Function,p1); [%let e = parse_function p1 false]; ] -> e + | [ (Unop op,p1); expr as e ] -> make_unop op e p1 + | [ (Spread,p1); expr as e ] -> make_unop Spread e (punion p1 (pos e)) + | [ (Binop OpSub,p1); expr as e ] -> make_unop Neg e p1 (*/* removed unary + : this cause too much syntax errors go unnoticed, such as "a + + 1" (missing 'b') without adding anything to the language - | [< '(Binop OpAdd,p1); s >] -> - (match s with parser - | [< '(Const (Int i),p); e = expr_next (EConst (Int i),p) >] -> e - | [< '(Const (Float f),p); e = expr_next (EConst (Float f),p) >] -> e - | [< >] -> serror()) */*) - | [< '(Kwd For,p); '(POpen,_); it = secure_expr; s >] -> - let e = match s with parser - | [< '(PClose,_); e = secure_expr >] -> e - | [< >] -> + | [ (Binop OpAdd,p1) ] -> + (match%parser s with + | [ (Const (Int i),p); [%let e = expr_next (EConst (Int i),p)] ] -> e + | [ (Const (Float f),p); [%let e = expr_next (EConst (Float f),p)] ] -> e + | [ ] -> serror()) */*) + | [ (Kwd For,p); (POpen,_); secure_expr as it ] -> + let e = match%parser s with + | [ (PClose,_); secure_expr as e ] -> e + | [ ] -> syntax_error (Expected [")"]) s (mk_null_expr (pos it)) in (EFor (it,e),punion p (pos e)) - | [< '(Kwd If,p); '(POpen,_); cond = secure_expr; s >] -> - let e1 = match s with parser - | [< '(PClose,_); e1 = secure_expr >] -> e1 - | [< >] -> + | [ (Kwd If,p); (POpen,_); secure_expr as cond ] -> + let e1 = match%parser s with + | [ (PClose,_); secure_expr as e1 ] -> e1 + | [ ] -> syntax_error (Expected [")"]) s (mk_null_expr (pos cond)) in - let e2 = (match s with parser - | [< '(Kwd Else,_); e2 = secure_expr >] -> Some e2 - | [< >] -> + let e2 = (match%parser s with + | [ (Kwd Else,_); secure_expr as e2 ] -> Some e2 + | [ ] -> (* We check this in two steps to avoid the lexer missing tokens (#8565). *) match Stream.npeek 1 s with | [(Semicolon,_)] -> @@ -1531,48 +1530,48 @@ and expr = parser None ) in (EIf (cond,e1,e2), punion p (match e2 with None -> pos e1 | Some e -> pos e)) - | [< '(Kwd Return,p); s >] -> - begin match s with parser - | [< e = expr >] -> (EReturn (Some e),punion p (pos e)) - | [< >] -> + | [ (Kwd Return,p) ] -> + begin match%parser s with + | [ expr as e ] -> (EReturn (Some e),punion p (pos e)) + | [ ] -> if would_skip_display_position p true s then (EReturn (Some (mk_null_expr (punion_next p s))),p) else (EReturn None,p) end - | [< '(Kwd Break,p) >] -> (EBreak,p) - | [< '(Kwd Continue,p) >] -> (EContinue,p) - | [< '(Kwd While,p1); '(POpen,_); cond = secure_expr; s >] -> - let e = match s with parser - | [< '(PClose,_); e = secure_expr >] -> e - | [< >] -> + | [ (Kwd Break,p) ] -> (EBreak,p) + | [ (Kwd Continue,p) ] -> (EContinue,p) + | [ (Kwd While,p1); (POpen,_); secure_expr as cond ] -> + let e = match%parser s with + | [ (PClose,_); secure_expr as e ] -> e + | [ ] -> syntax_error (Expected [")"]) s (mk_null_expr (pos cond)) in (EWhile (cond,e,NormalWhile),punion p1 (pos e)) - | [< '(Kwd Do,p1); e = secure_expr; s >] -> - begin match s with parser - | [< '(Kwd While,_); '(POpen,_); cond = secure_expr; s >] -> + | [ (Kwd Do,p1); secure_expr as e ] -> + begin match%parser s with + | [ (Kwd While,_); (POpen,_); secure_expr as cond ] -> let p2 = expect_unless_resume_p PClose s in (EWhile (cond,e,DoWhile),punion p1 p2) - | [< >] -> + | [ ] -> syntax_error (Expected ["while"]) s e (* ignore do *) end - | [< '(Kwd Switch,p1); e = secure_expr; s >] -> - begin match s with parser - | [< '(BrOpen,_); cases , def = parse_switch_cases e [] >] -> - let p2 = match s with parser - | [< '(BrClose,p2) >] -> p2 - | [< >] -> + | [ (Kwd Switch,p1); secure_expr as e ] -> + begin match%parser s with + | [ (BrOpen,_); [%let cases, def = parse_switch_cases e []] ] -> + let p2 = match%parser s with + | [ (BrClose,p2) ] -> p2 + | [ ] -> (* Ignore missing } if we are resuming and "guess" the last position. *) syntax_error (Expected ["}"]) s (pos (next_token s)) in (ESwitch (e,cases,def),punion p1 p2) - | [< >] -> + | [ ] -> syntax_error (Expected ["{"]) s (ESwitch(e,[],None),punion p1 (pos e)) end - | [< '(Kwd Try,p1); e = secure_expr; cl,p2 = parse_catches e [] (pos e) >] -> (ETry (e,cl),punion p1 p2) - | [< '(IntInterval i,p1); e2 = expr >] -> make_binop OpInterval (EConst (Int (i, None)),p1) e2 - | [< '(Kwd Untyped,p1); e = secure_expr >] -> (EUntyped e,punion p1 (pos e)) - | [< '(Dollar v,p); s >] -> expr_next (EConst (Ident ("$"^v)),p) s - | [< '(Kwd Inline,p); e = secure_expr >] -> make_meta Meta.Inline [] e p + | [ (Kwd Try,p1); secure_expr as e; [%let cl,p2 = parse_catches e [] (pos e)] ] -> (ETry (e,cl),punion p1 p2) + | [ (IntInterval i,p1); expr as e2 ] -> make_binop OpInterval (EConst (Int (i, None)),p1) e2 + | [ (Kwd Untyped,p1); secure_expr as e ] -> (EUntyped e,punion p1 (pos e)) + | [ (Dollar v,p) ] -> expr_next (EConst (Ident ("$"^v)),p) s + | [ (Kwd Inline,p); secure_expr as e ] -> make_meta Meta.Inline [] e p and expr_next e1 s = try @@ -1581,64 +1580,64 @@ and expr_next e1 s = handle_stream_error msg s; e1 -and expr_next' e1 = parser - | [< '(BrOpen,p1) when is_dollar_ident e1; eparam = expr; '(BrClose,p2); s >] -> +and expr_next' e1 s = match%parser s with + | [ (BrOpen,p1); expr as eparam; (BrClose,p2) ] when is_dollar_ident e1 -> (match fst e1 with | EConst(Ident n) -> expr_next (EMeta((Meta.from_string n,[],snd e1),eparam), punion p1 p2) s | _ -> die "" __LOC__) - | [< '(Dot,p); e = parse_field e1 EFNormal p >] -> e - | [< '(QuestionDot,p); e = parse_field e1 EFSafe p >] -> e - | [< '(POpen,p1); e = parse_call_params (fun el p2 -> (ECall(e1,el)),punion (pos e1) p2) p1; s >] -> expr_next e s - | [< '(BkOpen,p1); e2 = secure_expr; s >] -> + | [ (Dot,p); [%let e = parse_field e1 EFNormal p] ] -> e + | [ (QuestionDot,p); [%let e = parse_field e1 EFSafe p] ] -> e + | [ (POpen,p1); [%let e = parse_call_params (fun el p2 -> (ECall(e1,el)),punion (pos e1) p2) p1] ] -> expr_next e s + | [ (BkOpen,p1); secure_expr as e2 ] -> let p2 = expect_unless_resume_p BkClose s in let e2 = check_signature_mark e2 p1 p2 in expr_next (EArray (e1,e2), punion (pos e1) p2) s - | [< '(Arrow,pa); s >] -> + | [ (Arrow,pa) ] -> let er = secure_expr s in arrow_function (snd e1) [arrow_first_param e1 s] er s - | [< '(Binop OpGt,p1); s >] -> - (match s with parser - | [< '(Binop OpGt,p2) when p1.pmax = p2.pmin; s >] -> - (match s with parser - | [< '(Binop OpGt,p3) when p2.pmax = p3.pmin >] -> - (match s with parser - | [< '(Binop OpAssign,p4) when p3.pmax = p4.pmin; e2 = expr >] -> make_binop (OpAssignOp OpUShr) e1 e2 - | [< e2 = secure_expr >] -> make_binop OpUShr e1 e2) - | [< '(Binop OpAssign,p3) when p2.pmax = p3.pmin; e2 = expr >] -> make_binop (OpAssignOp OpShr) e1 e2 - | [< e2 = secure_expr >] -> make_binop OpShr e1 e2) - | [< '(Binop OpAssign,p2) when p1.pmax = p2.pmin; s >] -> + | [ (Binop OpGt,p1) ] -> + (match%parser s with + | [ (Binop OpGt,p2) ] when p1.pmax = p2.pmin -> + (match%parser s with + | [ (Binop OpGt,p3) ] when p2.pmax = p3.pmin -> + (match%parser s with + | [ (Binop OpAssign,p4); expr as e2 ] when p3.pmax = p4.pmin -> make_binop (OpAssignOp OpUShr) e1 e2 + | [ secure_expr as e2 ] -> make_binop OpUShr e1 e2) + | [ (Binop OpAssign,p3); expr as e2 ] when p2.pmax = p3.pmin -> make_binop (OpAssignOp OpShr) e1 e2 + | [ secure_expr as e2 ] -> make_binop OpShr e1 e2) + | [ (Binop OpAssign,p2) ] when p1.pmax = p2.pmin -> make_binop OpGte e1 (secure_expr s) - | [< e2 = secure_expr >] -> + | [ secure_expr as e2 ] -> make_binop OpGt e1 e2) - | [< '(Binop op,_); e2 = secure_expr >] -> make_binop op e1 e2 - | [< '(Spread,_); e2 = secure_expr >] -> make_binop OpInterval e1 e2 - | [< '(Unop op,p) when is_postfix e1 op; s >] -> + | [ (Binop op,_); secure_expr as e2 ] -> make_binop op e1 e2 + | [ (Spread,_); secure_expr as e2 ] -> make_binop OpInterval e1 e2 + | [ (Unop op,p) ] when is_postfix e1 op -> expr_next (EUnop (op,Postfix,e1), punion (pos e1) p) s - | [< '(Question,_); e2 = expr; s >] -> - begin match s with parser - | [< '(DblDot,_); e3 = expr >] -> (ETernary (e1,e2,e3),punion (pos e1) (pos e3)) - | [< >] -> syntax_error (Expected [":"]) s e2 + | [ (Question,_); expr as e2 ] -> + begin match%parser s with + | [ (DblDot,_); expr as e3 ] -> (ETernary (e1,e2,e3),punion (pos e1) (pos e3)) + | [ ] -> syntax_error (Expected [":"]) s e2 end - | [< '(Kwd In,_); e2 = expr >] -> + | [ (Kwd In,_); expr as e2 ] -> make_binop OpIn e1 e2 - | [< '(Const (Ident "is"),p_is); t = parse_complex_type; s >] -> + | [ (Const (Ident "is"),p_is); parse_complex_type as t ] -> let p1 = pos e1 in let p2 = pos t in let e_is = EIs (e1,t), (punion p1 p2) in expr_next e_is s - | [< >] -> e1 + | [ ] -> e1 and parse_field e1 efk p s = check_resume p (fun () -> (EDisplay (e1,DKDot),p)) (fun () -> - begin match s with parser - | [< '(Kwd Macro,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"macro",efk) , punion (pos e1) p2) s - | [< '(Kwd Extern,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"extern",efk) , punion (pos e1) p2) s - | [< '(Kwd Function,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"function",efk) , punion (pos e1) p2) s - | [< '(Kwd New,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"new",efk) , punion (pos e1) p2) s - | [< '(Kwd k,p2) when !parsing_macro_cond && p.pmax = p2.pmin; s >] -> expr_next (EField (e1,s_keyword k,efk) , punion (pos e1) p2) s - | [< '(Const (Ident f),p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,f,efk) , punion (pos e1) p2) s - | [< '(Dollar v,p2); s >] -> expr_next (EField (e1,"$"^v,efk) , punion (pos e1) p2) s - | [< >] -> + begin match%parser s with + | [ (Kwd Macro,p2) ] when p.pmax = p2.pmin -> expr_next (EField (e1,"macro",efk) , punion (pos e1) p2) s + | [ (Kwd Extern,p2) ] when p.pmax = p2.pmin -> expr_next (EField (e1,"extern",efk) , punion (pos e1) p2) s + | [ (Kwd Function,p2) ] when p.pmax = p2.pmin -> expr_next (EField (e1,"function",efk) , punion (pos e1) p2) s + | [ (Kwd New,p2) ] when p.pmax = p2.pmin -> expr_next (EField (e1,"new",efk) , punion (pos e1) p2) s + | [ (Kwd k,p2) ] when !parsing_macro_cond && p.pmax = p2.pmin -> expr_next (EField (e1,s_keyword k,efk) , punion (pos e1) p2) s + | [ (Const (Ident f),p2) ] when p.pmax = p2.pmin -> expr_next (EField (e1,f,efk) , punion (pos e1) p2) s + | [ (Dollar v,p2) ] -> expr_next (EField (e1,"$"^v,efk) , punion (pos e1) p2) s + | [ ] -> (* turn an integer followed by a dot into a float *) match e1 with | (EConst (Int (v, None)),p2) when p2.pmax = p.pmin -> expr_next (EConst (Float (v ^ ".", None)),punion p p2) s @@ -1646,24 +1645,24 @@ and parse_field e1 efk p s = end ) -and parse_guard = parser - | [< '(Kwd If,p1); '(POpen,_); e = expr; '(PClose,_); >] -> +and parse_guard = function%parser + | [ (Kwd If,p1); (POpen,_); expr as e; (PClose,_); ] -> e -and expr_or_var = parser - | [< '(Kwd Var,p1); np = dollar_ident; >] -> EVars [mk_evar np],punion p1 (snd np) - | [< '(Kwd Final,p1); s >] -> +and expr_or_var = function%parser + | [ (Kwd Var,p1); dollar_ident as np; ] -> EVars [mk_evar np],punion p1 (snd np) + | [ (Kwd Final,p1); [%s s] ] -> check_redundant_var p1 s; - begin match s with parser - | [< np = dollar_ident; >] -> + begin match%parser s with + | [ dollar_ident as np; ] -> EVars [mk_evar ~final:true np],punion p1 (snd np) - | [< >] -> + | [ ] -> serror() end - | [< e = secure_expr >] -> e + | [ secure_expr as e ] -> e -and parse_switch_cases eswitch cases = parser - | [< '(Kwd Default,p1); '(DblDot,pdot); s >] -> +and parse_switch_cases eswitch cases s = match%parser s with + | [ (Kwd Default,p1); (DblDot,pdot) ] -> let b,p2 = (block_with_pos [] p1 s) in let b = match b with | [] -> None,pdot @@ -1672,7 +1671,7 @@ and parse_switch_cases eswitch cases = parser let l , def = parse_switch_cases eswitch cases s in (match def with None -> () | Some _ -> syntax_error Duplicate_default ~pos:(Some p1) s ()); l , Some b - | [< '(Kwd Case,p1); el = psep Comma expr_or_var; eg = popt parse_guard; s >] -> + | [ (Kwd Case,p1); [%let el = psep Comma expr_or_var]; [%let eg = popt parse_guard] ] -> let pdot = expect_unless_resume_p DblDot s in if !was_auto_triggered then check_resume pdot (fun () -> ()) (fun () -> ()); (match el with @@ -1685,26 +1684,26 @@ and parse_switch_cases eswitch cases = parser in parse_switch_cases eswitch ((el,eg,b,p) :: cases) s ) - | [< >] -> + | [ ] -> List.rev cases , None -and parse_catch etry = parser - | [< '(Kwd Catch,p); '(POpen,_); name, pn = dollar_ident; s >] -> - match s with parser - | [< t,pt = parse_type_hint; '(PClose,_); e = secure_expr >] -> ((name,pn),(Some (t,pt)),e,punion p (pos e)),(pos e) - | [< '(PClose,_); e = secure_expr >] -> ((name,pn),None,e,punion p (pos e)),(pos e) - | [< '(_,p) >] -> error Missing_type p +and parse_catch etry = function%parser + | [ (Kwd Catch,p); (POpen,_); [%let name, pn = dollar_ident]; [%s s] ] -> + match%parser s with + | [ [%let t,pt = parse_type_hint]; (PClose,_); secure_expr as e ] -> ((name,pn),(Some (t,pt)),e,punion p (pos e)),(pos e) + | [ (PClose,_); secure_expr as e ] -> ((name,pn),None,e,punion p (pos e)),(pos e) + | [ (_,p) ] -> error Missing_type p -and parse_catches etry catches pmax = parser - | [< (catch,pmax) = parse_catch etry; s >] -> parse_catches etry (catch :: catches) pmax s - | [< >] -> List.rev catches,pmax +and parse_catches etry catches pmax = function%parser + | [ [%let (catch,pmax) = parse_catch etry]; [%s s] ] -> parse_catches etry (catch :: catches) pmax s + | [ ] -> List.rev catches,pmax and parse_call_params f p1 s = if not !in_display_file then begin let el = psep_trailing Comma expr s in - match s with parser - | [< '(PClose,p2) >] -> f el p2 - | [< >] -> + match%parser s with + | [ (PClose,p2) ] -> f el p2 + | [ ] -> let expected = if el = [] then ["expression";")"] else [",";")"] in syntax_error (Expected expected) s (f el (last_pos s)) end else begin @@ -1720,13 +1719,13 @@ and parse_call_params f p1 s = handle_stream_error msg s; mk_null_expr (punion_next p1 s) in - match s with parser - | [< '(PClose,p2) >] -> + match%parser s with + | [ (PClose,p2) ] -> let e = check_signature_mark e p1 p2 in f (List.rev (e :: acc)) p2 - | [< '(Comma,p2) >] -> - begin match s with parser - | [< '(PClose, p3) >] -> + | [ (Comma,p2)] -> + begin match%parser s with + | [ (PClose, p3) ] -> if (is_signature_display()) then begin let prev_arg_pos = punion p1 p2 in let comma_paren_pos = punion p2 p3 in @@ -1745,27 +1744,27 @@ and parse_call_params f p1 s = (* if not in signature display mode don't check anything *) f (List.rev (e :: acc)) p3 end - | [< >] -> + | [] -> let e = check_signature_mark e p1 p2 in parse_next_param (e :: acc) p2 end - | [< >] -> + | [ ] -> let p2 = next_pos s in syntax_error (Expected [",";")"]) s (); let e = check_signature_mark e p1 p2 in f (List.rev (e :: acc)) p2 in - match s with parser - | [< '(PClose,p2) >] -> f [] p2 - | [< >] -> parse_next_param [] p1 + match%parser s with + | [ (PClose,p2) ] -> f [] p2 + | [ ] -> parse_next_param [] p1 end (* Tries to parse a toplevel expression and defaults to a null expression when in display mode. This function always accepts in display mode and should only be used for expected expressions, not accepted ones! *) -and secure_expr = parser - | [< e = expr >] -> e - | [< s >] -> +and secure_expr = function%parser + | [ expr as e ] -> e + | [ [%s s] ] -> syntax_error (Expected ["expression"]) s ( let last = last_token s in let plast = pos last in @@ -1798,20 +1797,20 @@ let parse_macro_ident t p s = let rec parse_macro_cond s = parsing_macro_cond := true; try - let cond = (match s with parser - | [< '(Const (Ident t),p) >] -> + let cond = (match%parser s with + | [ (Const (Ident t),p) ] -> parse_macro_ident t p s - | [< '(Const (String(s,qs)),p) >] -> + | [ (Const (String(s,qs)),p) ] -> None, (EConst (String(s,qs)),p) - | [< '(Const (Int (i, s)),p) >] -> + | [ (Const (Int (i, s)),p) ] -> None, (EConst (Int (i, s)),p) - | [< '(Const (Float (f, s)),p) >] -> + | [ (Const (Float (f, s)),p) ] -> None, (EConst (Float (f, s)),p) - | [< '(Kwd k,p) >] -> + | [ (Kwd k,p) ] -> parse_macro_ident (s_keyword k) p s - | [< '(Unop op,p); tk, e = parse_macro_cond >] -> + | [ (Unop op,p); [%let tk, e = parse_macro_cond] ] -> tk, make_unop op e p - | [< '(POpen,p1); (e,p) = expr; '(PClose,p2) >] -> + | [ (POpen,p1); [%let (e,p) = expr]; (PClose,p2) ] -> None, (EParenthesis(validate_macro_cond s (e,p)),punion p1 p2)) in parsing_macro_cond := false; cond diff --git a/src/syntax/parser.ml b/src/syntax/parser.ml index 46c612cf67a..60d866ddcb8 100644 --- a/src/syntax/parser.ml +++ b/src/syntax/parser.ml @@ -189,7 +189,7 @@ let syntax_error error_msg ?(pos=None) s v = syntax_error_with_pos error_msg p v let handle_stream_error msg s = - let err,pos = if msg = "" then begin + let err,pos = if msg = "Parse error." then begin let tk,pos = next_token s in (Unexpected tk),Some pos end else @@ -248,7 +248,7 @@ let decl_flag_to_module_field_flag (flag,p) = match flag with | DExtern -> Some (AExtern,p) | DFinal | DPublic | DStatic -> unsupported_decl_flag_module_field flag p -let serror() = raise (Stream.Error "") +let serror() = raise (Stream.Error "Parse error.") let magic_display_field_name = " - display - " let magic_type_path = { tpackage = []; tname = ""; tparams = []; tsub = None }