tweak

Author: bobzhang

jscomp/core/js_dump.ml

@@ -72,27 +72,59 @@ module L = Js_dump_lit
   }
   There are no sane way to easy detect it ahead of time, we should be
   conservative here.
+  (our call Js_fun_env.get_unbounded env) is not precise
 *)
+
+
 module Curry_gen = struct 
-  
-  let pp_optimize_curry (f : P.t) (len : int) = 
+  let pp_curry_dot f =   
     P.string f Js_runtime_modules.curry;
-    P.string f L.dot ; 
+    P.string f L.dot 
+  let pp_optimize_curry (f : P.t) (len : int) = 
+    pp_curry_dot f;
     P.string f "__";
     P.string f (Printf.sprintf "%d" len)
 
   let pp_app_any (f : P.t) =    
-    P.string f Js_runtime_modules.curry;
-    P.string f L.dot ; 
+    pp_curry_dot f;
     P.string f "app"
 
   let pp_app (f : P.t) (len : int) =    
-    P.string f Js_runtime_modules.curry; 
-    P.string f L.dot; 
+    pp_curry_dot f;
     P.string f "_"; 
     P.string f (Printf.sprintf "%d" len)
 end 
 
+let pp_block_dot f = 
+  P.string f Js_runtime_modules.block;
+  P.string f L.dot 
+
+let pp_block_create f =   
+  pp_block_dot f ;
+  P.string f L.caml_block_create
+
+let pp_block_record f =   
+  pp_block_dot f ;
+  P.string f L.block_record
+
+let pp_block_local_module f =   
+  pp_block_dot f;
+  P.string f L.block_local_module
+
+let pp_block_poly_var f =   
+  pp_block_dot f;
+  P.string f L.block_poly_var
+
+let pp_block_simple_variant f =   
+  pp_block_dot f ;
+  P.string f L.block_simple_variant
+
+let pp_block_variant f =   
+  pp_block_dot f ; 
+  P.string f L.block_variant
+
+
+
 let return_indent = String.length L.return / Ext_pp.indent_length
 
 let throw_indent = String.length L.throw / Ext_pp.indent_length
@@ -232,34 +264,6 @@ let pp_direction f (direction : J.for_direction) =
   | Upto -> P.string f L.plus_plus
   | Downto -> P.string f L.minus_minus 
 
-let pp_block_dot f = 
-  P.string f L.caml_block;
-  P.string f L.dot 
-
-let pp_block_create f =   
-  pp_block_dot f ;
-  P.string f L.caml_block_create
-
-let pp_block_record f =   
-  pp_block_dot f ;
-  P.string f L.block_record
-
-let pp_block_local_module f =   
-  pp_block_dot f;
-  P.string f L.block_local_module
-
-let pp_block_poly_var f =   
-  pp_block_dot f;
-  P.string f L.block_poly_var
-
-let pp_block_simple_variant f =   
-  pp_block_dot f ;
-  P.string f L.block_simple_variant
-
-let pp_block_variant f =   
-  pp_block_dot f ; 
-  P.string f L.block_variant
-
 let return_sp f = 
     P.string f L.return ; P.space f   
 
@@ -383,7 +387,7 @@ and  pp_function is_method
       | Name_top id | Name_non_top id -> 
         Ident_set.add (Js_fun_env.get_unbounded env ) id in
     (* the context will be continued after this function *)
-    let outer_cxt = Ext_pp_scope.merge set_env cxt in
+    let outer_cxt = Ext_pp_scope.merge cxt set_env in
 
     (* the context used to be printed inside this function
 
@@ -1203,7 +1207,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
          [print for loop] has side effect,
          we should take it out
       *)
-      let inner_cxt = Ext_pp_scope.merge lexical cxt in
+      let inner_cxt = Ext_pp_scope.merge cxt lexical in
       let lexical = Ident_set.elements lexical in
       P.vgroup f 0
         (fun _ ->

jscomp/ext/ext_pp_scope.ml

@@ -34,7 +34,7 @@ type t =
 (**
    -- "name" --> int map -- stamp --> index suffix
 *)
-let empty = 
+let empty : t = 
   String_map.empty 
 
 let rec print fmt v = 
@@ -48,7 +48,7 @@ and print_int_map fmt m =
       Format.fprintf fmt "%d - %d" k v       
     )    
 
-let add_ident ~mangled:name stamp (cxt : t) : int * t = 
+let add_ident ~mangled:name (stamp : int) (cxt : t) : int * t = 
   match String_map.find_opt cxt name with 
   | None -> 
     (0, String_map.add cxt name (Int_map.add Int_map.empty stamp 0  )  )
@@ -116,7 +116,7 @@ let ident (cxt : t) f (id : Ident.t) : t  =
   cxt   
 
 
-let merge set cxt  = 
+let merge (cxt : t) (set : Ident_set.t) = 
   Ident_set.fold set cxt (fun ident acc -> 
       snd (add_ident ~mangled:(Ext_ident.convert ident.name) ident.stamp acc)) 
 

jscomp/ext/ext_pp_scope.mli

@@ -44,7 +44,7 @@ val print : Format.formatter -> t -> unit
 
 val sub_scope : t -> Ident_set.t -> t
 
-val merge : Ident_set.t -> t -> t
+val merge : t -> Ident_set.t ->  t
 
 
 

jscomp/test/gpr_3566_drive_test.ml

@@ -0,0 +1,10 @@
+let suites :  Mt.pair_suites ref  = ref []
+
+let test_id = ref 0
+let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y 
+
+module H = Gpr_3566_test.Test ()
+let () = 
+  eq __LOC__ H.b true
+  
+let () = Mt.from_pair_suites __FILE__ !suites

jscomp/test/gpr_3566_test.ml

@@ -0,0 +1,62 @@
+
+type t = A of int | B of string
+let eq_A (x :t) y = 
+  match x with
+  | A x -> 
+    (match y with A x1 -> x = x1 | _ -> false)
+   | _ -> false  
+
+module Test() =
+struct
+  let () = Js.log "no inline"
+  let u = A 3
+  module Block = struct  end
+  let y = 32
+  let b = eq_A (A 3) u  
+end
+
+
+module Test2() =
+struct
+  let () = Js.log "no inline"
+
+  module Block = struct  end
+  let y = 32
+  let b = eq_A (A 3) (A 3)
+end
+
+
+let x = 3
+
+let f i y =
+  let x = A i  in 
+  eq_A x y
+
+module Test3 () = struct  
+  let f x y = x = y
+  module Caml_obj = struct 
+  end 
+end
+module Test4 () = struct 
+  module Caml_obj = struct 
+  end 
+  let f x y = x = y
+end 
+
+
+module Test5 () = struct
+  let f x = Some x 
+  module Caml_option = struct   
+  end 
+end 
+
+module Test6 () = struct 
+  module Caml_option = struct   
+  end 
+  let f x = Some x 
+end
+
+module Test7 () = struct 
+  module Caml_option = struct
+  end 
+end