summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--parsing/parser.mly29
-rw-r--r--parsing/parsetree.mli4
-rw-r--r--parsing/pstream.ml11
-rw-r--r--tools/ocamlprof.ml4
-rw-r--r--typing/typecore.ml6
5 files changed, 30 insertions, 24 deletions
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 0d81f0dc9..79a5ef3cf 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -46,12 +46,12 @@ let mkassert e =
mkexp (Pexp_constant (Const_int st));
mkexp (Pexp_constant (Const_int en))]) in
let ex = Ldot (Lident "Pervasives", "Assert_failure") in
- let bucket = mkexp (Pexp_construct (ex, Some triple)) in
+ let bucket = mkexp (Pexp_construct (ex, Some triple, false)) in
let ra = Ldot (Lident "Pervasives", "raise") in
let raiser = mkexp (Pexp_apply (mkexp (Pexp_ident ra), [bucket])) in
- let un = mkexp (Pexp_construct (Lident "()", None)) in
+ let un = mkexp (Pexp_construct (Lident "()", None, false)) in
match e with
- | {pexp_desc = Pexp_construct (Lident "false", None) } -> raiser
+ | {pexp_desc = Pexp_construct (Lident "false", None, false) } -> raiser
| _ -> if !Clflags.noassert
then un
else mkexp (Pexp_ifthenelse (e, un, Some raiser))
@@ -71,16 +71,18 @@ let mkuminus name arg =
let rec mklistexp = function
[] ->
- mkexp(Pexp_construct(Lident "[]", None))
+ mkexp(Pexp_construct(Lident "[]", None, false))
| e1 :: el ->
mkexp(Pexp_construct(Lident "::",
- Some(mkexp(Pexp_tuple[e1; mklistexp el]))))
+ Some(mkexp(Pexp_tuple[e1; mklistexp el])),
+ false))
let rec mklistpat = function
[] ->
- mkpat(Ppat_construct(Lident "[]", None))
+ mkpat(Ppat_construct(Lident "[]", None, false))
| p1 :: pl ->
mkpat(Ppat_construct(Lident "::",
- Some(mkpat(Ppat_tuple[p1; mklistpat pl]))))
+ Some(mkpat(Ppat_tuple[p1; mklistpat pl])),
+ false))
let mkstrexp e =
{ pstr_desc = Pstr_eval e; pstr_loc = e.pexp_loc }
@@ -404,7 +406,7 @@ expr:
| expr_comma_list
{ mkexp(Pexp_tuple(List.rev $1)) }
| constr_longident simple_expr %prec prec_constr_appl
- { mkexp(Pexp_construct($1, Some $2)) }
+ { mkexp(Pexp_construct($1, Some $2, false)) }
| IF seq_expr THEN expr ELSE expr %prec prec_if
{ mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
| IF seq_expr THEN expr %prec prec_if
@@ -414,7 +416,7 @@ expr:
| FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
{ mkexp(Pexp_for($2, $4, $6, $5, $8)) }
| expr COLONCOLON expr
- { mkexp(Pexp_construct(Lident "::", Some(mkexp(Pexp_tuple[$1;$3])))) }
+ { mkexp(Pexp_construct(Lident "::", Some(mkexp(Pexp_tuple[$1;$3])), false)) }
| expr INFIXOP0 expr
{ mkinfix $1 $2 $3 }
| expr INFIXOP1 expr
@@ -466,7 +468,7 @@ simple_expr:
| constant
{ mkexp(Pexp_constant $1) }
| constr_longident
- { mkexp(Pexp_construct($1, None)) }
+ { mkexp(Pexp_construct($1, None, false)) }
| LPAREN seq_expr RPAREN
{ $2 }
| BEGIN seq_expr END
@@ -620,9 +622,10 @@ pattern:
| pattern_comma_list
{ mkpat(Ppat_tuple(List.rev $1)) }
| constr_longident pattern %prec prec_constr_appl
- { mkpat(Ppat_construct($1, Some $2)) }
+ { mkpat(Ppat_construct($1, Some $2, false)) }
| pattern COLONCOLON pattern
- { mkpat(Ppat_construct(Lident "::", Some(mkpat(Ppat_tuple[$1;$3])))) }
+ { mkpat(Ppat_construct(Lident "::", Some(mkpat(Ppat_tuple[$1;$3])),
+ false)) }
| pattern BAR pattern
{ mkpat(Ppat_or($1, $3)) }
;
@@ -636,7 +639,7 @@ simple_pattern:
| CHAR DOTDOT CHAR
{ mkrangepat $1 $3 }
| constr_longident
- { mkpat(Ppat_construct($1, None)) }
+ { mkpat(Ppat_construct($1, None, false)) }
| LBRACE lbl_pattern_list opt_semi RBRACE
{ mkpat(Ppat_record(List.rev $2)) }
| LBRACKET pattern_semi_list opt_semi RBRACKET
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 124263ceb..986dc3363 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -51,7 +51,7 @@ and pattern_desc =
| Ppat_alias of pattern * string
| Ppat_constant of constant
| Ppat_tuple of pattern list
- | Ppat_construct of Longident.t * pattern option
+ | Ppat_construct of Longident.t * pattern option * bool
| Ppat_record of (Longident.t * pattern) list
| Ppat_or of pattern * pattern
| Ppat_constraint of pattern * core_type
@@ -69,7 +69,7 @@ and expression_desc =
| Pexp_match of expression * (pattern * expression) list
| Pexp_try of expression * (pattern * expression) list
| Pexp_tuple of expression list
- | Pexp_construct of Longident.t * expression option
+ | Pexp_construct of Longident.t * expression option * bool
| Pexp_record of (Longident.t * expression) list
| Pexp_field of expression * Longident.t
| Pexp_setfield of expression * Longident.t * expression
diff --git a/parsing/pstream.ml b/parsing/pstream.ml
index 460002303..58e0aae89 100644
--- a/parsing/pstream.ml
+++ b/parsing/pstream.ml
@@ -32,13 +32,13 @@ let ploc loc p = { ppat_desc = p; ppat_loc = loc }
let spat = Ppat_var "%strm"
let sexp = Pexp_ident (Lident "%strm")
let eval x = mkexp (Pexp_ident (Ldot (Lident "Stream", x)))
-let econ c x = mkexp (Pexp_construct (Ldot (Lident "Stream", c), x))
-let pcon c x = mkpat (Ppat_construct (Ldot (Lident "Stream", c), x))
+let econ c x = mkexp (Pexp_construct (Ldot (Lident "Stream", c), x, false))
+let pcon c x = mkpat (Ppat_construct (Ldot (Lident "Stream", c), x, false))
let afun f x =
mkexp (Pexp_apply (mkexp (Pexp_ident (Ldot (Lident "Stream", f))), x))
let araise c x =
mkexp (Pexp_apply (mkexp (Pexp_ident (Lident "raise")), [econ c x]))
-let esome x = mkexp (Pexp_construct (Lident "Some", Some x))
+let esome x = mkexp (Pexp_construct (Lident "Some", Some x, false))
(* parsers *)
@@ -59,7 +59,7 @@ let stream_pattern_component skont =
(Pexp_try
(esome (mkexp (Pexp_apply (e, [mkexp sexp]))),
[(pcon "Failure" None,
- mkexp (Pexp_construct (Lident "None", None)))])),
+ mkexp (Pexp_construct (Lident "None", None, false)))])),
p, skont)
| Spat_sterm p ->
(esome (mkexp sexp), p, skont)
@@ -89,7 +89,8 @@ let rec stream_pattern epo e ekont =
mkexp
(Pexp_match
(tst,
- [(ploc p.ppat_loc (Ppat_construct (Lident "Some", Some p)), e);
+ [(ploc p.ppat_loc (Ppat_construct (Lident "Some", Some p, false)),
+ e);
(mkpat Ppat_any, ckont)]))
let rec parser_cases =
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index 7fb1f18f8..a5ee31f5a 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -163,8 +163,8 @@ and rewrite_exp sexp =
| Pexp_tuple sexpl ->
rewrite_exp_list sexpl
- | Pexp_construct(_, None) -> ()
- | Pexp_construct(_, Some sarg) ->
+ | Pexp_construct(_, None, _) -> ()
+ | Pexp_construct(_, Some sarg, _) ->
rewrite_exp sarg
| Pexp_record lid_sexp_list ->
diff --git a/typing/typecore.ml b/typing/typecore.ml
index e839f7017..b9d34b3ce 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -102,7 +102,7 @@ let rec type_pat env sp =
{ pat_desc = Tpat_tuple pl;
pat_loc = sp.ppat_loc;
pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl)) }
- | Ppat_construct(lid, sarg) ->
+ | Ppat_construct(lid, sarg, explicit_arity) ->
let constr =
try
Env.lookup_constructor lid env
@@ -111,6 +111,7 @@ let rec type_pat env sp =
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 ->
replicate_list sp constr.cstr_arity
@@ -362,7 +363,7 @@ let rec type_exp env sexp =
exp_loc = sexp.pexp_loc;
exp_type = newty (Ttuple(List.map (fun exp -> exp.exp_type) expl));
exp_env = env }
- | Pexp_construct(lid, sarg) ->
+ | Pexp_construct(lid, sarg, explicit_arity) ->
let constr =
try
Env.lookup_constructor lid env
@@ -371,6 +372,7 @@ let rec type_exp env sexp =
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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-22 07:05:47 +0000