diff options
30 files changed, 194 insertions, 251 deletions
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 78fc1433a..366d3b513 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -160,9 +160,9 @@ let make_default matcher env = let ctx_matcher p = let p = normalize_pat p in match p.pat_desc with - | Tpat_construct (_, cstr,omegas,_) -> + | Tpat_construct (_, cstr,omegas) -> (fun q rem -> match q.pat_desc with - | Tpat_construct (_, cstr',args,_) when cstr.cstr_tag=cstr'.cstr_tag -> + | Tpat_construct (_, cstr',args) when cstr.cstr_tag=cstr'.cstr_tag -> p,args @ rem | Tpat_any -> p,omegas @ rem | _ -> raise NoMatch) @@ -614,7 +614,7 @@ let rec extract_vars r p = match p.pat_desc with List.fold_left (fun r (_, _, p) -> extract_vars r p) r lpats -| Tpat_construct (_, _, pats,_) -> +| Tpat_construct (_, _, pats) -> List.fold_left extract_vars r pats | Tpat_array pats -> List.fold_left extract_vars r pats @@ -1129,15 +1129,15 @@ let make_field_args binding_kind arg first_pos last_pos argl = in make_args first_pos let get_key_constr = function - | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr.cstr_tag + | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag | _ -> assert false let get_args_constr p rem = match p with -| {pat_desc=Tpat_construct (_, _, args, _)} -> args @ rem +| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem | _ -> assert false let pat_as_constr = function - | {pat_desc=Tpat_construct (_, cstr,_,_)} -> cstr + | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr | _ -> fatal_error "Matching.pat_as_constr" @@ -1151,7 +1151,7 @@ let matcher_constr cstr = match cstr.cstr_arity with with | NoMatch -> matcher_rec p2 rem end - | Tpat_construct (_, cstr1, [],_) when cstr.cstr_tag = cstr1.cstr_tag -> + | Tpat_construct (_, cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag -> rem | Tpat_any -> rem | _ -> raise NoMatch in @@ -1172,7 +1172,7 @@ let matcher_constr cstr = match cstr.cstr_arity with rem | _, _ -> assert false end - | Tpat_construct (_, cstr1, [arg],_) + | Tpat_construct (_, cstr1, [arg]) when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem | Tpat_any -> omega::rem | _ -> raise NoMatch in @@ -1180,7 +1180,7 @@ let matcher_constr cstr = match cstr.cstr_arity with | _ -> fun q rem -> match q.pat_desc with | Tpat_or (_,_,_) -> raise OrPat - | Tpat_construct (_, cstr1, args,_) + | Tpat_construct (_, cstr1, args) when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem | _ -> raise NoMatch @@ -2443,7 +2443,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with divide_constant (combine_constant arg cst partial) ctx pm - | Tpat_construct (_, cstr, _, _) -> + | Tpat_construct (_, cstr, _) -> compile_test (compile_match repr partial) partial divide_constructor (combine_constructor arg pat cstr partial) diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 79daa9e36..fb7a031fd 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -333,10 +333,10 @@ let transl_prim loc prim args = simplify_constant_constructor) = Hashtbl.find comparisons_table prim_name in begin match args with - [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}] + [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}] when simplify_constant_constructor -> intcomp - | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _, _)}; arg2] + | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}; arg2] when simplify_constant_constructor -> intcomp | [arg1; {exp_desc = Texp_variant(_, None)}] @@ -696,7 +696,7 @@ and transl_exp0 e = with Not_constant -> Lprim(Pmakeblock(0, Immutable), ll) end - | Texp_construct(_, cstr, args, _) -> + | Texp_construct(_, cstr, args) -> let ll = transl_list args in begin match cstr.cstr_tag with Cstr_constant n -> @@ -805,7 +805,7 @@ and transl_exp0 e = Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body) | Texp_pack modl -> !transl_module Tcoerce_none None modl - | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _, _)} -> + | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} -> assert_failed e | Texp_assert (cond) -> if !Clflags.noassert @@ -821,7 +821,7 @@ and transl_exp0 e = ( Const_int _ | Const_char _ | Const_string _ | Const_int32 _ | Const_int64 _ | Const_nativeint _ ) | Texp_function(_, _, _) - | Texp_construct (_, {cstr_arity = 0}, _, _) + | Texp_construct (_, {cstr_arity = 0}, _) -> transl_exp e | Texp_constant(Const_float _) -> Lprim(Pmakeblock(Obj.forward_tag, Immutable), [transl_exp e]) diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index c39f226e0..d405a3760 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml @@ -27,10 +27,6 @@ module Make (Ast : Sig.Camlp4Ast) = struct open Camlp4_import.Asttypes; open Ast; - value constructors_arity () = - debug ast2pt "constructors_arity: %b@." Camlp4_config.constructors_arity.val in - Camlp4_config.constructors_arity.val; - value error loc str = Loc.raise loc (Failure str); value char_of_char_token loc s = @@ -504,8 +500,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct [ <:patt@loc< $id:(<:ident@sloc< $lid:s$ >>)$ >> -> mkpat loc (Ppat_var (with_loc s sloc)) | <:patt@loc< $id:i$ >> -> - let p = Ppat_construct (long_uident ~conv_con i) - None (constructors_arity ()) + let p = Ppat_construct (long_uident ~conv_con i) None in mkpat loc p | PaAli loc p1 p2 -> let (p, i) = @@ -519,26 +514,20 @@ module Make (Ast : Sig.Camlp4Ast) = struct | PaAny loc -> mkpat loc Ppat_any | <:patt@loc< $id:(<:ident@sloc< $uid:s$ >>)$ ($tup:<:patt@loc_any< _ >>$) >> -> mkpat loc (Ppat_construct (lident_with_loc (conv_con s) sloc) - (Some (mkpat loc_any Ppat_any)) False) + (Some (mkpat loc_any Ppat_any))) | PaApp loc _ _ as f -> let (f, al) = patt_fa [] f in let al = List.map patt al in match (patt f).ppat_desc with - [ Ppat_construct li None _ -> - if constructors_arity () then - mkpat loc (Ppat_construct li (Some (mkpat loc (Ppat_tuple al))) True) - else + [ Ppat_construct li None -> let a = match al with [ [a] -> a | _ -> mkpat loc (Ppat_tuple al) ] in - mkpat loc (Ppat_construct li (Some a) False) + mkpat loc (Ppat_construct li (Some a)) | Ppat_variant s None -> let a = - if constructors_arity () then - mkpat loc (Ppat_tuple al) - else match al with [ [a] -> a | _ -> mkpat loc (Ppat_tuple al) ] @@ -695,8 +684,7 @@ value varify_constructors var_names = let (e, l) = match sep_expr_acc [] e with [ [(loc, ml, <:expr@sloc< $uid:s$ >>) :: l] -> - let ca = constructors_arity () in - (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None ca), l) + (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None), l) | [(loc, ml, <:expr@sloc< $lid:s$ >>) :: l] -> (mkexp loc (Pexp_ident (mkli sloc s ml)), l) | [(_, [], e) :: l] -> (expr e, l) @@ -718,23 +706,17 @@ value varify_constructors var_names = let (f, al) = expr_fa [] f in let al = List.map label_expr al in match (expr f).pexp_desc with - [ Pexp_construct li None _ -> + [ Pexp_construct li None -> let al = List.map snd al in - if constructors_arity () then - mkexp loc (Pexp_construct li (Some (mkexp loc (Pexp_tuple al))) True) - else let a = match al with [ [a] -> a | _ -> mkexp loc (Pexp_tuple al) ] in - mkexp loc (Pexp_construct li (Some a) False) + mkexp loc (Pexp_construct li (Some a)) | Pexp_variant s None -> let al = List.map snd al in let a = - if constructors_arity () then - mkexp loc (Pexp_tuple al) - else match al with [ [a] -> a | _ -> mkexp loc (Pexp_tuple al) ] @@ -746,7 +728,7 @@ value varify_constructors var_names = [("", expr e1); ("", expr e2)]) | ExArr loc e -> mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) | ExAsf loc -> - mkexp loc (Pexp_assert (mkexp loc (Pexp_construct {txt=Lident "false"; loc=mkloc loc} None false))) + mkexp loc (Pexp_assert (mkexp loc (Pexp_construct {txt=Lident "false"; loc=mkloc loc} None))) | ExAss loc e v -> let e = match e with @@ -861,12 +843,11 @@ value varify_constructors var_names = | <:expr@loc< ($tup:_$) >> -> error loc "singleton tuple" | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (Some (ctyp t)) None) | <:expr@loc< () >> -> - mkexp loc (Pexp_construct (lident_with_loc "()" loc) None True) + mkexp loc (Pexp_construct (lident_with_loc "()" loc) None) | <:expr@loc< $lid:s$ >> -> mkexp loc (Pexp_ident (lident_with_loc s loc)) | <:expr@loc< $uid:s$ >> -> - (* let ca = constructors_arity () in *) - mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None True) + mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None) | ExVrn loc s -> mkexp loc (Pexp_variant (conv_con s) None) | ExWhi loc e1 el -> let e2 = ExSeq loc el in diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml index 23c86ffd4..9a3c2f6af 100644 --- a/camlp4/boot/Camlp4.ml +++ b/camlp4/boot/Camlp4.ml @@ -14139,8 +14139,6 @@ module Struct = open Ast - let constructors_arity () = !Camlp4_config.constructors_arity - let error loc str = Loc.raise loc (Failure str) let char_of_char_token loc s = @@ -14690,8 +14688,7 @@ module Struct = mkpat loc (Ppat_var (with_loc s sloc)) | Ast.PaId (loc, i) -> let p = - Ppat_construct ((long_uident ~conv_con i), None, - (constructors_arity ())) + Ppat_construct ((long_uident ~conv_con i), None) in mkpat loc p | PaAli (loc, p1, p2) -> let (p, i) = @@ -14708,34 +14705,25 @@ module Struct = (Ast.PaTup (_, (Ast.PaAny loc_any)))) -> mkpat loc (Ppat_construct ((lident_with_loc (conv_con s) sloc), - (Some (mkpat loc_any Ppat_any)), false)) + (Some (mkpat loc_any Ppat_any)))) | (PaApp (loc, _, _) as f) -> let (f, al) = patt_fa [] f in let al = List.map patt al in (match (patt f).ppat_desc with - | Ppat_construct (li, None, _) -> - if constructors_arity () - then - mkpat loc - (Ppat_construct (li, - (Some (mkpat loc (Ppat_tuple al))), true)) - else - (let a = + | Ppat_construct (li, None) -> + let a = match al with | [ a ] -> a | _ -> mkpat loc (Ppat_tuple al) - in + in mkpat loc - (Ppat_construct (li, (Some a), false))) + (Ppat_construct (li, (Some a))) | Ppat_variant (s, None) -> let a = - if constructors_arity () - then mkpat loc (Ppat_tuple al) - else - (match al with - | [ a ] -> a - | _ -> mkpat loc (Ppat_tuple al)) + match al with + | [ a ] -> a + | _ -> mkpat loc (Ppat_tuple al) in mkpat loc (Ppat_variant (s, (Some a))) | _ -> error (loc_of_patt f) @@ -14918,11 +14906,9 @@ module Struct = let (e, l) = (match sep_expr_acc [] e with | (loc, ml, Ast.ExId (sloc, (Ast.IdUid (_, s)))) :: l -> - let ca = constructors_arity () - in ((mkexp loc (Pexp_construct ((mkli sloc (conv_con s) ml), - None, ca))), + None))), l) | (loc, ml, Ast.ExId (sloc, (Ast.IdLid (_, s)))) :: l -> ((mkexp loc (Pexp_ident (mkli sloc s ml))), l) @@ -14950,31 +14936,22 @@ module Struct = let al = List.map label_expr al in (match (expr f).pexp_desc with - | Pexp_construct (li, None, _) -> + | Pexp_construct (li, None) -> let al = List.map snd al in - if constructors_arity () - then - mkexp loc - (Pexp_construct (li, - (Some (mkexp loc (Pexp_tuple al))), true)) - else - (let a = + let a = match al with | [ a ] -> a | _ -> mkexp loc (Pexp_tuple al) - in + in mkexp loc - (Pexp_construct (li, (Some a), false))) + (Pexp_construct (li, (Some a))) | Pexp_variant (s, None) -> let al = List.map snd al in let a = - if constructors_arity () - then mkexp loc (Pexp_tuple al) - else - (match al with - | [ a ] -> a - | _ -> mkexp loc (Pexp_tuple al)) + match al with + | [ a ] -> a + | _ -> mkexp loc (Pexp_tuple al) in mkexp loc (Pexp_variant (s, (Some a))) | _ -> mkexp loc (Pexp_apply ((expr f), al))) | ExAre (loc, e1, e2) -> @@ -14985,7 +14962,7 @@ module Struct = [ ("", (expr e1)); ("", (expr e2)) ])) | ExArr (loc, e) -> mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) - | ExAsf loc -> mkexp loc (Pexp_assert (mkexp loc (Pexp_construct ({txt=Lident "false"; loc=mkloc loc}, None, false)))) + | ExAsf loc -> mkexp loc (Pexp_assert (mkexp loc (Pexp_construct ({txt=Lident "false"; loc=mkloc loc}, None)))) | ExAss (loc, e, v) -> let e = (match e with @@ -15155,13 +15132,13 @@ module Struct = (Pexp_constraint ((expr e), (Some (ctyp t)), None)) | Ast.ExId (loc, (Ast.IdUid (_, "()"))) -> mkexp loc - (Pexp_construct ((lident_with_loc "()" loc), None, true)) + (Pexp_construct ((lident_with_loc "()" loc), None)) | Ast.ExId (loc, (Ast.IdLid (_, s))) -> mkexp loc (Pexp_ident (lident_with_loc s loc)) | Ast.ExId (loc, (Ast.IdUid (_, s))) -> mkexp loc (Pexp_construct ((lident_with_loc (conv_con s) loc), - None, true)) + None)) | ExVrn (loc, s) -> mkexp loc (Pexp_variant ((conv_con s), None)) | ExWhi (loc, e1, el) -> diff --git a/experimental/frisch/extension_points.txt b/experimental/frisch/extension_points.txt index efe2b157d..0de1a1752 100644 --- a/experimental/frisch/extension_points.txt +++ b/experimental/frisch/extension_points.txt @@ -471,6 +471,20 @@ condition is the constructor "false" after type-checking the condition: assert(false : bool) assert(let open X in false) +--- Get rid of the "explicit arity" flag on Pexp_construct/Ppat_construct + +This Boolean was used (only by camlp5?) to indicate that the tuple +(expression/pattern) used as the argument was intended to correspond +to the arity of an n-ary constructor. In particular, this allowed +the revised syntax to distinguish "A x y" from "A (x, y)" (the second one +being wrapped in an extra fake tuple) and get a proper error message +if "A (x, y)" was used with a constructor expecting two arguments. + +If really required, the same feature could be restored by storing the +flag as an attribute (with very light support in the type-checker), in +order to avoid polluting the official Parsetree. + + === More TODOs - Adapt pprintast to print attributes and extension nodes. diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml index 944d1feb9..c8bed97d3 100644 --- a/experimental/frisch/ifdef.ml +++ b/experimental/frisch/ifdef.ml @@ -46,10 +46,8 @@ let ifdef = {txt = Lident "GETENV"}, Some {pexp_loc = loc; pexp_desc = Pexp_construct ( {txt = Lident sym}, - None, - _ - )}, - _ + None + )} )} -> E.strconst ~loc (getenv sym) | x -> super # expr x diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index bef106f77..4f36b8754 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -266,7 +266,7 @@ module Analyser = (List.map iter_pattern patlist, Odoc_env.subst_type env pat.pat_type) - | Typedtree.Tpat_construct (_, cons_desc, _, _) when + | Typedtree.Tpat_construct (_, cons_desc, _) when (* we give a name to the parameter only if it unit *) (match cons_desc.cstr_res.desc with Tconstr (p, _, _) -> diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml index 67bf0ff19..bc0ed437e 100644 --- a/otherlibs/labltk/browser/searchid.ml +++ b/otherlibs/labltk/browser/searchid.ml @@ -417,8 +417,8 @@ let rec bound_variables pat = | Ppat_var s -> [s.txt] | Ppat_alias (pat,s) -> s.txt :: bound_variables pat | Ppat_tuple l -> List2.flat_map l ~f:bound_variables - | Ppat_construct (_,None,_) -> [] - | Ppat_construct (_,Some pat,_) -> bound_variables pat + | Ppat_construct (_,None) -> [] + | Ppat_construct (_,Some pat) -> bound_variables pat | Ppat_variant (_,None) -> [] | Ppat_variant (_,Some pat) -> bound_variables pat | Ppat_record (l, _) -> diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml index ef511b877..0d59c8ab7 100644 --- a/otherlibs/labltk/browser/searchpos.ml +++ b/otherlibs/labltk/browser/searchpos.ml @@ -765,7 +765,7 @@ and search_pos_expr ~pos exp = search_pos_expr exp ~pos; List.iter l ~f:(search_case ~pos) | Texp_tuple l -> List.iter l ~f:(search_pos_expr ~pos) - | Texp_construct (_, _, l,_) -> List.iter l ~f:(search_pos_expr ~pos) + | Texp_construct (_, _, l) -> List.iter l ~f:(search_pos_expr ~pos) | Texp_variant (_, None) -> () | Texp_variant (_, Some exp) -> search_pos_expr exp ~pos | Texp_record (l, opt) -> @@ -827,7 +827,7 @@ and search_pos_pat ~pos ~env pat = add_found_str (`Exp(`Const, pat.pat_type)) ~env ~loc:pat.pat_loc | Tpat_tuple l -> List.iter l ~f:(search_pos_pat ~pos ~env) - | Tpat_construct (_, _, l, _) -> + | Tpat_construct (_, _, l) -> List.iter l ~f:(search_pos_pat ~pos ~env) | Tpat_variant (_, None, _) -> () | Tpat_variant (_, Some pat, _) -> search_pos_pat pat ~pos ~env diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index 8e40c215b..5796177cd 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -61,7 +61,7 @@ module Pat = struct let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) - let construct ?loc ?attrs a b c = mk ?loc ?attrs (Ppat_construct (a, b, c)) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) @@ -85,7 +85,7 @@ module Exp = struct let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) - let construct ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_construct (a, b, c)) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) @@ -372,7 +372,7 @@ module Convenience = struct let lid s = mkloc (Longident.parse s) !default_loc let tuple l = Exp.tuple l - let constr s args = Exp.construct (lid s) (may_tuple Exp.tuple args) false + let constr s args = Exp.construct (lid s) (may_tuple Exp.tuple args) let nil () = constr "[]" [] let unit () = constr "()" [] let cons hd tl = constr "::" [hd; tl] @@ -391,7 +391,7 @@ module Convenience = struct Exp.let_ (if recursive then Recursive else Nonrecursive) b body let pvar s = Pat.var (mkloc s !default_loc) - let pconstr s args = Pat.construct (lid s) (may_tuple Pat.tuple args) true + let pconstr s args = Pat.construct (lid s) (may_tuple Pat.tuple args) let punit () = pconstr "()" [] diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 5bade9134..5952c1b52 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -64,7 +64,7 @@ module Pat: val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern - val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> bool -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern @@ -90,7 +90,7 @@ module Exp: val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression - val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> bool -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 4f150d5d9..901042e0a 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -211,7 +211,7 @@ module E = struct | Pexp_match (e, l) -> match_ ~loc ~attrs (sub # expr e) (List.map (map_case sub) l) | Pexp_try (e, l) -> try_ ~loc ~attrs (sub # expr e) (List.map (map_case sub) l) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) - | Pexp_construct (lid, arg, b) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) b + | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub # expr) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) (map_opt (sub # expr) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) @@ -251,7 +251,7 @@ module P = struct | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) - | Ppat_construct (l, p, b) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) b + | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) cf diff --git a/parsing/parser.mly b/parsing/parser.mly index fcbdeb65d..22c4e0568 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -69,7 +69,7 @@ let ghtyp d = Typ.mk ~loc:(symbol_gloc ()) d let ghloc d = { txt = d; loc = symbol_gloc () } let ghunit () = - ghexp (Pexp_construct (mknoloc (Lident "()"), None, false)) + ghexp (Pexp_construct (mknoloc (Lident "()"), None)) let mkinfix arg1 name arg2 = mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2])) @@ -106,16 +106,16 @@ let mkuplus name arg = mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg])) let mkexp_cons consloc args loc = - Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args, false)) + Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args)) let mkpat_cons consloc args loc = - Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args, false)) + Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args)) let rec mktailexp nilloc = function [] -> let loc = { nilloc with loc_ghost = true } in let nil = { txt = Lident "[]"; loc = loc } in - Exp.mk ~loc (Pexp_construct (nil, None, false)) + Exp.mk ~loc (Pexp_construct (nil, None)) | e1 :: el -> let exp_el = mktailexp nilloc el in let loc = {loc_start = e1.pexp_loc.loc_start; @@ -129,7 +129,7 @@ let rec mktailpat nilloc = function [] -> let loc = { nilloc with loc_ghost = true } in let nil = { txt = Lident "[]"; loc = loc } in - Pat.mk ~loc (Ppat_construct (nil, None, false)) + Pat.mk ~loc (Ppat_construct (nil, None)) | p1 :: pl -> let pat_pl = mktailpat nilloc pl in let loc = {loc_start = p1.ppat_loc.loc_start; @@ -1028,7 +1028,7 @@ expr: | expr_comma_list %prec below_COMMA { mkexp(Pexp_tuple(List.rev $1)) } | constr_longident simple_expr %prec below_SHARP - { mkexp(Pexp_construct(mkrhs $1 1, Some $2, false)) } + { mkexp(Pexp_construct(mkrhs $1 1, Some $2)) } | name_tag simple_expr %prec below_SHARP { mkexp(Pexp_variant($1, Some $2)) } | IF ext_attributes seq_expr THEN expr ELSE expr @@ -1114,7 +1114,7 @@ simple_expr: | constant { mkexp(Pexp_constant $1) } | constr_longident %prec prec_constant_constructor - { mkexp(Pexp_construct(mkrhs $1 1, None, false)) } + { mkexp(Pexp_construct(mkrhs $1 1, None)) } | name_tag %prec prec_constant_constructor { mkexp(Pexp_variant($1, None)) } | LPAREN seq_expr RPAREN @@ -1125,7 +1125,7 @@ simple_expr: { wrap_exp_attrs (reloc_exp $3) $2 (* check location *) } | BEGIN ext_attributes END { mkexp_attrs (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()), - None, false)) $2 } + None)) $2 } | BEGIN ext_attributes seq_expr error { unclosed "begin" 1 "end" 3 } | LPAREN seq_expr type_constraint RPAREN @@ -1318,7 +1318,7 @@ pattern: | pattern_comma_list %prec below_COMMA { mkpat(Ppat_tuple(List.rev $1)) } | constr_longident pattern %prec prec_constr_appl - { mkpat(Ppat_construct(mkrhs $1 1, Some $2, false)) } + { mkpat(Ppat_construct(mkrhs $1 1, Some $2)) } | name_tag pattern %prec prec_constr_appl { mkpat(Ppat_variant($1, Some $2)) } | pattern COLONCOLON pattern @@ -1348,7 +1348,7 @@ simple_pattern: | signed_constant DOTDOT signed_constant { mkpat(Ppat_interval ($1, $3)) } | constr_longident - { mkpat(Ppat_construct(mkrhs $1 1, None, false)) } + { mkpat(Ppat_construct(mkrhs $1 1, None)) } | name_tag { mkpat(Ppat_variant($1, None)) } | SHARP type_longident diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index d51591944..6fde14dfb 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -145,23 +145,11 @@ and pattern_desc = but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) (n >= 2) *) - | Ppat_construct of Longident.t loc * pattern option * bool - (* C (None, false) - C P (Some P, false) - - Constructors with multiple arguments are represented - by storing a Ppat_tuple in P. - - bool = true is never created by the standard parser. - It can be used when P is a Ppat_tuple to inform the - type-checker that the length of that tuple corresponds - to the number of parameters for that constructor (otherwise - this is inferred from the definition of the constructor). - This can be useful with a different concrete syntax - which distinguishes n-ary constructors from constructors - with a tuple argument in patterns. + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) - | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) @@ -231,12 +219,10 @@ and expression_desc = (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) (n >= 2) *) - | Pexp_construct of Longident.t loc * expression option * bool - (* C (None, false) - C E (Some E, false) - - Constructors with multiple arguments are represented - by storing a Pexp_tuple in E. + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index b65f79b1c..653347ef7 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -55,7 +55,7 @@ let is_predef_option = function | _ -> false let is_unit = function - | {pexp_desc=Pexp_construct ( {txt= Lident "()"; _},_,_); + | {pexp_desc=Pexp_construct ( {txt= Lident "()"; _},_); pexp_attributes = [] } -> true | _ -> false @@ -82,20 +82,20 @@ type construct = let view_expr x = match x.pexp_desc with - | Pexp_construct ( {txt= Lident "()"; _},_,_) -> `tuple - | Pexp_construct ( {txt= Lident "[]";_},_,_) -> `nil - | Pexp_construct ( {txt= Lident"::";_},Some _,_) -> + | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple + | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil + | Pexp_construct ( {txt= Lident"::";_},Some _) -> let rec loop exp acc = match exp with - | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_,_);_} -> (List.rev acc,true) + | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);_} -> (List.rev acc,true) | {pexp_desc= - Pexp_construct ({txt=Lident "::";_},Some ({pexp_desc= Pexp_tuple([e1;e2]);_}),_);_} -> + Pexp_construct ({txt=Lident "::";_},Some ({pexp_desc= Pexp_tuple([e1;e2]);_}));_} -> loop e2 (e1::acc) | e -> (List.rev (e::acc),false) in let (ls,b) = loop x [] in if b then `list ls else `cons ls - | Pexp_construct (x,None,_) -> `simple (x.txt) + | Pexp_construct (x,None) -> `simple (x.txt) | _ -> `normal let is_simple_construct :construct -> bool = function @@ -335,14 +335,14 @@ class printer ()= object(self:'self) | {ppat_desc = Ppat_construct ({ txt = Lident("::") ;_}, - Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}), - _);_} -> + Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_})); _} + -> pp f "%a::%a" self#simple_pattern pat1 pattern_list_helper pat2 (*RA*) | p -> self#pattern1 f p in match x.ppat_desc with | Ppat_variant (l, Some p) -> pp f "@[<2>`%s@;%a@]" l self#pattern1 p (*RA*) - | Ppat_construct (({txt=Lident("()"|"[]");_}), _, _) -> self#simple_pattern f x - | Ppat_construct (({txt;_} as li), po, _) -> (* FIXME The third field always false *) + | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> self#simple_pattern f x + | Ppat_construct (({txt;_} as li), po) -> (* FIXME The third field always false *) if txt = Lident "::" then pp f "%a" pattern_list_helper x else @@ -353,7 +353,7 @@ class printer ()= object(self:'self) | _ -> self#simple_pattern f x method simple_pattern (f:Format.formatter) (x:pattern) :unit = match x.ppat_desc with - | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _, _) -> pp f "%s" x + | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f "%s" x | Ppat_any -> pp f "_"; | Ppat_var ({txt = txt;_}) -> if (is_infix (fixity_of_string txt)) || List.mem txt.[0] prefix_symbols then @@ -571,7 +571,7 @@ class printer ()= object(self:'self) (*reset here only because [function,match,try,sequence] are lower priority*) end (e,l)) - | Pexp_construct (li, Some eo, _) + | Pexp_construct (li, Some eo) when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*) (match view_expr x with | `cons ls -> self#list self#simple_expr f ls ~sep:"@;::@;" diff --git a/parsing/printast.ml b/parsing/printast.ml index fc00e3043..7da500c1b 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -198,10 +198,9 @@ and pattern i ppf x = | Ppat_tuple (l) -> line i ppf "Ppat_tuple\n"; list i pattern ppf l; - | Ppat_construct (li, po, b) -> + | Ppat_construct (li, po) -> line i ppf "Ppat_construct %a\n" fmt_longident_loc li; option i pattern ppf po; - bool i ppf b; | Ppat_variant (l, po) -> line i ppf "Ppat_variant \"%s\"\n" l; option i pattern ppf po; @@ -261,10 +260,9 @@ and expression i ppf x = | Pexp_tuple (l) -> line i ppf "Pexp_tuple\n"; list i expression ppf l; - | Pexp_construct (li, eo, b) -> + | Pexp_construct (li, eo) -> line i ppf "Pexp_construct %a\n" fmt_longident_loc li; option i expression ppf eo; - bool i ppf b; | Pexp_variant (l, eo) -> line i ppf "Pexp_variant \"%s\"\n" l; option i expression ppf eo; diff --git a/tools/addlabels.ml b/tools/addlabels.ml index c5ef65d6f..37e5625fe 100644 --- a/tools/addlabels.ml +++ b/tools/addlabels.ml @@ -65,7 +65,7 @@ let rec pattern_vars pat = | Ppat_tuple l | Ppat_array l -> List.concat (List.map pattern_vars l) - | Ppat_construct (_, Some pat, _) + | Ppat_construct (_, Some pat) | Ppat_variant (_, Some pat) | Ppat_constraint (pat, _) -> pattern_vars pat @@ -260,7 +260,7 @@ let rec add_labels_expr ~text ~values ~classes expr = List.iter add_labels_rec (e :: List.map snd args) | Pexp_tuple l | Pexp_array l -> List.iter add_labels_rec l - | Pexp_construct (_, Some e, _) + | Pexp_construct (_, Some e) | Pexp_variant (_, Some e) | Pexp_field (e, _) | Pexp_constraint (e, _, _) diff --git a/tools/depend.ml b/tools/depend.ml index de42f5702..522ca5953 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -113,7 +113,7 @@ let rec add_pattern bv pat = | Ppat_interval _ | Ppat_constant _ -> () | Ppat_tuple pl -> List.iter (add_pattern bv) pl - | Ppat_construct(c, op, _) -> add bv c; add_opt add_pattern bv op + | Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op | Ppat_record(pl, _) -> List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl | Ppat_array pl -> List.iter (add_pattern bv) pl @@ -143,7 +143,7 @@ let rec add_expr bv exp = | Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel | Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel | Pexp_tuple el -> List.iter (add_expr bv) el - | Pexp_construct(c, opte, _) -> add bv c; add_opt add_expr bv opte + | Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte | Pexp_variant(_, opte) -> add_opt add_expr bv opte | Pexp_record(lblel, opte) -> List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel; diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml index a684cfe40..1049d2cc4 100644 --- a/tools/eqparsetree.ml +++ b/tools/eqparsetree.ml @@ -231,10 +231,9 @@ let rec eq_pattern_desc : (pattern_desc * pattern_desc) -> 'result = | (Ppat_constant a0, Ppat_constant b0) -> Asttypes.eq_constant (a0, b0) | (Ppat_tuple a0, Ppat_tuple b0) -> eq_list eq_pattern (a0, b0) - | (Ppat_construct (a0, a1, a2), Ppat_construct (b0, b1, b2)) -> + | (Ppat_construct (a0, a1), Ppat_construct (b0, b1)) -> ((Asttypes.eq_loc Longident.eq_t (a0, b0)) && (eq_option eq_pattern (a1, b1))) - && (eq_bool (a2, b2)) | (Ppat_variant (a0, a1), Ppat_variant (b0, b1)) -> (Asttypes.eq_label (a0, b0)) && (eq_option eq_pattern (a1, b1)) | (Ppat_record (a0, a1), Ppat_record (b0, b1)) -> @@ -685,10 +684,9 @@ and eq_expression_desc : (eq_pattern (a0, b0)) && (eq_expression (a1, b1))) (a1, b1)) | (Pexp_tuple a0, Pexp_tuple b0) -> eq_list eq_expression (a0, b0) - | (Pexp_construct (a0, a1, a2), Pexp_construct (b0, b1, b2)) -> + | (Pexp_construct (a0, a1), Pexp_construct (b0, b1)) -> ((Asttypes.eq_loc Longident.eq_t (a0, b0)) && (eq_option eq_expression (a1, b1))) - && (eq_bool (a2, b2)) | (Pexp_variant (a0, a1), Pexp_variant (b0, b1)) -> (Asttypes.eq_label (a0, b0)) && (eq_option eq_expression (a1, b1)) diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml index cb17c06b4..2d348a93e 100644 --- a/tools/ocamlprof.ml +++ b/tools/ocamlprof.ml @@ -207,8 +207,8 @@ and rw_exp iflag sexp = | Pexp_tuple sexpl -> rewrite_exp_list iflag sexpl - | Pexp_construct(_, None, _) -> () - | Pexp_construct(_, Some sarg, _) -> + | Pexp_construct(_, None) -> () + | Pexp_construct(_, Some sarg) -> rewrite_exp iflag sarg | Pexp_variant(_, None) -> () diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml index 29ef9f72a..e352692f1 100644 --- a/tools/tast_iter.ml +++ b/tools/tast_iter.ml @@ -68,7 +68,7 @@ let pattern sub pat = | Tpat_var _ | Tpat_constant _ -> () | Tpat_tuple l - | Tpat_construct (_, _, l, _) -> List.iter (sub # pattern) l + | Tpat_construct (_, _, l) -> List.iter (sub # pattern) l | Tpat_variant (_, po, _) -> opt (sub # pattern) po | Tpat_record (l, _) -> List.iter (fun (_, _, pat) -> sub # pattern pat) l | Tpat_array l -> List.iter (sub # pattern) l @@ -104,7 +104,7 @@ let expression sub exp = sub # cases cases | Texp_tuple list -> List.iter (sub # expression) list - | Texp_construct (_, _, args, _) -> + | Texp_construct (_, _, args) -> List.iter (sub # expression) args | Texp_variant (_, expo) -> opt (sub # expression) expo diff --git a/tools/untypeast.ml b/tools/untypeast.ml index 00fe20a11..ff74b88ef 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -176,7 +176,7 @@ and untype_pattern pat = | Tpat_constant cst -> Ppat_constant cst | Tpat_tuple list -> Ppat_tuple (List.map untype_pattern list) - | Tpat_construct (lid, _, args, explicit_arity) -> + | Tpat_construct (lid, _, args) -> Ppat_construct (lid, (match args with [] -> None @@ -185,7 +185,7 @@ and untype_pattern pat = (Pat.tuple ~loc:pat.pat_loc (List.map untype_pattern args) ) - ), explicit_arity) + )) | Tpat_variant (label, pato, _) -> Ppat_variant (label, option untype_pattern pato) | Tpat_record (list, closed) -> @@ -244,7 +244,7 @@ and untype_expression exp = Pexp_try (untype_expression exp, untype_cases cases) | Texp_tuple list -> Pexp_tuple (List.map untype_expression list) - | Texp_construct (lid, _, args, explicit_arity) -> + | Texp_construct (lid, _, args) -> Pexp_construct (lid, (match args with [] -> None @@ -252,7 +252,7 @@ and untype_expression exp = | args -> Some (Exp.tuple ~loc:exp.exp_loc (List.map untype_expression args)) - ), explicit_arity) + )) | Texp_variant (label, expo) -> Pexp_variant (label, option untype_expression expo) | Texp_record (list, expo) -> diff --git a/typing/parmatch.ml b/typing/parmatch.ml index c744392dc..2862e5456 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -88,7 +88,7 @@ let rec compat p q = | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0 | Tpat_tuple ps, Tpat_tuple qs -> compats ps qs | Tpat_lazy p, Tpat_lazy q -> compat p q - | Tpat_construct (_, c1,ps1, _), Tpat_construct (_, c2,ps2, _) -> + | Tpat_construct (_, c1,ps1), Tpat_construct (_, c2,ps2) -> c1.cstr_tag = c2.cstr_tag && compats ps1 ps2 | Tpat_variant(l1,Some p1, r1), Tpat_variant(l2,Some p2,_) -> l1=l2 && compat p1 p2 @@ -201,13 +201,13 @@ let rec pretty_val ppf v = | Tpat_constant c -> fprintf ppf "%s" (pretty_const c) | Tpat_tuple vs -> fprintf ppf "@[(%a)@]" (pretty_vals ",") vs - | Tpat_construct (_, {cstr_tag=tag},[], _) -> + | Tpat_construct (_, {cstr_tag=tag},[]) -> let name = get_constr_name tag v.pat_type v.pat_env in fprintf ppf "%s" name - | Tpat_construct (_, {cstr_tag=tag},[w], _) -> + | Tpat_construct (_, {cstr_tag=tag},[w]) -> let name = get_constr_name tag v.pat_type v.pat_env in fprintf ppf "@[<2>%s@ %a@]" name pretty_arg w - | Tpat_construct (_, {cstr_tag=tag},vs, _) -> + | Tpat_construct (_, {cstr_tag=tag},vs) -> let name = get_constr_name tag v.pat_type v.pat_env in begin match (name, vs) with ("::", [v1;v2]) -> @@ -236,19 +236,19 @@ let rec pretty_val ppf v = fprintf ppf "@[(%a|@,%a)@]" pretty_or v pretty_or w and pretty_car ppf v = match v.pat_desc with -| Tpat_construct (_,{cstr_tag=tag}, [_ ; _], _) +| Tpat_construct (_,{cstr_tag=tag}, [_ ; _]) when is_cons tag v -> fprintf ppf "(%a)" pretty_val v | _ -> pretty_val ppf v and pretty_cdr ppf v = match v.pat_desc with -| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2], _) +| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2]) when is_cons tag v -> fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2 | _ -> pretty_val ppf v and pretty_arg ppf v = match v.pat_desc with -| Tpat_construct (_,_,_::_, _) -> fprintf ppf "(%a)" pretty_val v +| Tpat_construct (_,_,_::_) -> fprintf ppf "(%a)" pretty_val v | _ -> pretty_val ppf v and pretty_or ppf v = match v.pat_desc with @@ -288,7 +288,7 @@ let prerr_pat v = (* Check top matching *) let simple_match p1 p2 = match p1.pat_desc, p2.pat_desc with - | Tpat_construct(_, c1, _, _), Tpat_construct(_, c2, _, _) -> + | Tpat_construct(_, c1, _), Tpat_construct(_, c2, _) -> c1.cstr_tag = c2.cstr_tag | Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) -> l1 = l2 @@ -339,7 +339,7 @@ let all_record_args lbls = match lbls with (* Build argument list when p2 >= p1, where p1 is a simple pattern *) let rec simple_match_args p1 p2 = match p2.pat_desc with | Tpat_alias (p2,_,_) -> simple_match_args p1 p2 -| Tpat_construct(_, cstr, args, _) -> args +| Tpat_construct(_, cstr, args) -> args | Tpat_variant(lab, Some arg, _) -> [arg] | Tpat_tuple(args) -> args | Tpat_record(args,_) -> extract_fields (record_arg p1) args @@ -347,7 +347,7 @@ let rec simple_match_args p1 p2 = match p2.pat_desc with | Tpat_lazy arg -> [arg] | (Tpat_any | Tpat_var(_)) -> begin match p1.pat_desc with - Tpat_construct(_, _,args, _) -> omega_list args + Tpat_construct(_, _,args) -> omega_list args | Tpat_variant(_, Some _, _) -> [omega] | Tpat_tuple(args) -> omega_list args | Tpat_record(args,_) -> omega_list args @@ -368,9 +368,9 @@ let rec normalize_pat q = match q.pat_desc with | Tpat_alias (p,_,_) -> normalize_pat p | Tpat_tuple (args) -> make_pat (Tpat_tuple (omega_list args)) q.pat_type q.pat_env - | Tpat_construct (lid, c,args,explicit_arity) -> + | Tpat_construct (lid, c,args) -> make_pat - (Tpat_construct (lid, c,omega_list args, explicit_arity)) + (Tpat_construct (lid, c,omega_list args)) q.pat_type q.pat_env | Tpat_variant (l, arg, row) -> make_pat (Tpat_variant (l, may_map (fun _ -> omega) arg, row)) @@ -455,10 +455,10 @@ let do_set_args erase_mutable q r = match q with omegas args, closed)) q.pat_type q.pat_env:: rest -| {pat_desc = Tpat_construct (lid, c,omegas, explicit_arity)} -> +| {pat_desc = Tpat_construct (lid, c,omegas)} -> let args,rest = read_args omegas r in make_pat - (Tpat_construct (lid, c,args, explicit_arity)) + (Tpat_construct (lid, c,args)) q.pat_type q.pat_env:: rest | {pat_desc = Tpat_variant (l, omega, row)} -> @@ -627,7 +627,7 @@ let row_of_pat pat = let generalized_constructor x = match x with - ({pat_desc = Tpat_construct(_,c,_, _);pat_env=env},_) -> + ({pat_desc = Tpat_construct(_,c,_);pat_env=env},_) -> c.cstr_generalized | _ -> assert false @@ -641,9 +641,9 @@ let clean_env env = loop env let full_match ignore_generalized closing env = match env with -| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_,_)},_)::_ -> +| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_)},_)::_ -> false -| ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ -> +| ({pat_desc = Tpat_construct(_,c,_);pat_type=typ},_) :: _ -> if ignore_generalized then (* remove generalized constructors; those cases will be handled separately *) @@ -686,12 +686,12 @@ let full_match ignore_generalized closing env = match env with | _ -> fatal_error "Parmatch.full_match" let full_match_gadt env = match env with - | ({pat_desc = Tpat_construct(_,c,_,_);pat_type=typ},_) :: _ -> + | ({pat_desc = Tpat_construct(_,c,_);pat_type=typ},_) :: _ -> List.length env = c.cstr_consts + c.cstr_nonconsts | _ -> true let extendable_match env = match env with -| ({pat_desc=Tpat_construct(_,{cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)} +| ({pat_desc=Tpat_construct(_,{cstr_tag=(Cstr_constant _|Cstr_block _)},_)} as p,_) :: _ -> let path = get_type_path p.pat_type p.pat_env in not @@ -705,7 +705,7 @@ let should_extend ext env = match ext with | None -> false | Some ext -> match env with | ({pat_desc = - Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)} + Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},_)} as p, _) :: _ -> let path = get_type_path p.pat_type p.pat_env in Path.same path ext @@ -736,7 +736,7 @@ let complete_tags nconsts nconstrs tags = let pat_of_constr ex_pat cstr = {ex_pat with pat_desc = Tpat_construct (mknoloc (Longident.Lident "?pat_of_constr?"), - cstr,omegas cstr.cstr_arity,false)} + cstr,omegas cstr.cstr_arity)} let rec pat_of_constrs ex_pat = function | [] -> raise Empty @@ -773,7 +773,7 @@ let rec map_filter f = (* Sends back a pattern that complements constructor tags all_tag *) let complete_constrs p all_tags = match p.pat_desc with - | Tpat_construct (_,c,_,_) -> + | Tpat_construct (_,c,_) -> begin try let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in let (constrs, _) = @@ -806,22 +806,22 @@ let build_other_constant proj make first next p env = let build_other ext env = match env with | ({pat_desc = - Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_,_)},_) + Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_)},_) ::_ -> make_pat (Tpat_construct (lid, {c with cstr_tag=(Cstr_exception (Path.Pident (Ident.create "*exception*"), Location.none))}, - [], false)) + [])) Ctype.none Env.empty -| ({pat_desc = Tpat_construct (_, _,_,_)} as p,_) :: _ -> +| ({pat_desc = Tpat_construct (_, _,_)} as p,_) :: _ -> begin match ext with | Some ext when Path.same ext (get_type_path p.pat_type p.pat_env) -> extra_pat | _ -> let get_tag = function - | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag + | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag | _ -> fatal_error "Parmatch.get_tag" in let all_tags = List.map (fun (p,_) -> get_tag p) env in pat_of_constrs p (complete_constrs p all_tags) @@ -938,7 +938,7 @@ let build_other_gadt ext env = match env with | ({pat_desc = Tpat_construct _} as p,_) :: _ -> let get_tag = function - | {pat_desc = Tpat_construct (_,c,_,_)} -> c.cstr_tag + | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag | _ -> fatal_error "Parmatch.get_tag" in let all_tags = List.map (fun (p,_) -> get_tag p) env in let cnstrs = complete_constrs p all_tags in @@ -962,7 +962,7 @@ let rec has_instance p = match p.pat_desc with | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) -> has_instance p | Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2 - | Tpat_construct (_,_,ps,_) | Tpat_tuple ps | Tpat_array ps -> + | Tpat_construct (_,_,ps) | Tpat_tuple ps | Tpat_array ps -> has_instances ps | Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps) | Tpat_lazy p @@ -1109,7 +1109,7 @@ let print_pat pat = | Tpat_any -> "_" | Tpat_alias (p, x) -> Printf.sprintf "(%s) as ?" (string_of_pat p) | Tpat_constant n -> "0" - | Tpat_construct (_, lid, _, _) -> + | Tpat_construct (_, lid, _) -> Printf.sprintf "%s" (String.concat "." (Longident.flatten lid.txt)) | Tpat_lazy p -> Printf.sprintf "(lazy %s)" (string_of_pat p) @@ -1523,7 +1523,7 @@ let rec le_pat p q = | Tpat_alias(p,_,_), _ -> le_pat p q | _, Tpat_alias(q,_,_) -> le_pat p q | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0 - | Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) -> + | Tpat_construct(_,c1,ps), Tpat_construct(_,c2,qs) -> c1.cstr_tag = c2.cstr_tag && le_pats ps qs | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) -> (l1 = l2 && le_pat p1 p2) @@ -1573,10 +1573,10 @@ let rec lub p q = match p.pat_desc,q.pat_desc with | Tpat_lazy p, Tpat_lazy q -> let r = lub p q in make_pat (Tpat_lazy r) p.pat_type p.pat_env -| Tpat_construct (lid, c1,ps1,_), Tpat_construct (_,c2,ps2,_) +| Tpat_construct (lid, c1,ps1), Tpat_construct (_,c2,ps2) when c1.cstr_tag = c2.cstr_tag -> let rs = lubs ps1 ps2 in - make_pat (Tpat_construct (lid, c1,rs, false)) + make_pat (Tpat_construct (lid, c1,rs)) p.pat_type p.pat_env | Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_) when l1=l2 -> @@ -1768,14 +1768,14 @@ module Conv = struct List.map (fun lst -> mkpat (Ppat_tuple lst)) results - | Tpat_construct (cstr_lid, cstr,lst,_) -> + | Tpat_construct (cstr_lid, cstr,lst) -> let id = fresh cstr.cstr_name in let lid = { cstr_lid with txt = Longident.Lident id } in Hashtbl.add constrs id cstr; let results = select (List.map loop lst) in begin match lst with [] -> - [mkpat (Ppat_construct(lid, None, false))] + [mkpat (Ppat_construct(lid, None))] | _ -> List.map (fun lst -> @@ -1785,7 +1785,7 @@ module Conv = struct | [x] -> Some x | _ -> Some (mkpat (Ppat_tuple lst)) in - mkpat (Ppat_construct(lid, arg, false))) + mkpat (Ppat_construct(lid, arg))) results end | Tpat_variant(label,p_opt,row_desc) -> @@ -1916,7 +1916,7 @@ let extendable_path path = Path.same path Predef.path_option) let rec collect_paths_from_pat r p = match p.pat_desc with -| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},ps,_) -> +| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _)},ps) -> let path = get_type_path p.pat_type p.pat_env in List.fold_left collect_paths_from_pat @@ -1924,7 +1924,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with ps | Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r | Tpat_tuple ps | Tpat_array ps -| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps,_)-> +| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps)-> List.fold_left collect_paths_from_pat r ps | Tpat_record (lps,_) -> List.fold_left @@ -2018,7 +2018,7 @@ let rec inactive pat = match pat with false | Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_, None, _) -> true -| Tpat_tuple ps | Tpat_construct (_, _, ps,_) | Tpat_array ps -> +| Tpat_tuple ps | Tpat_construct (_, _, ps) | Tpat_array ps -> List.for_all (fun p -> inactive p.pat_desc) ps | Tpat_alias (p,_,_) | Tpat_variant (_, Some p, _) -> inactive p.pat_desc diff --git a/typing/printtyped.ml b/typing/printtyped.ml index f5feab1f4..64a8c5025 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -223,10 +223,9 @@ and pattern i ppf x = | Tpat_tuple (l) -> line i ppf "Ppat_tuple\n"; list i pattern ppf l; - | Tpat_construct (li, _, po, explicity_arity) -> + | Tpat_construct (li, _, po) -> line i ppf "Ppat_construct %a\n" fmt_longident li; list i pattern ppf po; - bool i ppf explicity_arity; | Tpat_variant (l, po, _) -> line i ppf "Ppat_variant \"%s\"\n" l; option i pattern ppf po; @@ -296,10 +295,9 @@ and expression i ppf x = | Texp_tuple (l) -> line i ppf "Pexp_tuple\n"; list i expression ppf l; - | Texp_construct (li, _, eo, b) -> + | Texp_construct (li, _, eo) -> line i ppf "Pexp_construct %a\n" fmt_longident li; list i expression ppf eo; - bool i ppf b; | Texp_variant (l, eo) -> line i ppf "Pexp_variant \"%s\"\n" l; option i expression ppf eo; diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 848cc32a4..4a54e529c 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -862,15 +862,13 @@ and class_expr cl_num val_env met_env scl = Exp.case (Pat.construct ~loc (mknoloc (Longident.(Ldot (Lident "*predef*", "Some")))) - (Some (Pat.var ~loc (mknoloc "*sth*"))) - false) + (Some (Pat.var ~loc (mknoloc "*sth*")))) (Exp.ident ~loc (mknoloc (Longident.Lident "*sth*"))); Exp.case (Pat.construct ~loc (mknoloc (Longident.(Ldot (Lident "*predef*", "None")))) - None - false) + None) default; ] in diff --git a/typing/typecore.ml b/typing/typecore.ml index b8355a1c8..df2159cee 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -132,7 +132,7 @@ let iter_expression f e = | Pexp_try (e, pel) -> expr e; List.iter case pel | Pexp_array el | Pexp_tuple el -> List.iter expr el - | Pexp_construct (_, eo, _) + | Pexp_construct (_, eo) | Pexp_variant (_, eo) -> may expr eo | Pexp_record (iel, eo) -> may expr eo; List.iter (fun (_, e) -> expr e) iel @@ -252,13 +252,13 @@ let mkexp exp_desc exp_type exp_loc exp_env = let option_none ty loc = let lid = Longident.Lident "None" in let cnone = Env.lookup_constructor lid Env.initial in - mkexp (Texp_construct(mknoloc lid, cnone, [], false)) + mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc Env.initial let option_some texp = let lid = Longident.Lident "Some" in let csome = Env.lookup_constructor lid Env.initial in - mkexp ( Texp_construct(mknoloc lid , csome, [texp],false) ) + mkexp ( Texp_construct(mknoloc lid , csome, [texp]) ) (type_option texp.exp_type) texp.exp_loc texp.exp_env let extract_option_type env ty = @@ -452,7 +452,7 @@ let rec build_as_type env p = | Tpat_tuple pl -> let tyl = List.map (build_as_type env) pl in newty (Ttuple tyl) - | Tpat_construct(_, cstr, pl,_) -> + | Tpat_construct(_, cstr, pl) -> let keep = cstr.cstr_private = Private || cstr.cstr_existentials <> [] in if keep then p.pat_type else let tyl = List.map (build_as_type env) pl in @@ -955,7 +955,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = pat_type = expected_ty; pat_attributes = sp.ppat_attributes; pat_env = !env } - | Ppat_construct(lid, sarg, explicit_arity) -> + | Ppat_construct(lid, sarg) -> let opath = try let (p0, p, _) = extract_concrete_variant !env expected_ty in @@ -985,7 +985,6 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = let sargs = match sarg with None -> [] - | Some {ppat_desc = Ppat_tuple spl} when explicit_arity -> spl | Some {ppat_desc = Ppat_tuple spl} when constr.cstr_arity > 1 -> spl | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 -> if constr.cstr_arity = 0 then @@ -1005,7 +1004,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = unify_pat_types loc !env ty_res expected_ty; let args = List.map2 (fun p t -> type_pat p t) sargs ty_args in rp { - pat_desc=Tpat_construct(lid, constr, args,explicit_arity); + pat_desc=Tpat_construct(lid, constr, args); pat_loc = loc; pat_extra=[]; pat_type = expected_ty; pat_attributes = sp.ppat_attributes; @@ -1314,7 +1313,7 @@ let rec is_nonexpansive exp = is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd3 el) | Texp_tuple el -> List.for_all is_nonexpansive el - | Texp_construct( _, _, el,_) -> + | Texp_construct( _, _, el) -> List.for_all is_nonexpansive el | Texp_variant(_, arg) -> is_nonexpansive_opt arg | Texp_record(lbl_exp_list, opt_init_exp) -> @@ -1748,7 +1747,7 @@ let iter_ppat f p = | Ppat_type _ | Ppat_unpack _ -> () | Ppat_array pats -> List.iter f pats | Ppat_or (p1,p2) -> f p1; f p2 - | Ppat_variant (_, arg) | Ppat_construct (_, arg, _) -> may f arg + | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg | Ppat_tuple lst -> List.iter f lst | Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p | Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args @@ -1764,7 +1763,7 @@ let contains_polymorphic_variant p = let contains_gadt env p = let rec loop p = match p.ppat_desc with - Ppat_construct (lid, _, _) -> + Ppat_construct (lid, _) -> begin try let cstrs = Env.lookup_all_constructors lid.txt env in List.iter (fun (cstr,_) -> if cstr.cstr_generalized then raise Exit) @@ -1933,15 +1932,13 @@ and type_expect_ ?in_function env sexp ty_expected = Exp.case (Pat.construct ~loc:default_loc (mknoloc (Longident.(Ldot (Lident "*predef*", "Some")))) - (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))) - false) + (Some (Pat.var ~loc:default_loc (mknoloc "*sth*")))) (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*"))); Exp.case (Pat.construct ~loc:default_loc (mknoloc (Longident.(Ldot (Lident "*predef*", "None")))) - None - false) + None) default; ] in @@ -2076,8 +2073,8 @@ and type_expect_ ?in_function env sexp ty_expected = exp_type = newty (Ttuple (List.map (fun e -> e.exp_type) expl)); exp_attributes = sexp.pexp_attributes; exp_env = env } - | Pexp_construct(lid, sarg, explicit_arity) -> - type_construct env loc lid sarg explicit_arity ty_expected sexp.pexp_attributes + | Pexp_construct(lid, sarg) -> + type_construct env loc lid sarg ty_expected sexp.pexp_attributes | Pexp_variant(l, sarg) -> (* Keep sharing *) let ty_expected0 = instance env ty_expected in @@ -2601,7 +2598,7 @@ and type_expect_ ?in_function env sexp ty_expected = let cond = type_expect env e Predef.type_bool in let exp_type = match cond.exp_desc with - | Texp_construct(_, {cstr_name="false"}, _, _) -> + | Texp_construct(_, {cstr_name="false"}, _) -> instance env ty_expected | _ -> instance_def Predef.type_unit @@ -3090,7 +3087,7 @@ and type_application env funct sargs = else type_args [] [] ty (instance env ty) ty sargs [] -and type_construct env loc lid sarg explicit_arity ty_expected attrs = +and type_construct env loc lid sarg ty_expected attrs = let opath = try let (p0, p,_) = extract_concrete_variant env ty_expected in @@ -3103,7 +3100,6 @@ and type_construct env loc lid sarg explicit_arity ty_expected attrs = let sargs = match sarg with None -> [] - | Some {pexp_desc = Pexp_tuple sel} when explicit_arity -> sel | Some {pexp_desc = Pexp_tuple sel} when constr.cstr_arity > 1 -> sel | Some se -> [se] in if List.length sargs <> constr.cstr_arity then @@ -3114,7 +3110,7 @@ and type_construct env loc lid sarg explicit_arity ty_expected attrs = let (ty_args, ty_res) = instance_constructor constr in let texp = re { - exp_desc = Texp_construct(lid, constr, [],explicit_arity); + exp_desc = Texp_construct(lid, constr, []); exp_loc = loc; exp_extra = []; exp_type = ty_res; exp_attributes = attrs; @@ -3139,8 +3135,9 @@ and type_construct env loc lid sarg explicit_arity ty_expected attrs = (List.combine ty_args ty_args0) in if constr.cstr_private = Private then raise(Error(loc, env, Private_type ty_res)); + (* NOTE: shouldn't we call "re" on this final expression? -- AF *) { texp with - exp_desc = Texp_construct(lid, constr, args, explicit_arity) } + exp_desc = Texp_construct(lid, constr, args) } (* Typing of statements (expressions whose values are discarded) *) diff --git a/typing/typedtree.ml b/typing/typedtree.ml index 55e1272dc..f1f84ae26 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -45,7 +45,7 @@ and pattern_desc = | Tpat_constant of constant | Tpat_tuple of pattern list | Tpat_construct of - Longident.t loc * constructor_description * pattern list * bool + Longident.t loc * constructor_description * pattern list | Tpat_variant of label * pattern option * row_desc ref | Tpat_record of (Longident.t loc * label_description * pattern) list * @@ -79,8 +79,7 @@ and expression_desc = | Texp_try of expression * case list | Texp_tuple of expression list | Texp_construct of - Longident.t loc * constructor_description * expression list * - bool + Longident.t loc * constructor_description * expression list | Texp_variant of label * expression option | Texp_record of (Longident.t loc * label_description * expression) list * @@ -446,7 +445,7 @@ and 'a class_infos = let iter_pattern_desc f = function | Tpat_alias(p, _, _) -> f p | Tpat_tuple patl -> List.iter f patl - | Tpat_construct(_, cstr, patl, _) -> List.iter f patl + | Tpat_construct(_, cstr, patl) -> List.iter f patl | Tpat_variant(_, pat, _) -> may f pat | Tpat_record (lbl_pat_list, _) -> List.iter (fun (_, lbl, pat) -> f pat) lbl_pat_list @@ -465,8 +464,8 @@ let map_pattern_desc f d = Tpat_tuple (List.map f pats) | Tpat_record (lpats, closed) -> Tpat_record (List.map (fun (lid, l,p) -> lid, l, f p) lpats, closed) - | Tpat_construct (lid, c,pats, arity) -> - Tpat_construct (lid, c, List.map f pats, arity) + | Tpat_construct (lid, c,pats) -> + Tpat_construct (lid, c, List.map f pats) | Tpat_array pats -> Tpat_array (List.map f pats) | Tpat_lazy p1 -> Tpat_lazy (f p1) diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 5f1b12a07..cdd6d93d8 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -44,7 +44,7 @@ and pattern_desc = | Tpat_constant of constant | Tpat_tuple of pattern list | Tpat_construct of - Longident.t loc * constructor_description * pattern list * bool + Longident.t loc * constructor_description * pattern list | Tpat_variant of label * pattern option * row_desc ref | Tpat_record of (Longident.t loc * label_description * pattern) list * @@ -78,8 +78,7 @@ and expression_desc = | Texp_try of expression * case list | Texp_tuple of expression list | Texp_construct of - Longident.t loc * constructor_description * expression list * - bool + Longident.t loc * constructor_description * expression list | Texp_variant of label * expression option | Texp_record of (Longident.t loc * label_description * expression) list * diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml index 5a6f5bc73..2f33219b3 100644 --- a/typing/typedtreeIter.ml +++ b/typing/typedtreeIter.ml @@ -206,7 +206,7 @@ module MakeIterator(Iter : IteratorArgument) : sig | Tpat_constant cst -> () | Tpat_tuple list -> List.iter iter_pattern list - | Tpat_construct (_, _, args, _) -> + | Tpat_construct (_, _, args) -> List.iter iter_pattern args | Tpat_variant (label, pato, _) -> begin match pato with @@ -257,7 +257,7 @@ module MakeIterator(Iter : IteratorArgument) : sig iter_cases list | Texp_tuple list -> List.iter iter_expression list - | Texp_construct (_, _, args, _) -> + | Texp_construct (_, _, args) -> List.iter iter_expression args | Texp_variant (label, expo) -> begin match expo with diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml index 82d20b262..57e04e6a1 100644 --- a/typing/typedtreeMap.ml +++ b/typing/typedtreeMap.ml @@ -195,9 +195,9 @@ module MakeMap(Map : MapArgument) = struct let pat1 = map_pattern pat1 in Tpat_alias (pat1, p, text) | Tpat_tuple list -> Tpat_tuple (List.map map_pattern list) - | Tpat_construct (lid, cstr_decl, args, arity) -> + | Tpat_construct (lid, cstr_decl, args) -> Tpat_construct (lid, cstr_decl, - List.map map_pattern args, arity) + List.map map_pattern args) | Tpat_variant (label, pato, rowo) -> let pato = match pato with None -> pato @@ -259,9 +259,9 @@ module MakeMap(Map : MapArgument) = struct ) | Texp_tuple list -> Texp_tuple (List.map map_expression list) - | Texp_construct (lid, cstr_desc, args, arity) -> + | Texp_construct (lid, cstr_desc, args) -> Texp_construct (lid, cstr_desc, - List.map map_expression args, arity ) + List.map map_expression args ) | Texp_variant (label, expo) -> let expo =match expo with None -> expo |