Use x?: t

Author: cristianoc

compiler-libs-406/oprint.ml

@@ -390,7 +390,7 @@ and print_typargs ppf =
       pp_close_box ppf ();
       pp_print_space ppf ()
 and print_out_label ppf (name, mut, opt, arg) =
-  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name
+  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if mut then "mutable " else "") name (if opt then "?" else "")
     print_out_type arg
 
 let out_type = ref print_out_type

src/res_core.ml

@@ -170,10 +170,6 @@ let makePatternOptional ~optional (p : Parsetree.pattern) =
   if optional then {p with ppat_attributes = optionalAttr :: p.ppat_attributes}
   else p
 
-let makeTypeOptional ~optional (t : Parsetree.core_type) =
-  if optional then {t with ptyp_attributes = optionalAttr :: t.ptyp_attributes}
-  else t
-
 let suppressFragileMatchWarningAttr =
   ( Location.mknoloc "warning",
     Parsetree.PStr
@@ -4292,32 +4288,20 @@ and parseFieldDeclarationRegion p =
   | Lident _ ->
     let lident, loc = parseLident p in
     let name = Location.mkloc lident loc in
+    let optional = parseOptionalLabel p in
     let typ =
       match p.Parser.token with
       | Colon ->
         Parser.next p;
-        let optional = parseOptionalLabel p in
-        let t = parsePolyTypeExpr p in
-        makeTypeOptional ~optional t
+        parsePolyTypeExpr p
       | _ ->
-        Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} []
+        Ast_helper.Typ.constr ~loc:name.loc ~attrs
+          {name with txt = Lident name.txt}
+          []
     in
     let loc = mkLoc startPos typ.ptyp_loc.loc_end in
+    let attrs = if optional then optionalAttr :: attrs else attrs in
     Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
-  | Question -> (
-    Parser.next p;
-    match p.token with
-    | Lident _ ->
-      let lident, loc = parseLident p in
-      let name = Location.mkloc lident loc in
-      let typ =
-        Ast_helper.Typ.constr ~loc:name.loc ~attrs:[optionalAttr]
-          {name with txt = Lident name.txt}
-          []
-      in
-      let loc = mkLoc startPos typ.ptyp_loc.loc_end in
-      Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
-    | _ -> None)
   | _ -> None
 
 (* record-decl ::=

src/res_printer.ml

@@ -1430,15 +1430,15 @@ and printLabelDeclaration (ld : Parsetree.label_declaration) cmtTbl =
     let doc = printIdentLike ld.pld_name.txt in
     printComments doc cmtTbl ld.pld_name.loc
   in
-  let optional = printOptionalLabel ld.pld_type.ptyp_attributes in
+  let optional = printOptionalLabel ld.pld_attributes in
   Doc.group
     (Doc.concat
        [
          attrs;
          mutableFlag;
          name;
-         Doc.text ": ";
          optional;
+         Doc.text ": ";
          printTypExpr ld.pld_type cmtTbl;
        ])
 

tests/parsing/grammar/expressions/expected/record.res.txt

@@ -32,6 +32,9 @@ let _ =
       z = (((None : tt))[@ns.optional ]) } -> 11
   | { name = ((name)[@ns.optional ]); x = 3 } -> 42
   | { name = ((name)[@ns.optional ]); x = 3 } -> 4242
+type nonrec tt = {
+  x: int ;
+  y: string [@ns.opttinal ]}
 type nonrec ttt = {
   x: int ;
-  y: ((string)[@ns.optional ]) }
+  y: string [@ns.optional ]}

tests/parsing/grammar/expressions/record.res

@@ -43,4 +43,6 @@ let _ = switch z {
   | {? name, x: 3} => 4242
 }
 
-type ttt = {x:int, y: ?string}
+type tt = {x:int, @ns.opttinal y : string}
+
+type ttt = {x:int, y?: string}

tests/printer/expr/expected/record.res.txt

@@ -93,4 +93,6 @@ let _ = switch z {
 | {?name, x: 3} => 4242
 }
 
-type ttt = {x: int, y: ?string}
+type tt = {x: int, y?: string}
+
+type ttt = {x: int, y?: string}

tests/printer/expr/record.res

@@ -83,5 +83,6 @@ let _ = switch z {
   | {? name, x: 3} => 4242
 }
 
-type ttt = {x:int, y: ?string}
+type tt = {x:int, @ns.optional y: string}
 
+type ttt = {x:int, y?: string}