Clean up optional implementation.

Author: cristianoc

jscomp/ml/typecore.ml

@@ -1153,16 +1153,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  match ld.lbl_repres with
  | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
  | _ -> false in
- let process_optional_label (id, ld, pat) =
+ let process_optional_label (ld, pat) =
  let exp_optional_attr =
  Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
- in {pat with ppat_desc}
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
  else pat
  in 
  let type_label_pat (label_lid, label, sarg) k =
+ let sarg = process_optional_label (label, sarg) in
  begin_def ();
  let (vars, ty_arg, ty_res) = instance_label false label in
  if vars = [] then end_def ();
@@ -1172,7 +1173,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  raise(Error(label_lid.loc, !env,
  Label_mismatch(label_lid.txt, trace)))
  end;
- let sarg = process_optional_label (label_lid, label, sarg) in
  type_pat sarg ty_arg (fun arg ->
  if vars <> [] then begin
  end_def ();
@@ -1879,8 +1879,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
  Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
- in (id, ld, {e with pexp_desc})
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+ in (id, ld, e)
  else (id, ld, e)
  in
  match sexp.pexp_desc with

jscomp/test/res_debug.js

@@ -16,12 +16,7 @@ var newrecord = Caml_obj.obj_dup(v0);
 newrecord.x = 3;
 
 function testMatch(v) {
- var y = v.y;
- if (y !== undefined) {
- return y;
- } else {
- return 42;
- }
+ return v.y;
 }
 
 var v2 = newrecord;

jscomp/test/res_debug.res

@@ -44,12 +44,12 @@ let v1 : r = { x : 3
  , z : 3
 }
 
-@@warning("-56") // Turn off match case unreachable
+//@@warning("-56") // Turn off match case unreachable
 
 let testMatch = v =>
  switch v {
  | {y} => y
- | {y: @optional None} => 42
+// | {y: @optional None} => 42
  }
 
 let h = '😊'

lib/4.06.1/unstable/js_compiler.ml

@@ -40056,16 +40056,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  match ld.lbl_repres with
  | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
  | _ -> false in
- let process_optional_label (id, ld, pat) =
+ let process_optional_label (ld, pat) =
  let exp_optional_attr =
  Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
- in {pat with ppat_desc}
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
  else pat
  in 
  let type_label_pat (label_lid, label, sarg) k =
+ let sarg = process_optional_label (label, sarg) in
  begin_def ();
  let (vars, ty_arg, ty_res) = instance_label false label in
  if vars = [] then end_def ();
@@ -40075,7 +40076,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  raise(Error(label_lid.loc, !env,
  Label_mismatch(label_lid.txt, trace)))
  end;
- let sarg = process_optional_label (label_lid, label, sarg) in
  type_pat sarg ty_arg (fun arg ->
  if vars <> [] then begin
  end_def ();
@@ -40782,8 +40782,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
  Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
- in (id, ld, {e with pexp_desc})
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+ in (id, ld, e)
  else (id, ld, e)
  in
  match sexp.pexp_desc with

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -40056,16 +40056,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  match ld.lbl_repres with
  | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
  | _ -> false in
- let process_optional_label (id, ld, pat) =
+ let process_optional_label (ld, pat) =
  let exp_optional_attr =
  Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
- in {pat with ppat_desc}
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
  else pat
  in 
  let type_label_pat (label_lid, label, sarg) k =
+ let sarg = process_optional_label (label, sarg) in
  begin_def ();
  let (vars, ty_arg, ty_res) = instance_label false label in
  if vars = [] then end_def ();
@@ -40075,7 +40076,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  raise(Error(label_lid.loc, !env,
  Label_mismatch(label_lid.txt, trace)))
  end;
- let sarg = process_optional_label (label_lid, label, sarg) in
  type_pat sarg ty_arg (fun arg ->
  if vars <> [] then begin
  end_def ();
@@ -40782,8 +40782,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
  Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
- in (id, ld, {e with pexp_desc})
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+ in (id, ld, e)
  else (id, ld, e)
  in
  match sexp.pexp_desc with

lib/4.06.1/whole_compiler.ml

@@ -214587,16 +214587,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  match ld.lbl_repres with
  | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
  | _ -> false in
- let process_optional_label (id, ld, pat) =
+ let process_optional_label (ld, pat) =
  let exp_optional_attr =
  Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
- in {pat with ppat_desc}
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
  else pat
  in 
  let type_label_pat (label_lid, label, sarg) k =
+ let sarg = process_optional_label (label, sarg) in
  begin_def ();
  let (vars, ty_arg, ty_res) = instance_label false label in
  if vars = [] then end_def ();
@@ -214606,7 +214607,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
  raise(Error(label_lid.loc, !env,
  Label_mismatch(label_lid.txt, trace)))
  end;
- let sarg = process_optional_label (label_lid, label, sarg) in
  type_pat sarg ty_arg (fun arg ->
  if vars <> [] then begin
  end_def ();
@@ -215313,8 +215313,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
  Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
  in
  if label_is_optional ld && not exp_optional_attr then
- let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
- in (id, ld, {e with pexp_desc})
+ let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+ let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+ in (id, ld, e)
  else (id, ld, e)
  in
  match sexp.pexp_desc with