Exhauce PR#6611: remove the option wrapper on optional arguments in the syntax tree

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15738 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -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:
 -------------

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

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

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