Merge 5ea4b0a into 4a5190a

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 :

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

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 

jscomp/core/js_dump.ml

@@ -359,32 +359,31 @@ 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 _ -> 
-          P.string f L.case;
-          P.space f ;
-          pp_cond  f e; (* could be integer or string*)
-          P.space f ;
-          P.string f L.colon  );
-
-      P.space f;
-      P.group f 1 @@ fun _ ->
-      let cxt =
-        match sl with 
-        | [] -> cxt 
-        | _ ->
-          P.newline f ;
-          statement_list false cxt  f sl
-      in
-      (if break then 
-         begin
-           P.newline f ;
-           P.string f L.break;
-           semi f;
-         end) ;
-      cxt
+      P.group f 1  (fun _ -> 
+          P.group f 1 (fun _ -> 
+              P.string f L.case;
+              P.space f ;
+              pp_cond  f e; (* could be integer or string *)
+              P.space f ;
+              P.string f L.colon  );
+          P.space f;
+          P.group f 1 (fun _ ->
+              let cxt =
+                match sl with 
+                | [] -> cxt 
+                | _ ->
+                  P.newline f ;
+                  statement_list false cxt  f sl
+              in
+              (if should_break then 
+                 begin
+                   P.newline f ;
+                   P.string f L.break;
+                   semi f;
+                 end) ;
+              cxt))
     in
     P.newline f;
     cxt 

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)

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 

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))]
 

jscomp/core/js_output.ml

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU Lesser General Public License as published by
  * the Free Software Foundation, either version 3 of the License, or
@@ -17,159 +17,160 @@
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
 
-module E = Js_exp_make 
-module S = Js_stmt_make 
+module E = Js_exp_make
+module S = Js_stmt_make
 
-type finished = 
-  | True 
-  | False 
+type finished =
+  | True
+  | False
   | Dummy (* Have no idea, so that when [++] is applied, always use the other *)
 
-type t  =  { 
+type t  =  {
   block : J.block ;
   value : J.expression option;
-  finished : finished ; 
+  output_finished : finished ;
 
 }
 
 type continuation = Lam_compile_context.continuation
 
-let make ?value ?(finished=False) block =
-    { block ; value ; finished }
+let make ?value ?(output_finished=False) block =
+    { block ; value ; output_finished  }
 
 
-let dummy = 
-    {value = None; block = []; finished = Dummy }
+let dummy =
+    {value = None; block = []; output_finished = Dummy }
 
-let output_of_expression 
+let output_of_expression
     (continuation : continuation)
     (should_return : Lam_compile_context.return_type)
     (lam : Lam.t) (exp : J.expression) : t =
-  begin match continuation, should_return with 
-  | EffectCall, ReturnFalse -> 
-      if Lam_analysis.no_side_effects lam 
+  begin match continuation, should_return with
+  | EffectCall, ReturnFalse ->
+      if Lam_analysis.no_side_effects lam
       then dummy
-      else {block = []; value  = Some exp ; finished = False}
-  | Declare (kind, n), ReturnFalse -> 
+      else {block = []; value  = Some exp ; output_finished = False}
+  | Declare (kind, n), ReturnFalse ->
       make [ S.define_variable ~kind n  exp]
-  | Assign n ,ReturnFalse -> 
+  | Assign n ,ReturnFalse ->
       make [S.assign n exp ]
   | EffectCall, ReturnTrue _ ->
-      make [S.return_stmt  exp] ~finished:True    
-  | (Declare _ | Assign _ ), ReturnTrue _ -> 
-      make [S.unknown_lambda lam] ~finished:True
-  | NeedValue, _ -> 
-    {block = []; value = Some exp; finished = False }
+      make [S.return_stmt  exp] ~output_finished:True
+  | (Declare _ | Assign _ ), ReturnTrue _ ->
+      make [S.unknown_lambda lam] ~output_finished:True
+  | NeedValue, _ ->
+    {block = []; value = Some exp; output_finished = False }
   end
 
-let output_of_block_and_expression 
-    (continuation : continuation) 
+let output_of_block_and_expression
+    (continuation : continuation)
     (should_return : Lam_compile_context.return_type)
-    (lam : Lam.t) (block : J.block) exp : t = 
-  match continuation, should_return with 
+    (lam : Lam.t) (block : J.block) exp : t =
+  match continuation, should_return with
   | EffectCall, ReturnFalse -> make block ~value:exp
-  | Declare (kind,n), ReturnFalse -> 
+  | Declare (kind,n), ReturnFalse ->
     make (block @ [ S.define_variable ~kind  n exp])
-  | Assign n, ReturnFalse -> make (block @ [S.assign n exp])  
-  | EffectCall, ReturnTrue _ -> make (block @ [S.return_stmt exp]) ~finished:True
+  | Assign n, ReturnFalse -> make (block @ [S.assign n exp])
+  | EffectCall, ReturnTrue _ -> make (block @ [S.return_stmt exp]) ~output_finished:True
   | (Declare _ | Assign _), ReturnTrue _ ->
-    make [S.unknown_lambda lam] ~finished:True
-  | NeedValue, (ReturnTrue _ | ReturnFalse) -> 
+    make [S.unknown_lambda lam] ~output_finished:True
+  | NeedValue, (ReturnTrue _ | ReturnFalse) ->
     make block ~value:exp
 
 
 
-let block_with_opt_expr block (x : J.expression option) : J.block =   
-    match x with 
+let block_with_opt_expr block (x : J.expression option) : J.block =
+    match x with
     | None  -> block
     | Some x when Js_analyzer.no_side_effect_expression x -> block
     | Some x -> block @ [S.exp x ]
 
-let opt_expr_with_block (x : J.expression option) block : J.block =     
-    match x with 
+let opt_expr_with_block (x : J.expression option) block : J.block =
+    match x with
     | None  -> block
     | Some x when Js_analyzer.no_side_effect_expression x -> block
     | Some x -> (S.exp x) :: block
-
 
-let rec unnest_block (block : J.block) : J.block = 
-  match block with 
-  | [{statement_desc = Block block}] -> unnest_block block 
-  |  _ -> block 
 
-let output_as_block ( x : t)  : J.block = 
-  match x with 
-  | {block; value = opt; finished} ->
+let rec unnest_block (block : J.block) : J.block =
+  match block with
+  | [{statement_desc = Block block}] -> unnest_block block
+  |  _ -> block
+
+let output_as_block ( x : t)  : J.block =
+  match x with
+  | {block; value = opt; output_finished} ->
       let block = unnest_block block in
-      if finished = True  then block
-      else 
+      if output_finished = True  then block
+      else
         block_with_opt_expr block opt
-
 
-let to_break_block (x : t) : J.block * bool = 
-    let block = unnest_block x.block in 
-    match x with 
-    | {finished = True;  _ } -> 
+
+let to_break_block (x : t) : J.block * bool =
+    let block = unnest_block x.block in
+    match x with
+    | {output_finished = True;  _ } ->
         block, false
        (* value does not matter when [finished] is true
            TODO: check if it has side efects
         *)
-    | { value =  None; finished } -> 
-        block, (match finished with | True -> false | (False | Dummy)  -> true  )
+    | { value =  None; output_finished } ->
+        block,
+        (match output_finished with | True -> false | (False | Dummy)  -> true  )
 
-    | {value = Some _ as opt; _} -> 
+    | {value = Some _ as opt; _} ->
         block_with_opt_expr block opt, true
 
 
 (** TODO: make everything expression make inlining hard, and code not readable?
-           1. readability dpends on how we print the expression 
+           1. readability dpends on how we print the expression
            2. inlining needs generate symbols, which are statements, type mismatch
               we need capture [Exp e]
 
-           can we call them all [statement]? statement has no value 
+           can we call them all [statement]? statement has no value
         *)
 (* | {block = [{statement_desc = Exp e }]; value = None ; _}, _ *)
 (*   -> *)
 (*     append { x with block = []; value = Some e} y *)
 (* |  _ , {block = [{statement_desc = Exp e }]; value = None ; _} *)
 (*   -> *)
 (*     append x { y with block = []; value = Some e} *)
-        
-let rec append_output  (x : t ) (y : t ) : t =  
+
+let rec append_output  (x : t ) (y : t ) : t =
     match x , y with (* ATTTENTION: should not optimize [opt_e2], it has to conform to [NeedValue]*)
-    | {finished = True; _ }, _ -> x  
-    | _, {block = []; value= None; finished = Dummy } -> x 
+    | { output_finished = True; _ }, _ -> x
+    | _, {block = []; value= None; output_finished = Dummy } -> x
           (* finished = true --> value = E.undefined otherwise would throw*)
-    | {block = []; value= None; _ }, y  -> y 
-    | {block = []; value= Some _; _}, {block = []; value= None; _ } -> x 
-    | {block = []; value =  Some e1; _}, ({block = []; value = Some e2; finished } as z) -> 
-        if Js_analyzer.no_side_effect_expression e1 
+    | {block = []; value= None; _ }, y  -> y
+    | {block = []; value= Some _; _}, {block = []; value= None; _ } -> x
+    | {block = []; value =  Some e1; _}, ({block = []; value = Some e2; output_finished } as z) ->
+        if Js_analyzer.no_side_effect_expression e1
         then z
             (* It would optimize cases like [module aliases]
-                Bigarray, List 
+                Bigarray, List
              *)
         else
-          {block = []; value = Some (E.seq e1 e2); finished}
+          {block = []; value = Some (E.seq e1 e2); output_finished}
           (* {block = [S.exp e1]; value =  Some e2(\* (E.seq e1 e2) *\); finished} *)
 
-    | {block = block1; value = opt_e1; _},  {block = block2; value = opt_e2; finished} -> 
+    | {block = block1; value = opt_e1; _},  {block = block2; value = opt_e2; output_finished} ->
         let block1 = unnest_block block1 in
         make (block1 @ (opt_expr_with_block opt_e1  @@ unnest_block block2))
-          ?value:opt_e2 ~finished
+          ?value:opt_e2 ~output_finished:output_finished
 
 
 
 
 (* Fold right is more efficient *)
-let concat (xs : t list) : t = 
+let concat (xs : t list) : t =
   Ext_list.fold_right (fun x acc -> append_output x  acc) xs dummy
 
-let to_string x   = 
+let to_string x   =
   Js_dump.string_of_block (output_as_block x)