diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rwxr-xr-x | boot/ocamlc | bin | 1735256 -> 1735246 bytes | |||
| -rwxr-xr-x | boot/ocamldep | bin | 536568 -> 536334 bytes | |||
| -rw-r--r-- | parsing/parser.mly | 11 | ||||
| -rw-r--r-- | typing/typeclass.ml | 4 | ||||
| -rw-r--r-- | typing/typetexp.ml | 7 |
6 files changed, 15 insertions, 8 deletions
@@ -61,6 +61,7 @@ Bug fixes: Features wishes: - PR#6367: introduce Asttypes.arg_label to encode labelled arguments +- PR#6611: remove the option wrapper on optional arguments in the syntax tree OCaml 4.02.2: ------------- diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 3285cfbbf..3a554e315 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamldep b/boot/ocamldep Binary files differindex 161190658..8efece272 100755 --- a/boot/ocamldep +++ b/boot/ocamldep diff --git a/parsing/parser.mly b/parsing/parser.mly index b3c4454a3..49768b4fd 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -32,9 +32,6 @@ let mkctf d = Ctf.mk ~loc:(symbol_rloc()) d let mkcf d = Cf.mk ~loc:(symbol_rloc()) d let mkrhs rhs pos = mkloc rhs (rhs_loc pos) -let mkoption d = - let loc = {d.ptyp_loc with loc_ghost = true} in - Typ.mk ~loc (Ptyp_constr(mkloc (Ldot (Lident "*predef*", "option")) loc,[d])) let reloc_pat x = { x with ppat_loc = symbol_rloc () };; let reloc_exp x = { x with pexp_loc = symbol_rloc () };; @@ -948,9 +945,9 @@ class_type: { $1 } | QUESTION LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type - { mkcty(Pcty_arrow(Optional $2 , mkoption $4, $6)) } + { mkcty(Pcty_arrow(Optional $2 , $4, $6)) } | OPTLABEL simple_core_type_or_tuple_no_attr MINUSGREATER class_type - { mkcty(Pcty_arrow(Optional $1, mkoption $2, $4)) } + { mkcty(Pcty_arrow(Optional $1, $2, $4)) } | LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type { mkcty(Pcty_arrow(Labelled $1, $3, $5)) } | simple_core_type_or_tuple_no_attr MINUSGREATER class_type @@ -1794,9 +1791,9 @@ core_type2: simple_core_type_or_tuple { $1 } | QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2 - { mktyp(Ptyp_arrow(Optional $2 , mkoption $4, $6)) } + { mktyp(Ptyp_arrow(Optional $2 , $4, $6)) } | OPTLABEL core_type2 MINUSGREATER core_type2 - { mktyp(Ptyp_arrow(Optional $1 , mkoption $2, $4)) } + { mktyp(Ptyp_arrow(Optional $1 , $2, $4)) } | LIDENT COLON core_type2 MINUSGREATER core_type2 { mktyp(Ptyp_arrow(Labelled $1, $3, $5)) } | core_type2 MINUSGREATER core_type2 diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 32babd8fb..ebd1ec863 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -498,6 +498,10 @@ and class_type env scty = | Pcty_arrow (l, sty, scty) -> let cty = transl_simple_type env false sty in let ty = cty.ctyp_type in + let ty = + if Btype.is_optional l + then Ctype.newty (Tconstr(Predef.path_option,[ty], ref Mnil)) + else ty in let clty = class_type env scty in let typ = Cty_arrow (l, ty, clty.cltyp_type) in cltyp (Tcty_arrow (l, cty, clty)) typ diff --git a/typing/typetexp.ml b/typing/typetexp.ml index e33a7ecd4..b5d27ba66 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -421,7 +421,12 @@ let rec transl_type env policy styp = | Ptyp_arrow(l, st1, st2) -> let cty1 = transl_type env policy st1 in let cty2 = transl_type env policy st2 in - let ty = newty (Tarrow(l, cty1.ctyp_type, cty2.ctyp_type, Cok)) in + let ty1 = cty1.ctyp_type in + let ty1 = + if Btype.is_optional l + then newty (Tconstr(Predef.path_option,[ty1], ref Mnil)) + else ty1 in + let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, Cok)) in ctyp (Ttyp_arrow (l, cty1, cty2)) ty | Ptyp_tuple stl -> if List.length stl < 2 then |