[part 1] [debug mode] provide runtime support

jscomp/all.depend

@@ -488,8 +488,8 @@ core/lam_compile_context.cmx : core/lam_stats.cmx core/lam.cmx core/j.cmx \
 core/js_map.cmx : core/j.cmx
 core/js_fold.cmx : core/j.cmx
 core/js_fold_basic.cmx : core/lam_module_ident.cmx \
-    core/js_runtime_modules.cmx core/js_fold.cmx core/j.cmx ext/ident_set.cmx \
-    core/js_fold_basic.cmi
+    core/js_runtime_modules.cmx core/js_fold.cmx common/js_config.cmx \
+    core/j.cmx ext/ident_set.cmx core/js_fold_basic.cmi
 core/js_pass_scope.cmx : core/js_fun_env.cmx core/js_fold.cmx \
     core/js_closure.cmx ext/ident_set.cmx common/ext_log.cmx ext/ext_list.cmx \
     core/js_pass_scope.cmi
@@ -595,9 +595,10 @@ core/js_dump_import_export.cmx : core/js_dump_string.cmx \
     core/js_dump_import_export.cmi
 core/js_dump.cmx : core/js_stmt_make.cmx core/js_runtime_modules.cmx \
     core/js_op_util.cmx core/js_op.cmx core/js_number.cmx core/js_fun_env.cmx \
-    core/js_exp_make.cmx core/js_dump_string.cmx core/js_dump_property.cmx \
-    core/js_dump_lit.cmx core/js_closure.cmx core/j.cmx ext/ident_set.cmx \
-    ext/ext_pp_scope.cmx ext/ext_pp.cmx ext/ext_list.cmx ext/ext_ident.cmx \
+    core/js_fold_basic.cmx core/js_exp_make.cmx core/js_dump_string.cmx \
+    core/js_dump_property.cmx core/js_dump_lit.cmx common/js_config.cmx \
+    core/js_closure.cmx core/j.cmx ext/ident_set.cmx ext/ext_pp_scope.cmx \
+    ext/ext_pp.cmx ext/ext_list.cmx ext/ext_ident.cmx ext/ext_array.cmx \
     core/js_dump.cmi
 core/js_name_of_module_id.cmx : core/lam_compile_env.cmx \
     core/js_packages_state.cmx core/js_packages_info.cmx \

jscomp/bin/all_ounit_tests.ml

@@ -1292,6 +1292,7 @@ val range : int -> int -> int array
 
 val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array
 
+val to_list_f : ('a -> 'b) -> 'a array -> 'b list 
 val to_list_map : ('a -> 'b option) -> 'a array -> 'b list 
 
 val to_list_map_acc : 
@@ -1426,6 +1427,13 @@ let map2i f a b =
   else
     Array.mapi (fun i a -> f i  a ( Array.unsafe_get b i )) a 
 
+let rec tolist_f_aux a f  i res =
+  if i < 0 then res else
+    let v = Array.unsafe_get a i in
+    tolist_f_aux a f  (i - 1)
+      (f v :: res)
+
+let to_list_f f a = tolist_f_aux a f (Array.length a  - 1) []
 
 let rec tolist_aux a f  i res =
   if i < 0 then res else

jscomp/common/js_config.ml

@@ -104,4 +104,6 @@ let dump_js = ref false
 let syntax_only = ref false
 let binary_ast = ref false
 
-let bs_suffix = ref false 
+let bs_suffix = ref false 
+
+let debug = ref false

jscomp/common/js_config.mli

@@ -94,3 +94,4 @@ val binary_ast : bool ref
 
 
 val bs_suffix : bool ref
+val debug : bool ref

jscomp/core/js_dump.ml

@@ -798,25 +798,66 @@ and
     ->
     (* Note that, if we ignore more than tag [0] we loose some information
        with regard tag  *)
-    begin match tag.expression_desc, tag_info with
 
-      | Number (Int { i = 0l ; _})  ,
-        (Blk_tuple | Blk_array | Blk_variant _ | Blk_record _ | Blk_na | Blk_module _
-        |  Blk_constructor (_, 1) (* Sync up with {!Js_dump}*)
-        )
-        -> expression_desc cxt l f  (Array (el, mutable_flag))
       (* TODO: for numbers like 248, 255 we can reverse engineer to make it
          [Obj.xx_flag], but we can not do this in runtime libraries
       *)
 
-      | _, _
-        ->
-        P.string f L.caml_block;
-        P.string f L.dot ;
-        P.string f L.caml_block_create;
-        P.paren_group f 1
-          (fun _ -> arguments cxt f [tag; E.array mutable_flag el])
-    end
+      if Js_fold_basic.needBlockRuntime tag tag_info then begin 
+        match tag_info with 
+        | Blk_record labels ->
+          P.string f L.caml_block;
+          P.string f L.dot ;
+          P.string f L.block_record;
+          P.paren_group f 1 
+          (fun _ -> arguments cxt f 
+            [E.array Immutable
+             (Ext_array.to_list_f E.str labels);
+              E.array mutable_flag 
+              (List.map (fun (x : J.expression)   -> {x with comment = None}) el) ]
+          )
+        | Blk_module (Some labels) ->         
+          P.string f L.caml_block;
+          P.string f L.dot ;
+          P.string f L.block_local_module;
+          P.paren_group f 1 
+          (fun _ -> arguments cxt f 
+            [E.array Immutable
+             (Ext_list.map E.str labels);
+              E.array mutable_flag
+              (List.map (fun (x :J.expression) -> {x with comment = None}) el)
+            ]
+          )
+         | Blk_variant name ->  
+          P.string f L.caml_block;
+          P.string f L.dot ;
+          P.string f L.block_poly_var;
+          P.paren_group f 1 
+          (fun _ -> arguments cxt f 
+            [ 
+              E.str name;
+              E.array mutable_flag el]
+          )        
+         | Blk_constructor(name,_) when !Js_config.debug ->
+           P.string f L.caml_block;
+          P.string f L.dot ;
+          P.string f L.block_variant;
+          P.paren_group f 1 
+          (fun _ -> arguments cxt f 
+            [E.str name; E.array mutable_flag el]) 
+
+        | _ ->
+        begin 
+          P.string f L.caml_block;
+          P.string f L.dot ;
+          P.string f L.caml_block_create;
+          P.paren_group f 1
+            (fun _ -> arguments cxt f [tag; E.array mutable_flag el])
+        end 
+      end 
+      else     
+          expression_desc cxt l f  (Array (el, mutable_flag))
+
   | Caml_block_tag e ->
     P.group f 1 (fun _ ->
         let cxt = expression 15 cxt f  e in

jscomp/core/js_dump_lit.ml

@@ -84,4 +84,9 @@ let plus_plus = "++"
 let minus_minus = "--"
 let caml_block = "Block"
 let caml_block_create = "__"
+let block_record = "record"
+let block_local_module = "localModule"
+let block_poly_var = "polyVar"
+let block_variant = "variant"
+
 let case = "case" 

jscomp/core/js_fold_basic.ml

@@ -25,10 +25,52 @@
 
 
 
+ let needBlockRuntimeInDebugMode 
+  (tag : J.expression)
+  (tag_info : J.tag_info) = 
+  match tag_info with 
+  | Blk_variant _ 
+  | Blk_module _    
+  | Blk_record _   
+  | Blk_constructor _   -> true
+  | Blk_tuple 
+  | Blk_array   
+  | Blk_exception 
+  | Blk_extension  -> false 
+  | Blk_na  ->  
+    begin match tag.expression_desc with 
+    | Number (Int { i = 0l ; _})
+       ->
+      false
+     | _ -> true 
+    end     
 
+let needBlockRuntimeInReleaseMode (tag : J.expression) (tag_info : J.tag_info) = 
+  match  tag_info with 
+  | Blk_module _
+  | Blk_record _  
+  | Blk_constructor (_, 1)    
+  | Blk_variant _ 
+  | Blk_na   
+  | Blk_tuple 
+  | Blk_array   
+    -> 
+    begin match tag.expression_desc with 
+    | Number (Int { i = 0l ; _})
+       ->
+      false
+     | _ -> true 
+    end     
+  | Blk_constructor _   -> true
+  | Blk_exception 
+  | Blk_extension  -> false 
+    (* converted to [Pcreate_extension] in the beginning*)
+
 
-
-
+let needBlockRuntime tag info = 
+  if !Js_config.debug then 
+    needBlockRuntimeInDebugMode tag info
+  else needBlockRuntimeInReleaseMode tag info  
 
 class count_deps (add : Ident.t -> unit )  = 
   object(self)
@@ -76,18 +118,11 @@ class count_hard_dependencies =
         super#expression x             
       | {expression_desc = Caml_block(_,_, tag, tag_info); _}
         -> 
-        begin match tag.expression_desc, tag_info with 
-          | Number (Int { i = 0l ; _})  , 
-            (Blk_tuple | Blk_array | Blk_variant _ | Blk_record _ | Blk_na | Blk_module _
-            |  Blk_constructor (_, 1)
-            )  (*Sync up with {!Js_dump}*)
-            -> ()
-          | _, _
-            -> 
-            add_lam_module_ident hard_dependencies 
+        if needBlockRuntime tag tag_info then
+          add_lam_module_ident hard_dependencies 
               (Lam_module_ident.of_runtime               
-                (Ident.create_persistent Js_runtime_modules.block));
-        end;
+                (Ident.create_persistent Js_runtime_modules.block))
+        ;
         super#expression x 
       | _ -> super#expression x
     method get_hard_dependencies = hard_dependencies

jscomp/core/js_fold_basic.mli

@@ -27,7 +27,10 @@
 
 
 
-
+ val needBlockRuntime : 
+    J.expression ->
+    J.tag_info ->   
+    bool
 
 (** A module to calculate hard dependency based on JS IR in module [J] *)
 

jscomp/core/js_main.ml

@@ -145,6 +145,11 @@ let buckle_script_flags : (string * Arg.spec * string) list =
    " (experimental) Set the string to be evaluated, note this flag will be conflicted with -bs-main"
   )
   ::
+  ("-bs-g",
+    Arg.Set Js_config.debug,
+    " debug mode"
+  )
+  ::
   (
     "-bs-sort-imports",
     Arg.Set Js_config.sort_imports,

jscomp/ext/ext_array.ml

@@ -96,6 +96,13 @@ let map2i f a b =
   else
     Array.mapi (fun i a -> f i  a ( Array.unsafe_get b i )) a 
 
+let rec tolist_f_aux a f  i res =
+  if i < 0 then res else
+    let v = Array.unsafe_get a i in
+    tolist_f_aux a f  (i - 1)
+      (f v :: res)
+
+let to_list_f f a = tolist_f_aux a f (Array.length a  - 1) []
 
 let rec tolist_aux a f  i res =
   if i < 0 then res else

jscomp/ext/ext_array.mli

@@ -41,6 +41,7 @@ val range : int -> int -> int array
 
 val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array
 
+val to_list_f : ('a -> 'b) -> 'a array -> 'b list 
 val to_list_map : ('a -> 'b option) -> 'a array -> 'b list 
 
 val to_list_map_acc : 

jscomp/others/.depend

@@ -96,6 +96,7 @@ belt_HashMapInt.cmj : belt_internalBucketsType.cmj belt_internalBuckets.cmj \
     belt_Array.cmj belt_HashMapInt.cmi
 belt_HashMapString.cmj : belt_internalBucketsType.cmj \
     belt_internalBuckets.cmj belt_Array.cmj belt_HashMapString.cmi
+belt_Debug.cmj :
 node_process.cmi : js_dict.cmi
 js_re.cmi :
 js_null_undefined.cmi :

jscomp/others/Makefile

@@ -55,6 +55,7 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string
 	dom dom_storage\
 	belt_HashMapInt\
 	belt_HashMapString\
+	belt_Debug\
 
 # belt_Bag\
 # belt_BagM\

jscomp/others/belt.ml

@@ -244,3 +244,8 @@ module HashMap = Belt_HashMap
 module Option = Belt_Option
 
 
+(** {!Belt.Debug}
+
+    Utilities for set up debugging    
+*)
+module Debug = Belt_Debug