more verbose labels

Author: bobzhang

Diff for: jscomp/all.depend

@@ -761,9 +761,11 @@ super_errors/super_main.cmx : super_errors/super_typetexp.cmx \
     super_errors/super_env.cmx
 super_errors/super_reason_react.cmi :
 super_errors/super_misc.cmi :
+outcome_printer/reason_syntax_util.cmx :
 outcome_printer/outcome_printer_ns.cmx : ext/ext_namespace.cmx \
     outcome_printer/outcome_printer_ns.cmi
-outcome_printer/tweaked_reason_oprint.cmx :
+outcome_printer/tweaked_reason_oprint.cmx : \
+    outcome_printer/reason_syntax_util.cmx
 outcome_printer/reason_outcome_printer_main.cmx : \
     outcome_printer/tweaked_reason_oprint.cmx
 outcome_printer/outcome_printer_ns.cmi :

Diff for: jscomp/core/bs_conditional_initial.ml

@@ -25,7 +25,7 @@
 
 let setup_env () = 
 #if BS_DEBUG then    
-    Js_config.set_debug_file "gpr_2352_test.ml";
+    Js_config.set_debug_file "gpr_2413_test.ml";
 #end       
   Lexer.replace_directive_bool "BS" true;
   Lexer.replace_directive_string "BS_VERSION"  Bs_version.version

Diff for: jscomp/core/j.ml

@@ -379,8 +379,8 @@ and variable_declaration = {
 }
 
 and 'a case_clause = { 
-  case : 'a ; 
-  body : block * bool ;  (* true means break *)
+  switch_case : 'a ; 
+  switch_body : block * bool ;  (* true means break *)
 }
 
 (* TODO: For efficency: block should not be a list, it should be able to 

Diff for: jscomp/core/js_dump.ml

@@ -359,7 +359,7 @@ and  pp_function method_
 and output_one : 'a . 
   _ -> P.t -> (P.t -> 'a -> unit) -> 'a J.case_clause -> _
   = fun cxt f  pp_cond
-    ({case = e; body = (sl,break)} : _ J.case_clause) -> 
+    ({switch_case = e; switch_body = (sl,should_break)} : _ J.case_clause) -> 
     let cxt = 
       P.group f 1 @@ fun _ -> 
       P.group f 1 @@ (fun _ -> 
@@ -378,7 +378,7 @@ and output_one : 'a .
           P.newline f ;
           statement_list false cxt  f sl
       in
-      (if break then 
+      (if should_break then 
          begin
            P.newline f ;
            P.string f L.break;

Diff for: jscomp/core/js_fold.ml

@@ -461,7 +461,7 @@ class virtual fold =
     {[ goto : label option ; ]}
   *)
         'a. ('self_type -> 'a -> 'self_type) -> 'a case_clause -> 'self_type =
-      fun _f_a { case = _x; body = _x_i1 } ->
+      fun _f_a { switch_case = _x; switch_body = _x_i1 } ->
         let o = _f_a o _x in
         let o =
           (fun (_x, _x_i1) -> let o = o#block _x in let o = o#bool _x_i1 in o)

Diff for: jscomp/core/js_map.ml

@@ -512,13 +512,13 @@ class virtual map =
   *)
         'a 'a_out.
         ('self_type -> 'a -> 'a_out) -> 'a case_clause -> 'a_out case_clause =
-      fun _f_a { case = _x; body = _x_i1 } ->
+      fun _f_a { switch_case = _x; switch_body = _x_i1 } ->
         let _x = _f_a o _x in
         let _x_i1 =
           (fun (_x, _x_i1) ->
              let _x = o#block _x in let _x_i1 = o#bool _x_i1 in (_x, _x_i1))
             _x_i1
-        in { case = _x; body = _x_i1; }
+        in { switch_case = _x; switch_body = _x_i1; }
     method block : block -> block = (* true means break *)
       (* TODO: For efficency: block should not be a list, it should be able to 
    be concatenated in both ways 

Diff for: jscomp/core/js_of_lam_variant.ml

@@ -40,8 +40,8 @@ let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t =
     E.of_block
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) ->
-              {J.case = i ;
-               body = [S.return_stmt (E.str r)],
+              {J.switch_case = i ;
+               switch_body = [S.return_stmt (E.str r)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
 
@@ -58,8 +58,8 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
       (E.of_block
       [(S.int_switch (E.index arg 0l)
       (Ext_list.map (fun (i,r) ->
-              {J.case = i ;
-               body = [S.return_stmt (E.str r)],
+              {J.switch_case = i ;
+               switch_body = [S.return_stmt (E.str r)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
       , (* TODO: improve, one dispatch later,
@@ -86,8 +86,8 @@ let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) : E.t  =
     E.of_block
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) ->
-              {J.case = i ;
-               body = [S.return_stmt (E.int (Int32.of_int  r))],
+              {J.switch_case = i ;
+               switch_body = [S.return_stmt (E.int (Int32.of_int  r))],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
 

Diff for: jscomp/core/js_output.ml

@@ -122,7 +122,8 @@ let to_break_block (x : t) : J.block * bool =
            TODO: check if it has side efects
         *)
     | { value =  None; finished } -> 
-        block, (match finished with | True -> false | (False | Dummy)  -> true  )
+        block, 
+        (match finished with | True -> false | (False | Dummy)  -> true  )
 
     | {value = Some _ as opt; _} -> 
         block_with_opt_expr block opt, true

Diff for: jscomp/core/js_stmt_make.ml

@@ -100,7 +100,8 @@ let int_switch ?comment   ?declaration ?default (e : J.expression)  clauses : t
     let continuation =  
       begin match Ext_list.find_opt 
         (fun (x : _ J.case_clause) ->
-         if x.case = (Int32.to_int i) then Some (fst x.body) else None ) clauses
+         if x.switch_case = (Int32.to_int i) then
+          Some (fst x.switch_body) else None ) clauses
         with 
         | Some case -> case 
         | None -> 
@@ -137,8 +138,8 @@ let string_switch ?comment ?declaration  ?default (e : J.expression)  clauses :
     let continuation = 
       begin match Ext_list.find_opt 
                     (fun  (x : string J.case_clause) ->
-                      if x.case = s then 
-                        Some (fst x.body)
+                      if x.switch_case = s then 
+                        Some (fst x.switch_body)
                       else None  
                       ) clauses
         with 

Diff for: jscomp/core/lam_compile.ml

@@ -480,10 +480,10 @@ and compile_general_cases :
              |> Ext_list.map_last 
                (fun last (x,lam) -> 
                   if last 
-                  then {J.case =  x;
-                        body =
+                  then {J.switch_case =  x;
+                        switch_body =
                           Js_output.to_break_block (compile_lambda cxt lam) }
-                  else { case = x; body = [],false }))
+                  else { switch_case = x; switch_body = [],false }))
           (* TODO: we should also group default *)
           (* The last clause does not need [break]
               common break through, *)

Diff for: jscomp/others/.depend

@@ -57,6 +57,7 @@ belt_MapString.cmj : belt_internalMapString.cmj belt_internalAVLtree.cmj \
     belt_Array.cmj belt_MapString.cmi
 belt_MapInt.cmj : belt_internalMapInt.cmj belt_internalAVLtree.cmj \
     belt_Array.cmj belt_MapInt.cmi
+belt_Option.cmj : belt_Option.cmi
 belt_Set.cmj : belt_SetString.cmj belt_SetInt.cmj belt_SetDict.cmj \
     belt_Id.cmj belt_Array.cmj belt_Set.cmi
 belt_MutableSet.cmj : belt_internalAVLset.cmj belt_SortArray.cmj \
@@ -127,6 +128,7 @@ belt_Map.cmi : belt_MapString.cmi belt_MapInt.cmi belt_MapDict.cmi \
     belt_Id.cmi
 belt_MapString.cmi :
 belt_MapInt.cmi :
+belt_Option.cmi :
 belt_Set.cmi : belt_SetString.cmi belt_SetInt.cmi belt_SetDict.cmi \
     belt_Id.cmi
 belt_MutableSet.cmi : belt_MutableSetString.cmi belt_MutableSetInt.cmi \

Diff for: jscomp/test/.depend

@@ -302,6 +302,7 @@ gpr_1946_test.cmj : ../stdlib/obj.cmj ../runtime/js.cmj
 gpr_2250_test.cmj : mt.cmj
 gpr_2316_test.cmj : mt.cmj ../runtime/js.cmj
 gpr_2352_test.cmj :
+gpr_2413_test.cmj :
 gpr_2474.cmj :
 gpr_2487.cmj : ../others/belt.cmj
 gpr_2503_test.cmj : mt.cmj ../runtime/js.cmj

Diff for: jscomp/test/Makefile

@@ -245,6 +245,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_
 	pipe_syntax\
 	gpr_2352_test\
 	gpr_2633_test\
+	gpr_2413_test\
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 # simple_derive_test

Diff for: jscomp/test/gpr_2413_test.js

@@ -0,0 +1,32 @@
+'use strict';
+
+var Caml_int32 = require("../../lib/js/caml_int32.js");
+
+function f(param) {
+  var exit = 0;
+  switch (param.tag | 0) {
+    case 0 : 
+        var match = param[0];
+        if (match.tag) {
+          var a = match[0];
+          return a - a | 0;
+        } else {
+          var a$1 = match[0];
+          return a$1 + a$1 | 0;
+        }
+        break;
+    case 1 : 
+    case 2 : 
+        exit = 1;
+        break;
+    
+  }
+  if (exit === 1) {
+    var a$2 = param[0][0];
+    return Caml_int32.imul(a$2, a$2);
+  }
+  
+}
+
+exports.f = f;
+/* No side effect */

Diff for: jscomp/test/gpr_2413_test.ml

@@ -0,0 +1,15 @@
+type inner =
+  | P of int
+  | S of int
+    
+  type outer =
+  | A of inner
+  | B of inner
+  | C of inner
+  
+  let f = function
+  (* These cause unreachable code *)
+  | A P a -> a + a
+  | A S a -> a - a
+  (* These don't, because there's commonality between them *)
+  | B P a | B S a | C P a | C S a -> a * a

Diff for: lib/whole_compiler.d

@@ -492,6 +492,7 @@
 ../lib/whole_compiler.ml : ./syntax/ast_tuple_pattern_flatten.mli
 ../lib/whole_compiler.ml : ./core/js_pass_flatten_and_mark_dead.ml
 ../lib/whole_compiler.ml : ./outcome_printer/outcome_printer_ns.ml
+../lib/whole_compiler.ml : ./outcome_printer/reason_syntax_util.ml
 ../lib/whole_compiler.ml : ./core/js_pass_flatten_and_mark_dead.mli
 ../lib/whole_compiler.ml : ./outcome_printer/outcome_printer_ns.mli
 ../lib/whole_compiler.ml : ./outcome_printer/tweaked_reason_oprint.ml