diff --git a/jscomp/all.depend b/jscomp/all.depend
index 89cc2e0bef..e7b8ad7955 100644
--- a/jscomp/all.depend
+++ b/jscomp/all.depend
@@ -507,9 +507,9 @@ core/lam_compile_group.cmx : ext/string_hash_set.cmx core/lam_util.cmx \
     ext/ext_list.cmx ext/ext_ident.cmx ext/ext_filename.cmx \
     depends/bs_exception.cmx core/lam_compile_group.cmi
 core/js_implementation.cmx : core/ocaml_parse.cmx ext/literals.cmx \
-    core/lam_compile_group.cmx common/js_config.cmx ext/ext_pervasives.cmx \
-    common/ext_log.cmx syntax/bs_ast_invariant.cmx depends/binary_ast.cmx \
-    core/js_implementation.cmi
+    core/lam_compile_group.cmx core/lam_compile_env.cmx common/js_config.cmx \
+    ext/ext_pervasives.cmx common/ext_log.cmx syntax/bs_ast_invariant.cmx \
+    depends/binary_ast.cmx core/js_implementation.cmi
 core/ocaml_batch_compile.cmx : core/ocaml_parse.cmx \
     core/js_implementation.cmx common/js_config.cmx ext/ext_ref.cmx \
     ext/ext_pervasives.cmx ext/ext_format.cmx ext/ext_filename.cmx \
@@ -525,8 +525,8 @@ core/bspack_main.cmx : ext/string_hashtbl.cmx ext/ext_string.cmx \
     ext/ext_pervasives.cmx ext/ext_list.cmx ext/ext_io.cmx \
     ext/ext_filename.cmx depends/ast_extract.cmx core/bspack_main.cmi
 core/jsoo_main.cmx : syntax/ppx_entry.cmx core/lam_compile_group.cmx \
-    core/js_dump.cmx ext/ext_pp.cmx common/bs_version.cmx \
-    core/bs_conditional_initial.cmx core/jsoo_main.cmi
+    core/lam_compile_env.cmx core/js_dump.cmx ext/ext_pp.cmx \
+    common/bs_version.cmx core/bs_conditional_initial.cmx core/jsoo_main.cmi
 core/bspp_main.cmx : core/bspp_main.cmi
 core/js_cmi_datasets.cmx : ext/string_map.cmx core/js_cmi_datasets.cmi
 core/js_main.cmx : core/ocaml_parse.cmx core/ocaml_options.cmx \
diff --git a/jscomp/bin/all_ounit_tests.i.ml b/jscomp/bin/all_ounit_tests.i.ml
index 8f7c974fb5..7f14da9465 100644
--- a/jscomp/bin/all_ounit_tests.i.ml
+++ b/jscomp/bin/all_ounit_tests.i.ml
@@ -75,7 +75,7 @@ open OUnitTypes
 
 (** Most simple heuristic, just pick the first test. *)
 let simple state =
-  (* 160 *) List.hd state.tests_planned
+  (* 80 *) List.hd state.tests_planned
 
 end
 module OUnitUtils
@@ -97,28 +97,28 @@ let is_success =
 
 let is_failure = 
   function
-    | RFailure _ -> (* 2 *) true
-    | RSuccess _ | RError _  | RSkip _ | RTodo _ -> (* 318 *) false
+    | RFailure _ -> (* 0 *) true
+    | RSuccess _ | RError _  | RSkip _ | RTodo _ -> (* 160 *) false
 
 let is_error = 
   function 
     | RError _ -> (* 0 *) true
-    | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 320 *) false
+    | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 160 *) false
 
 let is_skip = 
   function
     | RSkip _ -> (* 0 *) true
-    | RSuccess _ | RFailure _ | RError _  | RTodo _ -> (* 320 *) false
+    | RSuccess _ | RFailure _ | RError _  | RTodo _ -> (* 160 *) false
 
 let is_todo = 
   function
     | RTodo _ -> (* 0 *) true
-    | RSuccess _ | RFailure _ | RError _  | RSkip _ -> (* 320 *) false
+    | RSuccess _ | RFailure _ | RError _  | RSkip _ -> (* 160 *) false
 
 let result_flavour = 
   function
     | RError _ -> (* 0 *) "Error"
-    | RFailure _ -> (* 2 *) "Failure"
+    | RFailure _ -> (* 0 *) "Failure"
     | RSuccess _ -> (* 0 *) "Success"
     | RSkip _ -> (* 0 *) "Skip"
     | RTodo _ -> (* 0 *) "Todo"
@@ -129,7 +129,7 @@ let result_path =
     | RError (path, _)
     | RFailure (path, _)
     | RSkip (path, _)
-    | RTodo (path, _) -> (* 2 *) path
+    | RTodo (path, _) -> (* 0 *) path
 
 let result_msg = 
   function
@@ -137,7 +137,7 @@ let result_msg =
     | RError (_, msg)
     | RFailure (_, msg)
     | RSkip (_, msg)
-    | RTodo (_, msg) -> (* 2 *) msg
+    | RTodo (_, msg) -> (* 0 *) msg
 
 (* Returns true if the result list contains successes only. *)
 let rec was_successful = 
@@ -145,35 +145,35 @@ let rec was_successful =
     | [] -> (* 3 *) true
     | RSuccess _::t 
     | RSkip _::t -> 
-        (* 291 *) was_successful t
+        (* 240 *) was_successful t
 
     | RFailure _::_
     | RError _::_ 
     | RTodo _::_ -> 
-        (* 3 *) false
+        (* 0 *) false
 
 let string_of_node = 
   function
     | ListItem n -> 
-        (* 644 *) string_of_int n
+        (* 320 *) string_of_int n
     | Label s -> 
-        (* 966 *) s
+        (* 480 *) s
 
 (* Return the number of available tests *)
 let rec test_case_count = 
   function
-    | TestCase _ -> (* 160 *) 1 
-    | TestLabel (_, t) -> (* 190 *) test_case_count t
+    | TestCase _ -> (* 80 *) 1 
+    | TestLabel (_, t) -> (* 95 *) test_case_count t
     | TestList l -> 
-        (* 30 *) List.fold_left 
-          (fun c t -> (* 188 *) c + test_case_count t) 
+        (* 15 *) List.fold_left 
+          (fun c t -> (* 94 *) c + test_case_count t) 
           0 l
 
 let string_of_path path =
-  (* 322 *) String.concat ":" (List.rev_map string_of_node path)
+  (* 160 *) String.concat ":" (List.rev_map string_of_node path)
 
 let buff_format_printf f = 
-  (* 1 *) let buff = Buffer.create 13 in
+  (* 0 *) let buff = Buffer.create 13 in
   let fmt = Format.formatter_of_buffer buff in
     f fmt;
     Format.pp_print_flush fmt ();
@@ -193,13 +193,13 @@ let mapi f l =
     rmapi 0 l
 
 let fold_lefti f accu l =
-  (* 30 *) let rec rfold_lefti cnt accup l = 
-    (* 218 *) match l with
+  (* 15 *) let rec rfold_lefti cnt accup l = 
+    (* 109 *) match l with
       | [] -> 
-          (* 30 *) accup
+          (* 15 *) accup
 
       | h::t -> 
-          (* 188 *) rfold_lefti (cnt + 1) (f accup h cnt) t
+          (* 94 *) rfold_lefti (cnt + 1) (f accup h cnt) t
   in
     rfold_lefti 0 accu l
 
@@ -217,23 +217,23 @@ open OUnitUtils
 type event_type = GlobalEvent of global_event | TestEvent of test_event
 
 let format_event verbose event_type =
-  (* 964 *) match event_type with
+  (* 482 *) match event_type with
     | GlobalEvent e ->
-        (* 4 *) begin
+        (* 2 *) begin
           match e with 
             | GStart ->
                 (* 0 *) ""
             | GEnd ->
                 (* 0 *) ""
             | GResults (running_time, results, test_case_count) -> 
-                (* 4 *) let separator1 = String.make (Format.get_margin ()) '=' in
+                (* 2 *) let separator1 = String.make (Format.get_margin ()) '=' in
                 let separator2 = String.make (Format.get_margin ()) '-' in
                 let buf = Buffer.create 1024 in
-                let bprintf fmt = (* 16 *) Printf.bprintf buf fmt in
+                let bprintf fmt = (* 7 *) Printf.bprintf buf fmt in
                 let print_results = 
                   List.iter 
                     (fun result -> 
-                       (* 2 *) bprintf "%s\n%s: %s\n\n%s\n%s\n" 
+                       (* 0 *) bprintf "%s\n%s: %s\n\n%s\n%s\n" 
                          separator1 
                          (result_flavour result) 
                          (string_of_path (result_path result)) 
@@ -276,19 +276,19 @@ let format_event verbose event_type =
         end
 
     | TestEvent e ->
-        (* 960 *) begin
+        (* 480 *) begin
           let string_of_result = 
             if verbose then
               function
-                | RSuccess _      -> (* 159 *) "ok\n"
-                | RFailure (_, _) -> (* 1 *) "FAIL\n"
+                | RSuccess _      -> (* 80 *) "ok\n"
+                | RFailure (_, _) -> (* 0 *) "FAIL\n"
                 | RError (_, _)   -> (* 0 *) "ERROR\n"
                 | RSkip (_, _)    -> (* 0 *) "SKIP\n"
                 | RTodo (_, _)    -> (* 0 *) "TODO\n"
             else
               function
-                | RSuccess _      -> (* 159 *) "."
-                | RFailure (_, _) -> (* 1 *) "F"
+                | RSuccess _      -> (* 80 *) "."
+                | RFailure (_, _) -> (* 0 *) "F"
                 | RError (_, _)   -> (* 0 *) "E"
                 | RSkip (_, _)    -> (* 0 *) "S"
                 | RTodo (_, _)    -> (* 0 *) "T"
@@ -296,11 +296,11 @@ let format_event verbose event_type =
             if verbose then
               match e with 
                 | EStart p -> 
-                    (* 160 *) Printf.sprintf "%s start\n" (string_of_path p)
+                    (* 80 *) Printf.sprintf "%s start\n" (string_of_path p)
                 | EEnd p -> 
-                    (* 160 *) Printf.sprintf "%s end\n" (string_of_path p)
+                    (* 80 *) Printf.sprintf "%s end\n" (string_of_path p)
                 | EResult result -> 
-                    (* 160 *) string_of_result result
+                    (* 80 *) string_of_result result
                 | ELog (lvl, str) ->
                     (* 0 *) let prefix = 
                       match lvl with 
@@ -313,39 +313,39 @@ let format_event verbose event_type =
                     (* 0 *) str
             else 
               match e with 
-                | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 320 *) ""
-                | EResult result -> (* 160 *) string_of_result result
+                | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 160 *) ""
+                | EResult result -> (* 80 *) string_of_result result
         end
 
 let file_logger fn =
-  (* 2 *) let chn = open_out fn in
+  (* 1 *) let chn = open_out fn in
     (fun ev ->
-       (* 482 *) output_string chn (format_event true ev);
+       (* 241 *) output_string chn (format_event true ev);
        flush chn),
-    (fun () -> (* 2 *) close_out chn)
+    (fun () -> (* 1 *) close_out chn)
 
 let std_logger verbose =
-  (* 2 *) (fun ev -> 
-     (* 482 *) print_string (format_event verbose ev);
+  (* 1 *) (fun ev -> 
+     (* 241 *) print_string (format_event verbose ev);
      flush stdout),
-  (fun () -> (* 2 *) ())
+  (fun () -> (* 1 *) ())
 
 let null_logger =
   ignore, ignore
 
 let create output_file_opt verbose (log,close) =
-  (* 2 *) let std_log, std_close = std_logger verbose in
+  (* 1 *) let std_log, std_close = std_logger verbose in
   let file_log, file_close = 
     match output_file_opt with 
       | Some fn ->
-          (* 2 *) file_logger fn
+          (* 1 *) file_logger fn
       | None ->
           (* 0 *) null_logger
   in
     (fun ev ->
-       (* 482 *) std_log ev; file_log ev; log ev),
+       (* 241 *) std_log ev; file_log ev; log ev),
     (fun () ->
-       (* 2 *) std_close (); file_close (); close ())
+       (* 1 *) std_close (); file_close (); close ())
 
 let printf log fmt =
   (* 0 *) Printf.ksprintf
@@ -700,20 +700,20 @@ let todo msg =
   (* 0 *) raise (Todo msg)
 
 let assert_failure msg = 
-  (* 1 *) failwith ("OUnit: " ^ msg)
+  (* 0 *) failwith ("OUnit: " ^ msg)
 
 let assert_bool msg b =
-  (* 4000434 *) if not b then assert_failure msg
+  (* 2001318 *) if not b then assert_failure msg
 
 let assert_string str =
   (* 0 *) if not (str = "") then assert_failure str
 
 let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
-  (* 4001798 *) let get_error_string () =
-    (* 1 *) let res =
+  (* 2001401 *) let get_error_string () =
+    (* 0 *) let res =
       buff_format_printf
         (fun fmt ->
-           (* 1 *) Format.pp_open_vbox fmt 0;
+           (* 0 *) Format.pp_open_vbox fmt 0;
            begin
              match msg with 
                | Some s ->
@@ -722,7 +722,7 @@ let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
                    Format.pp_close_box fmt ();
                    Format.pp_print_cut fmt ()
                | None -> 
-                   (* 1 *) ()
+                   (* 0 *) ()
            end;
 
            begin
@@ -734,7 +734,7 @@ let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
                      (p actual)
 
                | None ->
-                   (* 1 *) Format.fprintf fmt "@[not equal@]@,"
+                   (* 0 *) Format.fprintf fmt "@[not equal@]@,"
            end;
 
            begin
@@ -745,7 +745,7 @@ let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
                       d (expected, actual)
 
                | None ->
-                   (* 1 *) ()
+                   (* 0 *) ()
            end;
            Format.pp_close_box fmt ())
     in
@@ -885,14 +885,14 @@ let assert_command
       ()
 
 let raises f =
-  (* 12 *) try
+  (* 6 *) try
     f ();
     None
   with e -> 
     Some e
 
 let assert_raises ?msg exn (f: unit -> 'a) = 
-  (* 12 *) let pexn = 
+  (* 6 *) let pexn = 
     Printexc.to_string 
   in
   let get_error_string () =
@@ -913,7 +913,7 @@ let assert_raises ?msg exn (f: unit -> 'a) =
           (* 0 *) assert_failure (get_error_string ())
 
       | Some e -> 
-          (* 12 *) assert_equal ?msg ~printer:pexn exn e
+          (* 6 *) assert_equal ?msg ~printer:pexn exn e
 
 (* Compare floats up to a given relative error *)
 let cmp_float ?(epsilon = 0.00001) a b =
@@ -925,8 +925,8 @@ let (@?) = assert_bool
 
 (* Some shorthands which allows easy test construction *)
 let (>:) s t = (* 0 *) TestLabel(s, t)             (* infix *)
-let (>::) s f = (* 160 *) TestLabel(s, TestCase(f))  (* infix *)
-let (>:::) s l = (* 30 *) TestLabel(s, TestList(l)) (* infix *)
+let (>::) s f = (* 80 *) TestLabel(s, TestCase(f))  (* infix *)
+let (>:::) s l = (* 15 *) TestLabel(s, TestList(l)) (* infix *)
 
 (* Utility function to manipulate test *)
 let rec test_decorate g =
@@ -1060,8 +1060,8 @@ let maybe_backtrace = ""
 
 (* Run all tests, report starts, errors, failures, and return the results *)
 let perform_test report test =
-  (* 2 *) let run_test_case f path =
-    (* 160 *) try 
+  (* 1 *) let run_test_case f path =
+    (* 80 *) try 
       f ();
       RSuccess path
     with
@@ -1080,22 +1080,22 @@ let perform_test report test =
   let rec flatten_test path acc = 
     function
       | TestCase(f) -> 
-          (* 160 *) (path, f) :: acc
+          (* 80 *) (path, f) :: acc
 
       | TestList (tests) ->
-          (* 30 *) fold_lefti 
+          (* 15 *) fold_lefti 
             (fun acc t cnt -> 
-               (* 188 *) flatten_test 
+               (* 94 *) flatten_test 
                  ((ListItem cnt)::path) 
                  acc t)
             acc tests
       
       | TestLabel (label, t) -> 
-          (* 190 *) flatten_test ((Label label)::path) acc t
+          (* 95 *) flatten_test ((Label label)::path) acc t
   in
   let test_cases = List.rev (flatten_test [] [] test) in
   let runner (path, f) = 
-    (* 160 *) let result = 
+    (* 80 *) let result = 
       report (EStart path);
       run_test_case f path 
     in
@@ -1104,18 +1104,18 @@ let perform_test report test =
       result
   in
   let rec iter state = 
-    (* 162 *) match state.tests_planned with 
+    (* 81 *) match state.tests_planned with 
       | [] ->
-          (* 2 *) state.results
+          (* 1 *) state.results
       | _ ->
-          (* 160 *) let (path, f) = !global_chooser state in            
+          (* 80 *) let (path, f) = !global_chooser state in            
           let result = runner (path, f) in
             iter 
               {
                 results = result :: state.results;
                 tests_planned = 
                   List.filter 
-                    (fun (path', _) -> (* 6480 *) path <> path') state.tests_planned
+                    (fun (path', _) -> (* 3240 *) path <> path') state.tests_planned
               }
   in
     iter {results = []; tests_planned = test_cases}
@@ -1123,14 +1123,14 @@ let perform_test report test =
 (* Function which runs the given function and returns the running time
    of the function, and the original result in a tuple *)
 let time_fun f x y =
-  (* 2 *) let begin_time = Unix.gettimeofday () in
+  (* 1 *) let begin_time = Unix.gettimeofday () in
   let result = f x y in
   let end_time = Unix.gettimeofday () in
     (end_time -. begin_time, result)
 
 (* A simple (currently too simple) text based test runner *)
 let run_test_tt ?verbose test =
-  (* 2 *) let log, log_close = 
+  (* 1 *) let log, log_close = 
     OUnitLogger.create 
       !global_output_file 
       !global_verbose 
@@ -1145,7 +1145,7 @@ let run_test_tt ?verbose test =
     time_fun 
       perform_test 
       (fun ev ->
-         (* 480 *) log (OUnitLogger.TestEvent ev))
+         (* 240 *) log (OUnitLogger.TestEvent ev))
       test 
   in
     
@@ -1161,7 +1161,7 @@ let run_test_tt ?verbose test =
       
 (* Call this one from you test suites *)
 let run_test_tt_main ?(arg_specs=[]) ?(set_verbose=ignore) suite = 
-  (* 2 *) let only_test = ref [] in
+  (* 1 *) let only_test = ref [] in
   let () = 
     Arg.parse
       (Arg.align
@@ -1316,7 +1316,7 @@ end = struct
 
 
 let reverse_range a i len =
-  (* 2 *) if len=0 then ()
+  (* 1 *) if len=0 then ()
   else
     for k = 0 to (len-1)/2 do
       let t = Array.unsafe_get a (i+k) in
@@ -1329,7 +1329,7 @@ let reverse_in_place a =
   (* 0 *) reverse_range a 0 (Array.length a)
 
 let reverse a =
-  (* 4 *) let b_len = Array.length a in
+  (* 2 *) let b_len = Array.length a in
   if b_len = 0 then [||] else  
   let b = Array.copy a in  
   for i = 0 to  b_len - 1 do
@@ -1338,13 +1338,13 @@ let reverse a =
   b  
 
 let reverse_of_list =  function
-  | [] -> (* 2 *) [||]
+  | [] -> (* 1 *) [||]
   | hd::tl as l ->
-    (* 4 *) let len = List.length l in
+    (* 2 *) let len = List.length l in
     let a = Array.make len hd in
     let rec fill i = function
-      | [] -> (* 4 *) a
-      | hd::tl -> (* 4 *) Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in
+      | [] -> (* 2 *) a
+      | hd::tl -> (* 2 *) Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in
     fill 0 tl
 
 let filter f a =
@@ -1425,15 +1425,15 @@ let rfind_and_split arr cmp v : _ split =
 
 
 let find_with_index arr cmp v = 
-  (* 8 *) let len  = Array.length arr in 
+  (* 4 *) let len  = Array.length arr in 
   let rec aux i len = 
-    (* 24 *) if i >= len then -1 
+    (* 12 *) if i >= len then -1 
     else if cmp (Array.unsafe_get arr i ) v then i 
     else aux (i + 1) len in 
   aux 0 len
 
 let find_and_split arr cmp v : _ split = 
-  (* 8 *) let i = find_with_index arr cmp v in 
+  (* 4 *) let i = find_with_index arr cmp v in 
   if i < 0 then 
     `No_split
   else
@@ -1699,9 +1699,9 @@ end = struct
 
 
 let split_by ?(keep_empty=false) is_delim str =
-  (* 2172 *) let len = String.length str in
+  (* 1086 *) let len = String.length str in
   let rec loop acc last_pos pos =
-    (* 93864 *) if pos = -1 then
+    (* 46932 *) if pos = -1 then
       if last_pos = 0 && not keep_empty then
         (*
            {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']}
@@ -1734,11 +1734,11 @@ let trim s =
   String.sub s !i (!k - !i + 1)
 
 let split ?keep_empty  str on = 
-  (* 346 *) if str = "" then [] else 
-    split_by ?keep_empty (fun x -> (* 48640 *) (x : char) = on) str  ;;
+  (* 173 *) if str = "" then [] else 
+    split_by ?keep_empty (fun x -> (* 24320 *) (x : char) = on) str  ;;
 
 let quick_split_by_ws str : string list = 
-  (* 1826 *) split_by ~keep_empty:false (fun x -> (* 43052 *) x = '\t' || x = '\n' || x = ' ') str
+  (* 913 *) split_by ~keep_empty:false (fun x -> (* 21526 *) x = '\t' || x = '\n' || x = ' ') str
 
 let starts_with s beg = 
   (* 0 *) let beg_len = String.length beg in
@@ -1796,7 +1796,7 @@ let escaped s =
    user can provide bad input range 
 *)
 let rec for_all_range s ~start:i ~finish:len p =     
-  (* 54 *) if i >= len then true 
+  (* 27 *) if i >= len then true 
   else  p (String.get s i) && 
         for_all_range s ~start:(i + 1) ~finish:len p
 
@@ -1906,7 +1906,7 @@ let starts_with_and_number s ~offset beg =
     else 
       -1 
 
-let equal (x : string) y  = (* 17652046 *) x = y
+let equal (x : string) y  = (* 8826023 *) x = y
 
 let unsafe_concat_with_length len sep l =
   (* 0 *) match l with 
@@ -1929,7 +1929,7 @@ let unsafe_concat_with_length len sep l =
 
 
 let rec rindex_rec s i c =
-  (* 42 *) if i < 0 then i else
+  (* 21 *) if i < 0 then i else
   if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
 
 let rec rindex_rec_opt s i c =
@@ -1937,28 +1937,28 @@ let rec rindex_rec_opt s i c =
   if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;;
 
 let rindex_neg s c = 
-  (* 14 *) rindex_rec s (String.length s - 1) c;;
+  (* 7 *) rindex_rec s (String.length s - 1) c;;
 
 let rindex_opt s c = 
   (* 0 *) rindex_rec_opt s (String.length s - 1) c;;
 
 let is_valid_module_file ~finish (s : string) = 
-  (* 44 *) match s.[0] with 
+  (* 22 *) match s.[0] with 
   | 'A' .. 'Z'
   | 'a' .. 'z' -> 
-    (* 20 *) for_all_range s ~start:1 ~finish
+    (* 10 *) for_all_range s ~start:1 ~finish
       (fun x -> 
-         (* 14 *) match x with 
-         | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> (* 14 *) true
+         (* 7 *) match x with 
+         | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> (* 7 *) true
          | _ -> (* 0 *) false )
-  | _ -> (* 24 *) false 
+  | _ -> (* 12 *) false 
 
 (** 
   TODO: move to another module 
   Make {!Ext_filename} not stateful
 *)
 let is_valid_source_name name =
-  (* 46 *) ((Filename.check_suffix name ".ml"  
+  (* 23 *) ((Filename.check_suffix name ".ml"  
     || Filename.check_suffix name ".re"
    ) &&
    (is_valid_module_file ~finish:(String.length name - 3) name)
@@ -1982,27 +1982,27 @@ let suites =
     >:::
     [
      __LOC__ >:: begin fun _ ->
-        (* 2 *) Ext_array.find_and_split 
+        (* 1 *) Ext_array.find_and_split 
             [|"a"; "b";"c"|]
             Ext_string.equal "--" =~ `No_split
      end;
     __LOC__ >:: begin fun _ ->
-        (* 2 *) Ext_array.find_and_split 
+        (* 1 *) Ext_array.find_and_split 
             [|"a"; "b";"c";"--"|]
             Ext_string.equal "--" =~ `Split ([|"a";"b";"c"|],[||])
      end;
      __LOC__ >:: begin fun _ ->
-        (* 2 *) Ext_array.find_and_split 
+        (* 1 *) Ext_array.find_and_split 
             [|"--"; "a"; "b";"c";"--"|]
             Ext_string.equal "--" =~ `Split ([||], [|"a";"b";"c";"--"|])
      end;
     __LOC__ >:: begin fun _ ->
-        (* 2 *) Ext_array.find_and_split 
+        (* 1 *) Ext_array.find_and_split 
             [| "u"; "g"; "--"; "a"; "b";"c";"--"|]
             Ext_string.equal "--" =~ `Split ([|"u";"g"|], [|"a";"b";"c";"--"|])
      end;
     __LOC__ >:: begin fun _ ->
-        (* 2 *) Ext_array.reverse [|1;2|] =~ [|2;1|];
+        (* 1 *) Ext_array.reverse [|1;2|] =~ [|2;1|];
         Ext_array.reverse [||] =~ [||]  
     end     ;
     ]
@@ -2049,8 +2049,8 @@ let rec cons_enum s e =
   | Node(l,v,r,_) -> (* 0 *) cons_enum l (More(v,r,e))
 
 let rec height = function
-  | Empty -> (* 23376 *) 0 
-  | Node(_,_,_,h) -> (* 70664 *) h   
+  | Empty -> (* 11688 *) 0 
+  | Node(_,_,_,h) -> (* 35332 *) h   
 
 (* Smallest and greatest element of a set *)
 
@@ -2072,11 +2072,11 @@ let empty = Empty
 let is_empty = function Empty -> (* 0 *) true | _ -> (* 0 *) false
 
 let rec cardinal_aux acc  = function
-  | Empty -> (* 42604 *) acc 
+  | Empty -> (* 21302 *) acc 
   | Node (l,_,r, _) -> 
-    (* 42200 *) cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
+    (* 21100 *) cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
 
-let cardinal s = (* 404 *) cardinal_aux 0 s 
+let cardinal s = (* 202 *) cardinal_aux 0 s 
 
 let rec elements_aux accu = function
   | Empty -> (* 0 *) accu
@@ -2113,7 +2113,7 @@ let max_int3 (a : int) b c =
   if b >=c then b
   else c     
 let max_int_2 (a : int) b =  
-  (* 251430 *) if a >= b then a else b 
+  (* 125715 *) if a >= b then a else b 
 
 
 
@@ -2122,9 +2122,9 @@ exception Height_diff_borken
 
 let rec check_height_and_diff = 
   function 
-  | Empty -> (* 251846 *) 0
+  | Empty -> (* 125923 *) 0
   | Node(l,_,r,h) -> 
-    (* 251430 *) let hl = check_height_and_diff l in
+    (* 125715 *) let hl = check_height_and_diff l in
     let hr = check_height_and_diff r in
     if h <>  max_int_2 hl hr + 1 then raise Height_invariant_broken
     else  
@@ -2133,7 +2133,7 @@ let rec check_height_and_diff =
       else h     
 
 let check tree = 
-  (* 416 *) ignore (check_height_and_diff tree)
+  (* 208 *) ignore (check_height_and_diff tree)
 (* 
     Invariants: 
     1. {[ l < v < r]}
@@ -2141,8 +2141,8 @@ let check tree =
     3. [height l] - [height r] <= 2
 *)
 let create l v r = 
-  (* 363628 *) let hl = match l with Empty -> (* 35734 *) 0 | Node (_,_,_,h) -> (* 327894 *) h in
-  let hr = match r with Empty -> (* 35892 *) 0 | Node (_,_,_,h) -> (* 327736 *) h in
+  (* 181814 *) let hl = match l with Empty -> (* 17867 *) 0 | Node (_,_,_,h) -> (* 163947 *) h in
+  let hr = match r with Empty -> (* 17946 *) 0 | Node (_,_,_,h) -> (* 163868 *) h in
   Node(l,v,r, if hl >= hr then hl + 1 else hr + 1)         
 
 (* Same as create, but performs one step of rebalancing if necessary.
@@ -2240,13 +2240,13 @@ let internal_bal l v r =
     end
 *)
 let internal_bal l v r =
-  (* 3342708 *) let hl = match l with Empty -> (* 179744 *) 0 | Node(_,_,_,h) -> (* 3162964 *) h in
-  let hr = match r with Empty -> (* 196988 *) 0 | Node(_,_,_,h) -> (* 3145720 *) h in
+  (* 1671354 *) let hl = match l with Empty -> (* 89872 *) 0 | Node(_,_,_,h) -> (* 1581482 *) h in
+  let hr = match r with Empty -> (* 98494 *) 0 | Node(_,_,_,h) -> (* 1572860 *) h in
   if hl > hr + 2 then begin
     match l with
       Empty -> (* 0 *) assert false
     | Node(ll, lv, lr, _) ->   
-      (* 23670 *) if height ll >= height lr then
+      (* 11835 *) if height ll >= height lr then
         (* [ll] >~ [lr] 
            [ll] >~ [r] 
            [ll] ~~ [ lr ^ r]  
@@ -2260,19 +2260,19 @@ let internal_bal l v r =
              [lr] >~ [r]
              [ll ^ lrl] ~~ [lrr ^ r]   
           *)
-          (* 11004 *) create (create ll lv lrl) lrv (create lrr v r)
+          (* 5502 *) create (create ll lv lrl) lrv (create lrr v r)
       end
   end else if hr > hl + 2 then begin
     match r with
       Empty -> (* 0 *) assert false
     | Node(rl, rv, rr, _) ->
-      (* 23350 *) if height rr >= height rl then
+      (* 11675 *) if height rr >= height rl then
         create (create l v rl) rv rr
       else begin
         match rl with
           Empty -> (* 0 *) assert false
         | Node(rll, rlv, rlr, _) ->
-          (* 11072 *) create (create l v rll) rlv (create rlr rv rr)
+          (* 5536 *) create (create l v rll) rlv (create rlr rv rr)
       end
   end else
     Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1))    
@@ -2282,7 +2282,7 @@ let rec remove_min_elt = function
   | Node(Empty, v, r, _) -> (* 0 *) r
   | Node(l, v, r, _) -> (* 0 *) internal_bal (remove_min_elt l) v r
 
-let singleton x = (* 132580 *) Node(Empty, x, Empty, 1)    
+let singleton x = (* 66290 *) Node(Empty, x, Empty, 1)    
 
 (* 
    All elements of l must precede the elements of r.
@@ -2304,14 +2304,14 @@ let internal_merge l r =
 *)
 
 let rec add_min_element v = function
-  | Empty -> (* 80294 *) singleton v
+  | Empty -> (* 40147 *) singleton v
   | Node (l, x, r, h) ->
-    (* 69164 *) internal_bal (add_min_element v l) x r
+    (* 34582 *) internal_bal (add_min_element v l) x r
 
 let rec add_max_element v = function
-  | Empty -> (* 52286 *) singleton v
+  | Empty -> (* 26143 *) singleton v
   | Node (l, x, r, h) ->
-    (* 68448 *) internal_bal l x (add_max_element v r)
+    (* 34224 *) internal_bal l x (add_max_element v r)
 
 (** 
     Invariants:
@@ -2323,11 +2323,11 @@ let rec add_max_element v = function
     Also use the lemma from [bal]
 *)
 let rec internal_join l v r =
-  (* 309196 *) match (l, r) with
-    (Empty, _) -> (* 80294 *) add_min_element v r
-  | (_, Empty) -> (* 52286 *) add_max_element v l
+  (* 154598 *) match (l, r) with
+    (Empty, _) -> (* 40147 *) add_min_element v r
+  | (_, Empty) -> (* 26143 *) add_max_element v l
   | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
-    (* 176616 *) if lh > rh + 2 then 
+    (* 88308 *) if lh > rh + 2 then 
       (* proof by induction:
          now [height of ll] is [lh - 1] 
       *)
@@ -2369,27 +2369,27 @@ let rec partition p = function
     else (internal_concat lt rt, internal_join lf v rf)
 
 let of_sorted_list l =
-  (* 2 *) let rec sub n l =
-    (* 1022 *) match n, l with
+  (* 1 *) let rec sub n l =
+    (* 511 *) match n, l with
     | 0, l -> (* 0 *) Empty, l
     | 1, x0 :: l -> (* 0 *) Node (Empty, x0, Empty, 1), l
-    | 2, x0 :: x1 :: l -> (* 46 *) Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l
+    | 2, x0 :: x1 :: l -> (* 23 *) Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l
     | 3, x0 :: x1 :: x2 :: l ->
-      (* 466 *) Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l
+      (* 233 *) Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l
     | n, l ->
-      (* 510 *) let nl = n / 2 in
+      (* 255 *) let nl = n / 2 in
       let left, l = sub nl l in
       match l with
       | [] -> (* 0 *) assert false
       | mid :: l ->
-        (* 510 *) let right, l = sub (n - nl - 1) l in
+        (* 255 *) let right, l = sub (n - nl - 1) l in
         create left mid right, l
   in
   fst (sub (List.length l) l)
 
 let of_sorted_array l =   
-  (* 804 *) let rec sub start n l  =
-    (* 156908 *) if n = 0 then Empty else 
+  (* 402 *) let rec sub start n l  =
+    (* 78454 *) if n = 0 then Empty else 
     if n = 1 then 
       let x0 = Array.unsafe_get l start in
       Node (Empty, x0, Empty, 1)
@@ -2413,32 +2413,32 @@ let of_sorted_array l =
   sub 0 (Array.length l) l 
 
 let is_ordered cmp tree =
-  (* 416 *) let rec is_ordered_min_max tree =
-    (* 503276 *) match tree with
-    | Empty -> (* 251846 *) `Empty
+  (* 208 *) let rec is_ordered_min_max tree =
+    (* 251638 *) match tree with
+    | Empty -> (* 125923 *) `Empty
     | Node(l,v,r,_) -> 
-      (* 251430 *) begin match is_ordered_min_max l with
+      (* 125715 *) begin match is_ordered_min_max l with
         | `No -> (* 0 *) `No 
         | `Empty ->
-          (* 121864 *) begin match is_ordered_min_max r with
+          (* 60932 *) begin match is_ordered_min_max r with
             | `No  -> (* 0 *) `No
-            | `Empty -> (* 96144 *) `V (v,v)
+            | `Empty -> (* 48072 *) `V (v,v)
             | `V(l,r) ->
-              (* 25720 *) if cmp v l < 0 then
+              (* 12860 *) if cmp v l < 0 then
                 `V(v,r)
               else
                 `No
           end
         | `V(min_v,max_v)->
-          (* 129566 *) begin match is_ordered_min_max r with
+          (* 64783 *) begin match is_ordered_min_max r with
             | `No -> (* 0 *) `No
             | `Empty -> 
-              (* 33836 *) if cmp max_v v < 0 then 
+              (* 16918 *) if cmp max_v v < 0 then 
                 `V(min_v,v)
               else
                 `No 
             | `V(min_v_r, max_v_r) ->
-              (* 95730 *) if cmp max_v min_v_r < 0 then
+              (* 47865 *) if cmp max_v min_v_r < 0 then
                 `V(min_v,max_v_r)
               else `No
           end
@@ -2562,7 +2562,7 @@ end = struct
 
 type t = int
 
-let compare (x : t) (y : t) = (* 3325104 *) Pervasives.compare x y 
+let compare (x : t) (y : t) = (* 1662552 *) Pervasives.compare x y 
 
 let equal (x : t) (y : t) = (* 0 *) x = y
 
@@ -2632,10 +2632,10 @@ let rec split x (tree : _ Set_gen.t) : _ Set_gen.t * bool * _ Set_gen.t =  (* 0
       let (ll, pres, rl) = split x l in (ll, pres, Set_gen.internal_join rl v r)
     else
       let (lr, pres, rr) = split x r in (Set_gen.internal_join l v lr, pres, rr)
-let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  (* 3341824 *) match tree with 
-  | Empty -> (* 199992 *) Node(Empty, x, Empty, 1)
+let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  (* 1670912 *) match tree with 
+  | Empty -> (* 99996 *) Node(Empty, x, Empty, 1)
   | Node(l, v, r, _) as t ->
-    (* 3141832 *) let c = compare_elt x v in
+    (* 1570916 *) let c = compare_elt x v in
     if c = 0 then t else
     if c < 0 then Set_gen.internal_bal (add x l) v r else Set_gen.internal_bal l v (add x r)
 
@@ -2741,7 +2741,7 @@ let of_array l =
 
 (* also check order *)
 let invariant t =
-  (* 2 *) Set_gen.check t ;
+  (* 1 *) Set_gen.check t ;
   Set_gen.is_ordered compare_elt t          
 
 
@@ -2883,29 +2883,29 @@ let filter = Set_gen.filter
 let of_sorted_list = Set_gen.of_sorted_list
 let of_sorted_array = Set_gen.of_sorted_array
 
-let rec split x (tree : _ Set_gen.t) : _ Set_gen.t * bool * _ Set_gen.t =  (* 301530 *) match tree with 
+let rec split x (tree : _ Set_gen.t) : _ Set_gen.t * bool * _ Set_gen.t =  (* 150765 *) match tree with 
   | Empty ->
-    (* 1412 *) (Empty, false, Empty)
+    (* 706 *) (Empty, false, Empty)
   | Node(l, v, r, _) ->
-    (* 300118 *) let c = compare_elt x v in
+    (* 150059 *) let c = compare_elt x v in
     if c = 0 then (l, true, r)
     else if c < 0 then
       let (ll, pres, rl) = split x l in (ll, pres, Set_gen.internal_join rl v r)
     else
       let (lr, pres, rr) = split x r in (Set_gen.internal_join l v lr, pres, rr)
-let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  (* 142680 *) match tree with 
-  | Empty -> (* 5240 *) Node(Empty, x, Empty, 1)
+let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  (* 71340 *) match tree with 
+  | Empty -> (* 2620 *) Node(Empty, x, Empty, 1)
   | Node(l, v, r, _) as t ->
-    (* 137440 *) let c = compare_elt x v in
+    (* 68720 *) let c = compare_elt x v in
     if c = 0 then t else
     if c < 0 then Set_gen.internal_bal (add x l) v r else Set_gen.internal_bal l v (add x r)
 
 let rec union (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) : _ Set_gen.t  =
-  (* 249272 *) match (s1, s2) with
-  | (Empty, t2) -> (* 42230 *) t2
-  | (t1, Empty) -> (* 1532 *) t1
+  (* 124636 *) match (s1, s2) with
+  | (Empty, t2) -> (* 21115 *) t2
+  | (t1, Empty) -> (* 766 *) t1
   | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
-    (* 205510 *) if h1 >= h2 then
+    (* 102755 *) if h1 >= h2 then
       if h2 = 1 then add v2 s1 else begin
         let (l2, _, r2) = split v1 s2 in
         Set_gen.internal_join (union l1 l2) v1 (union r1 r2)
@@ -2998,11 +2998,11 @@ let of_list l =
   | _ -> (* 0 *) of_sorted_list (List.sort_uniq compare_elt l)
 
 let of_array l = 
-  (* 6 *) Array.fold_left (fun  acc x -> (* 6000 *) add x acc) empty l
+  (* 3 *) Array.fold_left (fun  acc x -> (* 3000 *) add x acc) empty l
 
 (* also check order *)
 let invariant t =
-  (* 414 *) Set_gen.check t ;
+  (* 207 *) Set_gen.check t ;
   Set_gen.is_ordered compare_elt t          
 
 
@@ -3024,35 +3024,35 @@ let suites =
   __FILE__ >:::
   [
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_bool __LOC__
+      (* 1 *) OUnit.assert_bool __LOC__
         (Set_poly.invariant 
-           (Set_poly.of_array (Array.init 1000 (fun n -> (* 2000 *) n))))
+           (Set_poly.of_array (Array.init 1000 (fun n -> (* 1000 *) n))))
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_bool __LOC__
+      (* 1 *) OUnit.assert_bool __LOC__
         (Set_poly.invariant 
-           (Set_poly.of_array (Array.init 1000 (fun n -> (* 2000 *) 1000-n))))
+           (Set_poly.of_array (Array.init 1000 (fun n -> (* 1000 *) 1000-n))))
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_bool __LOC__
+      (* 1 *) OUnit.assert_bool __LOC__
         (Set_poly.invariant 
-           (Set_poly.of_array (Array.init 1000 (fun n -> (* 2000 *) Random.int 1000))))
+           (Set_poly.of_array (Array.init 1000 (fun n -> (* 1000 *) Random.int 1000))))
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_bool __LOC__
+      (* 1 *) OUnit.assert_bool __LOC__
         (Set_poly.invariant 
-           (Set_poly.of_sorted_list (Array.to_list (Array.init 1000 (fun n -> (* 2000 *) n)))))
+           (Set_poly.of_sorted_list (Array.to_list (Array.init 1000 (fun n -> (* 1000 *) n)))))
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let arr = Array.init 1000 (fun n -> (* 2000 *) n) in
+      (* 1 *) let arr = Array.init 1000 (fun n -> (* 1000 *) n) in
       let set = (Set_poly.of_sorted_array arr) in
       OUnit.assert_bool __LOC__
         (Set_poly.invariant set );
       OUnit.assert_equal 1000 (Set_poly.cardinal set)    
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) for i = 0 to 200 do 
-        let arr = Array.init i (fun n -> (* 40200 *) n) in
+      (* 1 *) for i = 0 to 200 do 
+        let arr = Array.init i (fun n -> (* 20100 *) n) in
         let set = (Set_poly.of_sorted_array arr) in
         OUnit.assert_bool __LOC__
           (Set_poly.invariant set );
@@ -3060,11 +3060,11 @@ let suites =
       done    
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let arr_size = 200 in
+      (* 1 *) let arr_size = 200 in
       let arr_sets = Array.make 200 Set_poly.empty in  
       for i = 0 to arr_size - 1 do
         let size = Random.int 1000 in  
-        let arr = Array.init size (fun n -> (* 206096 *) n) in
+        let arr = Array.init size (fun n -> (* 103048 *) n) in
         arr_sets.(i)<- (Set_poly.of_sorted_array arr)            
       done;
       let large = Array.fold_left Set_poly.union Set_poly.empty arr_sets in 
@@ -3072,7 +3072,7 @@ let suites =
     end;
 
      __LOC__ >:: begin fun _ ->
-      (* 2 *) let arr_size = 1_00_000 in
+      (* 1 *) let arr_size = 1_00_000 in
       let v = ref Set_int.empty in 
       for i = 0 to arr_size - 1 do
         let size = Random.int 0x3FFFFFFF in  
@@ -3223,13 +3223,13 @@ end = struct
    ]}
 *)
 let rec power_2_above x n =
-  (* 112 *) if x >= n then x
+  (* 56 *) if x >= n then x
   else if x * 2 > Sys.max_array_length then x
   else power_2_above (x * 2) n
 
 
 let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = 
-  (* 8 *) Printf.sprintf 
+  (* 4 *) Printf.sprintf 
     "bindings: %d,buckets: %d, longest: %d, hist:[%s]" 
     num_bindings 
     num_buckets 
@@ -3277,7 +3277,7 @@ type 'a t =
 
 
 let create  initial_size =
-  (* 14 *) let s = Ext_util.power_2_above 16 initial_size in
+  (* 7 *) let s = Ext_util.power_2_above 16 initial_size in
   { initial_size = s; size = 0; data = Array.make s [] }
 
 let clear h =
@@ -3294,7 +3294,7 @@ let reset h =
 
 let copy h = (* 0 *) { h with data = Array.copy h.data }
 
-let length h = (* 18 *) h.size
+let length h = (* 11 *) h.size
 
 let iter f h =
   (* 0 *) let rec do_bucket = function
@@ -3322,16 +3322,16 @@ let fold f h init =
   !accu
 
 let resize indexfun h =
-  (* 28 *) let odata = h.data in
+  (* 14 *) let odata = h.data in
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize < Sys.max_array_length then begin
     let ndata = Array.make nsize [ ] in
     h.data <- ndata;          (* so that indexfun sees the new bucket count *)
     let rec insert_bucket = function
-        [ ] -> (* 4928 *) ()
+        [ ] -> (* 2464 *) ()
       | key :: rest ->
-        (* 9884 *) let nidx = indexfun h key in
+        (* 4942 *) let nidx = indexfun h key in
         ndata.(nidx) <- key :: ndata.(nidx);
         insert_bucket rest
     in
@@ -3361,26 +3361,26 @@ let stats h =
    bucket_histogram = histo }
 
 let rec small_bucket_mem eq_key key lst =
-  (* 49712 *) match lst with 
-  | [] -> (* 3762 *) false 
+  (* 26088 *) match lst with 
+  | [] -> (* 1921 *) false 
   | key1::rest -> 
-    (* 45950 *) eq_key key   key1 ||
+    (* 24167 *) eq_key key   key1 ||
     match rest with 
-    | [] -> (* 3836 *) false 
+    | [] -> (* 1963 *) false 
     | key2 :: rest -> 
-      (* 13912 *) eq_key key   key2 ||
+      (* 7398 *) eq_key key   key2 ||
       match rest with 
-      | [] -> (* 2626 *) false 
+      | [] -> (* 1329 *) false 
       | key3 :: rest -> 
-        (* 6162 *) eq_key key   key3 ||
+        (* 3197 *) eq_key key   key3 ||
         small_bucket_mem eq_key key rest 
 
 let rec remove_bucket eq_key key (h : _ t) buckets = 
-  (* 11898 *) match buckets with 
+  (* 11351 *) match buckets with 
   | [ ] ->
     (* 4002 *) [ ]
   | k :: next ->
-    (* 7896 *) if  eq_key k   key
+    (* 7349 *) if  eq_key k   key
     then begin h.size <- h.size - 1; next end
     else k :: remove_bucket eq_key key h next    
 
@@ -3475,7 +3475,7 @@ module Make (H: Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) = str
 type key = H.t 
 let eq_key = H.equal
 let key_index (h :  _ Hash_set_gen.t ) key =
-  (* 18006 *) (H.hash  key) land (Array.length h.data - 1)
+  (* 13196 *) (H.hash  key) land (Array.length h.data - 1)
 type t = key Hash_set_gen.t
 
 
@@ -3493,7 +3493,7 @@ let elements = Hash_set_gen.elements
 
 
 let remove (h : _ Hash_set_gen.t) key =  
-  (* 2022 *) let i = key_index h key in
+  (* 4002 *) let i = key_index h key in
   let h_data = h.data in
   let old_h_size = h.size in 
   let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
@@ -3503,7 +3503,7 @@ let remove (h : _ Hash_set_gen.t) key =
 
 
 let add (h : _ Hash_set_gen.t) key =
-  (* 8004 *) let i = key_index h key  in 
+  (* 4103 *) let i = key_index h key  in 
   if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
     begin 
       h.data.(i) <- key :: h.data.(i);
@@ -3524,7 +3524,7 @@ let check_add (h : _ Hash_set_gen.t) key =
 
 
 let mem (h :  _ Hash_set_gen.t) key =
-  (* 4002 *) Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
+  (* 3102 *) Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
 
 # 106
 end
@@ -3611,7 +3611,7 @@ end = struct
 external seeded_hash_param :
   int -> int -> int -> 'a -> int = "caml_hash" "noalloc"
 let key_index (h :  _ Hash_set_gen.t ) (key : 'a) =
-  (* 41938 *) seeded_hash_param 10 100 0 key land (Array.length h.data - 1)
+  (* 20969 *) seeded_hash_param 10 100 0 key land (Array.length h.data - 1)
 let eq_key = (=)
 type  'a t = 'a Hash_set_gen.t 
 
@@ -3630,7 +3630,7 @@ let elements = Hash_set_gen.elements
 
 
 let remove (h : _ Hash_set_gen.t) key =  
-  (* 2022 *) let i = key_index h key in
+  (* 1011 *) let i = key_index h key in
   let h_data = h.data in
   let old_h_size = h.size in 
   let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
@@ -3640,7 +3640,7 @@ let remove (h : _ Hash_set_gen.t) key =
 
 
 let add (h : _ Hash_set_gen.t) key =
-  (* 30008 *) let i = key_index h key  in 
+  (* 15004 *) let i = key_index h key  in 
   if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
     begin 
       h.data.(i) <- key :: h.data.(i);
@@ -3661,7 +3661,7 @@ let check_add (h : _ Hash_set_gen.t) key =
 
 
 let mem (h :  _ Hash_set_gen.t) key =
-  (* 4002 *) Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
+  (* 2001 *) Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
 
   
 
@@ -3749,7 +3749,7 @@ type 'a t =
 
 
 let create  initial_size =
-  (* 24 *) let initial_size = Ext_util.power_2_above 16 initial_size in
+  (* 12 *) let initial_size = Ext_util.power_2_above 16 initial_size in
   { initial_size ; 
     size = 0; 
     data = Array.make initial_size Empty;
@@ -3757,7 +3757,7 @@ let create  initial_size =
   }
 
 let clear h =
-  (* 4 *) h.size <- 0;
+  (* 2 *) h.size <- 0;
   let h_data = h.data in 
   for i = 0 to h.data_mask  do 
     Array.unsafe_set h_data i  Empty
@@ -3772,18 +3772,18 @@ let reset h =
 
 let copy h = (* 0 *) { h with data = Array.copy h.data }
 
-let length h = (* 8 *) h.size
+let length h = (* 4 *) h.size
 
 
 let rec insert_bucket nmask ndata hash = function
-  | Empty -> (* 909828 *) ()
+  | Empty -> (* 454914 *) ()
   | Cons(key,info,rest) ->
-    (* 1195628 *) let nidx = hash key land nmask in (* so that indexfun sees the new bucket count *)
+    (* 597814 *) let nidx = hash key land nmask in (* so that indexfun sees the new bucket count *)
     Array.unsafe_set ndata nidx  (Cons(key,info, (Array.unsafe_get ndata nidx)));
     insert_bucket nmask ndata hash rest
 
 let resize hash h =
-  (* 48 *) let odata = h.data in
+  (* 24 *) let odata = h.data in
   let odata_mask = h.data_mask in 
   let nsize = (odata_mask + 1) * 2 in
   if nsize < Sys.max_array_length then begin
@@ -3793,9 +3793,9 @@ let resize hash h =
     h.data_mask <- nmask ; 
     for i = 0 to odata_mask do
       match Array.unsafe_get odata i with 
-      | Empty -> (* 142876 *) ()
+      | Empty -> (* 71438 *) ()
       | Cons(key,info,rest) -> 
-        (* 909828 *) let nidx = hash key land nmask in 
+        (* 454914 *) let nidx = hash key land nmask in 
         Array.unsafe_set ndata nidx  (Cons(key,info, (Array.unsafe_get ndata nidx)));
         insert_bucket nmask ndata hash rest 
     done
@@ -3804,36 +3804,36 @@ let resize hash h =
 
 let rec do_bucket f = function
   | Empty ->
-    (* 3145728 *) ()
+    (* 1572864 *) ()
   | Cons(k ,i,  rest) ->
-    (* 4000000 *) f k i ; do_bucket f rest 
+    (* 2000000 *) f k i ; do_bucket f rest 
 
 let iter f h =
-  (* 4 *) let d = h.data in
+  (* 2 *) let d = h.data in
   for i = 0 to h.data_mask do
     do_bucket f (Array.unsafe_get d i)
   done
 
 (* find one element *)
 let choose_exn h = 
-  (* 18 *) let rec aux arr offset last_index = 
-    (* 96 *) if offset > last_index then 
+  (* 9 *) let rec aux arr offset last_index = 
+    (* 48 *) if offset > last_index then 
       raise Not_found (* This happens when size is 0, otherwise it is never called *)
     else 
       match Array.unsafe_get arr offset with 
-      | Empty -> (* 78 *) aux arr (offset + 1) last_index 
-      | Cons (k,_,rest) -> (* 16 *) k 
+      | Empty -> (* 39 *) aux arr (offset + 1) last_index 
+      | Cons (k,_,rest) -> (* 8 *) k 
   in
   let h_data = h.data in 
   aux h_data 0 h.data_mask
 
 let fold f h init =
-  (* 4 *) let rec do_bucket b accu =
-    (* 7145728 *) match b with
+  (* 2 *) let rec do_bucket b accu =
+    (* 3572864 *) match b with
       Empty ->
-      (* 3145728 *) accu
+      (* 1572864 *) accu
     | Cons( k , i,  rest) ->
-      (* 4000000 *) do_bucket rest (f k i  accu) in
+      (* 2000000 *) do_bucket rest (f k i  accu) in
   let d = h.data in
   let accu = ref init in
   for i = 0 to h.data_mask do
@@ -3843,13 +3843,13 @@ let fold f h init =
 
 
 let rec set_bucket arr = function 
-  | Empty -> (* 8448 *) ()
+  | Empty -> (* 4224 *) ()
   | Cons(k,i,rest) ->
-    (* 9220 *) Array.unsafe_set arr i k;
+    (* 4610 *) Array.unsafe_set arr i k;
     set_bucket arr rest 
 
 let to_sorted_array h = 
-  (* 20 *) if h.size = 0 then [||]
+  (* 10 *) if h.size = 0 then [||]
   else 
     let v = choose_exn h in 
     let arr = Array.make h.size v in
@@ -3863,17 +3863,17 @@ let to_sorted_array h =
 
 
 let rec bucket_length acc (x : _ bucket) = 
-  (* 14311716 *) match x with 
-  | Empty -> (* 6299712 *) acc
-  | Cons(_,_,rest) -> (* 8012004 *) bucket_length (acc + 1) rest  
+  (* 7155858 *) match x with 
+  | Empty -> (* 3149856 *) acc
+  | Cons(_,_,rest) -> (* 4006002 *) bucket_length (acc + 1) rest  
 
 let stats h =
-  (* 8 *) let mbl =
-    Array.fold_left (fun m (b : _ bucket) -> (* 3149856 *) max m (bucket_length 0 b)) 0 h.data in
+  (* 4 *) let mbl =
+    Array.fold_left (fun m (b : _ bucket) -> (* 1574928 *) max m (bucket_length 0 b)) 0 h.data in
   let histo = Array.make (mbl + 1) 0 in
   Array.iter
     (fun b ->
-       (* 3149856 *) let l = bucket_length 0 b in
+       (* 1574928 *) let l = bucket_length 0 b in
        histo.(l) <- histo.(l) + 1)
     h.data;
   { Hashtbl.num_bindings = h.size;
@@ -3916,36 +3916,36 @@ let to_sorted_array = to_sorted_array
 
 
 let rec small_bucket_mem key lst =
-  (* 8687822 *) match lst with 
-  | Empty -> (* 2053362 *) false 
+  (* 4343911 *) match lst with 
+  | Empty -> (* 1026681 *) false 
   | Cons(key1,_, rest) -> 
-    (* 6634460 *) equal_key key key1 ||
+    (* 3317230 *) equal_key key key1 ||
     match rest with 
-    | Empty -> (* 1288446 *) false 
+    | Empty -> (* 644223 *) false 
     | Cons(key2 , _, rest) -> 
-      (* 2992624 *) equal_key key  key2 ||
+      (* 1496312 *) equal_key key  key2 ||
       match rest with 
-      | Empty -> (* 667412 *) false 
+      | Empty -> (* 333706 *) false 
       | Cons(key3,_,  rest) -> 
-        (* 1156576 *) equal_key key  key3 ||
+        (* 578288 *) equal_key key  key3 ||
         small_bucket_mem key rest 
 
 let rec small_bucket_rank key lst =
-  (* 4244994 *) match lst with 
+  (* 2122497 *) match lst with 
   | Empty -> (* 0 *) -1
   | Cons(key1,i,rest) -> 
-    (* 4244994 *) if equal_key key key1 then i 
+    (* 2122497 *) if equal_key key key1 then i 
     else match rest with 
       | Empty -> (* 0 *) -1 
       | Cons(key2,i2,  rest) -> 
-        (* 1892402 *) if equal_key key  key2 then i2 else
+        (* 946201 *) if equal_key key  key2 then i2 else
           match rest with 
           | Empty -> (* 0 *) -1 
           | Cons(key3,i3, rest) -> 
-            (* 723952 *) if equal_key key  key3 then i3 else
+            (* 361976 *) if equal_key key  key3 then i3 else
               small_bucket_rank key rest 
 let add h key =
-  (* 4010240 *) let h_data_mask = h.data_mask in 
+  (* 2005120 *) let h_data_mask = h.data_mask in 
   let i = hash key land h_data_mask in 
   if not (small_bucket_mem key  h.data.(i)) then 
     begin 
@@ -3955,7 +3955,7 @@ let add h key =
     end
 
 let of_array arr =
-  (* 14 *) let len = Array.length arr in 
+  (* 7 *) let len = Array.length arr in 
   let h = create len in 
   for i = 0 to len - 1 do 
     add h (Array.unsafe_get arr i)
@@ -3964,9 +3964,9 @@ let of_array arr =
 
 
 let mem h key =
-  (* 4000000 *) small_bucket_mem key (Array.unsafe_get h.data (hash  key land h.data_mask)) 
+  (* 2000000 *) small_bucket_mem key (Array.unsafe_get h.data (hash  key land h.data_mask)) 
 let rank h key = 
-  (* 4000000 *) small_bucket_rank key (Array.unsafe_get h.data (hash  key land h.data_mask))  
+  (* 2000000 *) small_bucket_rank key (Array.unsafe_get h.data (hash  key land h.data_mask))  
 
 
 
@@ -4039,7 +4039,7 @@ end = struct
 # 31
 type key = string 
 let key_index (h :  _ Hash_set_gen.t ) (key : key) =
-  (* 222 *) (Bs_hash_stubs.hash_string  key) land (Array.length h.data - 1)
+  (* 111 *) (Bs_hash_stubs.hash_string  key) land (Array.length h.data - 1)
 let eq_key = Ext_string.equal 
 type  t = key  Hash_set_gen.t 
 
@@ -4058,7 +4058,7 @@ let elements = Hash_set_gen.elements
 
 
 let remove (h : _ Hash_set_gen.t) key =  
-  (* 4 *) let i = key_index h key in
+  (* 2 *) let i = key_index h key in
   let h_data = h.data in
   let old_h_size = h.size in 
   let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
@@ -4068,7 +4068,7 @@ let remove (h : _ Hash_set_gen.t) key =
 
 
 let add (h : _ Hash_set_gen.t) key =
-  (* 202 *) let i = key_index h key  in 
+  (* 101 *) let i = key_index h key  in 
   if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
     begin 
       h.data.(i) <- key :: h.data.(i);
@@ -4077,7 +4077,7 @@ let add (h : _ Hash_set_gen.t) key =
     end
 
 let check_add (h : _ Hash_set_gen.t) key =
-  (* 16 *) let i = key_index h key  in 
+  (* 8 *) let i = key_index h key  in 
   if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
     begin 
       h.data.(i) <- key :: h.data.(i);
@@ -4106,8 +4106,8 @@ type id = { name : string ; stamp : int }
 
 module Id_hash_set = Hash_set.Make(struct 
     type t = id 
-    let equal x y = (* 25444 *) x.stamp = y.stamp && x.name = y.name 
-    let hash x = (* 18006 *) Hashtbl.hash x.stamp
+    let equal x y = (* 17873 *) x.stamp = y.stamp && x.name = y.name 
+    let hash x = (* 13196 *) Hashtbl.hash x.stamp
   end
   )
 
@@ -4124,21 +4124,21 @@ let suites =
   >:::
   [
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let v = Hash_set_poly.create 31 in
+      (* 1 *) let v = Hash_set_poly.create 31 in
       for i = 0 to 1000 do
         Hash_set_poly.add v i  
       done  ;
       OUnit.assert_equal (Hash_set_poly.length v) 1001
     end ;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let v = Hash_set_poly.create 31 in
+      (* 1 *) let v = Hash_set_poly.create 31 in
       for i = 0 to 1_0_000 do
         Hash_set_poly.add v 0
       done  ;
       OUnit.assert_equal (Hash_set_poly.length v) 1
     end ;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let v = Hash_set_poly.create 30 in 
+      (* 1 *) let v = Hash_set_poly.create 30 in 
       for i = 0 to 2_000 do 
         Hash_set_poly.add v {name = "x" ; stamp = i}
       done ;
@@ -4158,22 +4158,32 @@ let suites =
       (*    bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *)
     end ;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let module Hash_set = Id_hash_set in 
-      let v = Hash_set.create 30 in 
+      (* 1 *) let v = Id_hash_set.create 30 in 
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done ;
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done  ; 
       for i = 0 to 2_000 do 
-        assert (Hash_set.mem v {name = "x"; stamp = i})
+        assert (Id_hash_set.mem v {name = "x"; stamp = i})
       done;  
-      OUnit.assert_equal (Hash_set.length v)  2_001;
+      OUnit.assert_equal (Id_hash_set.length v)  2_001;
       for i =  1990 to 3_000 do 
-        Hash_set.remove v {name = "x"; stamp = i}
+        Id_hash_set.remove v {name = "x"; stamp = i}
       done ;
-      OUnit.assert_equal (Hash_set.length v) 1990;
+      OUnit.assert_equal (Id_hash_set.length v) 1990;
+      for i = 1000 to 3990 do 
+        Id_hash_set.remove v { name = "x"; stamp = i }
+      done;
+      OUnit.assert_equal (Id_hash_set.length v) 1000;
+      for i = 1000 to 1100 do 
+        Id_hash_set.add v { name = "x"; stamp = i};
+      done;
+      OUnit.assert_equal (Id_hash_set.length v ) 1101;
+      for i = 0 to 1100 do 
+        OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i})
+      done  
       (* OUnit.assert_equal (Hash_set.stats v) *)
       (*   {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *)
       (*    bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *)
@@ -4181,7 +4191,7 @@ let suites =
     end 
     ;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let v = Ordered_hash_set_string.create 3 in 
+      (* 1 *) let v = Ordered_hash_set_string.create 3 in 
       for i =  0 to 10 do
         Ordered_hash_set_string.add v (string_of_int i) 
       done; 
@@ -4192,10 +4202,10 @@ let suites =
         const_tbl
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let duplicate arr = 
-        (* 4 *) let len = Array.length arr in 
+      (* 1 *) let duplicate arr = 
+        (* 2 *) let len = Array.length arr in 
         let rec aux tbl off = 
-          (* 18 *) if off >= len  then None
+          (* 9 *) if off >= len  then None
           else 
             let curr = (Array.unsafe_get arr off) in
             if String_hash_set.check_add tbl curr then 
@@ -4207,8 +4217,8 @@ let suites =
       OUnit.assert_equal (duplicate [|"if"; "a"; "b"; "b"; "c"|]) (Some "b")
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let of_array lst =
-        (* 2 *) let len = Array.length lst in 
+      (* 1 *) let of_array lst =
+        (* 1 *) let len = Array.length lst in 
         let tbl = String_hash_set.create len in 
         Array.iter (String_hash_set.add tbl ) lst; tbl  in 
       let hash = of_array const_tbl  in 
@@ -4370,37 +4380,37 @@ let bench () =
 
 
 type id (* = Ident.t *) = { stamp : int; name : string; mutable flags : int; }
-let hash id = (* 8 *) Bs_hash_stubs.hash_stamp_and_name id.stamp id.name 
+let hash id = (* 4 *) Bs_hash_stubs.hash_stamp_and_name id.stamp id.name 
 let suites = 
     __FILE__
     >:::
     [
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) Bs_hash_stubs.hash_int 0 =~ Hashtbl.hash 0
+        (* 1 *) Bs_hash_stubs.hash_int 0 =~ Hashtbl.hash 0
       end;
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int
+        (* 1 *) Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int
       end;
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int
+        (* 1 *) Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int
       end;
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) Bs_hash_stubs.hash_string "The quick brown fox jumps over the lazy dog"  =~ 
+        (* 1 *) Bs_hash_stubs.hash_string "The quick brown fox jumps over the lazy dog"  =~ 
         Hashtbl.hash "The quick brown fox jumps over the lazy dog"
       end;
       __LOC__ >:: begin fun _ ->
-        (* 2 *) Array.init 100 (fun i -> (* 200 *) String.make i 'a' )
+        (* 1 *) Array.init 100 (fun i -> (* 100 *) String.make i 'a' )
         |> Array.iter (fun x -> 
-          (* 200 *) Bs_hash_stubs.hash_string x =~ Hashtbl.hash x) 
+          (* 100 *) Bs_hash_stubs.hash_string x =~ Hashtbl.hash x) 
       end;
       __LOC__ >:: begin fun _ ->
         (** only stamp matters here *)
-        (* 2 *) hash {stamp = 1 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 1 ;
+        (* 1 *) hash {stamp = 1 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 1 ;
         hash {stamp = 11 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 11;
       end;
       __LOC__ >:: begin fun _ ->
         (* only string matters here *)
-        (* 2 *) hash {stamp = 0 ; name = "Pervasives"; flags = 0} =~ Bs_hash_stubs.hash_string "Pervasives";
+        (* 1 *) hash {stamp = 0 ; name = "Pervasives"; flags = 0} =~ Bs_hash_stubs.hash_string "Pervasives";
         hash {stamp = 0 ; name = "UU"; flags = 0} =~ Bs_hash_stubs.hash_string "UU";
       end
       
@@ -4467,7 +4477,7 @@ and ('a, 'b) bucketlist =
 
 
 let create  initial_size =
-  (* 4 *) let s = Ext_util.power_2_above 16 initial_size in
+  (* 2 *) let s = Ext_util.power_2_above 16 initial_size in
   { initial_size = s; size = 0; seed = 0; data = Array.make s Empty }
 
 let clear h =
@@ -4484,19 +4494,19 @@ let reset h =
 
 let copy h = (* 0 *) { h with data = Array.copy h.data }
 
-let length h = (* 4 *) h.size
+let length h = (* 2 *) h.size
 
 let resize indexfun h =
-  (* 22 *) let odata = h.data in
+  (* 11 *) let odata = h.data in
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize < Sys.max_array_length then begin
     let ndata = Array.make nsize Empty in
     h.data <- ndata;          (* so that indexfun sees the new bucket count *)
     let rec insert_bucket = function
-        Empty -> (* 3008 *) ()
+        Empty -> (* 1504 *) ()
       | Cons(key, data, rest) ->
-        (* 6038 *) insert_bucket rest; (* preserve original order of elements *)
+        (* 3019 *) insert_bucket rest; (* preserve original order of elements *)
         let nidx = indexfun h key in
         ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
     for i = 0 to osize - 1 do
@@ -4637,7 +4647,7 @@ end = struct
 type key = string
 type 'a t = (key, 'a)  Hashtbl_gen.t 
 let key_index (h : _ t ) (key : key) =
-  (* 14038 *) (Bs_hash_stubs.hash_string  key ) land (Array.length h.data - 1)
+  (* 7019 *) (Bs_hash_stubs.hash_string  key ) land (Array.length h.data - 1)
 let eq_key = Ext_string.equal 
 
 # 33
@@ -4654,7 +4664,7 @@ let stats = Hashtbl_gen.stats
 
 
 let add (h : _ t) key info =
-  (* 4000 *) let i = key_index h key in
+  (* 2000 *) let i = key_index h key in
   let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in
   h.data.(i) <- bucket;
   h.size <- h.size + 1;
@@ -4722,11 +4732,11 @@ let find_all (h : _ t) key =
   find_in_bucket h.data.(key_index h key)
 
 let replace h key info =
-  (* 4000 *) let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = (* 8924 *) match bucketlist with 
+  (* 2000 *) let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = (* 4462 *) match bucketlist with 
     | Empty ->
-        (* 2000 *) raise_notrace Not_found
+        (* 1000 *) raise_notrace Not_found
     | Cons(k, i, next) ->
-        (* 6924 *) if eq_key k key
+        (* 3462 *) if eq_key k key
         then Cons(key, info, next)
         else Cons(k, i, replace_bucket next) in
   let i = key_index h key in
@@ -4779,7 +4789,7 @@ let suites =
     (* end; *)
 
     "add semantics " >:: begin fun _ -> 
-      (* 2 *) let h = String_hashtbl.create 0 in 
+      (* 1 *) let h = String_hashtbl.create 0 in 
       let count = 1000 in 
       for j = 0 to 1 do  
         for i = 0 to count - 1 do                 
@@ -4789,7 +4799,7 @@ let suites =
       String_hashtbl.length h =~ 2 * count 
     end; 
     "replace semantics" >:: begin fun _ -> 
-      (* 2 *) let h = String_hashtbl.create 0 in 
+      (* 1 *) let h = String_hashtbl.create 0 in 
       let count = 1000 in 
       for j = 0 to 1 do  
         for i = 0 to count - 1 do                 
@@ -4828,11 +4838,11 @@ type ('key,'a) enumeration =
   | More of 'key * 'a * ('key,'a) t * ('key, 'a) enumeration
 
 let rec cardinal_aux acc  = function
-  | Empty -> (* 3015 *) acc 
+  | Empty -> (* 2008 *) acc 
   | Node (l,_,_,r, _) -> 
-    (* 3008 *) cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
+    (* 2004 *) cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
 
-let cardinal s = (* 7 *) cardinal_aux 0 s 
+let cardinal s = (* 4 *) cardinal_aux 0 s 
 
 let rec bindings_aux accu = function
   | Empty -> (* 0 *) accu
@@ -4842,10 +4852,10 @@ let bindings s =
   (* 0 *) bindings_aux [] s
 
 let rec keys_aux accu = function
-    Empty -> (* 10 *) accu
-  | Node(l, v, _, r, _) -> (* 8 *) keys_aux (v :: keys_aux accu r) l
+    Empty -> (* 5 *) accu
+  | Node(l, v, _, r, _) -> (* 4 *) keys_aux (v :: keys_aux accu r) l
 
-let keys s = (* 2 *) keys_aux [] s
+let keys s = (* 1 *) keys_aux [] s
 
 
 
@@ -4856,18 +4866,18 @@ let rec cons_enum m e =
 
 
 let height = function
-  | Empty -> (* 6000 *) 0
-  | Node(_,_,_,_,h) -> (* 17760 *) h
+  | Empty -> (* 3000 *) 0
+  | Node(_,_,_,_,h) -> (* 8880 *) h
 
 let create l x d r =
-  (* 7920 *) let hl = height l and hr = height r in
+  (* 3960 *) let hl = height l and hr = height r in
   Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
 
 let singleton x d = (* 0 *) Node(Empty, x, d, Empty, 1)
 
 let bal l x d r =
-  (* 55864 *) let hl = match l with Empty -> (* 10006 *) 0 | Node(_,_,_,_,h) -> (* 45858 *) h in
-  let hr = match r with Empty -> (* 4 *) 0 | Node(_,_,_,_,h) -> (* 55860 *) h in
+  (* 27932 *) let hl = match l with Empty -> (* 5003 *) 0 | Node(_,_,_,_,h) -> (* 22929 *) h in
+  let hr = match r with Empty -> (* 2 *) 0 | Node(_,_,_,_,h) -> (* 27930 *) h in
   if hl > hr + 2 then begin
     match l with
       Empty -> (* 0 *) invalid_arg "Map.bal"
@@ -4884,7 +4894,7 @@ let bal l x d r =
     match r with
       Empty -> (* 0 *) invalid_arg "Map.bal"
     | Node(rl, rv, rd, rr, _) ->
-      (* 3960 *) if height rr >= height rl then
+      (* 1980 *) if height rr >= height rl then
         create (create l x d rl) rv rd rr
       else begin
         match rl with
@@ -4897,7 +4907,7 @@ let bal l x d r =
 
 let empty = Empty
 
-let is_empty = function Empty -> (* 2 *) true | _ -> (* 0 *) false
+let is_empty = function Empty -> (* 1 *) true | _ -> (* 0 *) false
 
 let rec min_binding_exn = function
     Empty -> (* 0 *) raise Not_found
@@ -4926,9 +4936,9 @@ let merge t1 t2 =
 
 
 let rec iter f = function
-    Empty -> (* 1002 *) ()
+    Empty -> (* 1001 *) ()
   | Node(l, v, d, r, _) ->
-    (* 1010 *) iter f l; f v d; iter f r
+    (* 1000 *) iter f l; f v d; iter f r
 
 let rec map f = function
     Empty ->
@@ -5249,9 +5259,9 @@ let max_binding_exn = Map_gen.max_binding_exn
 let min_binding_exn = Map_gen.min_binding_exn
 
 
-let rec add x data (tree : _ Map_gen.t as 'a) : 'a = (* 8 *) match tree with 
+let rec add x data (tree : _ Map_gen.t as 'a) : 'a = (* 4 *) match tree with 
   | Empty ->
-    (* 8 *) Node(Empty, x, data, Empty, 1)
+    (* 4 *) Node(Empty, x, data, Empty, 1)
   | Node(l, v, d, r, h) ->
     (* 0 *) let c = compare_key x v in
     if c = 0 then
@@ -5276,11 +5286,11 @@ let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a =
       bal l v d (adjust x data replace r)
 
 
-let rec find_exn x (tree : _ Map_gen.t )  = (* 4 *) match tree with 
+let rec find_exn x (tree : _ Map_gen.t )  = (* 2 *) match tree with 
   | Empty ->
     (* 0 *) raise Not_found
   | Node(l, v, d, r, _) ->
-    (* 4 *) let c = compare_key x v in
+    (* 2 *) let c = compare_key x v in
     if c = 0 then d
     else find_exn x (if c < 0 then l else r)
 
@@ -5532,7 +5542,7 @@ type token =
   
 
 let error  (lexbuf : Lexing.lexbuf) e = 
-  (* 10 *) raise (Error (e, lexbuf.lex_start_p, lexbuf.lex_curr_p))
+  (* 5 *) raise (Error (e, lexbuf.lex_start_p, lexbuf.lex_curr_p))
 
 let lexeme_len (x : Lexing.lexbuf) =
   (* 0 *) x.lex_curr_pos - x.lex_start_pos
@@ -5754,12 +5764,12 @@ let __ocaml_lex_tables = {
 }
 
 let rec lex_json buf lexbuf =
-    (* 172 *) __ocaml_lex_lex_json_rec buf lexbuf 0
+    (* 86 *) __ocaml_lex_lex_json_rec buf lexbuf 0
 and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state =
-  (* 172 *) match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+  (* 86 *) match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
       | 0 ->
 # 137 "bsb/bsb_json.mll"
-          (* 62 *) ( lex_json buf lexbuf)
+          (* 31 *) ( lex_json buf lexbuf)
 # 309 "bsb/bsb_json.ml"
 
   | 1 ->
@@ -5792,32 +5802,32 @@ and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state =
 
   | 6 ->
 # 146 "bsb/bsb_json.mll"
-       (* 10 *) (Lbracket)
+       (* 5 *) (Lbracket)
 # 342 "bsb/bsb_json.ml"
 
   | 7 ->
 # 147 "bsb/bsb_json.mll"
-       (* 6 *) (Rbracket)
+       (* 3 *) (Rbracket)
 # 347 "bsb/bsb_json.ml"
 
   | 8 ->
 # 148 "bsb/bsb_json.mll"
-       (* 12 *) (Lbrace)
+       (* 6 *) (Lbrace)
 # 352 "bsb/bsb_json.ml"
 
   | 9 ->
 # 149 "bsb/bsb_json.mll"
-       (* 6 *) (Rbrace)
+       (* 3 *) (Rbrace)
 # 357 "bsb/bsb_json.ml"
 
   | 10 ->
 # 150 "bsb/bsb_json.mll"
-       (* 26 *) (Comma)
+       (* 13 *) (Comma)
 # 362 "bsb/bsb_json.ml"
 
   | 11 ->
 # 151 "bsb/bsb_json.mll"
-        (* 8 *) (Colon)
+        (* 4 *) (Colon)
 # 367 "bsb/bsb_json.ml"
 
   | 12 ->
@@ -5827,12 +5837,12 @@ and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state =
 
   | 13 ->
 # 154 "bsb/bsb_json.mll"
-         (* 22 *) ( Number (Lexing.lexeme lexbuf))
+         (* 11 *) ( Number (Lexing.lexeme lexbuf))
 # 377 "bsb/bsb_json.ml"
 
   | 14 ->
 # 156 "bsb/bsb_json.mll"
-      (* 8 *) (
+      (* 4 *) (
   let pos = Lexing.lexeme_start_p lexbuf in
   scan_string buf pos lexbuf;
   let content = (Buffer.contents  buf) in 
@@ -5843,7 +5853,7 @@ and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state =
 
   | 15 ->
 # 163 "bsb/bsb_json.mll"
-       (* 12 *) (Eof )
+       (* 6 *) (Eof )
 # 393 "bsb/bsb_json.ml"
 
   | 16 ->
@@ -5882,12 +5892,12 @@ and __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state =
       __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state
 
 and scan_string buf start lexbuf =
-    (* 16 *) __ocaml_lex_scan_string_rec buf start lexbuf 45
+    (* 8 *) __ocaml_lex_scan_string_rec buf start lexbuf 45
 and __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state =
-  (* 16 *) match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+  (* 8 *) match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
       | 0 ->
 # 172 "bsb/bsb_json.mll"
-      (* 8 *) ( () )
+      (* 4 *) ( () )
 # 437 "bsb/bsb_json.ml"
 
   | 1 ->
@@ -6001,7 +6011,7 @@ and
 
   | 8 ->
 # 222 "bsb/bsb_json.mll"
-      (* 8 *) (
+      (* 4 *) (
         let ofs = lexbuf.lex_start_pos in
         let len = lexbuf.lex_curr_pos - ofs in
         Buffer.add_substring buf lexbuf.lex_buffer ofs len;
@@ -6051,76 +6061,76 @@ type status =
 
 
 let rec parse_json lexbuf =
-  (* 22 *) let buf = Buffer.create 64 in 
+  (* 11 *) let buf = Buffer.create 64 in 
   let look_ahead = ref None in
   let token () : token = 
-    (* 126 *) match !look_ahead with 
+    (* 63 *) match !look_ahead with 
     | None ->  
-      (* 110 *) lex_json buf lexbuf 
+      (* 55 *) lex_json buf lexbuf 
     | Some x -> 
-      (* 16 *) look_ahead := None ;
+      (* 8 *) look_ahead := None ;
       x 
   in
-  let push e = (* 16 *) look_ahead := Some e in 
+  let push e = (* 8 *) look_ahead := Some e in 
   let rec json (lexbuf : Lexing.lexbuf) : t = 
-    (* 46 *) match token () with 
+    (* 23 *) match token () with 
     | True -> (* 0 *) `True
     | False -> (* 0 *) `False
     | Null -> (* 0 *) `Null
-    | Number s ->  (* 20 *) `Flo s 
+    | Number s ->  (* 10 *) `Flo s 
     | String s -> (* 0 *) `Str { str = s; loc =    lexbuf.lex_start_p}
-    | Lbracket -> (* 10 *) parse_array false lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf
-    | Lbrace -> (* 12 *) parse_map false String_map.empty lexbuf
-    |  _ -> (* 4 *) error lexbuf Unexpected_token
+    | Lbracket -> (* 5 *) parse_array false lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf
+    | Lbrace -> (* 6 *) parse_map false String_map.empty lexbuf
+    |  _ -> (* 2 *) error lexbuf Unexpected_token
   and parse_array  trailing_comma loc_start loc_finish acc lexbuf : t =
-    (* 20 *) match token () with 
+    (* 10 *) match token () with 
     | Rbracket ->
       (* if trailing_comma then  *)
       (*   error lexbuf Trailing_comma_in_array *)
       (* else  *)
-        (* 4 *) `Arr {loc_start ; content = Ext_array.reverse_of_list acc ; 
+        (* 2 *) `Arr {loc_start ; content = Ext_array.reverse_of_list acc ; 
               loc_end = lexbuf.lex_curr_p }
     | x -> 
-      (* 16 *) push x ;
+      (* 8 *) push x ;
       let new_one = json lexbuf in 
       begin match token ()  with 
       | Comma -> 
-          (* 10 *) parse_array true loc_start loc_finish (new_one :: acc) lexbuf 
+          (* 5 *) parse_array true loc_start loc_finish (new_one :: acc) lexbuf 
       | Rbracket 
-        -> (* 2 *) `Arr {content = (Ext_array.reverse_of_list (new_one::acc));
+        -> (* 1 *) `Arr {content = (Ext_array.reverse_of_list (new_one::acc));
                      loc_start ; 
                      loc_end = lexbuf.lex_curr_p }
       | _ -> 
         (* 0 *) error lexbuf Expect_comma_or_rbracket
       end
   and parse_map trailing_comma acc lexbuf : t = 
-    (* 20 *) match token () with 
+    (* 10 *) match token () with 
     | Rbrace -> 
       (* if trailing_comma then  *)
       (*   error lexbuf Trailing_comma_in_obj *)
       (* else  *)
-        (* 6 *) `Obj acc 
+        (* 3 *) `Obj acc 
     | String key -> 
-      (* 8 *) begin match token () with 
+      (* 4 *) begin match token () with 
       | Colon ->
-        (* 8 *) let value = json lexbuf in
+        (* 4 *) let value = json lexbuf in
         begin match token () with 
         | Rbrace -> (* 0 *) `Obj (String_map.add key value acc )
         | Comma -> 
-          (* 8 *) parse_map true  (String_map.add key value acc) lexbuf 
+          (* 4 *) parse_map true  (String_map.add key value acc) lexbuf 
         | _ -> (* 0 *) error lexbuf Expect_comma_or_rbrace
         end
       | _ -> (* 0 *) error lexbuf Expect_colon
       end
-    | _ -> (* 6 *) error lexbuf Expect_string_or_rbrace
+    | _ -> (* 3 *) error lexbuf Expect_string_or_rbrace
   in 
   let v = json lexbuf in 
   match token () with 
-  | Eof -> (* 12 *) v 
+  | Eof -> (* 6 *) v 
   | _ -> (* 0 *) error lexbuf Expect_eof
 
 let parse_json_from_string s = 
-  (* 22 *) parse_json (Lexing.from_string s )
+  (* 11 *) parse_json (Lexing.from_string s )
 
 let parse_json_from_chan in_chan = 
   (* 0 *) let lexbuf = Lexing.from_channel in_chan in 
@@ -6151,14 +6161,14 @@ type callback =
 let test   ?(fail=(fun () -> ())) key 
     (cb : callback) m 
      =
-     (* 4 *) begin match String_map.find_exn key m, cb with 
+     (* 2 *) begin match String_map.find_exn key m, cb with 
        | exception Not_found  ->
         (* 0 *) begin match cb with `Not_found f ->  (* 0 *) f ()
         | _ -> (* 0 *) fail ()
         end
        | `True, `Bool cb -> (* 0 *) cb true
        | `False, `Bool cb  -> (* 0 *) cb false 
-       | `Flo s , `Flo cb  -> (* 4 *) cb s 
+       | `Flo s , `Flo cb  -> (* 2 *) cb s 
        | `Obj b , `Obj cb -> (* 0 *) cb b 
        | `Arr {content}, `Arr cb -> (* 0 *) cb content 
        | `Arr {content; loc_start ; loc_end}, `Arr_loc cb -> 
@@ -6196,7 +6206,7 @@ let ((>::),
 
 open Bsb_json
 let (|?)  m (key, cb) =
-    (* 4 *) m  |> Bsb_json.test key cb 
+    (* 2 *) m  |> Bsb_json.test key cb 
 
 exception Parse_error 
 let suites = 
@@ -6204,45 +6214,45 @@ let suites =
   >:::
   [
     "empty_json" >:: begin fun _ -> 
-      (* 2 *) let v =parse_json_from_string "{}" in
+      (* 1 *) let v =parse_json_from_string "{}" in
       match v with 
-      | `Obj v -> (* 2 *) OUnit.assert_equal (String_map.is_empty v ) true
+      | `Obj v -> (* 1 *) OUnit.assert_equal (String_map.is_empty v ) true
       | _ -> (* 0 *) OUnit.assert_failure "should be empty"
     end
     ;
     "empty_arr" >:: begin fun _ -> 
-      (* 2 *) let v =parse_json_from_string "[]" in
+      (* 1 *) let v =parse_json_from_string "[]" in
       match v with 
-      | `Arr {content = [||]} -> (* 2 *) ()
+      | `Arr {content = [||]} -> (* 1 *) ()
       | _ -> (* 0 *) OUnit.assert_failure "should be empty"
     end
     ;
     "empty trails" >:: begin fun _ -> 
-      (* 2 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
-       (* 2 *) try parse_json_from_string {| [,]|} with _ -> raise Parse_error);
+      (* 1 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
+       (* 1 *) try parse_json_from_string {| [,]|} with _ -> raise Parse_error);
       OUnit.assert_raises Parse_error @@ fun _ -> 
-        (* 2 *) try parse_json_from_string {| {,}|} with _ -> raise Parse_error
+        (* 1 *) try parse_json_from_string {| {,}|} with _ -> raise Parse_error
     end;
     "two trails" >:: begin fun _ -> 
-      (* 2 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
-       (* 2 *) try parse_json_from_string {| [1,2,,]|} with _ -> raise Parse_error);
+      (* 1 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
+       (* 1 *) try parse_json_from_string {| [1,2,,]|} with _ -> raise Parse_error);
       (OUnit.assert_raises Parse_error @@ fun _ -> 
-       (* 2 *) try parse_json_from_string {| { "x": 3, ,}|} with _ -> raise Parse_error)
+       (* 1 *) try parse_json_from_string {| { "x": 3, ,}|} with _ -> raise Parse_error)
     end;
 
     "two trails fail" >:: begin fun _ -> 
-      (* 2 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
-       (* 2 *) try parse_json_from_string {| { "x": 3, 2 ,}|} with _ -> raise Parse_error)
+      (* 1 *) (OUnit.assert_raises Parse_error @@ fun _ -> 
+       (* 1 *) try parse_json_from_string {| { "x": 3, 2 ,}|} with _ -> raise Parse_error)
     end;
 
     "trail comma obj" >:: begin fun _ -> 
-      (* 2 *) let v =  parse_json_from_string {| { "x" : 3 , }|} in 
+      (* 1 *) let v =  parse_json_from_string {| { "x" : 3 , }|} in 
       let v1 =  parse_json_from_string {| { "x" : 3 , }|} in 
       let test v = 
-        (* 4 *) match v with 
+        (* 2 *) match v with 
         |`Obj v -> 
-          (* 4 *) v
-          |? ("x" , `Flo (fun x -> (* 4 *) OUnit.assert_equal x "3"))
+          (* 2 *) v
+          |? ("x" , `Flo (fun x -> (* 2 *) OUnit.assert_equal x "3"))
           |> ignore 
         | _ -> (* 0 *) OUnit.assert_failure "trail comma" in 
       test v ;
@@ -6250,11 +6260,11 @@ let suites =
     end
     ;
     "trail comma arr" >:: begin fun _ -> 
-      (* 2 *) let v = parse_json_from_string {| [ 1, 3, ]|} in
+      (* 1 *) let v = parse_json_from_string {| [ 1, 3, ]|} in
       let v1 = parse_json_from_string {| [ 1, 3 ]|} in
       let test v = 
-        (* 4 *) match v with 
-        | `Arr { content = [|`Flo "1" ; `Flo "3" |] } -> (* 4 *) ()
+        (* 2 *) match v with 
+        | `Arr { content = [|`Flo "1" ; `Flo "3" |] } -> (* 2 *) ()
         | _ -> (* 0 *) OUnit.assert_failure "trailing comma array" in 
       test v ;
       test v1
@@ -6538,14 +6548,14 @@ let flat_map2 f lx ly =
   aux [] lx ly
 
 let rec flat_map_aux f acc append lx =
-  (* 18 *) match lx with
-  | [] -> (* 6 *) List.rev_append acc append
-  | y::ys -> (* 12 *) flat_map_aux f (List.rev_append ( f y)  acc ) append ys 
+  (* 9 *) match lx with
+  | [] -> (* 3 *) List.rev_append acc append
+  | y::ys -> (* 6 *) flat_map_aux f (List.rev_append ( f y)  acc ) append ys 
 
 let flat_map f lx =
-  (* 2 *) flat_map_aux f [] [] lx
+  (* 1 *) flat_map_aux f [] [] lx
 
-let flat_map_acc f append lx = (* 4 *) flat_map_aux f [] append lx  
+let flat_map_acc f append lx = (* 2 *) flat_map_aux f [] append lx  
 
 let rec map2_last f l1 l2 =
   (* 0 *) match (l1, l2) with
@@ -6768,16 +6778,16 @@ let suites =
   >:::
   [
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) OUnit.assert_equal
-        (Ext_list.flat_map (fun x -> (* 4 *) [x;x]) [1;2]) [1;1;2;2] 
+      (* 1 *) OUnit.assert_equal
+        (Ext_list.flat_map (fun x -> (* 2 *) [x;x]) [1;2]) [1;1;2;2] 
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) OUnit.assert_equal
-        (Ext_list.flat_map_acc (fun x -> (* 4 *) [x;x]) [3;4] [1;2]) [1;1;2;2;3;4] 
+      (* 1 *) OUnit.assert_equal
+        (Ext_list.flat_map_acc (fun x -> (* 2 *) [x;x]) [3;4] [1;2]) [1;1;2;2;3;4] 
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_equal (
-          Ext_list.flat_map_acc (fun x -> (* 4 *) if x mod 2 = 0 then [true] else [])
+      (* 1 *) OUnit.assert_equal (
+          Ext_list.flat_map_acc (fun x -> (* 2 *) if x mod 2 = 0 then [true] else [])
             [false;false] [1;2]
       )  [true;false;false]
     end;
@@ -6855,11 +6865,11 @@ let max_binding_exn = Map_gen.max_binding_exn
 let min_binding_exn = Map_gen.min_binding_exn
 
 
-let rec add x data (tree : _ Map_gen.t as 'a) : 'a = (* 21972 *) match tree with 
+let rec add x data (tree : _ Map_gen.t as 'a) : 'a = (* 10986 *) match tree with 
   | Empty ->
-    (* 2016 *) Node(Empty, x, data, Empty, 1)
+    (* 1008 *) Node(Empty, x, data, Empty, 1)
   | Node(l, v, d, r, h) ->
-    (* 19956 *) let c = compare_key x v in
+    (* 9978 *) let c = compare_key x v in
     if c = 0 then
       Node(l, x, data, r, h)
     else if c < 0 then
@@ -6869,11 +6879,11 @@ let rec add x data (tree : _ Map_gen.t as 'a) : 'a = (* 21972 *) match tree with
 
 
 let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a = 
-  (* 39908 *) match tree with 
+  (* 19954 *) match tree with 
   | Empty ->
-    (* 2000 *) Node(Empty, x, data (), Empty, 1)
+    (* 1000 *) Node(Empty, x, data (), Empty, 1)
   | Node(l, v, d, r, h) ->
-    (* 37908 *) let c = compare_key x v in
+    (* 18954 *) let c = compare_key x v in
     if c = 0 then
       Node(l, x, replace  d , r, h)
     else if c < 0 then
@@ -6974,12 +6984,12 @@ let compare cmp m1 m2 = (* 0 *) Map_gen.compare compare_key cmp m1 m2
 let equal cmp m1 m2 = (* 0 *) Map_gen.equal compare_key cmp m1 m2 
 
 let add_list (xs : _ list ) init = 
-  (* 4 *) List.fold_left (fun acc (k,v) -> (* 16 *) add k v acc) init xs 
+  (* 2 *) List.fold_left (fun acc (k,v) -> (* 8 *) add k v acc) init xs 
 
-let of_list xs = (* 4 *) add_list xs empty
+let of_list xs = (* 2 *) add_list xs empty
 
 let of_array xs = 
-  (* 2 *) Array.fold_left (fun acc (k,v) -> (* 2000 *) add k v acc) empty xs
+  (* 1 *) Array.fold_left (fun acc (k,v) -> (* 1000 *) add k v acc) empty xs
 
 end
 module Ounit_map_tests
@@ -6994,33 +7004,33 @@ let suites =
   __MODULE__ >:::
   [
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) [1,"1"; 2,"2"; 12,"12"; 3, "3"]
+      (* 1 *) [1,"1"; 2,"2"; 12,"12"; 3, "3"]
       |> Int_map.of_list 
       |> Int_map.keys 
       |> OUnit.assert_equal [1;2;3;12]
     end
     ;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) OUnit.assert_equal (Int_map.cardinal Int_map.empty) 0 ;
+      (* 1 *) OUnit.assert_equal (Int_map.cardinal Int_map.empty) 0 ;
       OUnit.assert_equal ([1,"1"; 2,"2"; 12,"12"; 3, "3"]
       |> Int_map.of_list|>Int_map.cardinal )  4
       
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) Int_map.cardinal (Int_map.of_array (Array.init 1000 (fun i -> (* 2000 *) (i,i))))
+      (* 1 *) Int_map.cardinal (Int_map.of_array (Array.init 1000 (fun i -> (* 1000 *) (i,i))))
       =~ 1000
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let count = 1000 in 
-      let a = Array.init count (fun x -> (* 2000 *) x ) in 
+      (* 1 *) let count = 1000 in 
+      let a = Array.init count (fun x -> (* 1000 *) x ) in 
       let v = Int_map.empty in
       let u = 
         begin 
-          let v = Array.fold_left (fun acc key -> (* 2000 *) Int_map.adjust key (fun _ -> (* 2000 *) 1) (succ) acc ) v a   in 
-          Array.fold_left (fun acc key -> (* 2000 *) Int_map.adjust key (fun _ -> (* 0 *) 1) (succ) acc ) v a  
+          let v = Array.fold_left (fun acc key -> (* 1000 *) Int_map.adjust key (fun _ -> (* 1000 *) 1) (succ) acc ) v a   in 
+          Array.fold_left (fun acc key -> (* 1000 *) Int_map.adjust key (fun _ -> (* 0 *) 1) (succ) acc ) v a  
           end
         in  
-       Int_map.iter (fun _ v -> (* 1001 *) v =~ 2 ) u   ;
+       Int_map.iter (fun _ v -> (* 1000 *) v =~ 2 ) u   ;
        Int_map.cardinal u =~ count
     end
   ]
@@ -7039,32 +7049,32 @@ let suites =
   __FILE__
   >::: [
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let a = [|"a";"b";"c"|] in 
+      (* 1 *) let a = [|"a";"b";"c"|] in 
       Ordered_hash_set_string.(to_sorted_array (of_array a))
       =~ a 
     end;
 
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let a = Array.init 1000 (fun i -> (* 2000 *) string_of_int i) in 
+      (* 1 *) let a = Array.init 1000 (fun i -> (* 1000 *) string_of_int i) in 
       Ordered_hash_set_string.(to_sorted_array (of_array a))
       =~ a
     end;
 
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let a = [|"a";"b";"c"; "a"; "d"|] in 
+      (* 1 *) let a = [|"a";"b";"c"; "a"; "d"|] in 
       Ordered_hash_set_string.(to_sorted_array (of_array a))
       =~ [| "a" ; "b"; "c"; "d" |]
     end;
 
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) let b = Array.init 500 (fun i -> (* 1000 *) string_of_int i) in
+      (* 1 *) let b = Array.init 500 (fun i -> (* 500 *) string_of_int i) in
       let a = Array.append b b in 
       Ordered_hash_set_string.(to_sorted_array (of_array a))
       =~ b
     end;
 
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let h = Ordered_hash_set_string.create 1 in
+      (* 1 *) let h = Ordered_hash_set_string.create 1 in
       Ordered_hash_set_string.(to_sorted_array h)
       =~ [||];
       Ordered_hash_set_string.add h "1";
@@ -7075,18 +7085,18 @@ let suites =
     end;
 
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let h = Ordered_hash_set_string.create 1 in
+      (* 1 *) let h = Ordered_hash_set_string.create 1 in
       let count = 3000 in
       for i = 0 to count - 1 do
         Ordered_hash_set_string.add  h (string_of_int i) ;
       done ;
       print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h));
       Ordered_hash_set_string.(to_sorted_array h)
-      =~ (Array.init count (fun i -> (* 6000 *) string_of_int i ))
+      =~ (Array.init count (fun i -> (* 3000 *) string_of_int i ))
     end;
 
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let h = Ordered_hash_set_string.create 1 in
+      (* 1 *) let h = Ordered_hash_set_string.create 1 in
       let count = 1000_000 in
       for i = 0 to count - 1 do
         Ordered_hash_set_string.add  h (string_of_int i) ;
@@ -7098,17 +7108,17 @@ let suites =
         OUnit.assert_equal (Ordered_hash_set_string.rank h (string_of_int i)) i 
       done;  
       OUnit.assert_equal 
-        (Ordered_hash_set_string.fold(fun key rank acc -> (* 2000000 *) assert (string_of_int rank = key); (acc + 1) ) h 0)
+        (Ordered_hash_set_string.fold(fun key rank acc -> (* 1000000 *) assert (string_of_int rank = key); (acc + 1) ) h 0)
         count
       ;         
-      Ordered_hash_set_string.iter (fun key rank -> (* 2000000 *) assert (string_of_int rank = key))  h ; 
+      Ordered_hash_set_string.iter (fun key rank -> (* 1000000 *) assert (string_of_int rank = key))  h ; 
       OUnit.assert_equal (Ordered_hash_set_string.length h) count;
       print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h));
       Ordered_hash_set_string.clear h ; 
       OUnit.assert_equal (Ordered_hash_set_string.length h) 0;
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let count = 1000_000 in
+      (* 1 *) let count = 1000_000 in
       let h = Ordered_hash_set_string.create ( count) in      
       for i = 0 to count - 1 do
         Ordered_hash_set_string.add  h (string_of_int i) ;
@@ -7120,22 +7130,22 @@ let suites =
         OUnit.assert_equal (Ordered_hash_set_string.rank h (string_of_int i)) i 
       done;  
       OUnit.assert_equal 
-        (Ordered_hash_set_string.fold(fun key rank acc -> (* 2000000 *) assert (string_of_int rank = key); (acc + 1) ) h 0)
+        (Ordered_hash_set_string.fold(fun key rank acc -> (* 1000000 *) assert (string_of_int rank = key); (acc + 1) ) h 0)
         count
       ;         
-      Ordered_hash_set_string.iter (fun key rank -> (* 2000000 *) assert (string_of_int rank = key))  h ; 
+      Ordered_hash_set_string.iter (fun key rank -> (* 1000000 *) assert (string_of_int rank = key))  h ; 
       OUnit.assert_equal (Ordered_hash_set_string.length h) count;
       print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h));
       Ordered_hash_set_string.clear h ; 
       OUnit.assert_equal (Ordered_hash_set_string.length h) 0;
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) Ordered_hash_set_string.to_sorted_array (Ordered_hash_set_string.of_array [||]) =~ [||];
+      (* 1 *) Ordered_hash_set_string.to_sorted_array (Ordered_hash_set_string.of_array [||]) =~ [||];
       Ordered_hash_set_string.to_sorted_array (Ordered_hash_set_string.of_array [|"1"|]) =~ [|"1"|]
     end;
 
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) OUnit.assert_raises Not_found (fun _ -> (* 2 *) Ordered_hash_set_string.choose_exn (Ordered_hash_set_string.of_array [||]))
+      (* 1 *) OUnit.assert_raises Not_found (fun _ -> (* 1 *) Ordered_hash_set_string.choose_exn (Ordered_hash_set_string.of_array [||]))
     end;
 
   ]
@@ -7947,8 +7957,8 @@ let combine p1 p2 =
    ]}
 *)
 let split_aux p =
-  (* 24 *) let rec go p acc =
-    (* 154 *) let dir = Filename.dirname p in
+  (* 12 *) let rec go p acc =
+    (* 77 *) let dir = Filename.dirname p in
     if dir = p then dir, acc
     else go dir (Filename.basename p :: acc)
   in go p []
@@ -7995,28 +8005,28 @@ let rel_normalized_absolute_path from to_ =
   ]}
 *)
 let normalize_absolute_path x =
-  (* 24 *) let drop_if_exist xs =
-    (* 22 *) match xs with 
-    | [] -> (* 2 *) []
-    | _ :: xs -> (* 20 *) xs in 
+  (* 12 *) let drop_if_exist xs =
+    (* 11 *) match xs with 
+    | [] -> (* 1 *) []
+    | _ :: xs -> (* 10 *) xs in 
   let rec normalize_list acc paths =
-    (* 154 *) match paths with 
-    | [] -> (* 24 *) acc 
-    | "." :: xs -> (* 32 *) normalize_list acc xs
+    (* 77 *) match paths with 
+    | [] -> (* 12 *) acc 
+    | "." :: xs -> (* 16 *) normalize_list acc xs
     | ".." :: xs -> 
-      (* 22 *) normalize_list (drop_if_exist acc ) xs 
+      (* 11 *) normalize_list (drop_if_exist acc ) xs 
     | x :: xs -> 
-      (* 76 *) normalize_list (x::acc) xs 
+      (* 38 *) normalize_list (x::acc) xs 
   in
   let root, paths = split_aux x in
   let rev_paths =  normalize_list [] paths in 
   let rec go acc rev_paths =
-    (* 56 *) match rev_paths with 
-    | [] -> (* 20 *) Filename.concat root acc 
-    | last::rest ->  (* 36 *) go (Filename.concat last acc ) rest  in 
+    (* 28 *) match rev_paths with 
+    | [] -> (* 10 *) Filename.concat root acc 
+    | last::rest ->  (* 18 *) go (Filename.concat last acc ) rest  in 
   match rev_paths with 
-  | [] -> (* 4 *) root 
-  | last :: rest -> (* 20 *) go last rest 
+  | [] -> (* 2 *) root 
+  | last :: rest -> (* 10 *) go last rest 
 
 
 let get_extension x =
@@ -8041,14 +8051,14 @@ let ((>::),
 
 let normalize = Ext_filename.normalize_absolute_path
 let (=~) x y = 
-  (* 4 *) OUnit.assert_equal ~cmp:(fun x y ->   (* 4 *) String.compare x y = 0) x y
+  (* 2 *) OUnit.assert_equal ~cmp:(fun x y ->   (* 2 *) String.compare x y = 0) x y
     
 let suites = 
   __FILE__ 
   >:::
   [
     "linux path tests" >:: begin fun _ -> 
-      (* 2 *) let norm = 
+      (* 1 *) let norm = 
         Array.map normalize
           [|
             "/gsho/./..";
@@ -8077,10 +8087,10 @@ let suites =
         |]
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) normalize "/./a/.////////j/k//../////..///././b/./c/d/./." =~ "/a/b/c/d"
+      (* 1 *) normalize "/./a/.////////j/k//../////..///././b/./c/d/./." =~ "/a/b/c/d"
     end;
     __LOC__ >:: begin fun _ -> 
-      (* 2 *) normalize "/./a/.////////j/k//../////..///././b/./c/d/././../" =~ "/a/b/c"
+      (* 1 *) normalize "/./a/.////////j/k//../////..///././b/./c/d/././../" =~ "/a/b/c"
     end
   ]
 
@@ -8180,7 +8190,7 @@ type 'a t = {
   mutable len : int ;  
 }
 
-let length d = (* 182 *) d.len
+let length d = (* 91 *) d.len
 
 let compact d =
   (* 0 *) let d_arr = d.arr in 
@@ -8196,7 +8206,7 @@ let singleton v =
   }
 
 let empty () =
-  (* 260 *) {
+  (* 130 *) {
     len = 0;
     arr = [||];
   }
@@ -8220,7 +8230,7 @@ let to_list d =
 
 
 let of_list lst =
-  (* 2 *) let arr = Array.of_list lst in 
+  (* 1 *) let arr = Array.of_list lst in 
   { arr ; len = Array.length arr}
 
 
@@ -8228,7 +8238,7 @@ let to_array d =
   (* 0 *) Array.sub d.arr 0 d.len
 
 let of_array src =
-  (* 32 *) {
+  (* 16 *) {
     len = Array.length src;
     arr = Array.copy src;
     (* okay to call {!Array.copy}*)
@@ -8241,21 +8251,21 @@ let of_sub_array arr off len =
 let unsafe_internal_array v = (* 0 *) v.arr  
 (* we can not call {!Array.copy} *)
 let copy src =
-  (* 2 *) let len = src.len in
+  (* 1 *) let len = src.len in
   {
     len ;
     arr = Array.sub src.arr 0 len ;
   }
 (* FIXME *)
 let reverse_in_place src = 
-  (* 2 *) Ext_array.reverse_range src.arr 0 src.len 
+  (* 1 *) Ext_array.reverse_range src.arr 0 src.len 
 
 let sub src start len =
   (* 0 *) { len ; 
     arr = Array.sub src.arr start len }
 
 let iter f d = 
-  (* 212 *) let arr = d.arr in 
+  (* 106 *) let arr = d.arr in 
   for i = 0 to d.len - 1 do
     f (Array.unsafe_get arr i)
   done
@@ -8283,7 +8293,7 @@ let iteri_range ~from ~to_ f d =
     done
 
 let map_into_array f src =
-  (* 20 *) let src_len = src.len in 
+  (* 10 *) let src_len = src.len in 
   let src_arr = src.arr in 
   if src_len = 0 then [||]
   else 
@@ -8294,7 +8304,7 @@ let map_into_array f src =
     done;
     arr 
 let map_into_list f src = 
-  (* 2 *) let src_len = src.len in 
+  (* 1 *) let src_len = src.len in 
   let src_arr = src.arr in 
   if src_len = 0 then []
   else 
@@ -8319,8 +8329,8 @@ let mapi f src =
     }
 
 let fold_left f x a =
-  (* 18 *) let rec loop a_len a_arr idx x =
-    (* 92 *) if idx >= a_len then x else 
+  (* 9 *) let rec loop a_len a_arr idx x =
+    (* 46 *) if idx >= a_len then x else 
       loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx))
   in
   loop a.len a.arr 0 x
@@ -8336,7 +8346,7 @@ let fold_right f a x =
    [filter] and [inplace_filter]
 *)
 let filter f d =
-  (* 2 *) let new_d = copy d in 
+  (* 1 *) let new_d = copy d in 
   let new_d_arr = new_d.arr in 
   let d_arr = d.arr in
   let p = ref 0 in
@@ -8353,10 +8363,10 @@ let filter f d =
   new_d 
 
 let equal eq x y : bool = 
-  (* 28 *) if x.len <> y.len then false 
+  (* 14 *) if x.len <> y.len then false 
   else 
     let rec aux x_arr y_arr i =
-      (* 170 *) if i < 0 then true else  
+      (* 85 *) if i < 0 then true else  
       if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then 
         aux x_arr y_arr (i - 1)
       else false in 
@@ -8365,12 +8375,12 @@ let equal eq x y : bool =
 let get d i = 
   (* 0 *) if i < 0 || i >= d.len then invalid_arg "Resize_array.get"
   else Array.unsafe_get d.arr i
-let unsafe_get d i = (* 212 *) Array.unsafe_get d.arr i 
+let unsafe_get d i = (* 106 *) Array.unsafe_get d.arr i 
 let last d = 
   (* 0 *) if d.len <= 0 then invalid_arg   "Resize_array.last"
   else Array.unsafe_get d.arr (d.len - 1)
 
-let capacity d = (* 4 *) Array.length d.arr
+let capacity d = (* 2 *) Array.length d.arr
 
 (* Attention can not use {!Array.exists} since the bound is not the same *)  
 let exists p d = 
@@ -8408,7 +8418,7 @@ let map f src =
     }
 
 let init len f =
-  (* 4 *) if len < 0 then invalid_arg  "Resize_array.init"
+  (* 2 *) if len < 0 then invalid_arg  "Resize_array.init"
   else if len = 0 then { len = 0 ; arr = [||] }
   else 
     let first = f 0 in 
@@ -8521,7 +8531,7 @@ let null = 0 (* can be optimized *)
   let init = Vec_gen.init 
 
   let make initsize : _ Vec_gen.t =
-    (* 2 *) if initsize < 0 then invalid_arg  "Resize_array.make" ;
+    (* 1 *) if initsize < 0 then invalid_arg  "Resize_array.make" ;
     {
 
       len = 0;
@@ -8531,7 +8541,7 @@ let null = 0 (* can be optimized *)
 
 
   let reserve (d : _ Vec_gen.t ) s = 
-    (* 2 *) let d_len = d.len in 
+    (* 1 *) let d_len = d.len in 
     let d_arr = d.arr in 
     if s < d_len || s < Array.length d_arr then ()
     else 
@@ -8541,7 +8551,7 @@ let null = 0 (* can be optimized *)
       d.arr <- new_d_arr 
 
   let push v (d : _ Vec_gen.t) =
-    (* 670 *) let d_len = d.len in
+    (* 335 *) let d_len = d.len in
     let d_arr = d.arr in 
     let d_arr_len = Array.length d_arr in
     if d_arr_len = 0 then
@@ -8574,7 +8584,7 @@ let null = 0 (* can be optimized *)
     d.len <- d.len - 1
 
   let pop (d : _ Vec_gen.t) = 
-    (* 2 *) let idx  = d.len - 1  in
+    (* 1 *) let idx  = d.len - 1  in
     if idx < 0 then invalid_arg "Resize_array.pop";
     Array.unsafe_set d.arr idx null;
     d.len <- idx
@@ -8587,7 +8597,7 @@ let null = 0 (* can be optimized *)
     last 
 
   let delete_range (d : _ Vec_gen.t) idx len =
-    (* 6 *) if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
+    (* 3 *) if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
     let arr = d.arr in 
     Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
     for i = d.len - len to d.len - 1 do
@@ -8597,7 +8607,7 @@ let null = 0 (* can be optimized *)
 
 
   let get_and_delete_range (d : _ Vec_gen.t) idx len : _ Vec_gen.t = 
-    (* 90 *) if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
+    (* 45 *) if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
     let arr = d.arr in 
     let value = Array.sub arr idx len in
     Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
@@ -8619,7 +8629,7 @@ let null = 0 (* can be optimized *)
 
 
   let inplace_filter f (d : _ Vec_gen.t) = 
-    (* 6 *) let d_arr = d.arr in 
+    (* 3 *) let d_arr = d.arr in 
     let p = ref 0 in
     for i = 0 to d.len - 1 do 
       let x = Array.unsafe_get d_arr i in 
@@ -8757,7 +8767,7 @@ module Make ( Resize : Vec_gen.ResizeType) = struct
       d.arr <- new_d_arr 
 
   let push v (d : _ Vec_gen.t) =
-    (* 90 *) let d_len = d.len in
+    (* 45 *) let d_len = d.len in
     let d_arr = d.arr in 
     let d_arr_len = Array.length d_arr in
     if d_arr_len = 0 then
@@ -8997,11 +9007,11 @@ type node = Int_vec.t
    Cons:
    1. post processing input data  
  *)
-let min_int (x : int) y = (* 328 *) if x < y then x else y  
+let min_int (x : int) y = (* 164 *) if x < y then x else y  
 
 
 let graph  e =
-  (* 22 *) let index = ref 0 in 
+  (* 11 *) let index = ref 0 in 
   let s = Int_vec.empty () in
 
   let output = Int_vec_vec.empty () in (* collect output *)
@@ -9012,7 +9022,7 @@ let graph  e =
   let lowlink_array = Array.make node_numes (-1) in
   
   let rec scc v_data  =
-    (* 212 *) let new_index = !index + 1 in 
+    (* 106 *) let new_index = !index + 1 in 
     index := new_index ;
     Int_vec.push  v_data s ; 
 
@@ -9023,7 +9033,7 @@ let graph  e =
     let v = e.(v_data) in 
     v
     |> Int_vec.iter (fun w_data  ->
-        (* 430 *) if Array.unsafe_get index_array w_data < 0 then (* not processed *)
+        (* 215 *) if Array.unsafe_get index_array w_data < 0 then (* not processed *)
           begin  
             scc w_data;
             Array.unsafe_set lowlink_array v_data  
@@ -9058,9 +9068,9 @@ let graph  e =
   output 
 
 let graph_check v = 
-  (* 18 *) let v = graph v in 
+  (* 9 *) let v = graph v in 
   Int_vec_vec.length v, 
-  Int_vec_vec.fold_left (fun acc x -> (* 74 *) Int_vec.length x :: acc ) [] v  
+  Int_vec_vec.fold_left (fun acc x -> (* 37 *) Int_vec.length x :: acc ) [] v  
 
 end
 module Ounit_scc_tests
@@ -9255,18 +9265,18 @@ http://algs4.cs.princeton.edu/42digraph/KosarajuSharirSCC.java.html
 *)
 
 let handle_lines tiny_test_cases = 
-  (* 4 *) match Ext_string.split  tiny_test_cases '\n' with 
+  (* 2 *) match Ext_string.split  tiny_test_cases '\n' with 
   | nodes :: edges :: rest -> 
-    (* 4 *) let nodes_num = int_of_string nodes in 
+    (* 2 *) let nodes_num = int_of_string nodes in 
     let node_array = 
       Array.init nodes_num
-        (fun i -> (* 126 *) Int_vec.empty () )
+        (fun i -> (* 63 *) Int_vec.empty () )
     in 
     begin 
       rest |> List.iter (fun x ->
-          (* 338 *) match Ext_string.split x ' ' with 
+          (* 169 *) match Ext_string.split x ' ' with 
           | [ a ; b] -> 
-            (* 338 *) let a , b = int_of_string a , int_of_string b in 
+            (* 169 *) let a , b = int_of_string a , int_of_string b in 
             Int_vec.push  b node_array.(a) 
           | _ -> (* 0 *) assert false 
         );
@@ -9297,69 +9307,69 @@ let read_file file =
 let test  (input : (string * string list) list) = 
   (* string -> int mapping 
   *)
-  (* 14 *) let tbl = Hashtbl.create 32 in
+  (* 7 *) let tbl = Hashtbl.create 32 in
   let idx = ref 0 in 
   let add x =
-    (* 142 *) if not (Hashtbl.mem tbl x ) then 
+    (* 71 *) if not (Hashtbl.mem tbl x ) then 
       begin 
         Hashtbl.add  tbl x !idx ;
         incr idx 
       end in
   input |> List.iter 
-    (fun (x,others) -> (* 68 *) List.iter add (x::others));
+    (fun (x,others) -> (* 34 *) List.iter add (x::others));
   let nodes_num = Hashtbl.length tbl in
   let node_array = 
       Array.init nodes_num
-        (fun i -> (* 68 *) Int_vec.empty () ) in 
+        (fun i -> (* 34 *) Int_vec.empty () ) in 
   input |> 
   List.iter (fun (x,others) -> 
-      (* 68 *) let idx = Hashtbl.find tbl  x  in 
+      (* 34 *) let idx = Hashtbl.find tbl  x  in 
       others |> 
-      List.iter (fun y -> (* 74 *) Int_vec.push (Hashtbl.find tbl y ) node_array.(idx) )
+      List.iter (fun y -> (* 37 *) Int_vec.push (Hashtbl.find tbl y ) node_array.(idx) )
     ) ; 
   Ext_scc.graph_check node_array 
 
 let test2  (input : (string * string list) list) = 
   (* string -> int mapping 
   *)
-  (* 4 *) let tbl = Hashtbl.create 32 in
+  (* 2 *) let tbl = Hashtbl.create 32 in
   let idx = ref 0 in 
   let add x =
-    (* 36 *) if not (Hashtbl.mem tbl x ) then 
+    (* 18 *) if not (Hashtbl.mem tbl x ) then 
       begin 
         Hashtbl.add  tbl x !idx ;
         incr idx 
       end in
   input |> List.iter 
-    (fun (x,others) -> (* 18 *) List.iter add (x::others));
+    (fun (x,others) -> (* 9 *) List.iter add (x::others));
   let nodes_num = Hashtbl.length tbl in
   let other_mapping = Array.make nodes_num "" in 
-  Hashtbl.iter (fun k v  -> (* 18 *) other_mapping.(v) <- k ) tbl ;
+  Hashtbl.iter (fun k v  -> (* 9 *) other_mapping.(v) <- k ) tbl ;
   
   let node_array = 
       Array.init nodes_num
-        (fun i -> (* 18 *) Int_vec.empty () ) in 
+        (fun i -> (* 9 *) Int_vec.empty () ) in 
   input |> 
   List.iter (fun (x,others) -> 
-      (* 18 *) let idx = Hashtbl.find tbl  x  in 
+      (* 9 *) let idx = Hashtbl.find tbl  x  in 
       others |> 
-      List.iter (fun y -> (* 18 *) Int_vec.push (Hashtbl.find tbl y ) node_array.(idx) )
+      List.iter (fun y -> (* 9 *) Int_vec.push (Hashtbl.find tbl y ) node_array.(idx) )
     )  ;
   let output = Ext_scc.graph node_array in 
-  output |> Int_vec_vec.map_into_array (fun int_vec -> (* 16 *) Int_vec.map_into_array (fun i -> (* 18 *) other_mapping.(i)) int_vec )
+  output |> Int_vec_vec.map_into_array (fun int_vec -> (* 8 *) Int_vec.map_into_array (fun i -> (* 9 *) other_mapping.(i)) int_vec )
 
 
 let suites = 
     __FILE__
     >::: [
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines tiny_test_cases))  5
+        (* 1 *) OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines tiny_test_cases))  5
       end       ;
       __LOC__ >:: begin fun _ -> 
-        (* 2 *) OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines medium_test_cases))  10
+        (* 1 *) OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines medium_test_cases))  10
       end       ;
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9367,7 +9377,7 @@ let suites =
           ]) (3 , [1;2;1])
       end ; 
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9389,7 +9399,7 @@ let suites =
           *)
       end ;
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9398,7 +9408,7 @@ let suites =
           ]) (4 , [1;2;1;1])
       end ; 
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9407,7 +9417,7 @@ let suites =
           ]) (2, [1;4])
       end ;
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9416,7 +9426,7 @@ let suites =
           ]) (1, [5])
       end ; 
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "a", ["b"];
             "b" , ["c" ];
             "c", [ ];
@@ -9425,7 +9435,7 @@ let suites =
           ]) (5, [1;1;1;1;1])
       end ; 
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test [
+        (* 1 *) OUnit.assert_equal (test [
             "1", ["0"];
             "0" , ["2" ];
             "2", ["1" ];
@@ -9439,7 +9449,7 @@ let suites =
       (* end *)
       (* ; *)
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test2 [
+        (* 1 *) OUnit.assert_equal (test2 [
             "a", ["b" ; "c"];
             "b" , ["c" ; "d"];
             "c", [ "b"];
@@ -9448,7 +9458,7 @@ let suites =
       end ;
 
       __LOC__ >:: begin fun _ ->
-        (* 2 *) OUnit.assert_equal (test2 [
+        (* 1 *) OUnit.assert_equal (test2 [
             "a", ["b"];
             "b" , ["c" ];
             "c", ["d" ];
@@ -9475,11 +9485,11 @@ let suites =
     __FILE__ >::: 
     [
         __LOC__ >:: begin fun _ ->
-            (* 2 *) OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 )
+            (* 1 *) OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 )
         end;
 
         __LOC__ >:: begin fun _ -> 
-            (* 2 *) Ext_string.rindex_neg "hello" 'h' =~ 0 ;
+            (* 1 *) Ext_string.rindex_neg "hello" 'h' =~ 0 ;
             Ext_string.rindex_neg "hello" 'e' =~ 1 ;
             Ext_string.rindex_neg "hello" 'l' =~ 3 ;
             Ext_string.rindex_neg "hello" 'l' =~ 3 ;
@@ -9487,19 +9497,19 @@ let suites =
         end;
 
         __LOC__ >:: begin fun _ -> 
-            (* 2 *) OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 )
+            (* 1 *) OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 )
         end;
 
         __LOC__ >:: begin fun _ -> 
-            (* 2 *) OUnit.assert_bool __LOC__
+            (* 1 *) OUnit.assert_bool __LOC__
             (Ext_string.for_all_range "xABc"~start:1
-            ~finish:3 (function 'A' .. 'Z' -> (* 4 *) true | _ -> (* 0 *) false));
+            ~finish:3 (function 'A' .. 'Z' -> (* 2 *) true | _ -> (* 0 *) false));
             OUnit.assert_bool __LOC__
             (not (Ext_string.for_all_range "xABc"~start:1
-            ~finish:4 (function 'A' .. 'Z' -> (* 4 *) true | _ -> (* 2 *) false)));
+            ~finish:4 (function 'A' .. 'Z' -> (* 2 *) true | _ -> (* 1 *) false)));
             OUnit.assert_bool __LOC__
             ( (Ext_string.for_all_range "xABc"~start:1
-            ~finish:2 (function 'A' .. 'Z' -> (* 2 *) true | _ -> (* 0 *) false)));
+            ~finish:2 (function 'A' .. 'Z' -> (* 1 *) true | _ -> (* 0 *) false)));
             OUnit.assert_bool __LOC__
             ( (Ext_string.for_all_range "xABc"~start:1
             ~finish:1 (function 'A' .. 'Z' -> (* 0 *) true | _ -> (* 0 *) false)));
@@ -9509,7 +9519,7 @@ let suites =
         end;
 
         __LOC__ >:: begin fun _ -> 
-            (* 2 *) OUnit.assert_bool __LOC__ @@
+            (* 1 *) OUnit.assert_bool __LOC__ @@
              List.for_all Ext_string.is_valid_source_name
             ["x.ml"; "x.mli"; "x.re"; "x.rei"; "x.mll"; 
             "A_x.ml"; "ab.ml"; "a_.ml"; "a__.ml";
@@ -9595,7 +9605,7 @@ type t = {
 } 
 
 let init n = 
-  (* 4 *) let id = Array.make n 0 in 
+  (* 2 *) let id = Array.make n 0 in 
   for i = 0 to  n - 1 do
     Array.unsafe_set id i i  
   done  ;
@@ -9606,7 +9616,7 @@ let init n =
   }
 
 let rec find_aux id_store p = 
-  (* 7372 *) let parent = Array.unsafe_get id_store p in 
+  (* 3686 *) let parent = Array.unsafe_get id_store p in 
   if p <> parent then 
     find_aux id_store parent 
   else p       
@@ -9614,7 +9624,7 @@ let rec find_aux id_store p =
 let find store p = (* 0 *) find_aux store.id p 
 
 let union store p q =
-  (* 1822 *) let id_store = store.id in 
+  (* 911 *) let id_store = store.id in 
   let p_root = find_aux id_store p in 
   let q_root = find_aux id_store q in 
   if p_root <> q_root then 
@@ -9645,7 +9655,7 @@ let union store p q =
         end
     end 
 
-let count store = (* 4 *) store.components    
+let count store = (* 2 *) store.components    
 
 
 end
@@ -10574,16 +10584,16 @@ let mediumUF = {|625
 
 
 let process_str tinyUF = 
-  (* 4 *) match Ext_string.split tinyUF '\n' with 
+  (* 2 *) match Ext_string.split tinyUF '\n' with 
   | number :: rest ->
-    (* 4 *) let n = int_of_string number in
+    (* 2 *) let n = int_of_string number in
     let store = Union_find.init n in
     List.iter (fun x ->
-        (* 1826 *) match Ext_string.quick_split_by_ws x with 
+        (* 913 *) match Ext_string.quick_split_by_ws x with 
         | [a;b] ->
-          (* 1822 *) let a,b = int_of_string a , int_of_string b in 
+          (* 911 *) let a,b = int_of_string a , int_of_string b in 
           Union_find.union store a b 
-        | _ -> (* 4 *) ()) rest;
+        | _ -> (* 2 *) ()) rest;
     Union_find.count store
   | _ -> (* 0 *) assert false
 ;;        
@@ -10624,10 +10634,10 @@ let suites =
   >:::
   [
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_equal (process_str tinyUF) 2
+      (* 1 *) OUnit.assert_equal (process_str tinyUF) 2
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) OUnit.assert_equal (process_str mediumUF) 3
+      (* 1 *) OUnit.assert_equal (process_str mediumUF) 3
     end;
 (*
    __LOC__ >:: begin fun _ ->
@@ -10645,31 +10655,31 @@ let ((>::),
 
 open Bsb_json
 
-let v = Int_vec.init 10 (fun i -> (* 20 *) i);;
+let v = Int_vec.init 10 (fun i -> (* 10 *) i);;
 let (=~) x y = (* 0 *) OUnit.assert_equal ~cmp:(Int_vec.equal  (fun (x: int) y -> (* 0 *) x=y)) x y
 let (=~~) x y 
   = 
-  (* 28 *) OUnit.assert_equal ~cmp:(Int_vec.equal  (fun (x: int) y -> (* 142 *) x=y)) x (Int_vec.of_array y) 
+  (* 14 *) OUnit.assert_equal ~cmp:(Int_vec.equal  (fun (x: int) y -> (* 71 *) x=y)) x (Int_vec.of_array y) 
 
 let suites = 
   __FILE__ 
   >:::
   [
     "inplace_filter" >:: begin fun _ -> 
-      (* 2 *) v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|];
+      (* 1 *) v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|];
       ignore @@ Int_vec.push  32 v;
       v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 32|];
-      Int_vec.inplace_filter (fun x -> (* 22 *) x mod 2 = 0) v ;
+      Int_vec.inplace_filter (fun x -> (* 11 *) x mod 2 = 0) v ;
       v =~~ [|0; 2; 4; 6; 8; 32|];
-      Int_vec.inplace_filter (fun x -> (* 12 *) x mod 3 = 0) v ;
+      Int_vec.inplace_filter (fun x -> (* 6 *) x mod 3 = 0) v ;
       v =~~ [|0;6|];
-      Int_vec.inplace_filter (fun x -> (* 4 *) x mod 3 <> 0) v ;
+      Int_vec.inplace_filter (fun x -> (* 2 *) x mod 3 <> 0) v ;
       v =~~ [||]
     end
     ;
     "filter" >:: begin fun _ -> 
-      (* 2 *) let v = Int_vec.of_array [|1;2;3;4;5;6|] in 
-      v |> Int_vec.filter (fun x -> (* 12 *) x mod 3 = 0) |> (fun x -> (* 2 *) x =~~ [|3;6|]);
+      (* 1 *) let v = Int_vec.of_array [|1;2;3;4;5;6|] in 
+      v |> Int_vec.filter (fun x -> (* 6 *) x mod 3 = 0) |> (fun x -> (* 1 *) x =~~ [|3;6|]);
       v =~~ [|1;2;3;4;5;6|];
       Int_vec.pop v ; 
       v =~~ [|1;2;3;4;5|]
@@ -10677,7 +10687,7 @@ let suites =
     ;
 
     "capacity" >:: begin fun _ -> 
-      (* 2 *) let v = Int_vec.of_array [|3|] in 
+      (* 1 *) let v = Int_vec.of_array [|3|] in 
       Int_vec.reserve v 10 ;
       v =~~ [|3 |];
       Int_vec.push 1 v ;
@@ -10695,21 +10705,21 @@ let suites =
     end
     ;
     __LOC__  >:: begin fun _ -> 
-      (* 2 *) let empty = Int_vec.empty () in 
+      (* 1 *) let empty = Int_vec.empty () in 
       Int_vec.push   3 empty;
       empty =~~ [|3|];
 
     end
     ;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let lst = [1;2;3;4] in 
+      (* 1 *) let lst = [1;2;3;4] in 
       let v = Int_vec.of_list lst in 
       OUnit.assert_equal 
-        (Int_vec.map_into_list (fun x -> (* 8 *) x + 1) v)
-        (List.map (fun x -> (* 8 *) x + 1) lst)  
+        (Int_vec.map_into_list (fun x -> (* 4 *) x + 1) v)
+        (List.map (fun x -> (* 4 *) x + 1) lst)  
     end;
     __LOC__ >:: begin fun _ ->
-      (* 2 *) let v = Int_vec.make 4 in 
+      (* 1 *) let v = Int_vec.make 4 in 
       Int_vec.push 1 v;
       Int_vec.push 2 v;
       Int_vec.reverse_in_place v;
@@ -10729,7 +10739,7 @@ end = struct
 
 
 module Int_array = Resize_array.Make(struct type t = int let null = 0 end);;
-let v = Int_array.init 10 (fun i -> (* 20 *) i);;
+let v = Int_array.init 10 (fun i -> (* 10 *) i);;
 
 let ((>::),
     (>:::)) = OUnit.((>::),(>:::))
diff --git a/jscomp/bin/all_ounit_tests.ml b/jscomp/bin/all_ounit_tests.ml
index 408287ef1c..eba6c154af 100644
--- a/jscomp/bin/all_ounit_tests.ml
+++ b/jscomp/bin/all_ounit_tests.ml
@@ -4158,22 +4158,32 @@ let suites =
       (*    bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *)
     end ;
     __LOC__ >:: begin fun _ -> 
-      let module Hash_set = Id_hash_set in 
-      let v = Hash_set.create 30 in 
+      let v = Id_hash_set.create 30 in 
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done ;
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done  ; 
       for i = 0 to 2_000 do 
-        assert (Hash_set.mem v {name = "x"; stamp = i})
+        assert (Id_hash_set.mem v {name = "x"; stamp = i})
       done;  
-      OUnit.assert_equal (Hash_set.length v)  2_001;
+      OUnit.assert_equal (Id_hash_set.length v)  2_001;
       for i =  1990 to 3_000 do 
-        Hash_set.remove v {name = "x"; stamp = i}
+        Id_hash_set.remove v {name = "x"; stamp = i}
       done ;
-      OUnit.assert_equal (Hash_set.length v) 1990;
+      OUnit.assert_equal (Id_hash_set.length v) 1990;
+      for i = 1000 to 3990 do 
+        Id_hash_set.remove v { name = "x"; stamp = i }
+      done;
+      OUnit.assert_equal (Id_hash_set.length v) 1000;
+      for i = 1000 to 1100 do 
+        Id_hash_set.add v { name = "x"; stamp = i};
+      done;
+      OUnit.assert_equal (Id_hash_set.length v ) 1101;
+      for i = 0 to 1100 do 
+        OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i})
+      done  
       (* OUnit.assert_equal (Hash_set.stats v) *)
       (*   {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *)
       (*    bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *)
diff --git a/jscomp/bin/whole_compiler.d b/jscomp/bin/whole_compiler.d
index 0203ca7f2f..eec848b562 100644
--- a/jscomp/bin/whole_compiler.d
+++ b/jscomp/bin/whole_compiler.d
@@ -136,26 +136,6 @@ bin/whole_compiler.ml : ../ocaml/driver/compmisc.ml
 bin/whole_compiler.ml : ../ocaml/driver/compmisc.mli
 bin/whole_compiler.ml : common/ext_log.ml
 bin/whole_compiler.ml : common/ext_log.mli
-bin/whole_compiler.ml : ext/hash_set_gen.ml
-bin/whole_compiler.ml : ext/string_hash_set.ml
-bin/whole_compiler.ml : ext/string_hash_set.mli
-bin/whole_compiler.ml : ext/ext_ident.ml
-bin/whole_compiler.ml : ext/ext_ident.mli
-bin/whole_compiler.ml : ext/ident_map.ml
-bin/whole_compiler.ml : ext/ident_map.mli
-bin/whole_compiler.ml : ext/set_gen.ml
-bin/whole_compiler.ml : ext/ident_set.ml
-bin/whole_compiler.ml : ext/ident_set.mli
-bin/whole_compiler.ml : core/js_call_info.ml
-bin/whole_compiler.ml : core/js_call_info.mli
-bin/whole_compiler.ml : core/js_closure.ml
-bin/whole_compiler.ml : core/js_closure.mli
-bin/whole_compiler.ml : core/js_fun_env.ml
-bin/whole_compiler.ml : core/js_fun_env.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/lambda.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/lambda.mli
-bin/whole_compiler.ml : core/js_op.ml
-bin/whole_compiler.ml : core/j.ml
 bin/whole_compiler.ml : ext/ext_array.ml
 bin/whole_compiler.ml : ext/ext_array.mli
 bin/whole_compiler.ml : ext/vec_gen.ml
@@ -167,8 +147,18 @@ bin/whole_compiler.ml : ext/int_vec_vec.ml
 bin/whole_compiler.ml : ext/int_vec_vec.mli
 bin/whole_compiler.ml : ext/ext_scc.ml
 bin/whole_compiler.ml : ext/ext_scc.mli
+bin/whole_compiler.ml : ext/hash_set_gen.ml
+bin/whole_compiler.ml : ext/string_hash_set.ml
+bin/whole_compiler.ml : ext/string_hash_set.mli
+bin/whole_compiler.ml : ext/ext_ident.ml
+bin/whole_compiler.ml : ext/ext_ident.mli
 bin/whole_compiler.ml : ext/ident_hash_set.ml
 bin/whole_compiler.ml : ext/ident_hash_set.mli
+bin/whole_compiler.ml : ext/set_gen.ml
+bin/whole_compiler.ml : ext/ident_set.ml
+bin/whole_compiler.ml : ext/ident_set.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/lambda.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/lambda.mli
 bin/whole_compiler.ml : core/ocaml_stdlib_slots.ml
 bin/whole_compiler.ml : ext/ordered_hash_map_gen.ml
 bin/whole_compiler.ml : ext/ordered_hash_map_local_ident.ml
@@ -177,14 +167,18 @@ bin/whole_compiler.ml : core/lam.ml
 bin/whole_compiler.ml : core/lam.mli
 bin/whole_compiler.ml : core/js_cmj_format.ml
 bin/whole_compiler.ml : core/js_cmj_format.mli
-bin/whole_compiler.ml : ext/ext_pp.ml
-bin/whole_compiler.ml : ext/ext_pp.mli
-bin/whole_compiler.ml : ext/ext_int.ml
-bin/whole_compiler.ml : ext/ext_int.mli
-bin/whole_compiler.ml : ext/int_map.ml
-bin/whole_compiler.ml : ext/int_map.mli
-bin/whole_compiler.ml : ext/ext_pp_scope.ml
-bin/whole_compiler.ml : ext/ext_pp_scope.mli
+bin/whole_compiler.ml : core/config_util.ml
+bin/whole_compiler.ml : core/config_util.mli
+bin/whole_compiler.ml : ext/hash_set_poly.ml
+bin/whole_compiler.ml : ext/hash_set_poly.mli
+bin/whole_compiler.ml : core/js_call_info.ml
+bin/whole_compiler.ml : core/js_call_info.mli
+bin/whole_compiler.ml : core/js_closure.ml
+bin/whole_compiler.ml : core/js_closure.mli
+bin/whole_compiler.ml : core/js_fun_env.ml
+bin/whole_compiler.ml : core/js_fun_env.mli
+bin/whole_compiler.ml : core/js_op.ml
+bin/whole_compiler.ml : core/j.ml
 bin/whole_compiler.ml : core/js_fold.ml
 bin/whole_compiler.ml : core/js_analyzer.ml
 bin/whole_compiler.ml : core/js_analyzer.mli
@@ -194,12 +188,10 @@ bin/whole_compiler.ml : core/lam_compile_util.ml
 bin/whole_compiler.ml : core/lam_compile_util.mli
 bin/whole_compiler.ml : core/js_exp_make.ml
 bin/whole_compiler.ml : core/js_exp_make.mli
-bin/whole_compiler.ml : core/js_number.ml
-bin/whole_compiler.ml : core/js_number.mli
-bin/whole_compiler.ml : core/config_util.ml
-bin/whole_compiler.ml : core/config_util.mli
 bin/whole_compiler.ml : ext/ident_hashtbl.ml
 bin/whole_compiler.ml : ext/ident_hashtbl.mli
+bin/whole_compiler.ml : ext/ident_map.ml
+bin/whole_compiler.ml : ext/ident_map.mli
 bin/whole_compiler.ml : core/lam_analysis.ml
 bin/whole_compiler.ml : core/lam_analysis.mli
 bin/whole_compiler.ml : ext/hashtbl_make.ml
@@ -208,6 +200,8 @@ bin/whole_compiler.ml : core/lam_module_ident.ml
 bin/whole_compiler.ml : core/lam_module_ident.mli
 bin/whole_compiler.ml : core/lam_print.ml
 bin/whole_compiler.ml : core/lam_print.mli
+bin/whole_compiler.ml : ext/ext_int.ml
+bin/whole_compiler.ml : ext/ext_int.mli
 bin/whole_compiler.ml : ext/int_hash_set.ml
 bin/whole_compiler.ml : ext/int_hash_set.mli
 bin/whole_compiler.ml : core/lam_stats.ml
@@ -216,13 +210,35 @@ bin/whole_compiler.ml : core/lam_util.ml
 bin/whole_compiler.ml : core/lam_util.mli
 bin/whole_compiler.ml : core/js_stmt_make.ml
 bin/whole_compiler.ml : core/js_stmt_make.mli
-bin/whole_compiler.ml : ext/hash_set_poly.ml
-bin/whole_compiler.ml : ext/hash_set_poly.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/printlambda.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/printlambda.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/switch.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/switch.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/typeopt.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/typeopt.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/matching.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/matching.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/translobj.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/translobj.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/translcore.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/translcore.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/translclass.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/translclass.mli
+bin/whole_compiler.ml : ../ocaml/bytecomp/translmod.ml
+bin/whole_compiler.ml : ../ocaml/bytecomp/translmod.mli
 bin/whole_compiler.ml : core/type_int_to_string.ml
 bin/whole_compiler.ml : core/type_util.ml
 bin/whole_compiler.ml : core/type_util.mli
 bin/whole_compiler.ml : core/lam_compile_env.ml
 bin/whole_compiler.ml : core/lam_compile_env.mli
+bin/whole_compiler.ml : ext/ext_pp.ml
+bin/whole_compiler.ml : ext/ext_pp.mli
+bin/whole_compiler.ml : ext/int_map.ml
+bin/whole_compiler.ml : ext/int_map.mli
+bin/whole_compiler.ml : ext/ext_pp_scope.ml
+bin/whole_compiler.ml : ext/ext_pp_scope.mli
+bin/whole_compiler.ml : core/js_number.ml
+bin/whole_compiler.ml : core/js_number.mli
 bin/whole_compiler.ml : core/js_program_loader.ml
 bin/whole_compiler.ml : core/js_program_loader.mli
 bin/whole_compiler.ml : core/js_dump.ml
@@ -332,22 +348,6 @@ bin/whole_compiler.ml : ext/ext_option.ml
 bin/whole_compiler.ml : ext/ext_option.mli
 bin/whole_compiler.ml : core/lam_stats_export.ml
 bin/whole_compiler.ml : core/lam_stats_export.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/printlambda.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/printlambda.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/switch.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/switch.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/typeopt.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/typeopt.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/matching.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/matching.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/translobj.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/translobj.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/translcore.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/translcore.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/translclass.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/translclass.mli
-bin/whole_compiler.ml : ../ocaml/bytecomp/translmod.ml
-bin/whole_compiler.ml : ../ocaml/bytecomp/translmod.mli
 bin/whole_compiler.ml : core/lam_compile_group.ml
 bin/whole_compiler.ml : core/lam_compile_group.mli
 bin/whole_compiler.ml : ../ocaml/parsing/parse.ml
diff --git a/jscomp/bin/whole_compiler.ml b/jscomp/bin/whole_compiler.ml
index dac0280996..2ed3379f73 100644
--- a/jscomp/bin/whole_compiler.ml
+++ b/jscomp/bin/whole_compiler.ml
@@ -57162,9 +57162,8 @@ let iinfo b str f  =
 
 
 end
-module Hash_set_gen
-= struct
-#1 "hash_set_gen.ml"
+module Ext_array : sig 
+#1 "ext_array.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -57190,148 +57189,45 @@ module Hash_set_gen
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-(* We do dynamic hashing, and resize the table and rehash the elements
-   when buckets become too long. *)
-
-type 'a t =
-  { mutable size: int;                        (* number of entries *)
-    mutable data: 'a list array;  (* the buckets *)
-    initial_size: int;                        (* initial array size *)
-  }
-
-
-
 
-let create  initial_size =
-  let s = Ext_util.power_2_above 16 initial_size in
-  { initial_size = s; size = 0; data = Array.make s [] }
-
-let clear h =
-  h.size <- 0;
-  let len = Array.length h.data in
-  for i = 0 to len - 1 do
-    Array.unsafe_set h.data i  []
-  done
-
-let reset h =
-  h.size <- 0;
-  h.data <- Array.make h.initial_size [ ]
 
 
-let copy h = { h with data = Array.copy h.data }
 
-let length h = h.size
+(** Some utilities for {!Array} operations *)
+val reverse_range : 'a array -> int -> int -> unit
+val reverse_in_place : 'a array -> unit
+val reverse : 'a array -> 'a array 
+val reverse_of_list : 'a list -> 'a array
 
-let iter f h =
-  let rec do_bucket = function
-    | [ ] ->
-      ()
-    | k ::  rest ->
-      f k ; do_bucket rest in
-  let d = h.data in
-  for i = 0 to Array.length d - 1 do
-    do_bucket (Array.unsafe_get d i)
-  done
+val filter : ('a -> bool) -> 'a array -> 'a array
 
-let fold f h init =
-  let rec do_bucket b accu =
-    match b with
-      [ ] ->
-      accu
-    | k ::  rest ->
-      do_bucket rest (f k  accu) in
-  let d = h.data in
-  let accu = ref init in
-  for i = 0 to Array.length d - 1 do
-    accu := do_bucket (Array.unsafe_get d i) !accu
-  done;
-  !accu
+val filter_map : ('a -> 'b option) -> 'a array -> 'b array
 
-let resize indexfun h =
-  let odata = h.data in
-  let osize = Array.length odata in
-  let nsize = osize * 2 in
-  if nsize < Sys.max_array_length then begin
-    let ndata = Array.make nsize [ ] in
-    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
-    let rec insert_bucket = function
-        [ ] -> ()
-      | key :: rest ->
-        let nidx = indexfun h key in
-        ndata.(nidx) <- key :: ndata.(nidx);
-        insert_bucket rest
-    in
-    for i = 0 to osize - 1 do
-      insert_bucket (Array.unsafe_get odata i)
-    done
-  end
+val range : int -> int -> int array
 
-let elements set = 
-  fold  (fun k  acc ->  k :: acc) set []
+val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array
 
+val to_list_map : ('a -> 'b option) -> 'a array -> 'b list 
 
+val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int
 
 
-let stats h =
-  let mbl =
-    Array.fold_left (fun m b -> max m (List.length b)) 0 h.data in
-  let histo = Array.make (mbl + 1) 0 in
-  Array.iter
-    (fun b ->
-       let l = List.length b in
-       histo.(l) <- histo.(l) + 1)
-    h.data;
-  {Hashtbl.num_bindings = h.size;
-   num_buckets = Array.length h.data;
-   max_bucket_length = mbl;
-   bucket_histogram = histo }
+type 'a split = [ `No_split | `Split of 'a array * 'a array ]
 
-let rec small_bucket_mem eq_key key lst =
-  match lst with 
-  | [] -> false 
-  | key1::rest -> 
-    eq_key key   key1 ||
-    match rest with 
-    | [] -> false 
-    | key2 :: rest -> 
-      eq_key key   key2 ||
-      match rest with 
-      | [] -> false 
-      | key3 :: rest -> 
-        eq_key key   key3 ||
-        small_bucket_mem eq_key key rest 
+val rfind_and_split : 
+  'a array ->
+  ('a -> 'b -> bool) ->
+  'b -> 'a split
 
-let rec remove_bucket eq_key key (h : _ t) buckets = 
-  match buckets with 
-  | [ ] ->
-    [ ]
-  | k :: next ->
-    if  eq_key k   key
-    then begin h.size <- h.size - 1; next end
-    else k :: remove_bucket eq_key key h next    
+val find_and_split : 
+  'a array ->
+  ('a -> 'b -> bool) ->
+  'b -> 'a split
 
-module type S =
-sig
-  type key
-  type t
-  val create: int ->  t
-  val clear : t -> unit
-  val reset : t -> unit
-  val copy: t -> t
-  val remove:  t -> key -> unit
-  val add :  t -> key -> unit
-  val check_add : t -> key -> bool
-  val mem :  t -> key -> bool
-  val iter: (key -> unit) ->  t -> unit
-  val fold: (key -> 'b -> 'b) ->  t -> 'b -> 'b
-  val length:  t -> int
-  val stats:  t -> Hashtbl.statistics
-  val elements : t -> key list 
-end
+val exists : ('a -> bool) -> 'a array -> bool 
 
-end
-module String_hash_set : sig 
-#1 "string_hash_set.mli"
+end = struct
+#1 "ext_array.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -57357,94 +57253,147 @@ module String_hash_set : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-include Hash_set_gen.S with type key = string
 
-end = struct
-#1 "string_hash_set.ml"
-# 1 "ext/hash_set.cppo.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-# 31
-type key = string 
-let key_index (h :  _ Hash_set_gen.t ) (key : key) =
-  (Bs_hash_stubs.hash_string  key) land (Array.length h.data - 1)
-let eq_key = Ext_string.equal 
-type  t = key  Hash_set_gen.t 
 
 
-# 59
-let create = Hash_set_gen.create
-let clear = Hash_set_gen.clear
-let reset = Hash_set_gen.reset
-let copy = Hash_set_gen.copy
-let iter = Hash_set_gen.iter
-let fold = Hash_set_gen.fold
-let length = Hash_set_gen.length
-let stats = Hash_set_gen.stats
-let elements = Hash_set_gen.elements
+let reverse_range a i len =
+  if len=0 then ()
+  else
+    for k = 0 to (len-1)/2 do
+      let t = Array.unsafe_get a (i+k) in
+      Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k));
+      Array.unsafe_set a (i+len-1-k) t;
+    done
 
 
+let reverse_in_place a =
+  reverse_range a 0 (Array.length a)
 
-let remove (h : _ Hash_set_gen.t) key =  
-  let i = key_index h key in
-  let h_data = h.data in
-  let old_h_size = h.size in 
-  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
-  if old_h_size <> h.size then  
-    Array.unsafe_set h_data i new_bucket
+let reverse a =
+  let b_len = Array.length a in
+  if b_len = 0 then [||] else  
+  let b = Array.copy a in  
+  for i = 0 to  b_len - 1 do
+      Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) 
+  done;
+  b  
 
+let reverse_of_list =  function
+  | [] -> [||]
+  | hd::tl as l ->
+    let len = List.length l in
+    let a = Array.make len hd in
+    let rec fill i = function
+      | [] -> a
+      | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in
+    fill 0 tl
 
+let filter f a =
+  let arr_len = Array.length a in
+  let rec aux acc i =
+    if i = arr_len 
+    then reverse_of_list acc 
+    else
+      let v = Array.unsafe_get a i in
+      if f  v then 
+        aux (v::acc) (i+1)
+      else aux acc (i + 1) 
+  in aux [] 0
 
-let add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
-    end
 
-let check_add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
-      true 
-    end
-  else false 
+let filter_map (f : _ -> _ option) a =
+  let arr_len = Array.length a in
+  let rec aux acc i =
+    if i = arr_len 
+    then reverse_of_list acc 
+    else
+      let v = Array.unsafe_get a i in
+      match f  v with 
+      | Some v -> 
+        aux (v::acc) (i+1)
+      | None -> 
+        aux acc (i + 1) 
+  in aux [] 0
 
+let range from to_ =
+  if from > to_ then invalid_arg "Ext_array.range"  
+  else Array.init (to_ - from + 1) (fun i -> i + from)
 
-let mem (h :  _ Hash_set_gen.t) key =
-  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
+let map2i f a b = 
+  let len = Array.length a in 
+  if len <> Array.length b then 
+    invalid_arg "Ext_array.map2i"  
+  else
+    Array.mapi (fun i a -> f i  a ( Array.unsafe_get b i )) a 
 
-  
+let to_list_map f a =
+  let rec tolist i res =
+    if i < 0 then res else
+      let v = Array.unsafe_get a i in
+      tolist (i - 1)
+        (match f v with
+         | Some v -> v :: res
+         | None -> res) in
+  tolist (Array.length a - 1) []
+
+(**
+{[
+# rfind_with_index [|1;2;3|] (=) 2;;
+- : int = 1
+# rfind_with_index [|1;2;3|] (=) 1;;
+- : int = 0
+# rfind_with_index [|1;2;3|] (=) 3;;
+- : int = 2
+# rfind_with_index [|1;2;3|] (=) 4;;
+- : int = -1
+]}
+*)
+let rfind_with_index arr cmp v = 
+  let len = Array.length arr in 
+  let rec aux i = 
+    if i < 0 then i
+    else if  cmp (Array.unsafe_get arr i) v then i
+    else aux (i - 1) in 
+  aux (len - 1)
+
+type 'a split = [ `No_split | `Split of 'a array * 'a array ]
+let rfind_and_split arr cmp v : _ split = 
+  let i = rfind_with_index arr cmp v in 
+  if  i < 0 then 
+    `No_split 
+  else 
+    `Split (Array.sub arr 0 i , Array.sub arr  (i + 1 ) (Array.length arr - i - 1 ))
+
+
+let find_with_index arr cmp v = 
+  let len  = Array.length arr in 
+  let rec aux i len = 
+    if i >= len then -1 
+    else if cmp (Array.unsafe_get arr i ) v then i 
+    else aux (i + 1) len in 
+  aux 0 len
+
+let find_and_split arr cmp v : _ split = 
+  let i = find_with_index arr cmp v in 
+  if i < 0 then 
+    `No_split
+  else
+    `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1))        
+
+(** TODO: available since 4.03, use {!Array.exists} *)
+
+let exists p a =
+  let n = Array.length a in
+  let rec loop i =
+    if i = n then false
+    else if p (Array.unsafe_get a i) then true
+    else loop (succ i) in
+  loop 0
 
 end
-module Ext_ident : sig 
-#1 "ext_ident.mli"
+module Vec_gen
+= struct
+#1 "vec_gen.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -57469,53 +57418,320 @@ module Ext_ident : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+external unsafe_blit :
+  'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
 
 
+module type ResizeType = 
+sig 
+  type t 
+  val null : t (* used to populate new allocated array checkout {!Obj.new_block} for more performance *)
+end
 
+module type S = 
+sig 
+  type elt 
+  type t
+  val length : t -> int 
+  val compact : t -> unit
+  val singleton : elt -> t 
+  val empty : unit -> t 
+  val make : int -> t 
+  val init : int -> (int -> elt) -> t
+  val is_empty : t -> bool
+  val of_array : elt array -> t
+  val of_sub_array : elt array -> int -> int -> t
 
+  (** Exposed for some APIs which only take array as input, 
+      when exposed   
+  *)
+  val unsafe_internal_array : t -> elt array
+  val reserve : t -> int -> unit
+  val push :  elt -> t -> unit
+  val delete : t -> int -> unit 
+  val pop : t -> unit
+  val get_last_and_pop : t -> elt
+  val delete_range : t -> int -> int -> unit 
+  val get_and_delete_range : t -> int -> int -> t
+  val clear : t -> unit 
+  val reset : t -> unit 
+  val to_list : t -> elt list 
+  val of_list : elt list -> t
+  val to_array : t -> elt array 
+  val of_array : elt array -> t
+  val copy : t -> t 
+  val reverse_in_place : t -> unit
+  val iter : (elt -> unit) -> t -> unit 
+  val iteri : (int -> elt -> unit ) -> t -> unit 
+  val iter_range : from:int -> to_:int -> (elt -> unit) -> t -> unit 
+  val iteri_range : from:int -> to_:int -> (int -> elt -> unit) -> t -> unit
+  val map : (elt -> elt) -> t ->  t
+  val mapi : (int -> elt -> elt) -> t -> t
+  val map_into_array : (elt -> 'f) -> t -> 'f array
+  val map_into_list : (elt -> 'f) -> t -> 'f list 
+  val fold_left : ('f -> elt -> 'f) -> 'f -> t -> 'f
+  val fold_right : (elt -> 'g -> 'g) -> t -> 'g -> 'g
+  val filter : (elt -> bool) -> t -> t
+  val inplace_filter : (elt -> bool) -> t -> unit
+  val equal : (elt -> elt -> bool) -> t -> t -> bool 
+  val get : t -> int -> elt
+  val unsafe_get : t -> int -> elt
+  val last : t -> elt
+  val capacity : t -> int
+  val exists : (elt -> bool) -> t -> bool
+end
 
+type 'a t = {
+  mutable arr : 'a array ;
+  mutable len : int ;  
+}
 
+let length d = d.len
 
-(** A wrapper around [Ident] module in compiler-libs*)
-
-val is_js : Ident.t -> bool
+let compact d =
+  let d_arr = d.arr in 
+  if d.len <> Array.length d_arr then 
+    begin
+      let newarr = Array.sub d_arr 0 d.len in 
+      d.arr <- newarr
+    end
+let singleton v = 
+  {
+    len = 1 ; 
+    arr = [|v|]
+  }
 
-val is_js_object : Ident.t -> bool
+let empty () =
+  {
+    len = 0;
+    arr = [||];
+  }
 
-(** create identifiers for predefined [js] global variables *)
-val create_js : string -> Ident.t
+let is_empty d =
+  d.len = 0
 
-val create : string -> Ident.t
+let reset d = 
+  d.len <- 0; 
+  d.arr <- [||]
 
-val create_js_module : string -> Ident.t 
 
-val make_js_object : Ident.t -> unit
+(* For [to_*] operations, we should be careful to call {!Array.*} function 
+   in case we operate on the whole array
+*)
+let to_list d =
+  let rec loop d_arr idx accum =
+    if idx < 0 then accum else loop d_arr (idx - 1) (Array.unsafe_get d_arr idx :: accum)
+  in
+  loop d.arr (d.len - 1) []
 
-val reset : unit -> unit
 
-val gen_js :  ?name:string -> unit -> Ident.t
+let of_list lst =
+  let arr = Array.of_list lst in 
+  { arr ; len = Array.length arr}
 
-val make_unused : unit -> Ident.t
 
-val is_unused_ident : Ident.t -> bool 
+let to_array d = 
+  Array.sub d.arr 0 d.len
 
-(**
-   if name is not converted, the reference should be equal
-*)
-val convert : bool -> string -> string
-val property_no_need_convert : string -> bool 
+let of_array src =
+  {
+    len = Array.length src;
+    arr = Array.copy src;
+    (* okay to call {!Array.copy}*)
+  }
+let of_sub_array arr off len = 
+  { 
+    len = len ; 
+    arr = Array.sub arr off len  
+  }  
+let unsafe_internal_array v = v.arr  
+(* we can not call {!Array.copy} *)
+let copy src =
+  let len = src.len in
+  {
+    len ;
+    arr = Array.sub src.arr 0 len ;
+  }
+(* FIXME *)
+let reverse_in_place src = 
+  Ext_array.reverse_range src.arr 0 src.len 
 
-val undefined : Ident.t 
-val is_js_or_global : Ident.t -> bool
-val nil : Ident.t
+let sub src start len =
+  { len ; 
+    arr = Array.sub src.arr start len }
 
+let iter f d = 
+  let arr = d.arr in 
+  for i = 0 to d.len - 1 do
+    f (Array.unsafe_get arr i)
+  done
 
-val compare : Ident.t -> Ident.t -> int
-val equal : Ident.t -> Ident.t -> bool 
+let iteri f d =
+  let arr = d.arr in
+  for i = 0 to d.len - 1 do
+    f i (Array.unsafe_get arr i)
+  done
 
-end = struct
-#1 "ext_ident.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+let iter_range ~from ~to_ f d =
+  if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iter_range"
+  else 
+    let d_arr = d.arr in 
+    for i = from to to_ do 
+      f  (Array.unsafe_get d_arr i)
+    done
+
+let iteri_range ~from ~to_ f d =
+  if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iteri_range"
+  else 
+    let d_arr = d.arr in 
+    for i = from to to_ do 
+      f i (Array.unsafe_get d_arr i)
+    done
+
+let map_into_array f src =
+  let src_len = src.len in 
+  let src_arr = src.arr in 
+  if src_len = 0 then [||]
+  else 
+    let first_one = f (Array.unsafe_get src_arr 0) in 
+    let arr = Array.make  src_len  first_one in
+    for i = 1 to src_len - 1 do
+      Array.unsafe_set arr i (f (Array.unsafe_get src_arr i))
+    done;
+    arr 
+let map_into_list f src = 
+  let src_len = src.len in 
+  let src_arr = src.arr in 
+  if src_len = 0 then []
+  else 
+    let acc = ref [] in         
+    for i =  src_len - 1 downto 0 do
+      acc := f (Array.unsafe_get src_arr i) :: !acc
+    done;
+    !acc
+
+let mapi f src =
+  let len = src.len in 
+  if len = 0 then { len ; arr = [| |] }
+  else 
+    let src_arr = src.arr in 
+    let arr = Array.make len (Array.unsafe_get src_arr 0) in
+    for i = 1 to len - 1 do
+      Array.unsafe_set arr i (f i (Array.unsafe_get src_arr i))
+    done;
+    {
+      len ;
+      arr ;
+    }
+
+let fold_left f x a =
+  let rec loop a_len a_arr idx x =
+    if idx >= a_len then x else 
+      loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx))
+  in
+  loop a.len a.arr 0 x
+
+let fold_right f a x =
+  let rec loop a_arr idx x =
+    if idx < 0 then x
+    else loop a_arr (idx - 1) (f (Array.unsafe_get a_arr idx) x)
+  in
+  loop a.arr (a.len - 1) x
+
+(**  
+   [filter] and [inplace_filter]
+*)
+let filter f d =
+  let new_d = copy d in 
+  let new_d_arr = new_d.arr in 
+  let d_arr = d.arr in
+  let p = ref 0 in
+  for i = 0 to d.len  - 1 do
+    let x = Array.unsafe_get d_arr i in
+    (* TODO: can be optimized for segments blit *)
+    if f x  then
+      begin
+        Array.unsafe_set new_d_arr !p x;
+        incr p;
+      end;
+  done;
+  new_d.len <- !p;
+  new_d 
+
+let equal eq x y : bool = 
+  if x.len <> y.len then false 
+  else 
+    let rec aux x_arr y_arr i =
+      if i < 0 then true else  
+      if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then 
+        aux x_arr y_arr (i - 1)
+      else false in 
+    aux x.arr y.arr (x.len - 1)
+
+let get d i = 
+  if i < 0 || i >= d.len then invalid_arg "Resize_array.get"
+  else Array.unsafe_get d.arr i
+let unsafe_get d i = Array.unsafe_get d.arr i 
+let last d = 
+  if d.len <= 0 then invalid_arg   "Resize_array.last"
+  else Array.unsafe_get d.arr (d.len - 1)
+
+let capacity d = Array.length d.arr
+
+(* Attention can not use {!Array.exists} since the bound is not the same *)  
+let exists p d = 
+  let a = d.arr in 
+  let n = d.len in   
+  let rec loop i =
+    if i = n then false
+    else if p (Array.unsafe_get a i) then true
+    else loop (succ i) in
+  loop 0
+
+let map f src =
+  let src_len = src.len in 
+  if src_len = 0 then { len = 0 ; arr = [||]}
+  (* TODO: we may share the empty array 
+     but sharing mutable state is very challenging, 
+     the tricky part is to avoid mutating the immutable array,
+     here it looks fine -- 
+     invariant: whenever [.arr] mutated, make sure  it is not an empty array
+     Actually no: since starting from an empty array 
+     {[
+       push v (* the address of v should not be changed *)
+     ]}
+  *)
+  else 
+    let src_arr = src.arr in 
+    let first = f (Array.unsafe_get src_arr 0 ) in 
+    let arr = Array.make  src_len first in
+    for i = 1 to src_len - 1 do
+      Array.unsafe_set arr i (f (Array.unsafe_get src_arr i))
+    done;
+    {
+      len = src_len;
+      arr = arr;
+    }
+
+let init len f =
+  if len < 0 then invalid_arg  "Resize_array.init"
+  else if len = 0 then { len = 0 ; arr = [||] }
+  else 
+    let first = f 0 in 
+    let arr = Array.make len first in
+    for i = 1 to len - 1 do
+      Array.unsafe_set arr i (f i)
+    done;
+    {
+
+      len ;
+      arr 
+    }
+
+end
+module Int_vec : sig 
+#1 "int_vec.mli"
+(* 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
@@ -57539,266 +57755,11 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+include Vec_gen.S with type elt = int
 
-
-
-
-
-
-
-let js_flag = 0b1000 (* check with ocaml compiler *)
-
-let js_module_flag = 0b1_0000 (* javascript external modules *)
-(* TODO:
-    check name conflicts with javascript conventions
-    {[
-    Ext_ident.convert "^";;
-    - : string = "$caret"
-    ]}
- *)
-let js_object_flag = 0b10_0000 (* javascript object flags *)
-
-let is_js (i : Ident.t) = 
-  i.flags land js_flag <> 0 
-
-let is_js_or_global (i : Ident.t) = 
-  i.flags land (8 lor 1) <> 0 
-
-let is_js_module (i : Ident.t) =
-  i.flags land js_module_flag <> 0 
-
-let is_js_object (i : Ident.t) = 
-  i.flags land js_object_flag <> 0 
-
-let make_js_object (i : Ident.t) = 
-  i.flags <- i.flags lor js_object_flag 
-      
-(* It's a js function hard coded by js api, so when printing,
-   it should preserve the name 
- *)
-let create_js (name : string) : Ident.t  = 
-  { name = name; flags = js_flag ; stamp = 0}
-
-let js_module_table : Ident.t String_hashtbl.t = String_hashtbl.create 31 
-
-(* This is for a js exeternal module, we can change it when printing
-   for example
-   {[
-   var React$1 = require('react');
-   React$1.render(..)
-   ]}
-
-   Given a name, if duplicated, they should  have the same id
- *)
-let create_js_module (name : string) : Ident.t = 
-  let name = 
-    String.concat "" @@ List.map (String.capitalize ) @@ 
-    Ext_string.split name '-' in
-  (* TODO: if we do such transformation, we should avoid 
-      collision for example:
-      react-dom 
-      react--dom
-      check collision later
-   *)
-  match String_hashtbl.find_exn js_module_table name  with 
-  | exception Not_found -> 
-      let v = Ident.create name in
-      let ans = { v with flags = js_module_flag} in 
-      String_hashtbl.add js_module_table name ans;
-      ans
-  | v -> v 
-
-let create = Ident.create
-
-let gen_js ?(name="$js") () = create name 
-
-let reserved_words = 
-  [|
-    (* keywork *)
-    "break";
-    "case"; "catch"; "continue";
-    "debugger";"default";"delete";"do";
-    "else";
-    "finally";"for";"function";
-    "if"; "then"; "in";"instanceof";
-    "new";
-    "return";
-    "switch";
-    "this"; "throw"; "try"; "typeof";
-    "var"; "void"; "while"; "with";
-
-    (* reserved in ECMAScript 5 *)
-    "class"; "enum"; "export"; "extends"; "import"; "super";
-
-    "implements";"interface";
-    "let";
-    "package";"private";"protected";"public";
-    "static";
-    "yield";
-
-    (* other *)
-    "null";
-    "true";
-    "false";
-    "NaN";
-
-
-    "undefined";
-    "this";
-
-    (* also reserved in ECMAScript 3 *)
-    "abstract"; "boolean"; "byte"; "char"; "const"; "double";
-    "final"; "float"; "goto"; "int"; "long"; "native"; "short";
-    "synchronized"; 
-    (* "throws";  *)
-    (* seems to be fine, like nodejs [assert.throws] *)
-    "transient"; "volatile";
-
-    (* also reserved in ECMAScript 6 *)
-    "await";
-   
-   "event";
-   "location";
-   "window";
-   "document";
-   "eval";
-   "navigator";
-   (* "self"; *)
-   
-   "Array";
-   "Date";
-   "Math";
-   "JSON";
-   "Object";
-   "RegExp";
-   "String";
-   "Boolean";
-   "Number";
-
-   "Map"; (* es6*)
-   "Set";
-
-   "Infinity";
-   "isFinite";
-   
-   "ActiveXObject";
-   "XMLHttpRequest";
-   "XDomainRequest";
-   
-   "DOMException";
-   "Error";
-   "SyntaxError";
-   "arguments";
-   
-   "decodeURI";
-   "decodeURIComponent";
-   "encodeURI";
-   "encodeURIComponent";
-   "escape";
-   "unescape";
-
-   "isNaN";
-   "parseFloat";
-   "parseInt";
-   
-   (** reserved for commonjs *)   
-   "require";
-   "exports";
-   "module"
-  |]
-
-let reserved_map = 
-  let len = Array.length reserved_words in 
-  let set =  String_hash_set.create 1024 in (* large hash set for perfect hashing *)
-  for i = 0 to len - 1 do 
-    String_hash_set.add set reserved_words.(i);
-  done ;
-  set 
-
-
-
-
-
-(* TODO:
-    check name conflicts with javascript conventions
-    {[
-    Ext_ident.convert "^";;
-    - : string = "$caret"
-    ]}
- *)
-let convert keyword (name : string) = 
-   if keyword && String_hash_set.mem reserved_map name  then "$$" ^ name 
-   else 
-     let module E = struct exception Not_normal_letter of int end in
-     let len = String.length name  in
-     try
-       for i  = 0 to len - 1 do 
-         match String.unsafe_get name i with 
-         | 'a' .. 'z' | 'A' .. 'Z'
-         | '0' .. '9' | '_' | '$' -> ()
-         | _ -> raise (E.Not_normal_letter i)
-       done;
-       name
-     with E.Not_normal_letter i ->
-       String.sub name 0 i ^ 
-       (let buffer = Buffer.create len in 
-        for j = i to  len - 1 do 
-          let c = String.unsafe_get name j in
-          match c with 
-          | '*' -> Buffer.add_string buffer "$star"
-          | '\'' -> Buffer.add_string buffer "$prime"
-          | '!' -> Buffer.add_string buffer "$bang"
-          | '>' -> Buffer.add_string buffer "$great"
-          | '<' -> Buffer.add_string buffer "$less"
-          | '=' -> Buffer.add_string buffer "$eq"
-          | '+' -> Buffer.add_string buffer "$plus"
-          | '-' -> Buffer.add_string buffer "$neg"
-          | '@' -> Buffer.add_string buffer "$at"
-          | '^' -> Buffer.add_string buffer "$caret"
-          | '/' -> Buffer.add_string buffer "$slash"
-          | '|' -> Buffer.add_string buffer "$pipe"
-          | '.' -> Buffer.add_string buffer "$dot"
-          | '%' -> Buffer.add_string buffer "$percent"
-          | '~' -> Buffer.add_string buffer "$tilde"
-          | 'a'..'z' | 'A'..'Z'| '_'|'$' |'0'..'9'-> Buffer.add_char buffer  c
-          | _ -> Buffer.add_string buffer "$unknown"
-        done; Buffer.contents buffer)
-
-let property_no_need_convert s = 
-  s == convert false s 
-
-(* It is currently made a persistent ident to avoid fresh ids 
-    which would result in different signature files
-    - other solution: use lazy values
-*)
-let make_unused () = create "_"
-
-let is_unused_ident i = Ident.name i = "_"
-
-let reset () = 
-  String_hashtbl.clear js_module_table
-
-
-let undefined = create_js "undefined"
-let nil = create_js "null"
-
-(* Has to be total order, [x < y] 
-   and [x > y] should be consistent
-   flags are not relevant here 
- *)
-let compare (x : Ident.t ) ( y : Ident.t) = 
-  let u = x.stamp - y.stamp in
-  if u = 0 then 
-     String.compare x.name y.name 
-  else u 
-
-let equal ( x : Ident.t) ( y : Ident.t) = 
-  if x.stamp <> 0 then x.stamp = y.stamp
-  else y.stamp = 0 && x.name = y.name
-   
-end
-module Ident_map : sig 
-#1 "ident_map.mli"
+end = struct
+#1 "int_vec.ml"
+# 1 "ext/vec.cppo.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -57823,658 +57784,490 @@ module Ident_map : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-include Map_gen.S with type key = Ident.t
-end = struct
-#1 "ident_map.ml"
-
-# 2 "ext/map.cppo.ml"
-(* we don't create [map_poly], since some operations require raise an exception which carries [key] *)
 
 
+# 33
+type elt = int 
+type t = int Vec_gen.t 
+let null = 0 (* can be optimized *)
   
-# 16
-  type key = Ident.t
-  let compare_key = Ext_ident.compare
-
-# 22
-type 'a t = (key,'a) Map_gen.t
-exception Duplicate_key of key 
+# 39
+  let length = Vec_gen.length 
+  let compact = Vec_gen.compact 
+  let singleton = Vec_gen.singleton
+  let empty = Vec_gen.empty 
+  let is_empty = Vec_gen.is_empty 
+  let reset = Vec_gen.reset 
+  let to_list = Vec_gen.to_list 
+  let of_list = Vec_gen.of_list 
+  let to_array = Vec_gen.to_array
+  let of_array = Vec_gen.of_array 
+  let of_sub_array = Vec_gen.of_sub_array 
+  let unsafe_internal_array = Vec_gen.unsafe_internal_array 
+  let copy = Vec_gen.copy 
+  let reverse_in_place = Vec_gen.reverse_in_place 
+  let sub = Vec_gen.sub 
+  let iter = Vec_gen.iter 
+  let iteri = Vec_gen.iteri 
+  let iter_range = Vec_gen.iter_range 
+  let iteri_range = Vec_gen.iteri_range  
+  let filter = Vec_gen.filter 
+  let fold_right = Vec_gen.fold_right 
+  let fold_left = Vec_gen.fold_left 
+  let map_into_list = Vec_gen.map_into_list 
+  let map_into_array = Vec_gen.map_into_array 
+  let mapi = Vec_gen.mapi 
+  let equal = Vec_gen.equal 
+  let get = Vec_gen.get 
+  let exists = Vec_gen.exists 
+  let capacity = Vec_gen.capacity 
+  let last = Vec_gen.last 
+  let unsafe_get = Vec_gen.unsafe_get 
+  let map = Vec_gen.map 
+  let init = Vec_gen.init 
 
-let empty = Map_gen.empty 
-let is_empty = Map_gen.is_empty
-let iter = Map_gen.iter
-let fold = Map_gen.fold
-let for_all = Map_gen.for_all 
-let exists = Map_gen.exists 
-let singleton = Map_gen.singleton 
-let cardinal = Map_gen.cardinal
-let bindings = Map_gen.bindings
-let keys = Map_gen.keys
-let choose = Map_gen.choose 
-let partition = Map_gen.partition 
-let filter = Map_gen.filter 
-let map = Map_gen.map 
-let mapi = Map_gen.mapi
-let bal = Map_gen.bal 
-let height = Map_gen.height 
-let max_binding_exn = Map_gen.max_binding_exn
-let min_binding_exn = Map_gen.min_binding_exn
+  let make initsize : _ Vec_gen.t =
+    if initsize < 0 then invalid_arg  "Resize_array.make" ;
+    {
 
+      len = 0;
+      arr = Array.make  initsize null ;
+    }
 
-let rec add x data (tree : _ Map_gen.t as 'a) : 'a = match tree with 
-  | Empty ->
-    Node(Empty, x, data, Empty, 1)
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Node(l, x, data, r, h)
-    else if c < 0 then
-      bal (add x data l) v d r
-    else
-      bal l v d (add x data r)
 
 
-let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a = 
-  match tree with 
-  | Empty ->
-    Node(Empty, x, data (), Empty, 1)
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Node(l, x, replace  d , r, h)
-    else if c < 0 then
-      bal (adjust x data replace l) v d r
-    else
-      bal l v d (adjust x data replace r)
-
-
-let rec find_exn x (tree : _ Map_gen.t )  = match tree with 
-  | Empty ->
-    raise Not_found
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then d
-    else find_exn x (if c < 0 then l else r)
+  let reserve (d : _ Vec_gen.t ) s = 
+    let d_len = d.len in 
+    let d_arr = d.arr in 
+    if s < d_len || s < Array.length d_arr then ()
+    else 
+      let new_capacity = min Sys.max_array_length s in 
+      let new_d_arr = Array.make new_capacity null in 
+      Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len;
+      d.arr <- new_d_arr 
 
-let rec find_opt x (tree : _ Map_gen.t )  = match tree with 
-  | Empty -> None 
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then Some d
-    else find_opt x (if c < 0 then l else r)
+  let push v (d : _ Vec_gen.t) =
+    let d_len = d.len in
+    let d_arr = d.arr in 
+    let d_arr_len = Array.length d_arr in
+    if d_arr_len = 0 then
+      begin 
+        d.len <- 1 ;
+        d.arr <- [| v |]
+      end
+    else  
+      begin 
+        if d_len = d_arr_len then 
+          begin
+            if d_len >= Sys.max_array_length then 
+              failwith "exceeds max_array_length";
+            let new_capacity = min Sys.max_array_length d_len * 2 
+            (* [d_len] can not be zero, so [*2] will enlarge   *)
+            in
+            let new_d_arr = Array.make new_capacity null in 
+            d.arr <- new_d_arr;
+            Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len ;
+          end;
+        d.len <- d_len + 1;
+        Array.unsafe_set d.arr d_len v
+      end
 
-let rec find_default x (tree : _ Map_gen.t ) default     = match tree with 
-  | Empty -> default  
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then  d
-    else find_default x   (if c < 0 then l else r) default
+  let delete (d : _ Vec_gen.t) idx =
+    if idx < 0 || idx >= d.len then invalid_arg "Resize_array.delete" ;
+    let arr = d.arr in 
+    Vec_gen.unsafe_blit arr (idx + 1) arr idx  (d.len - idx - 1);
+    Array.unsafe_set arr (d.len - 1) null;
+    d.len <- d.len - 1
 
-let rec mem x (tree : _ Map_gen.t )   = match tree with 
-  | Empty ->
-    false
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    c = 0 || mem x (if c < 0 then l else r)
+  let pop (d : _ Vec_gen.t) = 
+    let idx  = d.len - 1  in
+    if idx < 0 then invalid_arg "Resize_array.pop";
+    Array.unsafe_set d.arr idx null;
+    d.len <- idx
+  let get_last_and_pop (d : _ Vec_gen.t) = 
+    let idx  = d.len - 1  in
+    if idx < 0 then invalid_arg "Resize_array.get_last_and_pop";
+    let last = Array.unsafe_get d.arr idx in 
+    Array.unsafe_set d.arr idx null;
+    d.len <- idx; 
+    last 
 
-let rec remove x (tree : _ Map_gen.t as 'a) : 'a = match tree with 
-  | Empty ->
-    Empty
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Map_gen.merge l r
-    else if c < 0 then
-      bal (remove x l) v d r
-    else
-      bal l v d (remove x r)
+  let delete_range (d : _ Vec_gen.t) idx len =
+    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
+    let arr = d.arr in 
+    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
+    for i = d.len - len to d.len - 1 do
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- d.len - len
 
 
-let rec split x (tree : _ Map_gen.t as 'a) : 'a * _ option * 'a  = match tree with 
-  | Empty ->
-    (Empty, None, Empty)
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then (l, Some d, r)
-    else if c < 0 then
-      let (ll, pres, rl) = split x l in (ll, pres, Map_gen.join rl v d r)
-    else
-      let (lr, pres, rr) = split x r in (Map_gen.join l v d lr, pres, rr)
+  let get_and_delete_range (d : _ Vec_gen.t) idx len : _ Vec_gen.t = 
+    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
+    let arr = d.arr in 
+    let value = Array.sub arr idx len in
+    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
+    for i = d.len - len to d.len - 1 do
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- d.len - len; 
+    {len = len ; arr = value}
 
-let rec merge f (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
-  match (s1, s2) with
-  | (Empty, Empty) -> Empty
-  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
-    let (l2, d2, r2) = split v1 s2 in
-    Map_gen.concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
-  | (_, Node (l2, v2, d2, r2, h2)) ->
-    let (l1, d1, r1) = split v2 s1 in
-    Map_gen.concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
-  | _ ->
-    assert false
 
-let rec disjoint_merge  (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
-  match (s1, s2) with
-  | (Empty, Empty) -> Empty
-  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
-    begin match split v1 s2 with 
-    | l2, None, r2 -> 
-      Map_gen.join (disjoint_merge  l1 l2) v1 d1 (disjoint_merge r1 r2)
-    | _, Some _, _ ->
-      raise (Duplicate_key  v1)
-    end        
-  | (_, Node (l2, v2, d2, r2, h2)) ->
-    begin match  split v2 s1 with 
-    | (l1, None, r1) -> 
-      Map_gen.join (disjoint_merge  l1 l2) v2 d2 (disjoint_merge  r1 r2)
-    | (_, Some _, _) -> 
-      raise (Duplicate_key v2)
-    end
-  | _ ->
-    assert false
+  (** Below are simple wrapper around normal Array operations *)  
 
+  let clear (d : _ Vec_gen.t ) =
+    for i = 0 to d.len - 1 do 
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- 0
 
 
-let compare cmp m1 m2 = Map_gen.compare compare_key cmp m1 m2
 
-let equal cmp m1 m2 = Map_gen.equal compare_key cmp m1 m2 
+  let inplace_filter f (d : _ Vec_gen.t) = 
+    let d_arr = d.arr in 
+    let p = ref 0 in
+    for i = 0 to d.len - 1 do 
+      let x = Array.unsafe_get d_arr i in 
+      if f x then 
+        begin 
+          let curr_p = !p in 
+          (if curr_p <> i then 
+             Array.unsafe_set d_arr curr_p x) ;
+          incr p
+        end
+    done ;
+    let last = !p  in 
+    delete_range d last  (d.len - last)
 
-let add_list (xs : _ list ) init = 
-  List.fold_left (fun acc (k,v) -> add k v acc) init xs 
 
-let of_list xs = add_list xs empty
+end
+module Resize_array : sig 
+#1 "resize_array.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let of_array xs = 
-  Array.fold_left (fun acc (k,v) -> add k v acc) empty xs
+module Make ( Resize : Vec_gen.ResizeType) : Vec_gen.S with type elt = Resize.t 
 
-end
-module Set_gen
-= struct
-#1 "set_gen.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../LICENSE.     *)
-(*                                                                     *)
-(***********************************************************************)
 
-(** balanced tree based on stdlib distribution *)
 
-type 'a t = 
-  | Empty 
-  | Node of 'a t * 'a * 'a t * int 
+end = struct
+#1 "resize_array.ml"
+# 1 "ext/vec.cppo.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-type 'a enumeration = 
-  | End | More of 'a * 'a t * 'a enumeration
 
 
-let rec cons_enum s e = 
-  match s with 
-  | Empty -> e 
-  | Node(l,v,r,_) -> cons_enum l (More(v,r,e))
+# 28
+module Make ( Resize : Vec_gen.ResizeType) = struct
+  type elt = Resize.t 
+  type nonrec t = elt Vec_gen.t
+  let null = Resize.null 
+  
+# 39
+  let length = Vec_gen.length 
+  let compact = Vec_gen.compact 
+  let singleton = Vec_gen.singleton
+  let empty = Vec_gen.empty 
+  let is_empty = Vec_gen.is_empty 
+  let reset = Vec_gen.reset 
+  let to_list = Vec_gen.to_list 
+  let of_list = Vec_gen.of_list 
+  let to_array = Vec_gen.to_array
+  let of_array = Vec_gen.of_array 
+  let of_sub_array = Vec_gen.of_sub_array 
+  let unsafe_internal_array = Vec_gen.unsafe_internal_array 
+  let copy = Vec_gen.copy 
+  let reverse_in_place = Vec_gen.reverse_in_place 
+  let sub = Vec_gen.sub 
+  let iter = Vec_gen.iter 
+  let iteri = Vec_gen.iteri 
+  let iter_range = Vec_gen.iter_range 
+  let iteri_range = Vec_gen.iteri_range  
+  let filter = Vec_gen.filter 
+  let fold_right = Vec_gen.fold_right 
+  let fold_left = Vec_gen.fold_left 
+  let map_into_list = Vec_gen.map_into_list 
+  let map_into_array = Vec_gen.map_into_array 
+  let mapi = Vec_gen.mapi 
+  let equal = Vec_gen.equal 
+  let get = Vec_gen.get 
+  let exists = Vec_gen.exists 
+  let capacity = Vec_gen.capacity 
+  let last = Vec_gen.last 
+  let unsafe_get = Vec_gen.unsafe_get 
+  let map = Vec_gen.map 
+  let init = Vec_gen.init 
 
-let rec height = function
-  | Empty -> 0 
-  | Node(_,_,_,h) -> h   
+  let make initsize : _ Vec_gen.t =
+    if initsize < 0 then invalid_arg  "Resize_array.make" ;
+    {
 
-(* Smallest and greatest element of a set *)
+      len = 0;
+      arr = Array.make  initsize null ;
+    }
 
-let rec min_elt = function
-    Empty -> raise Not_found
-  | Node(Empty, v, r, _) -> v
-  | Node(l, v, r, _) -> min_elt l
 
-let rec max_elt = function
-    Empty -> raise Not_found
-  | Node(l, v, Empty, _) -> v
-  | Node(l, v, r, _) -> max_elt r
 
+  let reserve (d : _ Vec_gen.t ) s = 
+    let d_len = d.len in 
+    let d_arr = d.arr in 
+    if s < d_len || s < Array.length d_arr then ()
+    else 
+      let new_capacity = min Sys.max_array_length s in 
+      let new_d_arr = Array.make new_capacity null in 
+      Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len;
+      d.arr <- new_d_arr 
 
+  let push v (d : _ Vec_gen.t) =
+    let d_len = d.len in
+    let d_arr = d.arr in 
+    let d_arr_len = Array.length d_arr in
+    if d_arr_len = 0 then
+      begin 
+        d.len <- 1 ;
+        d.arr <- [| v |]
+      end
+    else  
+      begin 
+        if d_len = d_arr_len then 
+          begin
+            if d_len >= Sys.max_array_length then 
+              failwith "exceeds max_array_length";
+            let new_capacity = min Sys.max_array_length d_len * 2 
+            (* [d_len] can not be zero, so [*2] will enlarge   *)
+            in
+            let new_d_arr = Array.make new_capacity null in 
+            d.arr <- new_d_arr;
+            Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len ;
+          end;
+        d.len <- d_len + 1;
+        Array.unsafe_set d.arr d_len v
+      end
 
+  let delete (d : _ Vec_gen.t) idx =
+    if idx < 0 || idx >= d.len then invalid_arg "Resize_array.delete" ;
+    let arr = d.arr in 
+    Vec_gen.unsafe_blit arr (idx + 1) arr idx  (d.len - idx - 1);
+    Array.unsafe_set arr (d.len - 1) null;
+    d.len <- d.len - 1
 
-let empty = Empty
+  let pop (d : _ Vec_gen.t) = 
+    let idx  = d.len - 1  in
+    if idx < 0 then invalid_arg "Resize_array.pop";
+    Array.unsafe_set d.arr idx null;
+    d.len <- idx
+  let get_last_and_pop (d : _ Vec_gen.t) = 
+    let idx  = d.len - 1  in
+    if idx < 0 then invalid_arg "Resize_array.get_last_and_pop";
+    let last = Array.unsafe_get d.arr idx in 
+    Array.unsafe_set d.arr idx null;
+    d.len <- idx; 
+    last 
 
-let is_empty = function Empty -> true | _ -> false
+  let delete_range (d : _ Vec_gen.t) idx len =
+    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
+    let arr = d.arr in 
+    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
+    for i = d.len - len to d.len - 1 do
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- d.len - len
 
-let rec cardinal_aux acc  = function
-  | Empty -> acc 
-  | Node (l,_,r, _) -> 
-    cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
 
-let cardinal s = cardinal_aux 0 s 
+  let get_and_delete_range (d : _ Vec_gen.t) idx len : _ Vec_gen.t = 
+    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
+    let arr = d.arr in 
+    let value = Array.sub arr idx len in
+    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
+    for i = d.len - len to d.len - 1 do
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- d.len - len; 
+    {len = len ; arr = value}
 
-let rec elements_aux accu = function
-  | Empty -> accu
-  | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l
 
-let elements s =
-  elements_aux [] s
+  (** Below are simple wrapper around normal Array operations *)  
 
-let choose = min_elt
+  let clear (d : _ Vec_gen.t ) =
+    for i = 0 to d.len - 1 do 
+      Array.unsafe_set d.arr i null
+    done;
+    d.len <- 0
 
-let rec iter f = function
-  | Empty -> ()
-  | Node(l, v, r, _) -> iter f l; f v; iter f r
 
-let rec fold f s accu =
-  match s with
-  | Empty -> accu
-  | Node(l, v, r, _) -> fold f r (f v (fold f l accu))
 
-let rec for_all p = function
-  | Empty -> true
-  | Node(l, v, r, _) -> p v && for_all p l && for_all p r
+  let inplace_filter f (d : _ Vec_gen.t) = 
+    let d_arr = d.arr in 
+    let p = ref 0 in
+    for i = 0 to d.len - 1 do 
+      let x = Array.unsafe_get d_arr i in 
+      if f x then 
+        begin 
+          let curr_p = !p in 
+          (if curr_p <> i then 
+             Array.unsafe_set d_arr curr_p x) ;
+          incr p
+        end
+    done ;
+    let last = !p  in 
+    delete_range d last  (d.len - last)
 
-let rec exists p = function
-  | Empty -> false
-  | Node(l, v, r, _) -> p v || exists p l || exists p r
+# 188
+end
 
+end
+module Int_vec_vec : sig 
+#1 "int_vec_vec.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let max_int3 (a : int) b c = 
-  if a >= b then 
-    if a >= c then a 
-    else c
-  else 
-  if b >=c then b
-  else c     
-let max_int_2 (a : int) b =  
-  if a >= b then a else b 
+include Vec_gen.S with type elt = Int_vec.t
 
+end = struct
+#1 "int_vec_vec.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-exception Height_invariant_broken
-exception Height_diff_borken 
+include Resize_array.Make(struct type t = Int_vec.t let null = Int_vec.empty () end)
 
-let rec check_height_and_diff = 
-  function 
-  | Empty -> 0
-  | Node(l,_,r,h) -> 
-    let hl = check_height_and_diff l in
-    let hr = check_height_and_diff r in
-    if h <>  max_int_2 hl hr + 1 then raise Height_invariant_broken
-    else  
-      let diff = (abs (hl - hr)) in  
-      if  diff > 2 then raise Height_diff_borken 
-      else h     
-
-let check tree = 
-  ignore (check_height_and_diff tree)
-(* 
-    Invariants: 
-    1. {[ l < v < r]}
-    2. l and r balanced 
-    3. [height l] - [height r] <= 2
-*)
-let create l v r = 
-  let hl = match l with Empty -> 0 | Node (_,_,_,h) -> h in
-  let hr = match r with Empty -> 0 | Node (_,_,_,h) -> h in
-  Node(l,v,r, if hl >= hr then hl + 1 else hr + 1)         
-
-(* Same as create, but performs one step of rebalancing if necessary.
-    Invariants:
-    1. {[ l < v < r ]}
-    2. l and r balanced 
-    3. | height l - height r | <= 3.
-
-    Proof by indunction
-
-    Lemma: the height of  [bal l v r] will bounded by [max l r] + 1 
-*)
-(*
-let internal_bal l v r =
-  match l with
-  | Empty ->
-    begin match r with 
-      | Empty -> Node(Empty,v,Empty,1)
-      | Node(rl,rv,rr,hr) -> 
-        if hr > 2 then
-          begin match rl with
-            | Empty -> create (* create l v rl *) (Node (Empty,v,Empty,1)) rv rr 
-            | Node(rll,rlv,rlr,hrl) -> 
-              let hrr = height rr in 
-              if hrr >= hrl then 
-                Node  
-                  ((Node (Empty,v,rl,hrl+1))(* create l v rl *),
-                   rv, rr, if hrr = hrl then hrr + 2 else hrr + 1) 
-              else 
-                let hrll = height rll in 
-                let hrlr = height rlr in 
-                create
-                  (Node(Empty,v,rll,hrll + 1)) 
-                  (* create l v rll *) 
-                  rlv 
-                  (Node (rlr,rv,rr, if hrlr > hrr then hrlr + 1 else hrr + 1))
-                  (* create rlr rv rr *)    
-          end 
-        else Node (l,v,r, hr + 1)  
-    end
-  | Node(ll,lv,lr,hl) ->
-    begin match r with 
-      | Empty ->
-        if hl > 2 then 
-          (*if height ll >= height lr then create ll lv (create lr v r)
-            else*)
-          begin match lr with 
-            | Empty -> 
-              create ll lv (Node (Empty,v,Empty, 1)) 
-            (* create lr v r *)  
-            | Node(lrl,lrv,lrr,hlr) -> 
-              if height ll >= hlr then 
-                create ll lv
-                  (Node(lr,v,Empty,hlr+1)) 
-                  (*create lr v r*)
-              else 
-                let hlrr = height lrr in  
-                create 
-                  (create ll lv lrl)
-                  lrv
-                  (Node(lrr,v,Empty,hlrr + 1)) 
-                  (*create lrr v r*)
-          end 
-        else Node(l,v,r, hl+1)    
-      | Node(rl,rv,rr,hr) ->
-        if hl > hr + 2 then           
-          begin match lr with 
-            | Empty ->   create ll lv (create lr v r)
-            | Node(lrl,lrv,lrr,_) ->
-              if height ll >= height lr then create ll lv (create lr v r)
-              else 
-                create (create ll lv lrl) lrv (create lrr v r)
-          end 
-        else
-        if hr > hl + 2 then             
-          begin match rl with 
-            | Empty ->
-              let hrr = height rr in   
-              Node(
-                (Node (l,v,Empty,hl + 1))
-                (*create l v rl*)
-                ,
-                rv,
-                rr,
-                if hrr > hr then hrr + 1 else hl + 2 
-              )
-            | Node(rll,rlv,rlr,_) ->
-              let hrr = height rr in 
-              let hrl = height rl in 
-              if hrr >= hrl then create (create l v rl) rv rr else 
-                create (create l v rll) rlv (create rlr rv rr)
-          end
-        else  
-          Node(l,v,r, if hl >= hr then hl+1 else hr + 1)
-    end
-*)
-let internal_bal l v r =
-  let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
-  let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
-  if hl > hr + 2 then begin
-    match l with
-      Empty -> assert false
-    | Node(ll, lv, lr, _) ->   
-      if height ll >= height lr then
-        (* [ll] >~ [lr] 
-           [ll] >~ [r] 
-           [ll] ~~ [ lr ^ r]  
-        *)
-        create ll lv (create lr v r)
-      else begin
-        match lr with
-          Empty -> assert false
-        | Node(lrl, lrv, lrr, _)->
-          (* [lr] >~ [ll]
-             [lr] >~ [r]
-             [ll ^ lrl] ~~ [lrr ^ r]   
-          *)
-          create (create ll lv lrl) lrv (create lrr v r)
-      end
-  end else if hr > hl + 2 then begin
-    match r with
-      Empty -> assert false
-    | Node(rl, rv, rr, _) ->
-      if height rr >= height rl then
-        create (create l v rl) rv rr
-      else begin
-        match rl with
-          Empty -> assert false
-        | Node(rll, rlv, rlr, _) ->
-          create (create l v rll) rlv (create rlr rv rr)
-      end
-  end else
-    Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1))    
-
-let rec remove_min_elt = function
-    Empty -> invalid_arg "Set.remove_min_elt"
-  | Node(Empty, v, r, _) -> r
-  | Node(l, v, r, _) -> internal_bal (remove_min_elt l) v r
-
-let singleton x = Node(Empty, x, Empty, 1)    
-
-(* 
-   All elements of l must precede the elements of r.
-       Assume | height l - height r | <= 2.
-   weak form of [concat] 
-*)
-
-let internal_merge l r =
-  match (l, r) with
-  | (Empty, t) -> t
-  | (t, Empty) -> t
-  | (_, _) -> internal_bal l (min_elt r) (remove_min_elt r)
-
-(* Beware: those two functions assume that the added v is *strictly*
-    smaller (or bigger) than all the present elements in the tree; it
-    does not test for equality with the current min (or max) element.
-    Indeed, they are only used during the "join" operation which
-    respects this precondition.
-*)
-
-let rec add_min_element v = function
-  | Empty -> singleton v
-  | Node (l, x, r, h) ->
-    internal_bal (add_min_element v l) x r
-
-let rec add_max_element v = function
-  | Empty -> singleton v
-  | Node (l, x, r, h) ->
-    internal_bal l x (add_max_element v r)
-
-(** 
-    Invariants:
-    1. l < v < r 
-    2. l and r are balanced 
+end
+module Ext_scc : sig 
+#1 "ext_scc.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+ 
 
-    Proof by induction
-    The height of output will be ~~ (max (height l) (height r) + 2)
-    Also use the lemma from [bal]
-*)
-let rec internal_join l v r =
-  match (l, r) with
-    (Empty, _) -> add_min_element v r
-  | (_, Empty) -> add_max_element v l
-  | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
-    if lh > rh + 2 then 
-      (* proof by induction:
-         now [height of ll] is [lh - 1] 
-      *)
-      internal_bal ll lv (internal_join lr v r) 
-    else
-    if rh > lh + 2 then internal_bal (internal_join l v rl) rv rr 
-    else create l v r
 
 
-(*
-    Required Invariants: 
-    [t1] < [t2]  
+type node = Int_vec.t
+(** Assume input is int array with offset from 0 
+    Typical input 
+    {[
+      [|
+        [ 1 ; 2 ]; // 0 -> 1,  0 -> 2 
+        [ 1 ];   // 0 -> 1 
+        [ 2 ]  // 0 -> 2 
+      |]
+    ]}
+    Note that we can tell how many nodes by calculating 
+    [Array.length] of the input 
 *)
-let internal_concat t1 t2 =
-  match (t1, t2) with
-  | (Empty, t) -> t
-  | (t, Empty) -> t
-  | (_, _) -> internal_join t1 (min_elt t2) (remove_min_elt t2)
-
-let rec filter p = function
-  | Empty -> Empty
-  | Node(l, v, r, _) ->
-    (* call [p] in the expected left-to-right order *)
-    let l' = filter p l in
-    let pv = p v in
-    let r' = filter p r in
-    if pv then internal_join l' v r' else internal_concat l' r'
-
-
-let rec partition p = function
-  | Empty -> (Empty, Empty)
-  | Node(l, v, r, _) ->
-    (* call [p] in the expected left-to-right order *)
-    let (lt, lf) = partition p l in
-    let pv = p v in
-    let (rt, rf) = partition p r in
-    if pv
-    then (internal_join lt v rt, internal_concat lf rf)
-    else (internal_concat lt rt, internal_join lf v rf)
-
-let of_sorted_list l =
-  let rec sub n l =
-    match n, l with
-    | 0, l -> Empty, l
-    | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l
-    | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l
-    | 3, x0 :: x1 :: x2 :: l ->
-      Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l
-    | n, l ->
-      let nl = n / 2 in
-      let left, l = sub nl l in
-      match l with
-      | [] -> assert false
-      | mid :: l ->
-        let right, l = sub (n - nl - 1) l in
-        create left mid right, l
-  in
-  fst (sub (List.length l) l)
-
-let of_sorted_array l =   
-  let rec sub start n l  =
-    if n = 0 then Empty else 
-    if n = 1 then 
-      let x0 = Array.unsafe_get l start in
-      Node (Empty, x0, Empty, 1)
-    else if n = 2 then     
-      let x0 = Array.unsafe_get l start in 
-      let x1 = Array.unsafe_get l (start + 1) in 
-      Node (Node(Empty, x0, Empty, 1), x1, Empty, 2) else
-    if n = 3 then 
-      let x0 = Array.unsafe_get l start in 
-      let x1 = Array.unsafe_get l (start + 1) in
-      let x2 = Array.unsafe_get l (start + 2) in
-      Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2)
-    else 
-      let nl = n / 2 in
-      let left = sub start nl l in
-      let mid = start + nl in 
-      let v = Array.unsafe_get l mid in 
-      let right = sub (mid + 1) (n - nl - 1) l in        
-      create left v right
-  in
-  sub 0 (Array.length l) l 
-
-let is_ordered cmp tree =
-  let rec is_ordered_min_max tree =
-    match tree with
-    | Empty -> `Empty
-    | Node(l,v,r,_) -> 
-      begin match is_ordered_min_max l with
-        | `No -> `No 
-        | `Empty ->
-          begin match is_ordered_min_max r with
-            | `No  -> `No
-            | `Empty -> `V (v,v)
-            | `V(l,r) ->
-              if cmp v l < 0 then
-                `V(v,r)
-              else
-                `No
-          end
-        | `V(min_v,max_v)->
-          begin match is_ordered_min_max r with
-            | `No -> `No
-            | `Empty -> 
-              if cmp max_v v < 0 then 
-                `V(min_v,v)
-              else
-                `No 
-            | `V(min_v_r, max_v_r) ->
-              if cmp max_v min_v_r < 0 then
-                `V(min_v,max_v_r)
-              else `No
-          end
-      end  in 
-  is_ordered_min_max tree <> `No 
-
-let invariant cmp t = 
-  check t ; 
-  is_ordered cmp t 
-
-let rec compare_aux cmp e1 e2 =
-  match (e1, e2) with
-    (End, End) -> 0
-  | (End, _)  -> -1
-  | (_, End) -> 1
-  | (More(v1, r1, e1), More(v2, r2, e2)) ->
-    let c = cmp v1 v2 in
-    if c <> 0
-    then c
-    else compare_aux cmp (cons_enum r1 e1) (cons_enum r2 e2)
-
-let compare cmp s1 s2 =
-  compare_aux cmp (cons_enum s1 End) (cons_enum s2 End)
-
-
-module type S = sig
-  type elt 
-  type t
-  val empty: t
-  val is_empty: t -> bool
-  val iter: (elt -> unit) -> t -> unit
-  val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
-  val for_all: (elt -> bool) -> t -> bool
-  val exists: (elt -> bool) -> t -> bool
-  val singleton: elt -> t
-  val cardinal: t -> int
-  val elements: t -> elt list
-  val min_elt: t -> elt
-  val max_elt: t -> elt
-  val choose: t -> elt
-  val of_sorted_list : elt list -> t 
-  val of_sorted_array : elt array -> t
-  val partition: (elt -> bool) -> t -> t * t
+val graph : Int_vec.t array -> Int_vec_vec.t
 
-  val mem: elt -> t -> bool
-  val add: elt -> t -> t
-  val remove: elt -> t -> t
-  val union: t -> t -> t
-  val inter: t -> t -> t
-  val diff: t -> t -> t
-  val compare: t -> t -> int
-  val equal: t -> t -> bool
-  val subset: t -> t -> bool
-  val filter: (elt -> bool) -> t -> t
 
-  val split: elt -> t -> t * bool * t
-  val find: elt -> t -> elt
-  val of_list: elt list -> t
-  val of_sorted_list : elt list ->  t
-  val of_sorted_array : elt array -> t 
-end 
+(** Used for unit test *)
+val graph_check : node array -> int * int list 
 
-end
-module Ident_set : sig 
-#1 "ident_set.mli"
+end = struct
+#1 "ext_scc.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58498,17 +58291,87 @@ module Ident_set : sig
  * 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. *)
+ 
+type node = Int_vec.t 
+(** 
+   [int] as data for this algorithm
+   Pros:
+   1. Easy to eoncode algorithm (especially given that the capacity of node is known)
+   2. Algorithms itself are much more efficient
+   3. Node comparison semantics is clear
+   4. Easy to print output
+   Cons:
+   1. post processing input data  
+ *)
+let min_int (x : int) y = if x < y then x else y  
 
 
-include Set_gen.S with type elt = Ident.t
+let graph  e =
+  let index = ref 0 in 
+  let s = Int_vec.empty () in
 
+  let output = Int_vec_vec.empty () in (* collect output *)
+  let node_numes = Array.length e in
+  
+  let on_stack_array = Array.make node_numes false in
+  let index_array = Array.make node_numes (-1) in 
+  let lowlink_array = Array.make node_numes (-1) in
+  
+  let rec scc v_data  =
+    let new_index = !index + 1 in 
+    index := new_index ;
+    Int_vec.push  v_data s ; 
 
+    index_array.(v_data) <- new_index ;  
+    lowlink_array.(v_data) <- new_index ; 
+    on_stack_array.(v_data) <- true ;
+    
+    let v = e.(v_data) in 
+    v
+    |> Int_vec.iter (fun w_data  ->
+        if Array.unsafe_get index_array w_data < 0 then (* not processed *)
+          begin  
+            scc w_data;
+            Array.unsafe_set lowlink_array v_data  
+              (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data))
+          end  
+        else if Array.unsafe_get on_stack_array w_data then 
+          (* successor is in stack and hence in current scc *)
+          begin 
+            Array.unsafe_set lowlink_array v_data  
+              (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data))
+          end
+      ) ; 
 
+    if Array.unsafe_get lowlink_array v_data = Array.unsafe_get index_array v_data then
+      (* start a new scc *)
+      begin
+        let s_len = Int_vec.length s in
+        let last_index = ref (s_len - 1) in 
+        let u = ref (Int_vec.unsafe_get s !last_index) in
+        while  !u <> v_data do 
+          Array.unsafe_set on_stack_array (!u)  false ; 
+          last_index := !last_index - 1;
+          u := Int_vec.unsafe_get s !last_index
+        done ;
+        on_stack_array.(v_data) <- false; (* necessary *)
+        Int_vec_vec.push   (Int_vec.get_and_delete_range s !last_index (s_len  - !last_index)) output;
+      end   
+  in
+  for i = 0 to node_numes - 1 do 
+    if Array.unsafe_get index_array i < 0 then scc i
+  done ;
+  output 
 
+let graph_check v = 
+  let v = graph v in 
+  Int_vec_vec.length v, 
+  Int_vec_vec.fold_left (fun acc x -> Int_vec.length x :: acc ) [] v  
 
-end = struct
-#1 "ident_set.ml"
-# 1 "ext/set.cppo.ml"
+end
+module Hash_set_gen
+= struct
+#1 "hash_set_gen.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58534,168 +58397,148 @@ end = struct
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-# 31
-type elt = Ident.t
-let compare_elt (x : elt) (y : elt) = 
-  let a =  Pervasives.compare (x.stamp : int) y.stamp in 
-  if a <> 0 then a 
-  else 
-    let b = Pervasives.compare (x.name : string) y.name in 
-    if b <> 0 then b 
-    else Pervasives.compare (x.flags : int) y.flags     
-type  t = elt Set_gen.t 
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
 
+type 'a t =
+  { mutable size: int;                        (* number of entries *)
+    mutable data: 'a list array;  (* the buckets *)
+    initial_size: int;                        (* initial array size *)
+  }
 
-# 57
-let empty = Set_gen.empty 
-let is_empty = Set_gen.is_empty
-let iter = Set_gen.iter
-let fold = Set_gen.fold
-let for_all = Set_gen.for_all 
-let exists = Set_gen.exists 
-let singleton = Set_gen.singleton 
-let cardinal = Set_gen.cardinal
-let elements = Set_gen.elements
-let min_elt = Set_gen.min_elt
-let max_elt = Set_gen.max_elt
-let choose = Set_gen.choose 
-let of_sorted_list = Set_gen.of_sorted_list
-let of_sorted_array = Set_gen.of_sorted_array
-let partition = Set_gen.partition 
-let filter = Set_gen.filter 
-let of_sorted_list = Set_gen.of_sorted_list
-let of_sorted_array = Set_gen.of_sorted_array
-
-let rec split x (tree : _ Set_gen.t) : _ Set_gen.t * bool * _ Set_gen.t =  match tree with 
-  | Empty ->
-    (Empty, false, Empty)
-  | Node(l, v, r, _) ->
-    let c = compare_elt x v in
-    if c = 0 then (l, true, r)
-    else if c < 0 then
-      let (ll, pres, rl) = split x l in (ll, pres, Set_gen.internal_join rl v r)
-    else
-      let (lr, pres, rr) = split x r in (Set_gen.internal_join l v lr, pres, rr)
-let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  match tree with 
-  | Empty -> Node(Empty, x, Empty, 1)
-  | Node(l, v, r, _) as t ->
-    let c = compare_elt x v in
-    if c = 0 then t else
-    if c < 0 then Set_gen.internal_bal (add x l) v r else Set_gen.internal_bal l v (add x r)
-
-let rec union (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) : _ Set_gen.t  =
-  match (s1, s2) with
-  | (Empty, t2) -> t2
-  | (t1, Empty) -> t1
-  | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
-    if h1 >= h2 then
-      if h2 = 1 then add v2 s1 else begin
-        let (l2, _, r2) = split v1 s2 in
-        Set_gen.internal_join (union l1 l2) v1 (union r1 r2)
-      end
-    else
-    if h1 = 1 then add v1 s2 else begin
-      let (l1, _, r1) = split v2 s1 in
-      Set_gen.internal_join (union l1 l2) v2 (union r1 r2)
-    end    
-
-let rec inter (s1 : _ Set_gen.t)  (s2 : _ Set_gen.t) : _ Set_gen.t  =
-  match (s1, s2) with
-  | (Empty, t2) -> Empty
-  | (t1, Empty) -> Empty
-  | (Node(l1, v1, r1, _), t2) ->
-    begin match split v1 t2 with
-      | (l2, false, r2) ->
-        Set_gen.internal_concat (inter l1 l2) (inter r1 r2)
-      | (l2, true, r2) ->
-        Set_gen.internal_join (inter l1 l2) v1 (inter r1 r2)
-    end 
-
-let rec diff (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) : _ Set_gen.t  =
-  match (s1, s2) with
-  | (Empty, t2) -> Empty
-  | (t1, Empty) -> t1
-  | (Node(l1, v1, r1, _), t2) ->
-    begin match split v1 t2 with
-      | (l2, false, r2) ->
-        Set_gen.internal_join (diff l1 l2) v1 (diff r1 r2)
-      | (l2, true, r2) ->
-        Set_gen.internal_concat (diff l1 l2) (diff r1 r2)    
-    end
-
-
-let rec mem x (tree : _ Set_gen.t) =  match tree with 
-  | Empty -> false
-  | Node(l, v, r, _) ->
-    let c = compare_elt x v in
-    c = 0 || mem x (if c < 0 then l else r)
 
-let rec remove x (tree : _ Set_gen.t) : _ Set_gen.t = match tree with 
-  | Empty -> Empty
-  | Node(l, v, r, _) ->
-    let c = compare_elt x v in
-    if c = 0 then Set_gen.internal_merge l r else
-    if c < 0 then Set_gen.internal_bal (remove x l) v r else Set_gen.internal_bal l v (remove x r)
 
-let compare s1 s2 = Set_gen.compare compare_elt s1 s2 
 
+let create  initial_size =
+  let s = Ext_util.power_2_above 16 initial_size in
+  { initial_size = s; size = 0; data = Array.make s [] }
 
-let equal s1 s2 =
-  compare s1 s2 = 0
+let clear h =
+  h.size <- 0;
+  let len = Array.length h.data in
+  for i = 0 to len - 1 do
+    Array.unsafe_set h.data i  []
+  done
 
-let rec subset (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) =
-  match (s1, s2) with
-  | Empty, _ ->
-    true
-  | _, Empty ->
-    false
-  | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) ->
-    let c = compare_elt v1 v2 in
-    if c = 0 then
-      subset l1 l2 && subset r1 r2
-    else if c < 0 then
-      subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2
-    else
-      subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2
+let reset h =
+  h.size <- 0;
+  h.data <- Array.make h.initial_size [ ]
 
 
+let copy h = { h with data = Array.copy h.data }
 
+let length h = h.size
 
-let rec find x (tree : _ Set_gen.t) = match tree with
-  | Empty -> raise Not_found
-  | Node(l, v, r, _) ->
-    let c = compare_elt x v in
-    if c = 0 then v
-    else find x (if c < 0 then l else r)
+let iter f h =
+  let rec do_bucket = function
+    | [ ] ->
+      ()
+    | k ::  rest ->
+      f k ; do_bucket rest in
+  let d = h.data in
+  for i = 0 to Array.length d - 1 do
+    do_bucket (Array.unsafe_get d i)
+  done
 
+let fold f h init =
+  let rec do_bucket b accu =
+    match b with
+      [ ] ->
+      accu
+    | k ::  rest ->
+      do_bucket rest (f k  accu) in
+  let d = h.data in
+  let accu = ref init in
+  for i = 0 to Array.length d - 1 do
+    accu := do_bucket (Array.unsafe_get d i) !accu
+  done;
+  !accu
 
+let resize indexfun h =
+  let odata = h.data in
+  let osize = Array.length odata in
+  let nsize = osize * 2 in
+  if nsize < Sys.max_array_length then begin
+    let ndata = Array.make nsize [ ] in
+    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
+    let rec insert_bucket = function
+        [ ] -> ()
+      | key :: rest ->
+        let nidx = indexfun h key in
+        ndata.(nidx) <- key :: ndata.(nidx);
+        insert_bucket rest
+    in
+    for i = 0 to osize - 1 do
+      insert_bucket (Array.unsafe_get odata i)
+    done
+  end
 
-let of_list l =
-  match l with
-  | [] -> empty
-  | [x0] -> singleton x0
-  | [x0; x1] -> add x1 (singleton x0)
-  | [x0; x1; x2] -> add x2 (add x1 (singleton x0))
-  | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0)))
-  | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0))))
-  | _ -> of_sorted_list (List.sort_uniq compare_elt l)
+let elements set = 
+  fold  (fun k  acc ->  k :: acc) set []
 
-let of_array l = 
-  Array.fold_left (fun  acc x -> add x acc) empty l
 
-(* also check order *)
-let invariant t =
-  Set_gen.check t ;
-  Set_gen.is_ordered compare_elt t          
 
 
+let stats h =
+  let mbl =
+    Array.fold_left (fun m b -> max m (List.length b)) 0 h.data in
+  let histo = Array.make (mbl + 1) 0 in
+  Array.iter
+    (fun b ->
+       let l = List.length b in
+       histo.(l) <- histo.(l) + 1)
+    h.data;
+  {Hashtbl.num_bindings = h.size;
+   num_buckets = Array.length h.data;
+   max_bucket_length = mbl;
+   bucket_histogram = histo }
 
+let rec small_bucket_mem eq_key key lst =
+  match lst with 
+  | [] -> false 
+  | key1::rest -> 
+    eq_key key   key1 ||
+    match rest with 
+    | [] -> false 
+    | key2 :: rest -> 
+      eq_key key   key2 ||
+      match rest with 
+      | [] -> false 
+      | key3 :: rest -> 
+        eq_key key   key3 ||
+        small_bucket_mem eq_key key rest 
 
+let rec remove_bucket eq_key key (h : _ t) buckets = 
+  match buckets with 
+  | [ ] ->
+    [ ]
+  | k :: next ->
+    if  eq_key k   key
+    then begin h.size <- h.size - 1; next end
+    else k :: remove_bucket eq_key key h next    
 
+module type S =
+sig
+  type key
+  type t
+  val create: int ->  t
+  val clear : t -> unit
+  val reset : t -> unit
+  val copy: t -> t
+  val remove:  t -> key -> unit
+  val add :  t -> key -> unit
+  val check_add : t -> key -> bool
+  val mem :  t -> key -> bool
+  val iter: (key -> unit) ->  t -> unit
+  val fold: (key -> 'b -> 'b) ->  t -> 'b -> 'b
+  val length:  t -> int
+  val stats:  t -> Hashtbl.statistics
+  val elements : t -> key list 
+end
 
 end
-module Js_call_info : sig 
-#1 "js_call_info.mli"
+module String_hash_set : sig 
+#1 "string_hash_set.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58721,42 +58564,11 @@ module Js_call_info : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-
-
-
-
-
-
-(** Type for collecting call site information, used in JS IR *) 
-
-type arity = 
-  | Full 
-  | NA 
-
-
-type call_info = 
-  | Call_ml (* called by plain ocaml expression *)
-  | Call_builtin_runtime (* built-in externals *)
-  | Call_na 
-  (* either from [@@bs.val] or not available, 
-     such calls does not follow such rules
-     {[ fun x y -> f x y === f ]} when [f] is an atom     
-  *) 
-
-
-type t = { 
-  call_info : call_info;
-  arity : arity;
-
-}
-
-val dummy : t
-val builtin_runtime_call : t
-
-val ml_full_call : t 
+include Hash_set_gen.S with type key = string
 
 end = struct
-#1 "js_call_info.ml"
+#1 "string_hash_set.ml"
+# 1 "ext/hash_set.cppo.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58780,42 +58592,66 @@ end = struct
  * 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. *)
+# 31
+type key = string 
+let key_index (h :  _ Hash_set_gen.t ) (key : key) =
+  (Bs_hash_stubs.hash_string  key) land (Array.length h.data - 1)
+let eq_key = Ext_string.equal 
+type  t = key  Hash_set_gen.t 
 
 
+# 59
+let create = Hash_set_gen.create
+let clear = Hash_set_gen.clear
+let reset = Hash_set_gen.reset
+let copy = Hash_set_gen.copy
+let iter = Hash_set_gen.iter
+let fold = Hash_set_gen.fold
+let length = Hash_set_gen.length
+let stats = Hash_set_gen.stats
+let elements = Hash_set_gen.elements
 
 
 
+let remove (h : _ Hash_set_gen.t) key =  
+  let i = key_index h key in
+  let h_data = h.data in
+  let old_h_size = h.size in 
+  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
+  if old_h_size <> h.size then  
+    Array.unsafe_set h_data i new_bucket
 
 
 
-type arity = 
-  | Full 
-  | NA 
-
-type call_info = 
-  | Call_ml (* called by plain ocaml expression *)
-  | Call_builtin_runtime (* built-in externals *)
-  | Call_na 
-  (* either from [@@bs.val] or not available, 
-     such calls does not follow such rules
-     {[ fun x y -> (f x y) === f ]} when [f] is an atom     
-
-  *) 
+let add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
+    end
 
-type t = { 
-  call_info : call_info;
-  arity : arity
-}
+let check_add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
+      true 
+    end
+  else false 
 
-let dummy = { arity = NA; call_info = Call_na }
 
-let builtin_runtime_call = {arity = Full; call_info = Call_builtin_runtime}
+let mem (h :  _ Hash_set_gen.t) key =
+  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
 
-let ml_full_call = {arity = Full; call_info = Call_ml}
+  
 
 end
-module Js_closure : sig 
-#1 "js_closure.mli"
+module Ext_ident : sig 
+#1 "ext_ident.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58847,68 +58683,45 @@ module Js_closure : sig
 
 
 
-(** Define a type used in JS IR to help convert lexical scope to JS [var] 
-    based scope convention
- *)
-
-type t = {
-  mutable outer_loop_mutable_values :  Ident_set.t 
-}
-
-val empty : unit -> t
+(** A wrapper around [Ident] module in compiler-libs*)
 
-val get_lexical_scope : t -> Ident_set.t
+val is_js : Ident.t -> bool
 
-val set_lexical_scope : t -> Ident_set.t -> unit
+val is_js_object : Ident.t -> bool
 
-end = struct
-#1 "js_closure.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+(** create identifiers for predefined [js] global variables *)
+val create_js : string -> Ident.t
 
+val create : string -> Ident.t
 
+val create_js_module : string -> Ident.t 
 
+val make_js_object : Ident.t -> unit
 
+val reset : unit -> unit
 
+val gen_js :  ?name:string -> unit -> Ident.t
 
+val make_unused : unit -> Ident.t
 
+val is_unused_ident : Ident.t -> bool 
 
-type t = {
-  mutable outer_loop_mutable_values :  Ident_set.t ;
-}
+(**
+   if name is not converted, the reference should be equal
+*)
+val convert : bool -> string -> string
+val property_no_need_convert : string -> bool 
 
-let empty () = {
-  outer_loop_mutable_values  = Ident_set.empty
-}
+val undefined : Ident.t 
+val is_js_or_global : Ident.t -> bool
+val nil : Ident.t
 
-let set_lexical_scope t v = t.outer_loop_mutable_values <- v 
 
-let get_lexical_scope t = t.outer_loop_mutable_values 
+val compare : Ident.t -> Ident.t -> int
+val equal : Ident.t -> Ident.t -> bool 
 
-end
-module Js_fun_env : sig 
-#1 "js_fun_env.mli"
+end = struct
+#1 "ext_ident.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58940,39 +58753,259 @@ module Js_fun_env : sig
 
 
 
-(** Define type t used in JS IR to collect some meta data for a function, like its closures, etc 
-  *)
+let js_flag = 0b1000 (* check with ocaml compiler *)
 
-type t 
+let js_module_flag = 0b1_0000 (* javascript external modules *)
+(* TODO:
+    check name conflicts with javascript conventions
+    {[
+    Ext_ident.convert "^";;
+    - : string = "$caret"
+    ]}
+ *)
+let js_object_flag = 0b10_0000 (* javascript object flags *)
 
-val empty :  ?immutable_mask:bool array  -> int -> t
+let is_js (i : Ident.t) = 
+  i.flags land js_flag <> 0 
 
-val is_tailcalled : t -> bool
+let is_js_or_global (i : Ident.t) = 
+  i.flags land (8 lor 1) <> 0 
 
-val is_empty : t -> bool 
+let is_js_module (i : Ident.t) =
+  i.flags land js_module_flag <> 0 
 
-val set_unbounded :  t -> Ident_set.t -> unit
+let is_js_object (i : Ident.t) = 
+  i.flags land js_object_flag <> 0 
 
+let make_js_object (i : Ident.t) = 
+  i.flags <- i.flags lor js_object_flag 
+      
+(* It's a js function hard coded by js api, so when printing,
+   it should preserve the name 
+ *)
+let create_js (name : string) : Ident.t  = 
+  { name = name; flags = js_flag ; stamp = 0}
 
+let js_module_table : Ident.t String_hashtbl.t = String_hashtbl.create 31 
 
-val set_lexical_scope : t -> Ident_set.t -> unit
+(* This is for a js exeternal module, we can change it when printing
+   for example
+   {[
+   var React$1 = require('react');
+   React$1.render(..)
+   ]}
 
-val get_lexical_scope : t -> Ident_set.t
+   Given a name, if duplicated, they should  have the same id
+ *)
+let create_js_module (name : string) : Ident.t = 
+  let name = 
+    String.concat "" @@ List.map (String.capitalize ) @@ 
+    Ext_string.split name '-' in
+  (* TODO: if we do such transformation, we should avoid 
+      collision for example:
+      react-dom 
+      react--dom
+      check collision later
+   *)
+  match String_hashtbl.find_exn js_module_table name  with 
+  | exception Not_found -> 
+      let v = Ident.create name in
+      let ans = { v with flags = js_module_flag} in 
+      String_hashtbl.add js_module_table name ans;
+      ans
+  | v -> v 
 
-val to_string : t -> string
+let create = Ident.create
 
-val mark_unused : t -> int -> unit 
+let gen_js ?(name="$js") () = create name 
 
-val get_unused : t -> int -> bool
+let reserved_words = 
+  [|
+    (* keywork *)
+    "break";
+    "case"; "catch"; "continue";
+    "debugger";"default";"delete";"do";
+    "else";
+    "finally";"for";"function";
+    "if"; "then"; "in";"instanceof";
+    "new";
+    "return";
+    "switch";
+    "this"; "throw"; "try"; "typeof";
+    "var"; "void"; "while"; "with";
 
-val get_mutable_params : Ident.t list -> t -> Ident.t list
+    (* reserved in ECMAScript 5 *)
+    "class"; "enum"; "export"; "extends"; "import"; "super";
 
-val get_unbounded : t -> Ident_set.t
+    "implements";"interface";
+    "let";
+    "package";"private";"protected";"public";
+    "static";
+    "yield";
 
-val get_length : t -> int
+    (* other *)
+    "null";
+    "true";
+    "false";
+    "NaN";
 
-end = struct
-#1 "js_fun_env.ml"
+
+    "undefined";
+    "this";
+
+    (* also reserved in ECMAScript 3 *)
+    "abstract"; "boolean"; "byte"; "char"; "const"; "double";
+    "final"; "float"; "goto"; "int"; "long"; "native"; "short";
+    "synchronized"; 
+    (* "throws";  *)
+    (* seems to be fine, like nodejs [assert.throws] *)
+    "transient"; "volatile";
+
+    (* also reserved in ECMAScript 6 *)
+    "await";
+   
+   "event";
+   "location";
+   "window";
+   "document";
+   "eval";
+   "navigator";
+   (* "self"; *)
+   
+   "Array";
+   "Date";
+   "Math";
+   "JSON";
+   "Object";
+   "RegExp";
+   "String";
+   "Boolean";
+   "Number";
+
+   "Map"; (* es6*)
+   "Set";
+
+   "Infinity";
+   "isFinite";
+   
+   "ActiveXObject";
+   "XMLHttpRequest";
+   "XDomainRequest";
+   
+   "DOMException";
+   "Error";
+   "SyntaxError";
+   "arguments";
+   
+   "decodeURI";
+   "decodeURIComponent";
+   "encodeURI";
+   "encodeURIComponent";
+   "escape";
+   "unescape";
+
+   "isNaN";
+   "parseFloat";
+   "parseInt";
+   
+   (** reserved for commonjs *)   
+   "require";
+   "exports";
+   "module"
+  |]
+
+let reserved_map = 
+  let len = Array.length reserved_words in 
+  let set =  String_hash_set.create 1024 in (* large hash set for perfect hashing *)
+  for i = 0 to len - 1 do 
+    String_hash_set.add set reserved_words.(i);
+  done ;
+  set 
+
+
+
+
+
+(* TODO:
+    check name conflicts with javascript conventions
+    {[
+    Ext_ident.convert "^";;
+    - : string = "$caret"
+    ]}
+ *)
+let convert keyword (name : string) = 
+   if keyword && String_hash_set.mem reserved_map name  then "$$" ^ name 
+   else 
+     let module E = struct exception Not_normal_letter of int end in
+     let len = String.length name  in
+     try
+       for i  = 0 to len - 1 do 
+         match String.unsafe_get name i with 
+         | 'a' .. 'z' | 'A' .. 'Z'
+         | '0' .. '9' | '_' | '$' -> ()
+         | _ -> raise (E.Not_normal_letter i)
+       done;
+       name
+     with E.Not_normal_letter i ->
+       String.sub name 0 i ^ 
+       (let buffer = Buffer.create len in 
+        for j = i to  len - 1 do 
+          let c = String.unsafe_get name j in
+          match c with 
+          | '*' -> Buffer.add_string buffer "$star"
+          | '\'' -> Buffer.add_string buffer "$prime"
+          | '!' -> Buffer.add_string buffer "$bang"
+          | '>' -> Buffer.add_string buffer "$great"
+          | '<' -> Buffer.add_string buffer "$less"
+          | '=' -> Buffer.add_string buffer "$eq"
+          | '+' -> Buffer.add_string buffer "$plus"
+          | '-' -> Buffer.add_string buffer "$neg"
+          | '@' -> Buffer.add_string buffer "$at"
+          | '^' -> Buffer.add_string buffer "$caret"
+          | '/' -> Buffer.add_string buffer "$slash"
+          | '|' -> Buffer.add_string buffer "$pipe"
+          | '.' -> Buffer.add_string buffer "$dot"
+          | '%' -> Buffer.add_string buffer "$percent"
+          | '~' -> Buffer.add_string buffer "$tilde"
+          | 'a'..'z' | 'A'..'Z'| '_'|'$' |'0'..'9'-> Buffer.add_char buffer  c
+          | _ -> Buffer.add_string buffer "$unknown"
+        done; Buffer.contents buffer)
+
+let property_no_need_convert s = 
+  s == convert false s 
+
+(* It is currently made a persistent ident to avoid fresh ids 
+    which would result in different signature files
+    - other solution: use lazy values
+*)
+let make_unused () = create "_"
+
+let is_unused_ident i = Ident.name i = "_"
+
+let reset () = 
+  String_hashtbl.clear js_module_table
+
+
+let undefined = create_js "undefined"
+let nil = create_js "null"
+
+(* Has to be total order, [x < y] 
+   and [x > y] should be consistent
+   flags are not relevant here 
+ *)
+let compare (x : Ident.t ) ( y : Ident.t) = 
+  let u = x.stamp - y.stamp in
+  if u = 0 then 
+     String.compare x.name y.name 
+  else u 
+
+let equal ( x : Ident.t) ( y : Ident.t) = 
+  if x.stamp <> 0 then x.stamp = y.stamp
+  else y.stamp = 0 && x.name = y.name
+   
+end
+module Ident_hash_set : sig 
+#1 "ident_hash_set.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -58998,96 +59031,95 @@ end = struct
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+include Hash_set_gen.S with type key = Ident.t
 
+end = struct
+#1 "ident_hash_set.ml"
+# 1 "ext/hash_set.cppo.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+# 37
+type key = Ident.t
+let key_index (h :  _ Hash_set_gen.t ) (key : key) =
+  (Bs_hash_stubs.hash_string_int  key.name key.stamp) land (Array.length h.data - 1)
+let eq_key = Ext_ident.equal
+type t = key Hash_set_gen.t
 
 
+# 59
+let create = Hash_set_gen.create
+let clear = Hash_set_gen.clear
+let reset = Hash_set_gen.reset
+let copy = Hash_set_gen.copy
+let iter = Hash_set_gen.iter
+let fold = Hash_set_gen.fold
+let length = Hash_set_gen.length
+let stats = Hash_set_gen.stats
+let elements = Hash_set_gen.elements
 
 
 
-(* Make it mutable so that we can do
-   in-place change without constructing a new one
-  -- however, it's a design choice -- to be reviewed later
-*)
-
-type immutable_mask = 
-  | All_immutable_and_no_tail_call 
-     (** iff not tailcalled 
-         if tailcalled, in theory, it does not need change params, 
-         for example
-         {[
-         let rec f  (n : int ref) = 
-            if !n > 0 then decr n; print_endline "hi"
-            else  f n
-         ]}
-         in this case, we still create [Immutable_mask], 
-         since the inline behavior is slightly different
-      *)
-  | Immutable_mask of bool array
-
-type t = { 
-  mutable unbounded : Ident_set.t;
-  mutable bound_loop_mutable_values : Ident_set.t; 
-  used_mask : bool array;
-  immutable_mask : immutable_mask; 
-}
-(** Invariant: unused param has to be immutable *)
-
-let empty ?immutable_mask n = { 
-  unbounded =  Ident_set.empty ;
-  used_mask = Array.make n false;
-  immutable_mask = 
-    (match immutable_mask with 
-     | Some x -> Immutable_mask x 
-     | None -> All_immutable_and_no_tail_call
-    );
-  bound_loop_mutable_values =Ident_set.empty;
-}
-
-let is_tailcalled x = x.immutable_mask <> All_immutable_and_no_tail_call
-
-let mark_unused  t i = 
-  t.used_mask.(i) <- true
-
-let get_unused t i = 
-  t.used_mask.(i)
-
-let get_length t = Array.length t.used_mask
-
-let to_string env =  
-  String.concat "," 
-    (List.map (fun (id : Ident.t) -> Printf.sprintf "%s/%d" id.name id.stamp)
-       (Ident_set.elements  env.unbounded ))
+let remove (h : _ Hash_set_gen.t) key =  
+  let i = key_index h key in
+  let h_data = h.data in
+  let old_h_size = h.size in 
+  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
+  if old_h_size <> h.size then  
+    Array.unsafe_set h_data i new_bucket
 
-let get_mutable_params (params : Ident.t list) (x : t ) = 
-  match x.immutable_mask with 
-  | All_immutable_and_no_tail_call -> []
-  | Immutable_mask xs -> 
-      Ext_list.filter_mapi 
-        (fun i p -> if not xs.(i) then Some p else None)  params
 
 
-let get_unbounded t = t.unbounded
+let add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
+    end
 
-let set_unbounded env v = 
-  (* Ext_log.err "%s -- set @." (to_string env); *)
-  (* if Ident_set.is_empty env.bound then *)
-  env.unbounded <- v 
- (* else assert false *)
+let check_add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
+      true 
+    end
+  else false 
 
-let set_lexical_scope env bound_loop_mutable_values = 
-  env.bound_loop_mutable_values <- bound_loop_mutable_values
 
-let get_lexical_scope env =  
-  env.bound_loop_mutable_values
+let mem (h :  _ Hash_set_gen.t) key =
+  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
 
-(* TODO:  can be refined if it 
-    only enclose toplevel variables 
- *)
-let is_empty t = Ident_set.is_empty t.unbounded
+  
 
 end
-module Lambda : sig 
-#1 "lambda.mli"
+module Set_gen
+= struct
+#1 "set_gen.ml"
 (***********************************************************************)
 (*                                                                     *)
 (*                                OCaml                                *)
@@ -59096,413 +59128,817 @@ module Lambda : sig
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* The "lambda" intermediate code *)
+(** balanced tree based on stdlib distribution *)
 
-open Asttypes
+type 'a t = 
+  | Empty 
+  | Node of 'a t * 'a * 'a t * int 
 
-type compile_time_constant =
-  | Big_endian
-  | Word_size
-  | Ostype_unix
-  | Ostype_win32
-  | Ostype_cygwin
+type 'a enumeration = 
+  | End | More of 'a * 'a t * 'a enumeration
 
-type loc_kind =
-  | Loc_FILE
-  | Loc_LINE
-  | Loc_MODULE
-  | Loc_LOC
-  | Loc_POS
 
+let rec cons_enum s e = 
+  match s with 
+  | Empty -> e 
+  | Node(l,v,r,_) -> cons_enum l (More(v,r,e))
 
+let rec height = function
+  | Empty -> 0 
+  | Node(_,_,_,h) -> h   
 
-type tag_info = 
-  | Blk_constructor of string * int (* Number of non-const constructors*)
-  | Blk_tuple
-  | Blk_array
-  | Blk_variant of string 
-  | Blk_record of string array
-  | Blk_module of string list option
-  | Blk_na
+(* Smallest and greatest element of a set *)
 
-val default_tag_info : tag_info
+let rec min_elt = function
+    Empty -> raise Not_found
+  | Node(Empty, v, r, _) -> v
+  | Node(l, v, r, _) -> min_elt l
 
-type field_dbg_info = 
-  | Fld_na
-  | Fld_record of string
-  | Fld_module of string 
+let rec max_elt = function
+    Empty -> raise Not_found
+  | Node(l, v, Empty, _) -> v
+  | Node(l, v, r, _) -> max_elt r
 
-type set_field_dbg_info = 
-  | Fld_set_na
-  | Fld_record_set of string 
 
-type pointer_info = 
-  | Pt_constructor of string
-  | Pt_variant of string 
-  | Pt_module_alias
-  | Pt_na 
 
-val default_pointer_info : pointer_info
 
-type primitive =
-  | Pidentity
-  | Pbytes_to_string
-  | Pbytes_of_string
-  | Pignore
-  | Prevapply 
-  | Pdirapply
-  | Ploc of loc_kind
-    (* Globals *)
-  | Pgetglobal of Ident.t
-  | Psetglobal of Ident.t
-  (* Operations on heap blocks *)
-  | Pmakeblock of int * tag_info * mutable_flag
-  | Pfield of int * field_dbg_info
-  | Psetfield of int * bool * set_field_dbg_info
-  (* could have field info at least for record *)
-  | Pfloatfield of int * field_dbg_info
-  | Psetfloatfield of int * set_field_dbg_info
-  | Pduprecord of Types.record_representation * int
-  (* Force lazy values *)
-  | Plazyforce
-  (* External call *)
-  | Pccall of Primitive.description
-  (* Exceptions *)
-  | Praise of raise_kind
-  (* Boolean operations *)
-  | Psequand | Psequor | Pnot
-  (* Integer operations *)
-  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
-  | Pandint | Porint | Pxorint
-  | Plslint | Plsrint | Pasrint
-  | Pintcomp of comparison
-  | Poffsetint of int
-  | Poffsetref of int
-  (* Float operations *)
-  | Pintoffloat | Pfloatofint
-  | Pnegfloat | Pabsfloat
-  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
-  | Pfloatcomp of comparison
-  (* String operations *)
-  | Pstringlength 
-  | Pstringrefu 
-  | Pstringsetu
-  | Pstringrefs
-  | Pstringsets
+let empty = Empty
 
-  | Pbyteslength
-  | Pbytesrefu
-  | Pbytessetu 
-  | Pbytesrefs
-  | Pbytessets
-  (* Array operations *)
-  | Pmakearray of array_kind
-  | Parraylength of array_kind
-  | Parrayrefu of array_kind
-  | Parraysetu of array_kind
-  | Parrayrefs of array_kind
-  | Parraysets of array_kind
-  (* Test if the argument is a block or an immediate integer *)
-  | Pisint
-  (* Test if the (integer) argument is outside an interval *)
-  | Pisout
-  (* Bitvect operations *)
-  | Pbittest
-  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
-  | Pbintofint of boxed_integer
-  | Pintofbint of boxed_integer
-  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
-  | Pnegbint of boxed_integer
-  | Paddbint of boxed_integer
-  | Psubbint of boxed_integer
-  | Pmulbint of boxed_integer
-  | Pdivbint of boxed_integer
-  | Pmodbint of boxed_integer
-  | Pandbint of boxed_integer
-  | Porbint of boxed_integer
-  | Pxorbint of boxed_integer
-  | Plslbint of boxed_integer
-  | Plsrbint of boxed_integer
-  | Pasrbint of boxed_integer
-  | Pbintcomp of boxed_integer * comparison
-  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
-  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
-  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
-  (* size of the nth dimension of a big array *)
-  | Pbigarraydim of int
-  (* load/set 16,32,64 bits from a string: (unsafe)*)
-  | Pstring_load_16 of bool
-  | Pstring_load_32 of bool
-  | Pstring_load_64 of bool
-  | Pstring_set_16 of bool
-  | Pstring_set_32 of bool
-  | Pstring_set_64 of bool
-  (* load/set 16,32,64 bits from a
-     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
-  | Pbigstring_load_16 of bool
-  | Pbigstring_load_32 of bool
-  | Pbigstring_load_64 of bool
-  | Pbigstring_set_16 of bool
-  | Pbigstring_set_32 of bool
-  | Pbigstring_set_64 of bool
-  (* Compile time constants *)
-  | Pctconst of compile_time_constant
-  (* byte swap *)
-  | Pbswap16
-  | Pbbswap of boxed_integer
-  (* Integer to external pointer *)
-  | Pint_as_pointer
+let is_empty = function Empty -> true | _ -> false
 
-and comparison =
-    Ceq | Cneq | Clt | Cgt | Cle | Cge
+let rec cardinal_aux acc  = function
+  | Empty -> acc 
+  | Node (l,_,r, _) -> 
+    cardinal_aux  (cardinal_aux (acc + 1)  r ) l 
 
-and array_kind =
-    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+let cardinal s = cardinal_aux 0 s 
 
-and boxed_integer =
-    Pnativeint | Pint32 | Pint64
+let rec elements_aux accu = function
+  | Empty -> accu
+  | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l
 
-and bigarray_kind =
-    Pbigarray_unknown
-  | Pbigarray_float32 | Pbigarray_float64
-  | Pbigarray_sint8 | Pbigarray_uint8
-  | Pbigarray_sint16 | Pbigarray_uint16
-  | Pbigarray_int32 | Pbigarray_int64
-  | Pbigarray_caml_int | Pbigarray_native_int
-  | Pbigarray_complex32 | Pbigarray_complex64
+let elements s =
+  elements_aux [] s
 
-and bigarray_layout =
-    Pbigarray_unknown_layout
-  | Pbigarray_c_layout
-  | Pbigarray_fortran_layout
+let choose = min_elt
 
-and raise_kind =
-  | Raise_regular
-  | Raise_reraise
-  | Raise_notrace
+let rec iter f = function
+  | Empty -> ()
+  | Node(l, v, r, _) -> iter f l; f v; iter f r
 
-type structured_constant =
-    Const_base of constant
-  | Const_pointer of int * pointer_info
-  | Const_block of int * tag_info * structured_constant list
-  | Const_float_array of string list
-  | Const_immstring of string
+let rec fold f s accu =
+  match s with
+  | Empty -> accu
+  | Node(l, v, r, _) -> fold f r (f v (fold f l accu))
 
-type function_kind = Curried | Tupled
+let rec for_all p = function
+  | Empty -> true
+  | Node(l, v, r, _) -> p v && for_all p l && for_all p r
 
-type let_kind = Strict | Alias | StrictOpt | Variable
-(* Meaning of kinds for let x = e in e':
-    Strict: e may have side-effets; always evaluate e first
-      (If e is a simple expression, e.g. a variable or constant,
-       we may still substitute e'[x/e].)
-    Alias: e is pure, we can substitute e'[x/e] if x has 0 or 1 occurrences
-      in e'
-    StrictOpt: e does not have side-effects, but depend on the store;
-      we can discard e if x does not appear in e'
-    Variable: the variable x is assigned later in e' *)
-type public_info = string option  (* label name *)
+let rec exists p = function
+  | Empty -> false
+  | Node(l, v, r, _) -> p v || exists p l || exists p r
 
-type meth_kind = Self | Public of public_info | Cached
 
-type shared_code = (int * int) list     (* stack size -> code label *)
+let max_int3 (a : int) b c = 
+  if a >= b then 
+    if a >= c then a 
+    else c
+  else 
+  if b >=c then b
+  else c     
+let max_int_2 (a : int) b =  
+  if a >= b then a else b 
 
 
-type lambda =
-    Lvar of Ident.t
-  | Lconst of structured_constant
-  | Lapply of lambda * lambda list * Location.t
-  | Lfunction of function_kind * Ident.t list * lambda
-  | Llet of let_kind * Ident.t * lambda * lambda
-  | Lletrec of (Ident.t * lambda) list * lambda
-  | Lprim of primitive * lambda list * Location.t
-  | Lswitch of lambda * lambda_switch
-(* switch on strings, clauses are sorted by string order,
-   strings are pairwise distinct *)
-  | Lstringswitch of lambda * (string * lambda) list * lambda option * Location.t
-  | Lstaticraise of int * lambda list
-  | Lstaticcatch of lambda * (int * Ident.t list) * lambda
-  | Ltrywith of lambda * Ident.t * lambda
-  | Lifthenelse of lambda * lambda * lambda
-  | Lsequence of lambda * lambda
-  | Lwhile of lambda * lambda
-  | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
-  | Lassign of Ident.t * lambda
-  | Lsend of meth_kind * lambda * lambda * lambda list * Location.t
-  | Levent of lambda * lambda_event
-  | Lifused of Ident.t * lambda
 
-and lambda_switch =
-  { sw_numconsts: int;                  (* Number of integer cases *)
-    sw_consts: (int * lambda) list;     (* Integer cases *)
-    sw_numblocks: int;                  (* Number of tag block cases *)
-    sw_blocks: (int * lambda) list;     (* Tag block cases *)
-    sw_failaction : lambda option}      (* Action to take if failure *)
-and lambda_event =
-  { lev_loc: Location.t;
-    lev_kind: lambda_event_kind;
-    lev_repr: int ref option;
-    lev_env: Env.summary }
+exception Height_invariant_broken
+exception Height_diff_borken 
 
-and lambda_event_kind =
-    Lev_before
-  | Lev_after of Types.type_expr
-  | Lev_function
+let rec check_height_and_diff = 
+  function 
+  | Empty -> 0
+  | Node(l,_,r,h) -> 
+    let hl = check_height_and_diff l in
+    let hr = check_height_and_diff r in
+    if h <>  max_int_2 hl hr + 1 then raise Height_invariant_broken
+    else  
+      let diff = (abs (hl - hr)) in  
+      if  diff > 2 then raise Height_diff_borken 
+      else h     
 
-(* Sharing key *)
-val make_key: lambda -> lambda option
+let check tree = 
+  ignore (check_height_and_diff tree)
+(* 
+    Invariants: 
+    1. {[ l < v < r]}
+    2. l and r balanced 
+    3. [height l] - [height r] <= 2
+*)
+let create l v r = 
+  let hl = match l with Empty -> 0 | Node (_,_,_,h) -> h in
+  let hr = match r with Empty -> 0 | Node (_,_,_,h) -> h in
+  Node(l,v,r, if hl >= hr then hl + 1 else hr + 1)         
 
-val const_unit: structured_constant
-val lambda_unit: lambda
-val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda
-val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
+(* Same as create, but performs one step of rebalancing if necessary.
+    Invariants:
+    1. {[ l < v < r ]}
+    2. l and r balanced 
+    3. | height l - height r | <= 3.
 
-val iter: (lambda -> unit) -> lambda -> unit
-module IdentSet: Set.S with type elt = Ident.t
-val free_variables: lambda -> IdentSet.t
-val free_methods: lambda -> IdentSet.t
+    Proof by indunction
 
-val transl_normal_path: Path.t -> lambda   (* Path.t is already normal *)
-val transl_path: ?loc:Location.t -> Env.t -> Path.t -> lambda
-val make_sequence: ('a -> lambda) -> 'a list -> lambda
+    Lemma: the height of  [bal l v r] will bounded by [max l r] + 1 
+*)
+(*
+let internal_bal l v r =
+  match l with
+  | Empty ->
+    begin match r with 
+      | Empty -> Node(Empty,v,Empty,1)
+      | Node(rl,rv,rr,hr) -> 
+        if hr > 2 then
+          begin match rl with
+            | Empty -> create (* create l v rl *) (Node (Empty,v,Empty,1)) rv rr 
+            | Node(rll,rlv,rlr,hrl) -> 
+              let hrr = height rr in 
+              if hrr >= hrl then 
+                Node  
+                  ((Node (Empty,v,rl,hrl+1))(* create l v rl *),
+                   rv, rr, if hrr = hrl then hrr + 2 else hrr + 1) 
+              else 
+                let hrll = height rll in 
+                let hrlr = height rlr in 
+                create
+                  (Node(Empty,v,rll,hrll + 1)) 
+                  (* create l v rll *) 
+                  rlv 
+                  (Node (rlr,rv,rr, if hrlr > hrr then hrlr + 1 else hrr + 1))
+                  (* create rlr rv rr *)    
+          end 
+        else Node (l,v,r, hr + 1)  
+    end
+  | Node(ll,lv,lr,hl) ->
+    begin match r with 
+      | Empty ->
+        if hl > 2 then 
+          (*if height ll >= height lr then create ll lv (create lr v r)
+            else*)
+          begin match lr with 
+            | Empty -> 
+              create ll lv (Node (Empty,v,Empty, 1)) 
+            (* create lr v r *)  
+            | Node(lrl,lrv,lrr,hlr) -> 
+              if height ll >= hlr then 
+                create ll lv
+                  (Node(lr,v,Empty,hlr+1)) 
+                  (*create lr v r*)
+              else 
+                let hlrr = height lrr in  
+                create 
+                  (create ll lv lrl)
+                  lrv
+                  (Node(lrr,v,Empty,hlrr + 1)) 
+                  (*create lrr v r*)
+          end 
+        else Node(l,v,r, hl+1)    
+      | Node(rl,rv,rr,hr) ->
+        if hl > hr + 2 then           
+          begin match lr with 
+            | Empty ->   create ll lv (create lr v r)
+            | Node(lrl,lrv,lrr,_) ->
+              if height ll >= height lr then create ll lv (create lr v r)
+              else 
+                create (create ll lv lrl) lrv (create lrr v r)
+          end 
+        else
+        if hr > hl + 2 then             
+          begin match rl with 
+            | Empty ->
+              let hrr = height rr in   
+              Node(
+                (Node (l,v,Empty,hl + 1))
+                (*create l v rl*)
+                ,
+                rv,
+                rr,
+                if hrr > hr then hrr + 1 else hl + 2 
+              )
+            | Node(rll,rlv,rlr,_) ->
+              let hrr = height rr in 
+              let hrl = height rl in 
+              if hrr >= hrl then create (create l v rl) rv rr else 
+                create (create l v rll) rlv (create rlr rv rr)
+          end
+        else  
+          Node(l,v,r, if hl >= hr then hl+1 else hr + 1)
+    end
+*)
+let internal_bal l v r =
+  let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
+  let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+  if hl > hr + 2 then begin
+    match l with
+      Empty -> assert false
+    | Node(ll, lv, lr, _) ->   
+      if height ll >= height lr then
+        (* [ll] >~ [lr] 
+           [ll] >~ [r] 
+           [ll] ~~ [ lr ^ r]  
+        *)
+        create ll lv (create lr v r)
+      else begin
+        match lr with
+          Empty -> assert false
+        | Node(lrl, lrv, lrr, _)->
+          (* [lr] >~ [ll]
+             [lr] >~ [r]
+             [ll ^ lrl] ~~ [lrr ^ r]   
+          *)
+          create (create ll lv lrl) lrv (create lrr v r)
+      end
+  end else if hr > hl + 2 then begin
+    match r with
+      Empty -> assert false
+    | Node(rl, rv, rr, _) ->
+      if height rr >= height rl then
+        create (create l v rl) rv rr
+      else begin
+        match rl with
+          Empty -> assert false
+        | Node(rll, rlv, rlr, _) ->
+          create (create l v rll) rlv (create rlr rv rr)
+      end
+  end else
+    Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1))    
 
-val subst_lambda: lambda Ident.tbl -> lambda -> lambda
-val bind : let_kind -> Ident.t -> lambda -> lambda -> lambda
+let rec remove_min_elt = function
+    Empty -> invalid_arg "Set.remove_min_elt"
+  | Node(Empty, v, r, _) -> r
+  | Node(l, v, r, _) -> internal_bal (remove_min_elt l) v r
 
-val commute_comparison : comparison -> comparison
-val negate_comparison : comparison -> comparison
+let singleton x = Node(Empty, x, Empty, 1)    
 
-(***********************)
-(* For static failures *)
-(***********************)
+(* 
+   All elements of l must precede the elements of r.
+       Assume | height l - height r | <= 2.
+   weak form of [concat] 
+*)
 
-(* Get a new static failure ident *)
-val next_raise_count : unit -> int
-val next_negative_raise_count : unit -> int
-  (* Negative raise counts are used to compile 'match ... with
-     exception x -> ...'.  This disabled some simplifications
-     performed by the Simplif module that assume that static raises
-     are in tail position in their handler. *)
+let internal_merge l r =
+  match (l, r) with
+  | (Empty, t) -> t
+  | (t, Empty) -> t
+  | (_, _) -> internal_bal l (min_elt r) (remove_min_elt r)
 
-val staticfail : lambda (* Anticipated static failure *)
+(* Beware: those two functions assume that the added v is *strictly*
+    smaller (or bigger) than all the present elements in the tree; it
+    does not test for equality with the current min (or max) element.
+    Indeed, they are only used during the "join" operation which
+    respects this precondition.
+*)
 
-(* Check anticipated failure, substitute its final value *)
-val is_guarded: lambda -> bool
-val patch_guarded : lambda -> lambda -> lambda
+let rec add_min_element v = function
+  | Empty -> singleton v
+  | Node (l, x, r, h) ->
+    internal_bal (add_min_element v l) x r
 
-val raise_kind: raise_kind -> string
-val lam_of_loc : loc_kind -> Location.t -> lambda
+let rec add_max_element v = function
+  | Empty -> singleton v
+  | Node (l, x, r, h) ->
+    internal_bal l x (add_max_element v r)
 
-val reset: unit -> unit
+(** 
+    Invariants:
+    1. l < v < r 
+    2. l and r are balanced 
 
-end = struct
-#1 "lambda.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+    Proof by induction
+    The height of output will be ~~ (max (height l) (height r) + 2)
+    Also use the lemma from [bal]
+*)
+let rec internal_join l v r =
+  match (l, r) with
+    (Empty, _) -> add_min_element v r
+  | (_, Empty) -> add_max_element v l
+  | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
+    if lh > rh + 2 then 
+      (* proof by induction:
+         now [height of ll] is [lh - 1] 
+      *)
+      internal_bal ll lv (internal_join lr v r) 
+    else
+    if rh > lh + 2 then internal_bal (internal_join l v rl) rv rr 
+    else create l v r
 
-open Misc
-open Path
-open Asttypes
 
-type compile_time_constant =
-  | Big_endian
-  | Word_size
-  | Ostype_unix
-  | Ostype_win32
-  | Ostype_cygwin
+(*
+    Required Invariants: 
+    [t1] < [t2]  
+*)
+let internal_concat t1 t2 =
+  match (t1, t2) with
+  | (Empty, t) -> t
+  | (t, Empty) -> t
+  | (_, _) -> internal_join t1 (min_elt t2) (remove_min_elt t2)
 
-type loc_kind =
-  | Loc_FILE
-  | Loc_LINE
-  | Loc_MODULE
-  | Loc_LOC
-  | Loc_POS
+let rec filter p = function
+  | Empty -> Empty
+  | Node(l, v, r, _) ->
+    (* call [p] in the expected left-to-right order *)
+    let l' = filter p l in
+    let pv = p v in
+    let r' = filter p r in
+    if pv then internal_join l' v r' else internal_concat l' r'
 
-type tag_info = 
-  | Blk_constructor of string * int (* Number of non-const constructors*)
-  | Blk_tuple
-  | Blk_array
-  | Blk_variant of string 
-  | Blk_record of string array (* when its empty means we dont get such information *)
-  | Blk_module of string list option
-  | Blk_na
 
-let default_tag_info : tag_info = Blk_na
+let rec partition p = function
+  | Empty -> (Empty, Empty)
+  | Node(l, v, r, _) ->
+    (* call [p] in the expected left-to-right order *)
+    let (lt, lf) = partition p l in
+    let pv = p v in
+    let (rt, rf) = partition p r in
+    if pv
+    then (internal_join lt v rt, internal_concat lf rf)
+    else (internal_concat lt rt, internal_join lf v rf)
 
-type field_dbg_info = 
-  | Fld_na
-  | Fld_record of string
-  | Fld_module of string 
+let of_sorted_list l =
+  let rec sub n l =
+    match n, l with
+    | 0, l -> Empty, l
+    | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l
+    | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l
+    | 3, x0 :: x1 :: x2 :: l ->
+      Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l
+    | n, l ->
+      let nl = n / 2 in
+      let left, l = sub nl l in
+      match l with
+      | [] -> assert false
+      | mid :: l ->
+        let right, l = sub (n - nl - 1) l in
+        create left mid right, l
+  in
+  fst (sub (List.length l) l)
 
-type set_field_dbg_info = 
-  | Fld_set_na
-  | Fld_record_set of string 
+let of_sorted_array l =   
+  let rec sub start n l  =
+    if n = 0 then Empty else 
+    if n = 1 then 
+      let x0 = Array.unsafe_get l start in
+      Node (Empty, x0, Empty, 1)
+    else if n = 2 then     
+      let x0 = Array.unsafe_get l start in 
+      let x1 = Array.unsafe_get l (start + 1) in 
+      Node (Node(Empty, x0, Empty, 1), x1, Empty, 2) else
+    if n = 3 then 
+      let x0 = Array.unsafe_get l start in 
+      let x1 = Array.unsafe_get l (start + 1) in
+      let x2 = Array.unsafe_get l (start + 2) in
+      Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2)
+    else 
+      let nl = n / 2 in
+      let left = sub start nl l in
+      let mid = start + nl in 
+      let v = Array.unsafe_get l mid in 
+      let right = sub (mid + 1) (n - nl - 1) l in        
+      create left v right
+  in
+  sub 0 (Array.length l) l 
 
-type primitive =
-  | Pidentity
-  | Pbytes_to_string
-  | Pbytes_of_string
-  | Pignore
-  | Prevapply 
-  | Pdirapply 
-  | Ploc of loc_kind
-    (* Globals *)
-  | Pgetglobal of Ident.t
-  | Psetglobal of Ident.t
-  (* Operations on heap blocks *)
-  | Pmakeblock of int * tag_info * mutable_flag
-  | Pfield of int * field_dbg_info
-  | Psetfield of int * bool * set_field_dbg_info
-  | Pfloatfield of int * field_dbg_info
-  | Psetfloatfield of int * set_field_dbg_info
-  | Pduprecord of Types.record_representation * int
-  (* Force lazy values *)
-  | Plazyforce
-  (* External call *)
-  | Pccall of  Primitive.description
-  (* Exceptions *)
-  | Praise of raise_kind
-  (* Boolean operations *)
-  | Psequand | Psequor | Pnot
-  (* Integer operations *)
-  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
-  | Pandint | Porint | Pxorint
-  | Plslint | Plsrint | Pasrint
-  | Pintcomp of comparison
-  | Poffsetint of int
-  | Poffsetref of int
-  (* Float operations *)
-  | Pintoffloat | Pfloatofint
-  | Pnegfloat | Pabsfloat
-  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
-  | Pfloatcomp of comparison
-  (* String operations *)
-  | Pstringlength 
-  | Pstringrefu 
-  | Pstringsetu
-  | Pstringrefs
-  | Pstringsets
+let is_ordered cmp tree =
+  let rec is_ordered_min_max tree =
+    match tree with
+    | Empty -> `Empty
+    | Node(l,v,r,_) -> 
+      begin match is_ordered_min_max l with
+        | `No -> `No 
+        | `Empty ->
+          begin match is_ordered_min_max r with
+            | `No  -> `No
+            | `Empty -> `V (v,v)
+            | `V(l,r) ->
+              if cmp v l < 0 then
+                `V(v,r)
+              else
+                `No
+          end
+        | `V(min_v,max_v)->
+          begin match is_ordered_min_max r with
+            | `No -> `No
+            | `Empty -> 
+              if cmp max_v v < 0 then 
+                `V(min_v,v)
+              else
+                `No 
+            | `V(min_v_r, max_v_r) ->
+              if cmp max_v min_v_r < 0 then
+                `V(min_v,max_v_r)
+              else `No
+          end
+      end  in 
+  is_ordered_min_max tree <> `No 
 
-  | Pbyteslength
-  | Pbytesrefu
-  | Pbytessetu 
-  | Pbytesrefs
-  | Pbytessets
-  (* Array operations *)
-  | Pmakearray of array_kind
-  | Parraylength of array_kind
+let invariant cmp t = 
+  check t ; 
+  is_ordered cmp t 
+
+let rec compare_aux cmp e1 e2 =
+  match (e1, e2) with
+    (End, End) -> 0
+  | (End, _)  -> -1
+  | (_, End) -> 1
+  | (More(v1, r1, e1), More(v2, r2, e2)) ->
+    let c = cmp v1 v2 in
+    if c <> 0
+    then c
+    else compare_aux cmp (cons_enum r1 e1) (cons_enum r2 e2)
+
+let compare cmp s1 s2 =
+  compare_aux cmp (cons_enum s1 End) (cons_enum s2 End)
+
+
+module type S = sig
+  type elt 
+  type t
+  val empty: t
+  val is_empty: t -> bool
+  val iter: (elt -> unit) -> t -> unit
+  val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val for_all: (elt -> bool) -> t -> bool
+  val exists: (elt -> bool) -> t -> bool
+  val singleton: elt -> t
+  val cardinal: t -> int
+  val elements: t -> elt list
+  val min_elt: t -> elt
+  val max_elt: t -> elt
+  val choose: t -> elt
+  val of_sorted_list : elt list -> t 
+  val of_sorted_array : elt array -> t
+  val partition: (elt -> bool) -> t -> t * t
+
+  val mem: elt -> t -> bool
+  val add: elt -> t -> t
+  val remove: elt -> t -> t
+  val union: t -> t -> t
+  val inter: t -> t -> t
+  val diff: t -> t -> t
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
+  val subset: t -> t -> bool
+  val filter: (elt -> bool) -> t -> t
+
+  val split: elt -> t -> t * bool * t
+  val find: elt -> t -> elt
+  val of_list: elt list -> t
+  val of_sorted_list : elt list ->  t
+  val of_sorted_array : elt array -> t 
+end 
+
+end
+module Ident_set : sig 
+#1 "ident_set.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+include Set_gen.S with type elt = Ident.t
+
+
+
+
+
+end = struct
+#1 "ident_set.ml"
+# 1 "ext/set.cppo.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+# 31
+type elt = Ident.t
+let compare_elt (x : elt) (y : elt) = 
+  let a =  Pervasives.compare (x.stamp : int) y.stamp in 
+  if a <> 0 then a 
+  else 
+    let b = Pervasives.compare (x.name : string) y.name in 
+    if b <> 0 then b 
+    else Pervasives.compare (x.flags : int) y.flags     
+type  t = elt Set_gen.t 
+
+
+# 57
+let empty = Set_gen.empty 
+let is_empty = Set_gen.is_empty
+let iter = Set_gen.iter
+let fold = Set_gen.fold
+let for_all = Set_gen.for_all 
+let exists = Set_gen.exists 
+let singleton = Set_gen.singleton 
+let cardinal = Set_gen.cardinal
+let elements = Set_gen.elements
+let min_elt = Set_gen.min_elt
+let max_elt = Set_gen.max_elt
+let choose = Set_gen.choose 
+let of_sorted_list = Set_gen.of_sorted_list
+let of_sorted_array = Set_gen.of_sorted_array
+let partition = Set_gen.partition 
+let filter = Set_gen.filter 
+let of_sorted_list = Set_gen.of_sorted_list
+let of_sorted_array = Set_gen.of_sorted_array
+
+let rec split x (tree : _ Set_gen.t) : _ Set_gen.t * bool * _ Set_gen.t =  match tree with 
+  | Empty ->
+    (Empty, false, Empty)
+  | Node(l, v, r, _) ->
+    let c = compare_elt x v in
+    if c = 0 then (l, true, r)
+    else if c < 0 then
+      let (ll, pres, rl) = split x l in (ll, pres, Set_gen.internal_join rl v r)
+    else
+      let (lr, pres, rr) = split x r in (Set_gen.internal_join l v lr, pres, rr)
+let rec add x (tree : _ Set_gen.t) : _ Set_gen.t =  match tree with 
+  | Empty -> Node(Empty, x, Empty, 1)
+  | Node(l, v, r, _) as t ->
+    let c = compare_elt x v in
+    if c = 0 then t else
+    if c < 0 then Set_gen.internal_bal (add x l) v r else Set_gen.internal_bal l v (add x r)
+
+let rec union (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) : _ Set_gen.t  =
+  match (s1, s2) with
+  | (Empty, t2) -> t2
+  | (t1, Empty) -> t1
+  | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
+    if h1 >= h2 then
+      if h2 = 1 then add v2 s1 else begin
+        let (l2, _, r2) = split v1 s2 in
+        Set_gen.internal_join (union l1 l2) v1 (union r1 r2)
+      end
+    else
+    if h1 = 1 then add v1 s2 else begin
+      let (l1, _, r1) = split v2 s1 in
+      Set_gen.internal_join (union l1 l2) v2 (union r1 r2)
+    end    
+
+let rec inter (s1 : _ Set_gen.t)  (s2 : _ Set_gen.t) : _ Set_gen.t  =
+  match (s1, s2) with
+  | (Empty, t2) -> Empty
+  | (t1, Empty) -> Empty
+  | (Node(l1, v1, r1, _), t2) ->
+    begin match split v1 t2 with
+      | (l2, false, r2) ->
+        Set_gen.internal_concat (inter l1 l2) (inter r1 r2)
+      | (l2, true, r2) ->
+        Set_gen.internal_join (inter l1 l2) v1 (inter r1 r2)
+    end 
+
+let rec diff (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) : _ Set_gen.t  =
+  match (s1, s2) with
+  | (Empty, t2) -> Empty
+  | (t1, Empty) -> t1
+  | (Node(l1, v1, r1, _), t2) ->
+    begin match split v1 t2 with
+      | (l2, false, r2) ->
+        Set_gen.internal_join (diff l1 l2) v1 (diff r1 r2)
+      | (l2, true, r2) ->
+        Set_gen.internal_concat (diff l1 l2) (diff r1 r2)    
+    end
+
+
+let rec mem x (tree : _ Set_gen.t) =  match tree with 
+  | Empty -> false
+  | Node(l, v, r, _) ->
+    let c = compare_elt x v in
+    c = 0 || mem x (if c < 0 then l else r)
+
+let rec remove x (tree : _ Set_gen.t) : _ Set_gen.t = match tree with 
+  | Empty -> Empty
+  | Node(l, v, r, _) ->
+    let c = compare_elt x v in
+    if c = 0 then Set_gen.internal_merge l r else
+    if c < 0 then Set_gen.internal_bal (remove x l) v r else Set_gen.internal_bal l v (remove x r)
+
+let compare s1 s2 = Set_gen.compare compare_elt s1 s2 
+
+
+let equal s1 s2 =
+  compare s1 s2 = 0
+
+let rec subset (s1 : _ Set_gen.t) (s2 : _ Set_gen.t) =
+  match (s1, s2) with
+  | Empty, _ ->
+    true
+  | _, Empty ->
+    false
+  | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) ->
+    let c = compare_elt v1 v2 in
+    if c = 0 then
+      subset l1 l2 && subset r1 r2
+    else if c < 0 then
+      subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2
+    else
+      subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2
+
+
+
+
+let rec find x (tree : _ Set_gen.t) = match tree with
+  | Empty -> raise Not_found
+  | Node(l, v, r, _) ->
+    let c = compare_elt x v in
+    if c = 0 then v
+    else find x (if c < 0 then l else r)
+
+
+
+let of_list l =
+  match l with
+  | [] -> empty
+  | [x0] -> singleton x0
+  | [x0; x1] -> add x1 (singleton x0)
+  | [x0; x1; x2] -> add x2 (add x1 (singleton x0))
+  | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0)))
+  | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0))))
+  | _ -> of_sorted_list (List.sort_uniq compare_elt l)
+
+let of_array l = 
+  Array.fold_left (fun  acc x -> add x acc) empty l
+
+(* also check order *)
+let invariant t =
+  Set_gen.check t ;
+  Set_gen.is_ordered compare_elt t          
+
+
+
+
+
+
+end
+module Lambda : sig 
+#1 "lambda.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* The "lambda" intermediate code *)
+
+open Asttypes
+
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+
+type loc_kind =
+  | Loc_FILE
+  | Loc_LINE
+  | Loc_MODULE
+  | Loc_LOC
+  | Loc_POS
+
+
+
+type tag_info = 
+  | Blk_constructor of string * int (* Number of non-const constructors*)
+  | Blk_tuple
+  | Blk_array
+  | Blk_variant of string 
+  | Blk_record of string array
+  | Blk_module of string list option
+  | Blk_na
+
+val default_tag_info : tag_info
+
+type field_dbg_info = 
+  | Fld_na
+  | Fld_record of string
+  | Fld_module of string 
+
+type set_field_dbg_info = 
+  | Fld_set_na
+  | Fld_record_set of string 
+
+type pointer_info = 
+  | Pt_constructor of string
+  | Pt_variant of string 
+  | Pt_module_alias
+  | Pt_na 
+
+val default_pointer_info : pointer_info
+
+type primitive =
+  | Pidentity
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pignore
+  | Prevapply 
+  | Pdirapply
+  | Ploc of loc_kind
+    (* Globals *)
+  | Pgetglobal of Ident.t
+  | Psetglobal of Ident.t
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * tag_info * mutable_flag
+  | Pfield of int * field_dbg_info
+  | Psetfield of int * bool * set_field_dbg_info
+  (* could have field info at least for record *)
+  | Pfloatfield of int * field_dbg_info
+  | Psetfloatfield of int * set_field_dbg_info
+  | Pduprecord of Types.record_representation * int
+  (* Force lazy values *)
+  | Plazyforce
+  (* External call *)
+  | Pccall of Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of comparison
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of comparison
+  (* String operations *)
+  | Pstringlength 
+  | Pstringrefu 
+  | Pstringsetu
+  | Pstringrefs
+  | Pstringsets
+
+  | Pbyteslength
+  | Pbytesrefu
+  | Pbytessetu 
+  | Pbytesrefs
+  | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind
+  | Parraylength of array_kind
   | Parrayrefu of array_kind
   | Parraysetu of array_kind
   | Parrayrefs of array_kind
@@ -59586,14 +60022,6 @@ and raise_kind =
   | Raise_reraise
   | Raise_notrace
 
-type pointer_info = 
-  | Pt_constructor of string
-  | Pt_variant of string 
-  | Pt_module_alias
-  | Pt_na
-
-let default_pointer_info = Pt_na
-
 type structured_constant =
     Const_base of constant
   | Const_pointer of int * pointer_info
@@ -59604,15 +60032,22 @@ type structured_constant =
 type function_kind = Curried | Tupled
 
 type let_kind = Strict | Alias | StrictOpt | Variable
-
+(* Meaning of kinds for let x = e in e':
+    Strict: e may have side-effets; always evaluate e first
+      (If e is a simple expression, e.g. a variable or constant,
+       we may still substitute e'[x/e].)
+    Alias: e is pure, we can substitute e'[x/e] if x has 0 or 1 occurrences
+      in e'
+    StrictOpt: e does not have side-effects, but depend on the store;
+      we can discard e if x does not appear in e'
+    Variable: the variable x is assigned later in e' *)
 type public_info = string option  (* label name *)
 
 type meth_kind = Self | Public of public_info | Cached
 
+type shared_code = (int * int) list     (* stack size -> code label *)
 
 
-type shared_code = (int * int) list
-
 type lambda =
     Lvar of Ident.t
   | Lconst of structured_constant
@@ -59620,8 +60055,10 @@ type lambda =
   | Lfunction of function_kind * Ident.t list * lambda
   | Llet of let_kind * Ident.t * lambda * lambda
   | Lletrec of (Ident.t * lambda) list * lambda
-  | Lprim of primitive * lambda list * Location.t 
+  | Lprim of primitive * lambda list * Location.t
   | Lswitch of lambda * lambda_switch
+(* switch on strings, clauses are sorted by string order,
+   strings are pairwise distinct *)
   | Lstringswitch of lambda * (string * lambda) list * lambda option * Location.t
   | Lstaticraise of int * lambda list
   | Lstaticcatch of lambda * (int * Ident.t list) * lambda
@@ -59636,12 +60073,11 @@ type lambda =
   | Lifused of Ident.t * lambda
 
 and lambda_switch =
-  { sw_numconsts: int;
-    sw_consts: (int * lambda) list;
-    sw_numblocks: int;
-    sw_blocks: (int * lambda) list;
-    sw_failaction : lambda option}
-
+  { sw_numconsts: int;                  (* Number of integer cases *)
+    sw_consts: (int * lambda) list;     (* Integer cases *)
+    sw_numblocks: int;                  (* Number of tag block cases *)
+    sw_blocks: (int * lambda) list;     (* Tag block cases *)
+    sw_failaction : lambda option}      (* Action to take if failure *)
 and lambda_event =
   { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
@@ -59653,77 +60089,378 @@ and lambda_event_kind =
   | Lev_after of Types.type_expr
   | Lev_function
 
-let const_unit = Const_pointer (0, default_pointer_info)
-
-let lambda_unit = Lconst const_unit
+(* Sharing key *)
+val make_key: lambda -> lambda option
 
-(* Build sharing keys *)
-(*
-   Those keys are later compared with Pervasives.compare.
-   For that reason, they should not include cycles.
-*)
+val const_unit: structured_constant
+val lambda_unit: lambda
+val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda
+val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
 
-exception Not_simple
+val iter: (lambda -> unit) -> lambda -> unit
+module IdentSet: Set.S with type elt = Ident.t
+val free_variables: lambda -> IdentSet.t
+val free_methods: lambda -> IdentSet.t
 
-let max_raw = 32
+val transl_normal_path: Path.t -> lambda   (* Path.t is already normal *)
+val transl_path: ?loc:Location.t -> Env.t -> Path.t -> lambda
+val make_sequence: ('a -> lambda) -> 'a list -> lambda
 
-let make_key e =
-  let count = ref 0   (* Used for controling size *)
-  and make_key = Ident.make_key_generator () in
-  (* make_key is used for normalizing let-bound variables *)
-  let rec tr_rec env e =
-    incr count ;
-    if !count > max_raw then raise Not_simple ; (* Too big ! *)
-    match e with
-    | Lvar id ->
-      begin
-        try Ident.find_same id env
-        with Not_found -> e
-      end
-    | Lconst  (Const_base (Const_string _)|Const_float_array _) ->
-        (* Mutable constants are not shared *)
-        raise Not_simple
-    | Lconst _ -> e
-    | Lapply (e,es,loc) ->
-        Lapply (tr_rec env e,tr_recs env es, Location.none)
-    | Llet (Alias,x,ex,e) -> (* Ignore aliases -> substitute *)
-        let ex = tr_rec env ex in
-        tr_rec (Ident.add x ex env) e
-    | Llet (str,x,ex,e) ->
-     (* Because of side effects, keep other lets with normalized names *)
-        let ex = tr_rec env ex in
-        let y = make_key x in
-        Llet (str,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
-    | Lprim (p,es,_) ->
-        Lprim (p,tr_recs env es, Location.none)
-    | Lswitch (e,sw) ->
-        Lswitch (tr_rec env e,tr_sw env sw)
-    | Lstringswitch (e,sw,d,_) ->
-        Lstringswitch
-          (tr_rec env e,
-           List.map (fun (s,e) -> s,tr_rec env e) sw,
-           tr_opt env d, Location.none)
-    | Lstaticraise (i,es) ->
-        Lstaticraise (i,tr_recs env es)
-    | Lstaticcatch (e1,xs,e2) ->
-        Lstaticcatch (tr_rec env e1,xs,tr_rec env e2)
-    | Ltrywith (e1,x,e2) ->
-        Ltrywith (tr_rec env e1,x,tr_rec env e2)
-    | Lifthenelse (cond,ifso,ifnot) ->
-        Lifthenelse (tr_rec env cond,tr_rec env ifso,tr_rec env ifnot)
-    | Lsequence (e1,e2) ->
-        Lsequence (tr_rec env e1,tr_rec env e2)
-    | Lassign (x,e) ->
-        Lassign (x,tr_rec env e)
-    | Lsend (m,e1,e2,es,loc) ->
-        Lsend (m,tr_rec env e1,tr_rec env e2,tr_recs env es,Location.none)
-    | Lifused (id,e) -> Lifused (id,tr_rec env e)
-    | Lletrec _|Lfunction _
-    | Lfor _ | Lwhile _
-(* Beware: (PR#6412) the event argument to Levent
-   may include cyclic structure of type Type.typexpr *)
-    | Levent _  ->
-        raise Not_simple
+val subst_lambda: lambda Ident.tbl -> lambda -> lambda
+val bind : let_kind -> Ident.t -> lambda -> lambda -> lambda
+
+val commute_comparison : comparison -> comparison
+val negate_comparison : comparison -> comparison
+
+(***********************)
+(* For static failures *)
+(***********************)
+
+(* Get a new static failure ident *)
+val next_raise_count : unit -> int
+val next_negative_raise_count : unit -> int
+  (* Negative raise counts are used to compile 'match ... with
+     exception x -> ...'.  This disabled some simplifications
+     performed by the Simplif module that assume that static raises
+     are in tail position in their handler. *)
+
+val staticfail : lambda (* Anticipated static failure *)
+
+(* Check anticipated failure, substitute its final value *)
+val is_guarded: lambda -> bool
+val patch_guarded : lambda -> lambda -> lambda
+
+val raise_kind: raise_kind -> string
+val lam_of_loc : loc_kind -> Location.t -> lambda
+
+val reset: unit -> unit
+
+end = struct
+#1 "lambda.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Misc
+open Path
+open Asttypes
+
+type compile_time_constant =
+  | Big_endian
+  | Word_size
+  | Ostype_unix
+  | Ostype_win32
+  | Ostype_cygwin
+
+type loc_kind =
+  | Loc_FILE
+  | Loc_LINE
+  | Loc_MODULE
+  | Loc_LOC
+  | Loc_POS
+
+type tag_info = 
+  | Blk_constructor of string * int (* Number of non-const constructors*)
+  | Blk_tuple
+  | Blk_array
+  | Blk_variant of string 
+  | Blk_record of string array (* when its empty means we dont get such information *)
+  | Blk_module of string list option
+  | Blk_na
+
+let default_tag_info : tag_info = Blk_na
+
+type field_dbg_info = 
+  | Fld_na
+  | Fld_record of string
+  | Fld_module of string 
+
+type set_field_dbg_info = 
+  | Fld_set_na
+  | Fld_record_set of string 
+
+type primitive =
+  | Pidentity
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pignore
+  | Prevapply 
+  | Pdirapply 
+  | Ploc of loc_kind
+    (* Globals *)
+  | Pgetglobal of Ident.t
+  | Psetglobal of Ident.t
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * tag_info * mutable_flag
+  | Pfield of int * field_dbg_info
+  | Psetfield of int * bool * set_field_dbg_info
+  | Pfloatfield of int * field_dbg_info
+  | Psetfloatfield of int * set_field_dbg_info
+  | Pduprecord of Types.record_representation * int
+  (* Force lazy values *)
+  | Plazyforce
+  (* External call *)
+  | Pccall of  Primitive.description
+  (* Exceptions *)
+  | Praise of raise_kind
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of comparison
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of comparison
+  (* String operations *)
+  | Pstringlength 
+  | Pstringrefu 
+  | Pstringsetu
+  | Pstringrefs
+  | Pstringsets
+
+  | Pbyteslength
+  | Pbytesrefu
+  | Pbytessetu 
+  | Pbytesrefs
+  | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Bitvect operations *)
+  | Pbittest
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of boxed_integer
+  | Pmodbint of boxed_integer
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * comparison
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load_16 of bool
+  | Pstring_load_32 of bool
+  | Pstring_load_64 of bool
+  | Pstring_set_16 of bool
+  | Pstring_set_32 of bool
+  | Pstring_set_64 of bool
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load_16 of bool
+  | Pbigstring_load_32 of bool
+  | Pbigstring_load_64 of bool
+  | Pbigstring_set_16 of bool
+  | Pbigstring_set_32 of bool
+  | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
+
+and comparison =
+    Ceq | Cneq | Clt | Cgt | Cle | Cge
+
+and array_kind =
+    Pgenarray | Paddrarray | Pintarray | Pfloatarray
+
+and boxed_integer =
+    Pnativeint | Pint32 | Pint64
+
+and bigarray_kind =
+    Pbigarray_unknown
+  | Pbigarray_float32 | Pbigarray_float64
+  | Pbigarray_sint8 | Pbigarray_uint8
+  | Pbigarray_sint16 | Pbigarray_uint16
+  | Pbigarray_int32 | Pbigarray_int64
+  | Pbigarray_caml_int | Pbigarray_native_int
+  | Pbigarray_complex32 | Pbigarray_complex64
+
+and bigarray_layout =
+    Pbigarray_unknown_layout
+  | Pbigarray_c_layout
+  | Pbigarray_fortran_layout
+
+and raise_kind =
+  | Raise_regular
+  | Raise_reraise
+  | Raise_notrace
+
+type pointer_info = 
+  | Pt_constructor of string
+  | Pt_variant of string 
+  | Pt_module_alias
+  | Pt_na
+
+let default_pointer_info = Pt_na
+
+type structured_constant =
+    Const_base of constant
+  | Const_pointer of int * pointer_info
+  | Const_block of int * tag_info * structured_constant list
+  | Const_float_array of string list
+  | Const_immstring of string
+
+type function_kind = Curried | Tupled
+
+type let_kind = Strict | Alias | StrictOpt | Variable
+
+type public_info = string option  (* label name *)
+
+type meth_kind = Self | Public of public_info | Cached
+
+
+
+type shared_code = (int * int) list
+
+type lambda =
+    Lvar of Ident.t
+  | Lconst of structured_constant
+  | Lapply of lambda * lambda list * Location.t
+  | Lfunction of function_kind * Ident.t list * lambda
+  | Llet of let_kind * Ident.t * lambda * lambda
+  | Lletrec of (Ident.t * lambda) list * lambda
+  | Lprim of primitive * lambda list * Location.t 
+  | Lswitch of lambda * lambda_switch
+  | Lstringswitch of lambda * (string * lambda) list * lambda option * Location.t
+  | Lstaticraise of int * lambda list
+  | Lstaticcatch of lambda * (int * Ident.t list) * lambda
+  | Ltrywith of lambda * Ident.t * lambda
+  | Lifthenelse of lambda * lambda * lambda
+  | Lsequence of lambda * lambda
+  | Lwhile of lambda * lambda
+  | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
+  | Lassign of Ident.t * lambda
+  | Lsend of meth_kind * lambda * lambda * lambda list * Location.t
+  | Levent of lambda * lambda_event
+  | Lifused of Ident.t * lambda
+
+and lambda_switch =
+  { sw_numconsts: int;
+    sw_consts: (int * lambda) list;
+    sw_numblocks: int;
+    sw_blocks: (int * lambda) list;
+    sw_failaction : lambda option}
+
+and lambda_event =
+  { lev_loc: Location.t;
+    lev_kind: lambda_event_kind;
+    lev_repr: int ref option;
+    lev_env: Env.summary }
+
+and lambda_event_kind =
+    Lev_before
+  | Lev_after of Types.type_expr
+  | Lev_function
+
+let const_unit = Const_pointer (0, default_pointer_info)
+
+let lambda_unit = Lconst const_unit
+
+(* Build sharing keys *)
+(*
+   Those keys are later compared with Pervasives.compare.
+   For that reason, they should not include cycles.
+*)
+
+exception Not_simple
+
+let max_raw = 32
+
+let make_key e =
+  let count = ref 0   (* Used for controling size *)
+  and make_key = Ident.make_key_generator () in
+  (* make_key is used for normalizing let-bound variables *)
+  let rec tr_rec env e =
+    incr count ;
+    if !count > max_raw then raise Not_simple ; (* Too big ! *)
+    match e with
+    | Lvar id ->
+      begin
+        try Ident.find_same id env
+        with Not_found -> e
+      end
+    | Lconst  (Const_base (Const_string _)|Const_float_array _) ->
+        (* Mutable constants are not shared *)
+        raise Not_simple
+    | Lconst _ -> e
+    | Lapply (e,es,loc) ->
+        Lapply (tr_rec env e,tr_recs env es, Location.none)
+    | Llet (Alias,x,ex,e) -> (* Ignore aliases -> substitute *)
+        let ex = tr_rec env ex in
+        tr_rec (Ident.add x ex env) e
+    | Llet (str,x,ex,e) ->
+     (* Because of side effects, keep other lets with normalized names *)
+        let ex = tr_rec env ex in
+        let y = make_key x in
+        Llet (str,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
+    | Lprim (p,es,_) ->
+        Lprim (p,tr_recs env es, Location.none)
+    | Lswitch (e,sw) ->
+        Lswitch (tr_rec env e,tr_sw env sw)
+    | Lstringswitch (e,sw,d,_) ->
+        Lstringswitch
+          (tr_rec env e,
+           List.map (fun (s,e) -> s,tr_rec env e) sw,
+           tr_opt env d, Location.none)
+    | Lstaticraise (i,es) ->
+        Lstaticraise (i,tr_recs env es)
+    | Lstaticcatch (e1,xs,e2) ->
+        Lstaticcatch (tr_rec env e1,xs,tr_rec env e2)
+    | Ltrywith (e1,x,e2) ->
+        Ltrywith (tr_rec env e1,x,tr_rec env e2)
+    | Lifthenelse (cond,ifso,ifnot) ->
+        Lifthenelse (tr_rec env cond,tr_rec env ifso,tr_rec env ifnot)
+    | Lsequence (e1,e2) ->
+        Lsequence (tr_rec env e1,tr_rec env e2)
+    | Lassign (x,e) ->
+        Lassign (x,tr_rec env e)
+    | Lsend (m,e1,e2,es,loc) ->
+        Lsend (m,tr_rec env e1,tr_rec env e2,tr_recs env es,Location.none)
+    | Lifused (id,e) -> Lifused (id,tr_rec env e)
+    | Lletrec _|Lfunction _
+    | Lfor _ | Lwhile _
+(* Beware: (PR#6412) the event argument to Levent
+   may include cyclic structure of type Type.typexpr *)
+    | Levent _  ->
+        raise Not_simple
 
   and tr_recs env es = List.map (tr_rec env) es
 
@@ -59998,9 +60735,23 @@ let reset () =
   raise_count := 0
 
 end
-module Js_op
+module Ocaml_stdlib_slots
 = struct
-#1 "js_op.ml"
+#1 "ocaml_stdlib_slots.ml"
+
+(* Generated by scripts/gen_slots.ml, should be updated everytime when we upgrade the compiler *)
+let pervasives = [| "invalid_arg";"failwith";"Exit";"min";"max";"abs";"max_int";"min_int";"lnot";"infinity";"neg_infinity";"nan";"max_float";"min_float";"epsilon_float";"^";"char_of_int";"string_of_bool";"bool_of_string";"string_of_int";"string_of_float";"@";"stdin";"stdout";"stderr";"print_char";"print_string";"print_bytes";"print_int";"print_float";"print_endline";"print_newline";"prerr_char";"prerr_string";"prerr_bytes";"prerr_int";"prerr_float";"prerr_endline";"prerr_newline";"read_line";"read_int";"read_float";"open_out";"open_out_bin";"open_out_gen";"flush";"flush_all";"output_char";"output_string";"output_bytes";"output";"output_substring";"output_byte";"output_binary_int";"output_value";"seek_out";"pos_out";"out_channel_length";"close_out";"close_out_noerr";"set_binary_mode_out";"open_in";"open_in_bin";"open_in_gen";"input_char";"input_line";"input";"really_input";"really_input_string";"input_byte";"input_binary_int";"input_value";"seek_in";"pos_in";"in_channel_length";"close_in";"close_in_noerr";"set_binary_mode_in";"LargeFile";"string_of_format";"^^";"exit";"at_exit";"valid_float_lexem";"unsafe_really_input";"do_at_exit" |]
+let camlinternalOO = [| "public_method_label";"new_method";"new_variable";"new_methods_variables";"get_variable";"get_variables";"get_method_label";"get_method_labels";"get_method";"set_method";"set_methods";"narrow";"widen";"add_initializer";"dummy_table";"create_table";"init_class";"inherits";"make_class";"make_class_store";"dummy_class";"copy";"create_object";"create_object_opt";"run_initializers";"run_initializers_opt";"create_object_and_run_initializers";"lookup_tables";"params";"stats" |]
+let camlinternalMod = [| "init_mod";"update_mod" |]
+let string = [| "make";"init";"copy";"sub";"fill";"blit";"concat";"iter";"iteri";"map";"mapi";"trim";"escaped";"index";"rindex";"index_from";"rindex_from";"contains";"contains_from";"rcontains_from";"uppercase";"lowercase";"capitalize";"uncapitalize";"compare" |]
+let array = [| "init";"make_matrix";"create_matrix";"append";"concat";"sub";"copy";"fill";"blit";"to_list";"of_list";"iter";"map";"iteri";"mapi";"fold_left";"fold_right";"sort";"stable_sort";"fast_sort" |]
+let list = [| "length";"hd";"tl";"nth";"rev";"append";"rev_append";"concat";"flatten";"iter";"iteri";"map";"mapi";"rev_map";"fold_left";"fold_right";"iter2";"map2";"rev_map2";"fold_left2";"fold_right2";"for_all";"exists";"for_all2";"exists2";"mem";"memq";"find";"filter";"find_all";"partition";"assoc";"assq";"mem_assoc";"mem_assq";"remove_assoc";"remove_assq";"split";"combine";"sort";"stable_sort";"fast_sort";"sort_uniq";"merge" |]
+    
+
+end
+module Ordered_hash_map_gen
+= struct
+#1 "ordered_hash_map_gen.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -60026,243 +60777,291 @@ module Js_op
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+(* does not support [remove], 
+    so that the adding order is strict and continous  
+ *)
 
+module type S =
+sig
+  type key
+  type 'value t
+  val create: int ->  'value t
+  val clear : 'vaulue t -> unit
+  val reset : 'value t -> unit
+  val copy: 'value t -> 'value t
+  val add : 'value t -> key -> 'value -> unit
+  val mem : 'value t -> key -> bool
+  val rank : 'value t -> key -> int (* -1 if not found*)
+  val find_value : 'value t -> key -> 'value (* raise if not found*)
+  val iter: (key -> 'value -> int -> unit) ->  'value t -> unit
+  val fold: (key -> 'value -> int -> 'b -> 'b) ->  'value t -> 'b -> 'b
+  val length:  'value t -> int
+  val stats: 'value t -> Hashtbl.statistics
+  val elements : 'value t -> key list 
+  val choose : 'value t -> key 
+  val to_sorted_array: 'value t -> key array
+end
 
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
+type ('a,'b) bucket = 
+  | Empty 
+  | Cons of 'a * int * 'b  * ('a,'b) bucket
 
+type ('a,'b) t =
+  { mutable size: int;                        (* number of entries *)
+    mutable data: ('a,'b) bucket array;  (* the buckets *)
+    initial_size: int;                        (* initial array size *)
+  }
 
 
 
 
+let create  initial_size =
+  let s = Ext_util.power_2_above 16 initial_size in
+  { initial_size = s; size = 0; data = Array.make s Empty }
 
-(** Define some basic types used in JS IR *)
-
-type binop =
-  | Eq  
-  (* acutally assignment ..
-     TODO: move it into statement, so that all expressions 
-     are side efffect free (except function calls)
-   *)
+let clear h =
+  h.size <- 0;
+  let len = Array.length h.data in
+  for i = 0 to len - 1 do
+    Array.unsafe_set h.data i  Empty
+  done
 
-  | Or
-  | And
-  | EqEqEq
-  | NotEqEq
-  | InstanceOf
+let reset h =
+  h.size <- 0;
+  h.data <- Array.make h.initial_size Empty
 
-  | Lt
-  | Le
-  | Gt
-  | Ge
 
-  | Bor
-  | Bxor
-  | Band
-  | Lsl
-  | Lsr
-  | Asr
+let copy h = { h with data = Array.copy h.data }
 
-  | Plus
-  | Minus
-  | Mul
-  | Div
-  | Mod
+let length h = h.size
 
-(**
-note that we don't need raise [Div_by_zero] in BuckleScript
+let resize indexfun h =
+  let odata = h.data in
+  let osize = Array.length odata in
+  let nsize = osize * 2 in
+  if nsize < Sys.max_array_length then begin
+    let ndata = Array.make nsize Empty in
+    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
+    let rec insert_bucket = function
+        Empty -> ()
+      | Cons(key,info,data,rest) ->
+        let nidx = indexfun h key in
+        ndata.(nidx) <- Cons(key,info,data, ndata.(nidx));
+        insert_bucket rest
+    in
+    for i = 0 to osize - 1 do
+      insert_bucket (Array.unsafe_get odata i)
+    done
+  end
 
-{[
-let add x y = x + y  (* | 0 *)
-let minus x y = x - y (* | 0 *)
-let mul x y = x * y   (* caml_mul | Math.imul *)
-let div x y = x / y (* caml_div (x/y|0)*)
-let imod x y = x mod y  (* caml_mod (x%y) (zero_divide)*)
+let iter f h =
+  let rec do_bucket = function
+    | Empty ->
+      ()
+    | Cons(k ,i, value, rest) ->
+      f k value i; do_bucket rest in
+  let d = h.data in
+  for i = 0 to Array.length d - 1 do
+    do_bucket (Array.unsafe_get d i)
+  done
 
-let bor x y = x lor y   (* x  | y *)
-let bxor x y = x lxor y (* x ^ y *)
-let band x y = x land y (* x & y *)
-let ilnot  y  = lnot y (* let lnot x = x lxor (-1) *)
-let ilsl x y = x lsl y (* x << y*)
-let ilsr x y = x lsr y  (* x >>> y | 0 *)
-let iasr  x y = x asr y (* x >> y *)
-]}
+let choose h = 
+  let rec aux arr offset len = 
+    if offset >= len then raise Not_found
+    else 
+      match Array.unsafe_get arr offset with 
+      | Empty -> aux arr (offset + 1) len 
+      | Cons (k,_,_,rest) -> k 
+  in
+  aux h.data 0 (Array.length h.data)
 
+let to_sorted_array h = 
+  if h.size = 0 then [||]
+  else 
+    let v = choose h in 
+    let arr = Array.make h.size v in
+    iter (fun k _ i -> Array.unsafe_set arr i k) h;
+    arr 
 
-Note that js treat unsigned shift 0 bits in a special way
-   Unsigned shifts convert their left-hand side to Uint32, 
-   signed shifts convert it to Int32.
-   Shifting by 0 digits returns the converted value.
-   {[
-    function ToUint32(x) {
-        return x >>> 0;
-    }
-    function ToInt32(x) {
-        return x >> 0;
-    }
-   ]}
-   So in Js, [-1 >>>0] will be the largest Uint32, while [-1>>0] will remain [-1]
-   and [-1 >>> 0 >> 0 ] will be [-1]
+let fold f h init =
+  let rec do_bucket b accu =
+    match b with
+      Empty ->
+      accu
+    | Cons( k , i,  value, rest) ->
+      do_bucket rest (f k  value i  accu) in
+  let d = h.data in
+  let accu = ref init in
+  for i = 0 to Array.length d - 1 do
+    accu := do_bucket (Array.unsafe_get d i) !accu
+  done;
+  !accu
+
+let elements set = 
+  fold  (fun k  _  _ acc  ->  k :: acc) set []
+
+
+let rec bucket_length acc (x : _ bucket) = 
+  match x with 
+  | Empty -> 0
+  | Cons(_,_,_,rest) -> bucket_length (acc + 1) rest  
+
+let stats h =
+  let mbl =
+    Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+  let histo = Array.make (mbl + 1) 0 in
+  Array.iter
+    (fun b ->
+       let l = bucket_length 0 b in
+       histo.(l) <- histo.(l) + 1)
+    h.data;
+  { Hashtbl.num_bindings = h.size;
+    num_buckets = Array.length h.data;
+    max_bucket_length = mbl;
+    bucket_histogram = histo }
+
+
+
+end
+module Ordered_hash_map_local_ident : sig 
+#1 "ordered_hash_map_local_ident.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+(** Hash algorithm only hash 
+    stamp, this makes sense when  all identifiers are local (no global)
 *)
-type int_op = 
-    
-  | Bor
-  | Bxor
-  | Band
-  | Lsl
-  | Lsr
-  | Asr
+include Ordered_hash_map_gen.S with type key = Ident.t
 
-  | Plus
-      (* for [+], given two numbers 
-         x + y | 0
-       *)
-  | Minus
-      (* x - y | 0 *)
-  | Mul
-      (* *)
-  | Div
-      (* x / y | 0 *)
-  | Mod
-      (* x  % y *)
+end = struct
+#1 "ordered_hash_map_local_ident.ml"
+  
+# 10 "ext/ordered_hash_map.cppo.ml"
+  type key = Ident.t
+  type   'value t = (key,'value) Ordered_hash_map_gen.t
+  let key_index (h : _ t) (key : key) =
+    (Bs_hash_stubs.hash_int  key.stamp) land (Array.length h.data - 1)
+  let equal_key = Ext_ident.equal
 
-(* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Expressions_and_Operators#Bitwise_operators
-    {[
-    ~
-    ]}
-    ~0xff -> -256
-    design; make sure each operation type is consistent
- *)
-type level = 
-  | Log 
-  | Info
-  | Warn
-  | Error
 
-type kind = 
-  | Ml
-  | Runtime 
-  | External of string
+# 20
+open Ordered_hash_map_gen
 
-type property = Lambda.let_kind = 
-  | Strict
-  | Alias
-  | StrictOpt 
-  | Variable
+let create = create
+let clear = clear
+let reset = reset
+let copy = copy
+let iter = iter
+let fold = fold
+let length = length
+let stats = stats
+let elements = elements
+let choose = choose
+let to_sorted_array = to_sorted_array
 
 
-type property_name = (* private *)
-  (* TODO: FIXME [caml_uninitialized_obj] seems to be a bug*)
-  | Key of string
-  | Int_key of int 
-  | Tag 
-  | Length
 
-type 'a access = 
-  | Getter
-  | Setter
-type jsint = Int32.t
+let rec small_bucket_mem key lst =
+  match lst with 
+  | Empty -> false 
+  | Cons(key1,_, _, rest) -> 
+    equal_key key key1 ||
+    match rest with 
+    | Empty -> false 
+    | Cons(key2 , _,_, rest) -> 
+      equal_key key  key2 ||
+      match rest with 
+      | Empty -> false 
+      | Cons(key3,_, _, rest) -> 
+        equal_key key  key3 ||
+        small_bucket_mem key rest 
 
-type int_or_char = 
-    { i : jsint; 
-      (* we can not use [int] on 32 bit platform, if we dont use 
-          [Int32.t], we need a configuration step          
-      *)
-      c : char option
-    }
+let rec small_bucket_rank key lst =
+  match lst with 
+  | Empty -> -1
+  | Cons(key1,i,_, rest) -> 
+    if equal_key key key1 then i 
+    else match rest with 
+      | Empty -> -1 
+      | Cons(key2,i2, _, rest) -> 
+        if equal_key key  key2 then i2 else
+          match rest with 
+          | Empty -> -1 
+          | Cons(key3,i3, _, rest) -> 
+            if equal_key key  key3 then i3 else
+              small_bucket_rank key rest 
+let rec small_bucket_find_value  key (lst : (_,_) bucket)   =
+  match lst with 
+  | Empty -> raise Not_found
+  | Cons(key1,_,value, rest) -> 
+    if equal_key key  key1 then value 
+    else match rest with 
+      | Empty -> raise Not_found 
+      | Cons(key2,_,value, rest) -> 
+        if equal_key key  key2 then value else
+          match rest with 
+          | Empty -> raise Not_found 
+          | Cons(key3, _ , value, rest) -> 
+            if equal_key key  key3 then value else
+              small_bucket_find_value key rest 
 
- (* literal char *)
-type float_lit = { f :  string }
-type number = 
-  | Float of float_lit 
-  | Int of int_or_char
-  | Uint of int32
-  | Nint of nativeint
-  (* becareful when constant folding +/-, 
-     since we treat it as js nativeint, bitwise operators:
-     https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators
-     The operands of all bitwise operators are converted to signed 32-bit integers in two's complement format.'
-  *)      
+let add h key value =
+  let i = key_index h key  in 
+  if not (small_bucket_mem key  h.data.(i)) then 
+    begin 
+      h.data.(i) <- Cons(key,h.size, value, h.data.(i));
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then resize key_index h
+    end
+
+let mem h key =
+  small_bucket_mem key (Array.unsafe_get h.data (key_index h key)) 
+let rank h key = 
+  small_bucket_rank key(Array.unsafe_get h.data (key_index h key))  
+
+let find_value h key =
+  small_bucket_find_value key (Array.unsafe_get h.data (key_index h key))
 
-type mutable_flag = 
-  | Mutable
-  | Immutable
-  | NA
 
-(* 
-    {[
-    let rec x = 1 :: y 
-    and y = 1 :: x
-    ]}
- *)
-type recursive_info = 
-  | SingleRecursive 
-  | NonRecursie
-  | NA
 
-type used_stats = 
-  | Dead_pure 
-        (* only [Dead] should be taken serious, 
-            other status can be converted during
-            inlining
-            -- all exported symbols can not be dead
-            -- once a symbole is called Dead_pure, 
-            it can not be alive anymore, we should avoid iterating it
-            
-          *)
-  | Dead_non_pure 
-      (* we still need iterating it, 
-         just its bindings does not make sense any more *)
-  | Exported (* Once it's exported, shall we change its status anymore? *)
-      (* In general, we should count in one pass, and eliminate code in another 
-         pass, you can not do it in a single pass, however, some simple 
-         dead code can be detected in a single pass
-       *)
-  | Once_pure (* used only once so that, if we do the inlining, it will be [Dead] *)
-  | Used (**)
-  | Scanning_pure
-  | Scanning_non_pure
-  | NA
 
 
-type ident_info = {
-    (* mutable recursive_info : recursive_info; *)
-    mutable used_stats : used_stats;
-  }
 
-type exports = Ident.t list 
 
-type module_id = { id : Ident.t; kind  : kind}
 
-type required_modules = module_id list
 
 
-type tag_info = Lambda.tag_info = 
-  | Blk_constructor of string * int
-  | Blk_tuple
-  | Blk_array
-  | Blk_variant of string 
-  | Blk_record of string array
-  | Blk_module of string list option
-  | Blk_na
 
-type length_object = 
-  | Array 
-  | String
-  | Bytes
-  | Function
-  | Caml_block
 
-type code_info = 
-  | Exp (* of int option *)
-  | Stmt
-(** TODO: define constant - for better constant folding  *)
-(* type constant =  *)
-(*   | Const_int of int *)
-(*   | Const_ *)
 
 end
-module J
-= struct
-#1 "j.ml"
+module Lam : sig 
+#1 "lam.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -60287,385 +61086,261 @@ module J
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+type array_kind = Lambda.array_kind
+type boxed_integer = Lambda.boxed_integer
+type comparison = Lambda.comparison 
+type bigarray_kind = Lambda.bigarray_kind
+type bigarray_layout = Lambda.bigarray_layout
+type compile_time_constant = Lambda.compile_time_constant
 
+type tag_info = Lambda.tag_info
+type mutable_flag = Asttypes.mutable_flag
+type field_dbg_info = Lambda.field_dbg_info 
+type set_field_dbg_info = Lambda.set_field_dbg_info
 
+type ident = Ident.t
 
+type function_arities = 
+  | Determin of bool * (int * Ident.t list option) list  * bool
+  (** when the first argument is true, it is for sure 
 
+      approximation sound but not complete 
+      the last one means it can take any params later, 
+      for an exception: it is (Determin (true,[], true))
+   *)
+  | NA 
 
+type primitive = 
+  | Pbytes_to_string
+  | Pbytes_of_string
+  | Pgetglobal of ident
+  (* | Psetglobal of ident *)
+  | Pglobal_exception of ident             
+  | Pmakeblock of int * Lambda.tag_info * Asttypes.mutable_flag
+  | Pfield of int * Lambda.field_dbg_info
+  | Psetfield of int * bool * Lambda.set_field_dbg_info
+  | Pfloatfield of int * Lambda.field_dbg_info
+  | Psetfloatfield of int * Lambda.set_field_dbg_info
+  | Pduprecord of Types.record_representation * int
+  | Plazyforce
+  | Pccall of  Primitive.description
+  | Praise 
+  | Psequand | Psequor | Pnot
+  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of Lambda.comparison
+  | Poffsetint of int
+  | Poffsetref of int
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of Lambda.comparison
+  | Pstringlength 
+  | Pstringrefu 
+  | Pstringrefs
+  | Pstringadd    
+  | Pbyteslength
+  | Pbytesrefu
+  | Pbytessetu 
+  | Pbytesrefs
+  | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Bitvect operations *)
+  | Pbittest
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of boxed_integer
+  | Pmodbint of boxed_integer
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * comparison
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load_16 of bool
+  | Pstring_load_32 of bool
+  | Pstring_load_64 of bool
+  | Pstring_set_16 of bool
+  | Pstring_set_32 of bool
+  | Pstring_set_64 of bool
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load_16 of bool
+  | Pbigstring_load_32 of bool
+  | Pbigstring_load_64 of bool
+  | Pbigstring_set_16 of bool
+  | Pbigstring_set_32 of bool
+  | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
 
+  | Pdebugger
+  | Pjs_unsafe_downgrade of string * Location.t
+  | Pinit_mod
+  | Pupdate_mod
+  | Pjs_fn_make of int 
+  | Pjs_fn_run of int 
+  | Pjs_fn_method of int 
+  | Pjs_fn_runmethod of int 
 
-(** Javascript IR
-  
-    It's a subset of Javascript AST specialized for OCaml lambda backend
+type switch  =
+  { sw_numconsts: int;
+    sw_consts: (int * t) list;
+    sw_numblocks: int;
+    sw_blocks: (int * t) list;
+    sw_failaction : t option}
+and apply_status =
+  | App_na
+  | App_ml_full
+  | App_js_full      
+and apply_info = private
+  { fn : t ; 
+    args : t list ; 
+    loc : Location.t;
+    status : apply_status
+  }
 
-    Note it's not exactly the same as Javascript, the AST itself follows lexical
-    convention and [Block] is just a sequence of statements, which means it does 
-    not introduce new scope
-*)
+and prim_info = private
+  { primitive : primitive ; 
+    args : t list ; 
+    loc : Location.t 
+  }
+and function_info = private
+  { arity : int ; 
+   kind : Lambda.function_kind ; 
+   params : ident list ;
+   body : t 
+  }
+and  t =  private
+  | Lvar of ident
+  | Lconst of Lambda.structured_constant
+  | Lapply of apply_info
+  | Lfunction of function_info
+  | Llet of Lambda.let_kind * ident * t * t
+  | Lletrec of (ident * t) list * t
+  | Lprim of prim_info
+  | Lswitch of t * switch
+  | Lstringswitch of t * (string * t) list * t option
+  | Lstaticraise of int * t list
+  | Lstaticcatch of t * (int * ident list) * t
+  | Ltrywith of t * ident * t
+  | Lifthenelse of t * t * t
+  | Lsequence of t * t
+  | Lwhile of t * t
+  | Lfor of ident * t * t * Asttypes.direction_flag * t
+  | Lassign of ident * t
+  | Lsend of Lambda.meth_kind * t * t * t list * Location.t
+  | Lifused of ident * t
+  (* | Levent of t * Lambda.lambda_event 
+     [Levent] in the branch hurt pattern match, 
+     we should use record for trivial debugger info
+  *)
 
-type label = string
 
-and binop = Js_op.binop
+module Prim : sig 
+  type t = primitive
+  val js_is_nil : t
+  val js_is_undef : t 
+  val js_is_nil_undef : t 
+end
 
-and int_op = Js_op.int_op
- 
-and kind = Js_op.kind
 
-and property = Js_op.property
+type binop = t -> t -> t 
 
-and number = Js_op.number 
+type triop = t -> t -> t -> t 
 
-and mutable_flag = Js_op.mutable_flag 
+type unop = t ->  t
 
-and ident_info = Js_op.ident_info
+val inner_map : (t -> t) -> t -> t
+val inner_iter : (t -> unit) -> t -> unit 
+val free_variables : t -> Ident_set.t
+val check : string -> t -> t 
+type bindings = (Ident.t * t) list
 
-and exports = Js_op.exports
+val scc : bindings -> t -> t  -> t 
 
-and tag_info = Js_op.tag_info 
- 
-and required_modules = Js_op.required_modules
+val var : ident -> t
+val const : Lambda.structured_constant -> t
 
-and code_info = Js_op.code_info 
-(** object literal, if key is ident, in this case, it might be renamed by 
-    Google Closure  optimizer,
-    currently we always use quote
- *)
-and property_name =  Js_op.property_name
-and jsint = Js_op.jsint
-and ident = Ident.t 
-
-and vident = 
-  | Id of ident
-  | Qualified of ident * kind * string option
-    (* Since camldot is only available for toplevel module accessors,
-       we don't need print  `A.length$2`
-       just print `A.length` - it's guarateed to be unique
-       
-       when the third one is None, it means the whole module 
-
-       TODO: 
-       invariant, when [kind] is [Runtime], then we can ignore [ident], 
-       since all [runtime] functions are unique, when do the 
-       pattern match we can ignore the first one for simplicity
-       for example       
-       {[
-         Qualified (_, Runtime, Some "caml_int_compare")         
-       ]}       
-     *)
-
-and exception_ident = ident 
-
-and for_ident = ident 
-
-and for_direction = Asttypes.direction_flag
-
-and property_map = 
-    (property_name * expression) list
-and length_object = Js_op.length_object
-and expression_desc =
-  | Math of string * expression list
-  | Length of expression * length_object
-  | Char_of_int of expression
-  | Char_to_int of expression 
-  | Array_of_size of expression 
-    (* used in [js_create_array] primitive, note having
-       uninitilized array is not as bad as in ocaml, 
-       since GC does not rely on it
-     *)
-  | Array_copy of expression (* shallow copy, like [x.slice] *)
-  | Array_append of expression * expression (* For [caml_array_append]*)
-  (* | Tag_ml_obj of expression *)
-  | String_append of expression * expression 
-
-  | Int_of_boolean of expression 
-  | Anything_to_number of expression
-  | Bool of bool (* js true/false*)
-  (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence 
-     [typeof] is an operator     
-  *)
-  | Typeof of expression
-  | Caml_not of expression (* 1 - v *)
-  | Js_not of expression (* !v *)
-  | String_of_small_int_array of expression 
-    (* String.fromCharCode.apply(null, args) *)
-    (* Convert JS boolean into OCaml boolean 
-       like [+true], note this ast talks using js
-       terminnology unless explicity stated                       
-     *)
-  | Json_stringify of expression 
-  (* TODO: in the future, it might make sense to group primitivie by type,
-     which makes optimizations easier
-     {[ JSON.stringify(value, replacer[, space]) ]}
-  *)
-  | Anything_to_string of expression
-  (* for debugging utitlites, 
-     TODO:  [Dump] is not necessary with this primitive 
-     Note that the semantics is slightly different from [JSON.stringify]     
-     {[
-       JSON.stringify("x")       
-     ]}
-     {[
-       ""x""       
-     ]}     
-     {[
-       JSON.stringify(undefined)       
-     ]}     
-     {[
-       undefined       
-     ]}
-     {[ '' + undefined
-     ]}     
-     {[ 'undefined'
-     ]}     
-  *)      
-  | Dump of Js_op.level * expression list
-  (* TODO: 
-     add 
-     {[ Assert of bool * expression ]}     
-  *)              
-    (* to support 
-       val log1 : 'a -> unit
-       val log2 : 'a -> 'b -> unit 
-       val log3 : 'a -> 'b -> 'c -> unit 
-     *)
-
-  (* TODO: Add some primitives so that [js inliner] can do a better job *)  
-  | Seq of expression * expression
-  | Cond of expression * expression * expression
-  | Bin of binop * expression * expression
-
-  (* [int_op] will guarantee return [int32] bits 
-     https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators  *)
-  (* | Int32_bin of int_op * expression * expression *)
-  | FlatCall of expression * expression 
-    (* f.apply(null,args) -- Fully applied guaranteed 
-       TODO: once we know args's shape --
-       if it's know at compile time, we can turn it into
-       f(args[0], args[1], ... )
-     *)
-  | Bind of expression * expression
-  (* {[ Bind (a,b) ]}
-     is literally
-     {[ a.bind(b) ]}
-  *)
-  | Call of expression * expression list * Js_call_info.t
-    (* Analysze over J expression is hard since, 
-        some primitive  call is translated 
-        into a plain call, it's better to keep them
-    *) 
-  | String_access of expression * expression 
-  | Access of expression * expression 
-    (* Invariant: 
-       The second argument has to be type of [int],
-       This can be constructed either in a static way [E.index] or a dynamic way 
-       [E.access]
-     *)
-  | Dot of expression * string * bool
-    (* The third argument bool indicates whether we should 
-       print it as 
-       a["idd"] -- false
-       or 
-       a.idd  -- true
-       There are several kinds of properties
-       1. OCaml module dot (need to be escaped or not)
-          All exported declarations have to be OCaml identifiers
-       2. Javascript dot (need to be preserved/or using quote)
-     *)
-  | New of expression * expression list option (* TODO: option remove *)
-  | Var of vident
-  | Fun of bool * ident list  * block * Js_fun_env.t
-  (* The first parameter by default is false, 
-     it will be true when it's a method
-  *)
-  | Str of bool * string 
-    (* A string is UTF-8 encoded, the string may contain
-       escape sequences.
-       The first argument is used to mark it is non-pure, please
-       don't optimize it, since it does have side effec, 
-       examples like "use asm;" and our compiler may generate "error;..." 
-       which is better to leave it alone
-     *)
-  | Raw_js_code of string * code_info
-  (* literally raw JS code 
-  *)
-  | Array of expression list * mutable_flag
-  | Caml_block of expression list * mutable_flag * expression * tag_info 
-  (* The third argument is [tag] , forth is [tag_info] *)
-  | Caml_uninitialized_obj of expression * expression
-  (* [tag] and [size] tailed  for [Obj.new_block] *)
-
-  (* For setter, it still return the value of expression, 
-     we can not use 
-     {[
-       type 'a access = Get | Set of 'a
-     ]}
-     in another module, since it will break our code generator
-     [Caml_block_tag] can return [undefined], 
-     you have to use [E.tag] in a safe way     
-  *)
-  | Caml_block_tag of expression
-  | Caml_block_set_tag of expression * expression
-  | Caml_block_set_length of expression * expression
-  (* It will just fetch tag, to make it safe, when creating it, 
-     we need apply "|0", we don't do it in the 
-     last step since "|0" can potentially be optimized
-  *)      
-  | Number of number
-  | Object of property_map
-
-and for_ident_expression = expression (* pure*)
-
-and finish_ident_expression = expression (* pure *)
-(* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/block
-   block can be nested, specified in ES3 
- *)
-
-(* Delay some units like [primitive] into JS layer ,
-   benefit: better cross module inlining, and smaller IR size?
- *)
-
-(* 
-  [closure] captured loop mutable values in the outer loop
-
-  check if it contains loop mutable values, happens in nested loop
-  when closured, it's no longer loop mutable value. 
-  which means the outer loop mutable value can not peek into the inner loop
-  {[
-  var i = f ();
-  for(var finish = 32; i < finish; ++i){
-  }
-  ]}
-  when [for_ident_expression] is [None], [var i] has to 
-  be initialized outside, so 
-
-  {[
-  var i = f ()
-  (function (xxx){
-  for(var finish = 32; i < finish; ++i)
-  }(..i))
-  ]}
-  This happens rare it's okay
-
-  this is because [i] has to be initialized outside, if [j] 
-  contains a block side effect
-  TODO: create such example
-*)
-
-(* Since in OCaml, 
-   
-  [for i = 0 to k end do done ]
-  k is only evaluated once , to encode this invariant in JS IR,
-  make sure [ident] is defined in the first b
-
-  TODO: currently we guarantee that [bound] was only 
-  excecuted once, should encode this in AST level
-*)
-
-(* Can be simplified to keep the semantics of OCaml
-   For (var i, e, ...){
-     let  j = ... 
-   }
-
-   if [i] or [j] is captured inside closure
+val apply : t -> t list -> Location.t -> apply_status -> t
+val function_ : 
+  arity:int ->
+  kind:Lambda.function_kind -> params:ident list -> body:t -> t
 
-   for (var i , e, ...){
-     (function (){
-     })(i)
-   }
-*)
+val let_ : Lambda.let_kind -> ident -> t -> t -> t
+val letrec : (ident * t) list -> t -> t
+val if_ : triop
+val switch : t -> switch  -> t 
+val stringswitch : t -> (string * t) list -> t option -> t 
 
-(* Single return is good for ininling..
-   However, when you do tail-call optmization
-   you loose the expression oriented semantics
-   Block is useful for implementing goto
-   {[
-   xx:{
-   break xx;
-   }
-   ]}
-*)
+val true_ : t 
+val false_ : t 
+val unit : t 
 
+val sequor : binop
+val sequand : binop
+val not_ : Location.t ->  unop
+val seq : binop
+val while_ : binop
+val event : t -> Lambda.lambda_event -> t  
+val try_ : t -> ident -> t  -> t 
+val ifused : ident -> t -> t
+val assign : ident -> t -> t 
 
-and statement_desc =
-  | Block of block
-  | Variable of variable_declaration
-        (* Function declaration and Variable declaration  *)
-  | Exp of expression
-  | If of expression * block * block option
-  | While of label option *  expression * block 
-        * Js_closure.t (* check if it contains loop mutable values, happens in nested loop *)
-  | ForRange of for_ident_expression option * finish_ident_expression * 
-        for_ident  *  for_direction * block
-        * Js_closure.t  
-  | Continue of label 
-  | Break (* only used when inline a fucntion *)
-  | Return of return_expression   (* Here we need track back a bit ?, move Return to Function ...
-                              Then we can only have one Return, which is not good *)
-  | Int_switch of expression * int case_clause list * block option 
-  | String_switch of expression * string case_clause list * block option 
-  | Throw of expression
-  | Try of block * (exception_ident * block) option * block option
-  | Debugger
-and return_expression = {
- (* since in ocaml, it's expression oriented langauge, [return] in
-    general has no jumps, it only happens when we do 
-    tailcall conversion, in that case there is a jump.
-    However, currently  a single [break] is good to cover
-    our compilation strategy 
+val send : 
+  Lambda.meth_kind ->
+  t -> t -> t list -> 
+  Location.t -> t 
 
-    Attention: we should not insert [break] arbitrarily, otherwise 
-    it would break the semantics
-    A more robust signature would be 
-    {[ goto : label option ; ]}
-  *)
-  return_value : expression
-}   
+val prim : primitive:primitive -> args:t list -> Location.t  ->  t
 
-and expression = {
-  expression_desc : expression_desc; 
-  comment : string option;
-} 
+val staticcatch : 
+  t -> int * ident list -> t -> t
 
-and statement = { 
-  statement_desc :  statement_desc; 
-  comment : string option;
-}
+val staticraise : 
+  int -> t list -> t
 
-and variable_declaration = { 
-  ident : ident ;
-  value : expression  option;
-  property : property;
-  ident_info : ident_info;
-}
+val for_ : 
+  ident ->
+  t  ->
+  t -> Asttypes.direction_flag -> t -> t 
 
-and 'a case_clause = { 
-  case : 'a ; 
-  body : block * bool ;  (* true means break *)
-}
 
-(* TODO: For efficency: block should not be a list, it should be able to 
-   be concatenated in both ways 
- *)
-and block =  statement list
 
-and program = {
-  name :  string;
 
-  block : block ;
-  exports : exports ;
-  export_set : Ident_set.t ;
 
-}
-and deps_program = 
-  {
-    program : program ; 
-    modules : required_modules ;
-    side_effect : string option (* None: no, Some reason  *)
-  }
+val convert : Lambda.lambda -> t 
 
-end
-module Ext_array : sig 
-#1 "ext_array.mli"
+end = struct
+#1 "lam.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -60690,2058 +61365,134 @@ module Ext_array : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+type array_kind = Lambda.array_kind
+type boxed_integer = Lambda.boxed_integer
+type comparison = Lambda.comparison 
+type bigarray_kind = Lambda.bigarray_kind
+type bigarray_layout = Lambda.bigarray_layout
+type compile_time_constant = Lambda.compile_time_constant
 
+type tag_info = Lambda.tag_info
+type mutable_flag = Asttypes.mutable_flag
+type field_dbg_info = Lambda.field_dbg_info 
+type set_field_dbg_info = Lambda.set_field_dbg_info
 
+type ident = Ident.t
 
+type function_arities = 
+  | Determin of bool * (int * Ident.t list option) list  * bool
+  | NA 
 
+type primitive = 
+  | Pbytes_to_string
+  | Pbytes_of_string
+  (* Globals *)
+  | Pgetglobal of ident
+  (* | Psetglobal of ident *)
+  | Pglobal_exception of ident       
+  (* Operations on heap blocks *)
+  | Pmakeblock of int * tag_info * mutable_flag
+  | Pfield of int * field_dbg_info
+  | Psetfield of int * bool * set_field_dbg_info
+  (* could have field info at least for record *)
+  | Pfloatfield of int * field_dbg_info
+  | Psetfloatfield of int * set_field_dbg_info
+  | Pduprecord of Types.record_representation * int
+  (* Force lazy values *)
+  | Plazyforce
+  (* External call *)
+  | Pccall of  Primitive.description
+  (* Exceptions *)
+  | Praise
+  (* Boolean operations *)
+  | Psequand | Psequor | Pnot
+  (* Integer operations *)
+  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
+  | Pandint | Porint | Pxorint
+  | Plslint | Plsrint | Pasrint
+  | Pintcomp of comparison
+  | Poffsetint of int
+  | Poffsetref of int
+  (* Float operations *)
+  | Pintoffloat | Pfloatofint
+  | Pnegfloat | Pabsfloat
+  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+  | Pfloatcomp of comparison
+  (* String operations *)
+  | Pstringlength 
+  | Pstringrefu 
+  | Pstringrefs
+  | Pstringadd  
+  | Pbyteslength
+  | Pbytesrefu
+  | Pbytessetu 
+  | Pbytesrefs
+  | Pbytessets
+  (* Array operations *)
+  | Pmakearray of array_kind
+  | Parraylength of array_kind
+  | Parrayrefu of array_kind
+  | Parraysetu of array_kind
+  | Parrayrefs of array_kind
+  | Parraysets of array_kind
+  (* Test if the argument is a block or an immediate integer *)
+  | Pisint
+  (* Test if the (integer) argument is outside an interval *)
+  | Pisout
+  (* Bitvect operations *)
+  | Pbittest
+  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
+  | Pbintofint of boxed_integer
+  | Pintofbint of boxed_integer
+  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
+  | Pnegbint of boxed_integer
+  | Paddbint of boxed_integer
+  | Psubbint of boxed_integer
+  | Pmulbint of boxed_integer
+  | Pdivbint of boxed_integer
+  | Pmodbint of boxed_integer
+  | Pandbint of boxed_integer
+  | Porbint of boxed_integer
+  | Pxorbint of boxed_integer
+  | Plslbint of boxed_integer
+  | Plsrbint of boxed_integer
+  | Pasrbint of boxed_integer
+  | Pbintcomp of boxed_integer * comparison
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
+  (* load/set 16,32,64 bits from a string: (unsafe)*)
+  | Pstring_load_16 of bool
+  | Pstring_load_32 of bool
+  | Pstring_load_64 of bool
+  | Pstring_set_16 of bool
+  | Pstring_set_32 of bool
+  | Pstring_set_64 of bool
+  (* load/set 16,32,64 bits from a
+     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
+  | Pbigstring_load_16 of bool
+  | Pbigstring_load_32 of bool
+  | Pbigstring_load_64 of bool
+  | Pbigstring_set_16 of bool
+  | Pbigstring_set_32 of bool
+  | Pbigstring_set_64 of bool
+  (* Compile time constants *)
+  | Pctconst of compile_time_constant
+  (* byte swap *)
+  | Pbswap16
+  | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
 
-(** Some utilities for {!Array} operations *)
-val reverse_range : 'a array -> int -> int -> unit
-val reverse_in_place : 'a array -> unit
-val reverse : 'a array -> 'a array 
-val reverse_of_list : 'a list -> 'a array
-
-val filter : ('a -> bool) -> 'a array -> 'a array
-
-val filter_map : ('a -> 'b option) -> 'a array -> 'b array
-
-val range : int -> int -> int array
-
-val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array
-
-val to_list_map : ('a -> 'b option) -> 'a array -> 'b list 
-
-val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int
-
-
-type 'a split = [ `No_split | `Split of 'a array * 'a array ]
-
-val rfind_and_split : 
-  'a array ->
-  ('a -> 'b -> bool) ->
-  'b -> 'a split
-
-val find_and_split : 
-  'a array ->
-  ('a -> 'b -> bool) ->
-  'b -> 'a split
-
-val exists : ('a -> bool) -> 'a array -> bool 
-
-end = struct
-#1 "ext_array.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-let reverse_range a i len =
-  if len=0 then ()
-  else
-    for k = 0 to (len-1)/2 do
-      let t = Array.unsafe_get a (i+k) in
-      Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k));
-      Array.unsafe_set a (i+len-1-k) t;
-    done
-
-
-let reverse_in_place a =
-  reverse_range a 0 (Array.length a)
-
-let reverse a =
-  let b_len = Array.length a in
-  if b_len = 0 then [||] else  
-  let b = Array.copy a in  
-  for i = 0 to  b_len - 1 do
-      Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) 
-  done;
-  b  
-
-let reverse_of_list =  function
-  | [] -> [||]
-  | hd::tl as l ->
-    let len = List.length l in
-    let a = Array.make len hd in
-    let rec fill i = function
-      | [] -> a
-      | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in
-    fill 0 tl
-
-let filter f a =
-  let arr_len = Array.length a in
-  let rec aux acc i =
-    if i = arr_len 
-    then reverse_of_list acc 
-    else
-      let v = Array.unsafe_get a i in
-      if f  v then 
-        aux (v::acc) (i+1)
-      else aux acc (i + 1) 
-  in aux [] 0
-
-
-let filter_map (f : _ -> _ option) a =
-  let arr_len = Array.length a in
-  let rec aux acc i =
-    if i = arr_len 
-    then reverse_of_list acc 
-    else
-      let v = Array.unsafe_get a i in
-      match f  v with 
-      | Some v -> 
-        aux (v::acc) (i+1)
-      | None -> 
-        aux acc (i + 1) 
-  in aux [] 0
-
-let range from to_ =
-  if from > to_ then invalid_arg "Ext_array.range"  
-  else Array.init (to_ - from + 1) (fun i -> i + from)
-
-let map2i f a b = 
-  let len = Array.length a in 
-  if len <> Array.length b then 
-    invalid_arg "Ext_array.map2i"  
-  else
-    Array.mapi (fun i a -> f i  a ( Array.unsafe_get b i )) a 
-
-let to_list_map f a =
-  let rec tolist i res =
-    if i < 0 then res else
-      let v = Array.unsafe_get a i in
-      tolist (i - 1)
-        (match f v with
-         | Some v -> v :: res
-         | None -> res) in
-  tolist (Array.length a - 1) []
-
-(**
-{[
-# rfind_with_index [|1;2;3|] (=) 2;;
-- : int = 1
-# rfind_with_index [|1;2;3|] (=) 1;;
-- : int = 0
-# rfind_with_index [|1;2;3|] (=) 3;;
-- : int = 2
-# rfind_with_index [|1;2;3|] (=) 4;;
-- : int = -1
-]}
-*)
-let rfind_with_index arr cmp v = 
-  let len = Array.length arr in 
-  let rec aux i = 
-    if i < 0 then i
-    else if  cmp (Array.unsafe_get arr i) v then i
-    else aux (i - 1) in 
-  aux (len - 1)
-
-type 'a split = [ `No_split | `Split of 'a array * 'a array ]
-let rfind_and_split arr cmp v : _ split = 
-  let i = rfind_with_index arr cmp v in 
-  if  i < 0 then 
-    `No_split 
-  else 
-    `Split (Array.sub arr 0 i , Array.sub arr  (i + 1 ) (Array.length arr - i - 1 ))
-
-
-let find_with_index arr cmp v = 
-  let len  = Array.length arr in 
-  let rec aux i len = 
-    if i >= len then -1 
-    else if cmp (Array.unsafe_get arr i ) v then i 
-    else aux (i + 1) len in 
-  aux 0 len
-
-let find_and_split arr cmp v : _ split = 
-  let i = find_with_index arr cmp v in 
-  if i < 0 then 
-    `No_split
-  else
-    `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1))        
-
-(** TODO: available since 4.03, use {!Array.exists} *)
-
-let exists p a =
-  let n = Array.length a in
-  let rec loop i =
-    if i = n then false
-    else if p (Array.unsafe_get a i) then true
-    else loop (succ i) in
-  loop 0
-
-end
-module Vec_gen
-= struct
-#1 "vec_gen.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-external unsafe_blit :
-  'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
-
-
-module type ResizeType = 
-sig 
-  type t 
-  val null : t (* used to populate new allocated array checkout {!Obj.new_block} for more performance *)
-end
-
-module type S = 
-sig 
-  type elt 
-  type t
-  val length : t -> int 
-  val compact : t -> unit
-  val singleton : elt -> t 
-  val empty : unit -> t 
-  val make : int -> t 
-  val init : int -> (int -> elt) -> t
-  val is_empty : t -> bool
-  val of_array : elt array -> t
-  val of_sub_array : elt array -> int -> int -> t
-
-  (** Exposed for some APIs which only take array as input, 
-      when exposed   
-  *)
-  val unsafe_internal_array : t -> elt array
-  val reserve : t -> int -> unit
-  val push :  elt -> t -> unit
-  val delete : t -> int -> unit 
-  val pop : t -> unit
-  val get_last_and_pop : t -> elt
-  val delete_range : t -> int -> int -> unit 
-  val get_and_delete_range : t -> int -> int -> t
-  val clear : t -> unit 
-  val reset : t -> unit 
-  val to_list : t -> elt list 
-  val of_list : elt list -> t
-  val to_array : t -> elt array 
-  val of_array : elt array -> t
-  val copy : t -> t 
-  val reverse_in_place : t -> unit
-  val iter : (elt -> unit) -> t -> unit 
-  val iteri : (int -> elt -> unit ) -> t -> unit 
-  val iter_range : from:int -> to_:int -> (elt -> unit) -> t -> unit 
-  val iteri_range : from:int -> to_:int -> (int -> elt -> unit) -> t -> unit
-  val map : (elt -> elt) -> t ->  t
-  val mapi : (int -> elt -> elt) -> t -> t
-  val map_into_array : (elt -> 'f) -> t -> 'f array
-  val map_into_list : (elt -> 'f) -> t -> 'f list 
-  val fold_left : ('f -> elt -> 'f) -> 'f -> t -> 'f
-  val fold_right : (elt -> 'g -> 'g) -> t -> 'g -> 'g
-  val filter : (elt -> bool) -> t -> t
-  val inplace_filter : (elt -> bool) -> t -> unit
-  val equal : (elt -> elt -> bool) -> t -> t -> bool 
-  val get : t -> int -> elt
-  val unsafe_get : t -> int -> elt
-  val last : t -> elt
-  val capacity : t -> int
-  val exists : (elt -> bool) -> t -> bool
-end
-
-type 'a t = {
-  mutable arr : 'a array ;
-  mutable len : int ;  
-}
-
-let length d = d.len
-
-let compact d =
-  let d_arr = d.arr in 
-  if d.len <> Array.length d_arr then 
-    begin
-      let newarr = Array.sub d_arr 0 d.len in 
-      d.arr <- newarr
-    end
-let singleton v = 
-  {
-    len = 1 ; 
-    arr = [|v|]
-  }
-
-let empty () =
-  {
-    len = 0;
-    arr = [||];
-  }
-
-let is_empty d =
-  d.len = 0
-
-let reset d = 
-  d.len <- 0; 
-  d.arr <- [||]
-
-
-(* For [to_*] operations, we should be careful to call {!Array.*} function 
-   in case we operate on the whole array
-*)
-let to_list d =
-  let rec loop d_arr idx accum =
-    if idx < 0 then accum else loop d_arr (idx - 1) (Array.unsafe_get d_arr idx :: accum)
-  in
-  loop d.arr (d.len - 1) []
-
-
-let of_list lst =
-  let arr = Array.of_list lst in 
-  { arr ; len = Array.length arr}
-
-
-let to_array d = 
-  Array.sub d.arr 0 d.len
-
-let of_array src =
-  {
-    len = Array.length src;
-    arr = Array.copy src;
-    (* okay to call {!Array.copy}*)
-  }
-let of_sub_array arr off len = 
-  { 
-    len = len ; 
-    arr = Array.sub arr off len  
-  }  
-let unsafe_internal_array v = v.arr  
-(* we can not call {!Array.copy} *)
-let copy src =
-  let len = src.len in
-  {
-    len ;
-    arr = Array.sub src.arr 0 len ;
-  }
-(* FIXME *)
-let reverse_in_place src = 
-  Ext_array.reverse_range src.arr 0 src.len 
-
-let sub src start len =
-  { len ; 
-    arr = Array.sub src.arr start len }
-
-let iter f d = 
-  let arr = d.arr in 
-  for i = 0 to d.len - 1 do
-    f (Array.unsafe_get arr i)
-  done
-
-let iteri f d =
-  let arr = d.arr in
-  for i = 0 to d.len - 1 do
-    f i (Array.unsafe_get arr i)
-  done
-
-let iter_range ~from ~to_ f d =
-  if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iter_range"
-  else 
-    let d_arr = d.arr in 
-    for i = from to to_ do 
-      f  (Array.unsafe_get d_arr i)
-    done
-
-let iteri_range ~from ~to_ f d =
-  if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iteri_range"
-  else 
-    let d_arr = d.arr in 
-    for i = from to to_ do 
-      f i (Array.unsafe_get d_arr i)
-    done
-
-let map_into_array f src =
-  let src_len = src.len in 
-  let src_arr = src.arr in 
-  if src_len = 0 then [||]
-  else 
-    let first_one = f (Array.unsafe_get src_arr 0) in 
-    let arr = Array.make  src_len  first_one in
-    for i = 1 to src_len - 1 do
-      Array.unsafe_set arr i (f (Array.unsafe_get src_arr i))
-    done;
-    arr 
-let map_into_list f src = 
-  let src_len = src.len in 
-  let src_arr = src.arr in 
-  if src_len = 0 then []
-  else 
-    let acc = ref [] in         
-    for i =  src_len - 1 downto 0 do
-      acc := f (Array.unsafe_get src_arr i) :: !acc
-    done;
-    !acc
-
-let mapi f src =
-  let len = src.len in 
-  if len = 0 then { len ; arr = [| |] }
-  else 
-    let src_arr = src.arr in 
-    let arr = Array.make len (Array.unsafe_get src_arr 0) in
-    for i = 1 to len - 1 do
-      Array.unsafe_set arr i (f i (Array.unsafe_get src_arr i))
-    done;
-    {
-      len ;
-      arr ;
-    }
-
-let fold_left f x a =
-  let rec loop a_len a_arr idx x =
-    if idx >= a_len then x else 
-      loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx))
-  in
-  loop a.len a.arr 0 x
-
-let fold_right f a x =
-  let rec loop a_arr idx x =
-    if idx < 0 then x
-    else loop a_arr (idx - 1) (f (Array.unsafe_get a_arr idx) x)
-  in
-  loop a.arr (a.len - 1) x
-
-(**  
-   [filter] and [inplace_filter]
-*)
-let filter f d =
-  let new_d = copy d in 
-  let new_d_arr = new_d.arr in 
-  let d_arr = d.arr in
-  let p = ref 0 in
-  for i = 0 to d.len  - 1 do
-    let x = Array.unsafe_get d_arr i in
-    (* TODO: can be optimized for segments blit *)
-    if f x  then
-      begin
-        Array.unsafe_set new_d_arr !p x;
-        incr p;
-      end;
-  done;
-  new_d.len <- !p;
-  new_d 
-
-let equal eq x y : bool = 
-  if x.len <> y.len then false 
-  else 
-    let rec aux x_arr y_arr i =
-      if i < 0 then true else  
-      if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then 
-        aux x_arr y_arr (i - 1)
-      else false in 
-    aux x.arr y.arr (x.len - 1)
-
-let get d i = 
-  if i < 0 || i >= d.len then invalid_arg "Resize_array.get"
-  else Array.unsafe_get d.arr i
-let unsafe_get d i = Array.unsafe_get d.arr i 
-let last d = 
-  if d.len <= 0 then invalid_arg   "Resize_array.last"
-  else Array.unsafe_get d.arr (d.len - 1)
-
-let capacity d = Array.length d.arr
-
-(* Attention can not use {!Array.exists} since the bound is not the same *)  
-let exists p d = 
-  let a = d.arr in 
-  let n = d.len in   
-  let rec loop i =
-    if i = n then false
-    else if p (Array.unsafe_get a i) then true
-    else loop (succ i) in
-  loop 0
-
-let map f src =
-  let src_len = src.len in 
-  if src_len = 0 then { len = 0 ; arr = [||]}
-  (* TODO: we may share the empty array 
-     but sharing mutable state is very challenging, 
-     the tricky part is to avoid mutating the immutable array,
-     here it looks fine -- 
-     invariant: whenever [.arr] mutated, make sure  it is not an empty array
-     Actually no: since starting from an empty array 
-     {[
-       push v (* the address of v should not be changed *)
-     ]}
-  *)
-  else 
-    let src_arr = src.arr in 
-    let first = f (Array.unsafe_get src_arr 0 ) in 
-    let arr = Array.make  src_len first in
-    for i = 1 to src_len - 1 do
-      Array.unsafe_set arr i (f (Array.unsafe_get src_arr i))
-    done;
-    {
-      len = src_len;
-      arr = arr;
-    }
-
-let init len f =
-  if len < 0 then invalid_arg  "Resize_array.init"
-  else if len = 0 then { len = 0 ; arr = [||] }
-  else 
-    let first = f 0 in 
-    let arr = Array.make len first in
-    for i = 1 to len - 1 do
-      Array.unsafe_set arr i (f i)
-    done;
-    {
-
-      len ;
-      arr 
-    }
-
-end
-module Int_vec : sig 
-#1 "int_vec.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-include Vec_gen.S with type elt = int
-
-end = struct
-#1 "int_vec.ml"
-# 1 "ext/vec.cppo.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-# 33
-type elt = int 
-type t = int Vec_gen.t 
-let null = 0 (* can be optimized *)
-  
-# 39
-  let length = Vec_gen.length 
-  let compact = Vec_gen.compact 
-  let singleton = Vec_gen.singleton
-  let empty = Vec_gen.empty 
-  let is_empty = Vec_gen.is_empty 
-  let reset = Vec_gen.reset 
-  let to_list = Vec_gen.to_list 
-  let of_list = Vec_gen.of_list 
-  let to_array = Vec_gen.to_array
-  let of_array = Vec_gen.of_array 
-  let of_sub_array = Vec_gen.of_sub_array 
-  let unsafe_internal_array = Vec_gen.unsafe_internal_array 
-  let copy = Vec_gen.copy 
-  let reverse_in_place = Vec_gen.reverse_in_place 
-  let sub = Vec_gen.sub 
-  let iter = Vec_gen.iter 
-  let iteri = Vec_gen.iteri 
-  let iter_range = Vec_gen.iter_range 
-  let iteri_range = Vec_gen.iteri_range  
-  let filter = Vec_gen.filter 
-  let fold_right = Vec_gen.fold_right 
-  let fold_left = Vec_gen.fold_left 
-  let map_into_list = Vec_gen.map_into_list 
-  let map_into_array = Vec_gen.map_into_array 
-  let mapi = Vec_gen.mapi 
-  let equal = Vec_gen.equal 
-  let get = Vec_gen.get 
-  let exists = Vec_gen.exists 
-  let capacity = Vec_gen.capacity 
-  let last = Vec_gen.last 
-  let unsafe_get = Vec_gen.unsafe_get 
-  let map = Vec_gen.map 
-  let init = Vec_gen.init 
-
-  let make initsize : _ Vec_gen.t =
-    if initsize < 0 then invalid_arg  "Resize_array.make" ;
-    {
-
-      len = 0;
-      arr = Array.make  initsize null ;
-    }
-
-
-
-  let reserve (d : _ Vec_gen.t ) s = 
-    let d_len = d.len in 
-    let d_arr = d.arr in 
-    if s < d_len || s < Array.length d_arr then ()
-    else 
-      let new_capacity = min Sys.max_array_length s in 
-      let new_d_arr = Array.make new_capacity null in 
-      Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len;
-      d.arr <- new_d_arr 
-
-  let push v (d : _ Vec_gen.t) =
-    let d_len = d.len in
-    let d_arr = d.arr in 
-    let d_arr_len = Array.length d_arr in
-    if d_arr_len = 0 then
-      begin 
-        d.len <- 1 ;
-        d.arr <- [| v |]
-      end
-    else  
-      begin 
-        if d_len = d_arr_len then 
-          begin
-            if d_len >= Sys.max_array_length then 
-              failwith "exceeds max_array_length";
-            let new_capacity = min Sys.max_array_length d_len * 2 
-            (* [d_len] can not be zero, so [*2] will enlarge   *)
-            in
-            let new_d_arr = Array.make new_capacity null in 
-            d.arr <- new_d_arr;
-            Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len ;
-          end;
-        d.len <- d_len + 1;
-        Array.unsafe_set d.arr d_len v
-      end
-
-  let delete (d : _ Vec_gen.t) idx =
-    if idx < 0 || idx >= d.len then invalid_arg "Resize_array.delete" ;
-    let arr = d.arr in 
-    Vec_gen.unsafe_blit arr (idx + 1) arr idx  (d.len - idx - 1);
-    Array.unsafe_set arr (d.len - 1) null;
-    d.len <- d.len - 1
-
-  let pop (d : _ Vec_gen.t) = 
-    let idx  = d.len - 1  in
-    if idx < 0 then invalid_arg "Resize_array.pop";
-    Array.unsafe_set d.arr idx null;
-    d.len <- idx
-  let get_last_and_pop (d : _ Vec_gen.t) = 
-    let idx  = d.len - 1  in
-    if idx < 0 then invalid_arg "Resize_array.get_last_and_pop";
-    let last = Array.unsafe_get d.arr idx in 
-    Array.unsafe_set d.arr idx null;
-    d.len <- idx; 
-    last 
-
-  let delete_range (d : _ Vec_gen.t) idx len =
-    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
-    let arr = d.arr in 
-    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
-    for i = d.len - len to d.len - 1 do
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- d.len - len
-
-
-  let get_and_delete_range (d : _ Vec_gen.t) idx len : _ Vec_gen.t = 
-    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
-    let arr = d.arr in 
-    let value = Array.sub arr idx len in
-    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
-    for i = d.len - len to d.len - 1 do
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- d.len - len; 
-    {len = len ; arr = value}
-
-
-  (** Below are simple wrapper around normal Array operations *)  
-
-  let clear (d : _ Vec_gen.t ) =
-    for i = 0 to d.len - 1 do 
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- 0
-
-
-
-  let inplace_filter f (d : _ Vec_gen.t) = 
-    let d_arr = d.arr in 
-    let p = ref 0 in
-    for i = 0 to d.len - 1 do 
-      let x = Array.unsafe_get d_arr i in 
-      if f x then 
-        begin 
-          let curr_p = !p in 
-          (if curr_p <> i then 
-             Array.unsafe_set d_arr curr_p x) ;
-          incr p
-        end
-    done ;
-    let last = !p  in 
-    delete_range d last  (d.len - last)
-
-
-end
-module Resize_array : sig 
-#1 "resize_array.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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 Make ( Resize : Vec_gen.ResizeType) : Vec_gen.S with type elt = Resize.t 
-
-
-
-end = struct
-#1 "resize_array.ml"
-# 1 "ext/vec.cppo.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-# 28
-module Make ( Resize : Vec_gen.ResizeType) = struct
-  type elt = Resize.t 
-  type nonrec t = elt Vec_gen.t
-  let null = Resize.null 
-  
-# 39
-  let length = Vec_gen.length 
-  let compact = Vec_gen.compact 
-  let singleton = Vec_gen.singleton
-  let empty = Vec_gen.empty 
-  let is_empty = Vec_gen.is_empty 
-  let reset = Vec_gen.reset 
-  let to_list = Vec_gen.to_list 
-  let of_list = Vec_gen.of_list 
-  let to_array = Vec_gen.to_array
-  let of_array = Vec_gen.of_array 
-  let of_sub_array = Vec_gen.of_sub_array 
-  let unsafe_internal_array = Vec_gen.unsafe_internal_array 
-  let copy = Vec_gen.copy 
-  let reverse_in_place = Vec_gen.reverse_in_place 
-  let sub = Vec_gen.sub 
-  let iter = Vec_gen.iter 
-  let iteri = Vec_gen.iteri 
-  let iter_range = Vec_gen.iter_range 
-  let iteri_range = Vec_gen.iteri_range  
-  let filter = Vec_gen.filter 
-  let fold_right = Vec_gen.fold_right 
-  let fold_left = Vec_gen.fold_left 
-  let map_into_list = Vec_gen.map_into_list 
-  let map_into_array = Vec_gen.map_into_array 
-  let mapi = Vec_gen.mapi 
-  let equal = Vec_gen.equal 
-  let get = Vec_gen.get 
-  let exists = Vec_gen.exists 
-  let capacity = Vec_gen.capacity 
-  let last = Vec_gen.last 
-  let unsafe_get = Vec_gen.unsafe_get 
-  let map = Vec_gen.map 
-  let init = Vec_gen.init 
-
-  let make initsize : _ Vec_gen.t =
-    if initsize < 0 then invalid_arg  "Resize_array.make" ;
-    {
-
-      len = 0;
-      arr = Array.make  initsize null ;
-    }
-
-
-
-  let reserve (d : _ Vec_gen.t ) s = 
-    let d_len = d.len in 
-    let d_arr = d.arr in 
-    if s < d_len || s < Array.length d_arr then ()
-    else 
-      let new_capacity = min Sys.max_array_length s in 
-      let new_d_arr = Array.make new_capacity null in 
-      Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len;
-      d.arr <- new_d_arr 
-
-  let push v (d : _ Vec_gen.t) =
-    let d_len = d.len in
-    let d_arr = d.arr in 
-    let d_arr_len = Array.length d_arr in
-    if d_arr_len = 0 then
-      begin 
-        d.len <- 1 ;
-        d.arr <- [| v |]
-      end
-    else  
-      begin 
-        if d_len = d_arr_len then 
-          begin
-            if d_len >= Sys.max_array_length then 
-              failwith "exceeds max_array_length";
-            let new_capacity = min Sys.max_array_length d_len * 2 
-            (* [d_len] can not be zero, so [*2] will enlarge   *)
-            in
-            let new_d_arr = Array.make new_capacity null in 
-            d.arr <- new_d_arr;
-            Vec_gen.unsafe_blit d_arr 0 new_d_arr 0 d_len ;
-          end;
-        d.len <- d_len + 1;
-        Array.unsafe_set d.arr d_len v
-      end
-
-  let delete (d : _ Vec_gen.t) idx =
-    if idx < 0 || idx >= d.len then invalid_arg "Resize_array.delete" ;
-    let arr = d.arr in 
-    Vec_gen.unsafe_blit arr (idx + 1) arr idx  (d.len - idx - 1);
-    Array.unsafe_set arr (d.len - 1) null;
-    d.len <- d.len - 1
-
-  let pop (d : _ Vec_gen.t) = 
-    let idx  = d.len - 1  in
-    if idx < 0 then invalid_arg "Resize_array.pop";
-    Array.unsafe_set d.arr idx null;
-    d.len <- idx
-  let get_last_and_pop (d : _ Vec_gen.t) = 
-    let idx  = d.len - 1  in
-    if idx < 0 then invalid_arg "Resize_array.get_last_and_pop";
-    let last = Array.unsafe_get d.arr idx in 
-    Array.unsafe_set d.arr idx null;
-    d.len <- idx; 
-    last 
-
-  let delete_range (d : _ Vec_gen.t) idx len =
-    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.delete_range"  ;
-    let arr = d.arr in 
-    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
-    for i = d.len - len to d.len - 1 do
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- d.len - len
-
-
-  let get_and_delete_range (d : _ Vec_gen.t) idx len : _ Vec_gen.t = 
-    if len < 0 || idx < 0 || idx + len > d.len then invalid_arg  "Resize_array.get_and_delete_range"  ;
-    let arr = d.arr in 
-    let value = Array.sub arr idx len in
-    Vec_gen.unsafe_blit arr (idx + len) arr idx (d.len  - idx - len);
-    for i = d.len - len to d.len - 1 do
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- d.len - len; 
-    {len = len ; arr = value}
-
-
-  (** Below are simple wrapper around normal Array operations *)  
-
-  let clear (d : _ Vec_gen.t ) =
-    for i = 0 to d.len - 1 do 
-      Array.unsafe_set d.arr i null
-    done;
-    d.len <- 0
-
-
-
-  let inplace_filter f (d : _ Vec_gen.t) = 
-    let d_arr = d.arr in 
-    let p = ref 0 in
-    for i = 0 to d.len - 1 do 
-      let x = Array.unsafe_get d_arr i in 
-      if f x then 
-        begin 
-          let curr_p = !p in 
-          (if curr_p <> i then 
-             Array.unsafe_set d_arr curr_p x) ;
-          incr p
-        end
-    done ;
-    let last = !p  in 
-    delete_range d last  (d.len - last)
-
-# 188
-end
-
-end
-module Int_vec_vec : sig 
-#1 "int_vec_vec.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-include Vec_gen.S with type elt = Int_vec.t
-
-end = struct
-#1 "int_vec_vec.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-include Resize_array.Make(struct type t = Int_vec.t let null = Int_vec.empty () end)
-
-end
-module Ext_scc : sig 
-#1 "ext_scc.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
- 
-
-
-
-type node = Int_vec.t
-(** Assume input is int array with offset from 0 
-    Typical input 
-    {[
-      [|
-        [ 1 ; 2 ]; // 0 -> 1,  0 -> 2 
-        [ 1 ];   // 0 -> 1 
-        [ 2 ]  // 0 -> 2 
-      |]
-    ]}
-    Note that we can tell how many nodes by calculating 
-    [Array.length] of the input 
-*)
-val graph : Int_vec.t array -> Int_vec_vec.t
-
-
-(** Used for unit test *)
-val graph_check : node array -> int * int list 
-
-end = struct
-#1 "ext_scc.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
- 
-type node = Int_vec.t 
-(** 
-   [int] as data for this algorithm
-   Pros:
-   1. Easy to eoncode algorithm (especially given that the capacity of node is known)
-   2. Algorithms itself are much more efficient
-   3. Node comparison semantics is clear
-   4. Easy to print output
-   Cons:
-   1. post processing input data  
- *)
-let min_int (x : int) y = if x < y then x else y  
-
-
-let graph  e =
-  let index = ref 0 in 
-  let s = Int_vec.empty () in
-
-  let output = Int_vec_vec.empty () in (* collect output *)
-  let node_numes = Array.length e in
-  
-  let on_stack_array = Array.make node_numes false in
-  let index_array = Array.make node_numes (-1) in 
-  let lowlink_array = Array.make node_numes (-1) in
-  
-  let rec scc v_data  =
-    let new_index = !index + 1 in 
-    index := new_index ;
-    Int_vec.push  v_data s ; 
-
-    index_array.(v_data) <- new_index ;  
-    lowlink_array.(v_data) <- new_index ; 
-    on_stack_array.(v_data) <- true ;
-    
-    let v = e.(v_data) in 
-    v
-    |> Int_vec.iter (fun w_data  ->
-        if Array.unsafe_get index_array w_data < 0 then (* not processed *)
-          begin  
-            scc w_data;
-            Array.unsafe_set lowlink_array v_data  
-              (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data))
-          end  
-        else if Array.unsafe_get on_stack_array w_data then 
-          (* successor is in stack and hence in current scc *)
-          begin 
-            Array.unsafe_set lowlink_array v_data  
-              (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data))
-          end
-      ) ; 
-
-    if Array.unsafe_get lowlink_array v_data = Array.unsafe_get index_array v_data then
-      (* start a new scc *)
-      begin
-        let s_len = Int_vec.length s in
-        let last_index = ref (s_len - 1) in 
-        let u = ref (Int_vec.unsafe_get s !last_index) in
-        while  !u <> v_data do 
-          Array.unsafe_set on_stack_array (!u)  false ; 
-          last_index := !last_index - 1;
-          u := Int_vec.unsafe_get s !last_index
-        done ;
-        on_stack_array.(v_data) <- false; (* necessary *)
-        Int_vec_vec.push   (Int_vec.get_and_delete_range s !last_index (s_len  - !last_index)) output;
-      end   
-  in
-  for i = 0 to node_numes - 1 do 
-    if Array.unsafe_get index_array i < 0 then scc i
-  done ;
-  output 
-
-let graph_check v = 
-  let v = graph v in 
-  Int_vec_vec.length v, 
-  Int_vec_vec.fold_left (fun acc x -> Int_vec.length x :: acc ) [] v  
-
-end
-module Ident_hash_set : sig 
-#1 "ident_hash_set.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-include Hash_set_gen.S with type key = Ident.t
-
-end = struct
-#1 "ident_hash_set.ml"
-# 1 "ext/hash_set.cppo.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-# 37
-type key = Ident.t
-let key_index (h :  _ Hash_set_gen.t ) (key : key) =
-  (Bs_hash_stubs.hash_string_int  key.name key.stamp) land (Array.length h.data - 1)
-let eq_key = Ext_ident.equal
-type t = key Hash_set_gen.t
-
-
-# 59
-let create = Hash_set_gen.create
-let clear = Hash_set_gen.clear
-let reset = Hash_set_gen.reset
-let copy = Hash_set_gen.copy
-let iter = Hash_set_gen.iter
-let fold = Hash_set_gen.fold
-let length = Hash_set_gen.length
-let stats = Hash_set_gen.stats
-let elements = Hash_set_gen.elements
-
-
-
-let remove (h : _ Hash_set_gen.t) key =  
-  let i = key_index h key in
-  let h_data = h.data in
-  let old_h_size = h.size in 
-  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
-  if old_h_size <> h.size then  
-    Array.unsafe_set h_data i new_bucket
-
-
-
-let add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
-    end
-
-let check_add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
-      true 
-    end
-  else false 
-
-
-let mem (h :  _ Hash_set_gen.t) key =
-  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
-
-  
-
-end
-module Ocaml_stdlib_slots
-= struct
-#1 "ocaml_stdlib_slots.ml"
-
-(* Generated by scripts/gen_slots.ml, should be updated everytime when we upgrade the compiler *)
-let pervasives = [| "invalid_arg";"failwith";"Exit";"min";"max";"abs";"max_int";"min_int";"lnot";"infinity";"neg_infinity";"nan";"max_float";"min_float";"epsilon_float";"^";"char_of_int";"string_of_bool";"bool_of_string";"string_of_int";"string_of_float";"@";"stdin";"stdout";"stderr";"print_char";"print_string";"print_bytes";"print_int";"print_float";"print_endline";"print_newline";"prerr_char";"prerr_string";"prerr_bytes";"prerr_int";"prerr_float";"prerr_endline";"prerr_newline";"read_line";"read_int";"read_float";"open_out";"open_out_bin";"open_out_gen";"flush";"flush_all";"output_char";"output_string";"output_bytes";"output";"output_substring";"output_byte";"output_binary_int";"output_value";"seek_out";"pos_out";"out_channel_length";"close_out";"close_out_noerr";"set_binary_mode_out";"open_in";"open_in_bin";"open_in_gen";"input_char";"input_line";"input";"really_input";"really_input_string";"input_byte";"input_binary_int";"input_value";"seek_in";"pos_in";"in_channel_length";"close_in";"close_in_noerr";"set_binary_mode_in";"LargeFile";"string_of_format";"^^";"exit";"at_exit";"valid_float_lexem";"unsafe_really_input";"do_at_exit" |]
-let camlinternalOO = [| "public_method_label";"new_method";"new_variable";"new_methods_variables";"get_variable";"get_variables";"get_method_label";"get_method_labels";"get_method";"set_method";"set_methods";"narrow";"widen";"add_initializer";"dummy_table";"create_table";"init_class";"inherits";"make_class";"make_class_store";"dummy_class";"copy";"create_object";"create_object_opt";"run_initializers";"run_initializers_opt";"create_object_and_run_initializers";"lookup_tables";"params";"stats" |]
-let camlinternalMod = [| "init_mod";"update_mod" |]
-let string = [| "make";"init";"copy";"sub";"fill";"blit";"concat";"iter";"iteri";"map";"mapi";"trim";"escaped";"index";"rindex";"index_from";"rindex_from";"contains";"contains_from";"rcontains_from";"uppercase";"lowercase";"capitalize";"uncapitalize";"compare" |]
-let array = [| "init";"make_matrix";"create_matrix";"append";"concat";"sub";"copy";"fill";"blit";"to_list";"of_list";"iter";"map";"iteri";"mapi";"fold_left";"fold_right";"sort";"stable_sort";"fast_sort" |]
-let list = [| "length";"hd";"tl";"nth";"rev";"append";"rev_append";"concat";"flatten";"iter";"iteri";"map";"mapi";"rev_map";"fold_left";"fold_right";"iter2";"map2";"rev_map2";"fold_left2";"fold_right2";"for_all";"exists";"for_all2";"exists2";"mem";"memq";"find";"filter";"find_all";"partition";"assoc";"assq";"mem_assoc";"mem_assq";"remove_assoc";"remove_assq";"split";"combine";"sort";"stable_sort";"fast_sort";"sort_uniq";"merge" |]
-    
-
-end
-module Ordered_hash_map_gen
-= struct
-#1 "ordered_hash_map_gen.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-(* does not support [remove], 
-    so that the adding order is strict and continous  
- *)
-
-module type S =
-sig
-  type key
-  type 'value t
-  val create: int ->  'value t
-  val clear : 'vaulue t -> unit
-  val reset : 'value t -> unit
-  val copy: 'value t -> 'value t
-  val add : 'value t -> key -> 'value -> unit
-  val mem : 'value t -> key -> bool
-  val rank : 'value t -> key -> int (* -1 if not found*)
-  val find_value : 'value t -> key -> 'value (* raise if not found*)
-  val iter: (key -> 'value -> int -> unit) ->  'value t -> unit
-  val fold: (key -> 'value -> int -> 'b -> 'b) ->  'value t -> 'b -> 'b
-  val length:  'value t -> int
-  val stats: 'value t -> Hashtbl.statistics
-  val elements : 'value t -> key list 
-  val choose : 'value t -> key 
-  val to_sorted_array: 'value t -> key array
-end
-
-(* We do dynamic hashing, and resize the table and rehash the elements
-   when buckets become too long. *)
-type ('a,'b) bucket = 
-  | Empty 
-  | Cons of 'a * int * 'b  * ('a,'b) bucket
-
-type ('a,'b) t =
-  { mutable size: int;                        (* number of entries *)
-    mutable data: ('a,'b) bucket array;  (* the buckets *)
-    initial_size: int;                        (* initial array size *)
-  }
-
-
-
-
-let create  initial_size =
-  let s = Ext_util.power_2_above 16 initial_size in
-  { initial_size = s; size = 0; data = Array.make s Empty }
-
-let clear h =
-  h.size <- 0;
-  let len = Array.length h.data in
-  for i = 0 to len - 1 do
-    Array.unsafe_set h.data i  Empty
-  done
-
-let reset h =
-  h.size <- 0;
-  h.data <- Array.make h.initial_size Empty
-
-
-let copy h = { h with data = Array.copy h.data }
-
-let length h = h.size
-
-let resize indexfun h =
-  let odata = h.data in
-  let osize = Array.length odata in
-  let nsize = osize * 2 in
-  if nsize < Sys.max_array_length then begin
-    let ndata = Array.make nsize Empty in
-    h.data <- ndata;          (* so that indexfun sees the new bucket count *)
-    let rec insert_bucket = function
-        Empty -> ()
-      | Cons(key,info,data,rest) ->
-        let nidx = indexfun h key in
-        ndata.(nidx) <- Cons(key,info,data, ndata.(nidx));
-        insert_bucket rest
-    in
-    for i = 0 to osize - 1 do
-      insert_bucket (Array.unsafe_get odata i)
-    done
-  end
-
-let iter f h =
-  let rec do_bucket = function
-    | Empty ->
-      ()
-    | Cons(k ,i, value, rest) ->
-      f k value i; do_bucket rest in
-  let d = h.data in
-  for i = 0 to Array.length d - 1 do
-    do_bucket (Array.unsafe_get d i)
-  done
-
-let choose h = 
-  let rec aux arr offset len = 
-    if offset >= len then raise Not_found
-    else 
-      match Array.unsafe_get arr offset with 
-      | Empty -> aux arr (offset + 1) len 
-      | Cons (k,_,_,rest) -> k 
-  in
-  aux h.data 0 (Array.length h.data)
-
-let to_sorted_array h = 
-  if h.size = 0 then [||]
-  else 
-    let v = choose h in 
-    let arr = Array.make h.size v in
-    iter (fun k _ i -> Array.unsafe_set arr i k) h;
-    arr 
-
-let fold f h init =
-  let rec do_bucket b accu =
-    match b with
-      Empty ->
-      accu
-    | Cons( k , i,  value, rest) ->
-      do_bucket rest (f k  value i  accu) in
-  let d = h.data in
-  let accu = ref init in
-  for i = 0 to Array.length d - 1 do
-    accu := do_bucket (Array.unsafe_get d i) !accu
-  done;
-  !accu
-
-let elements set = 
-  fold  (fun k  _  _ acc  ->  k :: acc) set []
-
-
-let rec bucket_length acc (x : _ bucket) = 
-  match x with 
-  | Empty -> 0
-  | Cons(_,_,_,rest) -> bucket_length (acc + 1) rest  
-
-let stats h =
-  let mbl =
-    Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
-  let histo = Array.make (mbl + 1) 0 in
-  Array.iter
-    (fun b ->
-       let l = bucket_length 0 b in
-       histo.(l) <- histo.(l) + 1)
-    h.data;
-  { Hashtbl.num_bindings = h.size;
-    num_buckets = Array.length h.data;
-    max_bucket_length = mbl;
-    bucket_histogram = histo }
-
-
-
-end
-module Ordered_hash_map_local_ident : sig 
-#1 "ordered_hash_map_local_ident.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-(** Hash algorithm only hash 
-    stamp, this makes sense when  all identifiers are local (no global)
-*)
-include Ordered_hash_map_gen.S with type key = Ident.t
-
-end = struct
-#1 "ordered_hash_map_local_ident.ml"
-  
-# 10 "ext/ordered_hash_map.cppo.ml"
-  type key = Ident.t
-  type   'value t = (key,'value) Ordered_hash_map_gen.t
-  let key_index (h : _ t) (key : key) =
-    (Bs_hash_stubs.hash_int  key.stamp) land (Array.length h.data - 1)
-  let equal_key = Ext_ident.equal
-
-
-# 20
-open Ordered_hash_map_gen
-
-let create = create
-let clear = clear
-let reset = reset
-let copy = copy
-let iter = iter
-let fold = fold
-let length = length
-let stats = stats
-let elements = elements
-let choose = choose
-let to_sorted_array = to_sorted_array
-
-
-
-let rec small_bucket_mem key lst =
-  match lst with 
-  | Empty -> false 
-  | Cons(key1,_, _, rest) -> 
-    equal_key key key1 ||
-    match rest with 
-    | Empty -> false 
-    | Cons(key2 , _,_, rest) -> 
-      equal_key key  key2 ||
-      match rest with 
-      | Empty -> false 
-      | Cons(key3,_, _, rest) -> 
-        equal_key key  key3 ||
-        small_bucket_mem key rest 
-
-let rec small_bucket_rank key lst =
-  match lst with 
-  | Empty -> -1
-  | Cons(key1,i,_, rest) -> 
-    if equal_key key key1 then i 
-    else match rest with 
-      | Empty -> -1 
-      | Cons(key2,i2, _, rest) -> 
-        if equal_key key  key2 then i2 else
-          match rest with 
-          | Empty -> -1 
-          | Cons(key3,i3, _, rest) -> 
-            if equal_key key  key3 then i3 else
-              small_bucket_rank key rest 
-let rec small_bucket_find_value  key (lst : (_,_) bucket)   =
-  match lst with 
-  | Empty -> raise Not_found
-  | Cons(key1,_,value, rest) -> 
-    if equal_key key  key1 then value 
-    else match rest with 
-      | Empty -> raise Not_found 
-      | Cons(key2,_,value, rest) -> 
-        if equal_key key  key2 then value else
-          match rest with 
-          | Empty -> raise Not_found 
-          | Cons(key3, _ , value, rest) -> 
-            if equal_key key  key3 then value else
-              small_bucket_find_value key rest 
-
-let add h key value =
-  let i = key_index h key  in 
-  if not (small_bucket_mem key  h.data.(i)) then 
-    begin 
-      h.data.(i) <- Cons(key,h.size, value, h.data.(i));
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then resize key_index h
-    end
-
-let mem h key =
-  small_bucket_mem key (Array.unsafe_get h.data (key_index h key)) 
-let rank h key = 
-  small_bucket_rank key(Array.unsafe_get h.data (key_index h key))  
-
-let find_value h key =
-  small_bucket_find_value key (Array.unsafe_get h.data (key_index h key))
-
-
-
-
-
-
-
-
-
-
-
-
-
-end
-module Lam : sig 
-#1 "lam.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-type array_kind = Lambda.array_kind
-type boxed_integer = Lambda.boxed_integer
-type comparison = Lambda.comparison 
-type bigarray_kind = Lambda.bigarray_kind
-type bigarray_layout = Lambda.bigarray_layout
-type compile_time_constant = Lambda.compile_time_constant
-
-type tag_info = Lambda.tag_info
-type mutable_flag = Asttypes.mutable_flag
-type field_dbg_info = Lambda.field_dbg_info 
-type set_field_dbg_info = Lambda.set_field_dbg_info
-
-type ident = Ident.t
-
-type function_arities = 
-  | Determin of bool * (int * Ident.t list option) list  * bool
-  (** when the first argument is true, it is for sure 
-
-      approximation sound but not complete 
-      the last one means it can take any params later, 
-      for an exception: it is (Determin (true,[], true))
-   *)
-  | NA 
-
-type primitive = 
-  | Pbytes_to_string
-  | Pbytes_of_string
-  | Pgetglobal of ident
-  | Psetglobal of ident
-  | Pglobal_exception of ident             
-  | Pmakeblock of int * Lambda.tag_info * Asttypes.mutable_flag
-  | Pfield of int * Lambda.field_dbg_info
-  | Psetfield of int * bool * Lambda.set_field_dbg_info
-  | Pfloatfield of int * Lambda.field_dbg_info
-  | Psetfloatfield of int * Lambda.set_field_dbg_info
-  | Pduprecord of Types.record_representation * int
-  | Plazyforce
-  | Pccall of  Primitive.description
-  | Praise 
-  | Psequand | Psequor | Pnot
-  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
-  | Pandint | Porint | Pxorint
-  | Plslint | Plsrint | Pasrint
-  | Pintcomp of Lambda.comparison
-  | Poffsetint of int
-  | Poffsetref of int
-  | Pintoffloat | Pfloatofint
-  | Pnegfloat | Pabsfloat
-  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
-  | Pfloatcomp of Lambda.comparison
-  | Pstringlength 
-  | Pstringrefu 
-  | Pstringrefs
-  | Pstringadd    
-  | Pbyteslength
-  | Pbytesrefu
-  | Pbytessetu 
-  | Pbytesrefs
-  | Pbytessets
-  (* Array operations *)
-  | Pmakearray of array_kind
-  | Parraylength of array_kind
-  | Parrayrefu of array_kind
-  | Parraysetu of array_kind
-  | Parrayrefs of array_kind
-  | Parraysets of array_kind
-  (* Test if the argument is a block or an immediate integer *)
-  | Pisint
-  (* Test if the (integer) argument is outside an interval *)
-  | Pisout
-  (* Bitvect operations *)
-  | Pbittest
-  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
-  | Pbintofint of boxed_integer
-  | Pintofbint of boxed_integer
-  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
-  | Pnegbint of boxed_integer
-  | Paddbint of boxed_integer
-  | Psubbint of boxed_integer
-  | Pmulbint of boxed_integer
-  | Pdivbint of boxed_integer
-  | Pmodbint of boxed_integer
-  | Pandbint of boxed_integer
-  | Porbint of boxed_integer
-  | Pxorbint of boxed_integer
-  | Plslbint of boxed_integer
-  | Plsrbint of boxed_integer
-  | Pasrbint of boxed_integer
-  | Pbintcomp of boxed_integer * comparison
-  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
-  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
-  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
-  (* size of the nth dimension of a big array *)
-  | Pbigarraydim of int
-  (* load/set 16,32,64 bits from a string: (unsafe)*)
-  | Pstring_load_16 of bool
-  | Pstring_load_32 of bool
-  | Pstring_load_64 of bool
-  | Pstring_set_16 of bool
-  | Pstring_set_32 of bool
-  | Pstring_set_64 of bool
-  (* load/set 16,32,64 bits from a
-     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
-  | Pbigstring_load_16 of bool
-  | Pbigstring_load_32 of bool
-  | Pbigstring_load_64 of bool
-  | Pbigstring_set_16 of bool
-  | Pbigstring_set_32 of bool
-  | Pbigstring_set_64 of bool
-  (* Compile time constants *)
-  | Pctconst of compile_time_constant
-  (* byte swap *)
-  | Pbswap16
-  | Pbbswap of boxed_integer
-  (* Integer to external pointer *)
-
-  | Pdebugger
-  | Pjs_unsafe_downgrade of string * Location.t
-  | Pinit_mod
-  | Pupdate_mod
-  | Pjs_fn_make of int 
-  | Pjs_fn_run of int 
-  | Pjs_fn_method of int 
-  | Pjs_fn_runmethod of int 
-
-type switch  =
-  { sw_numconsts: int;
-    sw_consts: (int * t) list;
-    sw_numblocks: int;
-    sw_blocks: (int * t) list;
-    sw_failaction : t option}
-and apply_status =
-  | App_na
-  | App_ml_full
-  | App_js_full      
-and apply_info = private
-  { fn : t ; 
-    args : t list ; 
-    loc : Location.t;
-    status : apply_status
-  }
-
-and prim_info = private
-  { primitive : primitive ; 
-    args : t list ; 
-    loc : Location.t 
-  }
-and function_info = private
-  { arity : int ; 
-   kind : Lambda.function_kind ; 
-   params : ident list ;
-   body : t 
-  }
-and  t =  private
-  | Lvar of ident
-  | Lconst of Lambda.structured_constant
-  | Lapply of apply_info
-  | Lfunction of function_info
-  | Llet of Lambda.let_kind * ident * t * t
-  | Lletrec of (ident * t) list * t
-  | Lprim of prim_info
-  | Lswitch of t * switch
-  | Lstringswitch of t * (string * t) list * t option
-  | Lstaticraise of int * t list
-  | Lstaticcatch of t * (int * ident list) * t
-  | Ltrywith of t * ident * t
-  | Lifthenelse of t * t * t
-  | Lsequence of t * t
-  | Lwhile of t * t
-  | Lfor of ident * t * t * Asttypes.direction_flag * t
-  | Lassign of ident * t
-  | Lsend of Lambda.meth_kind * t * t * t list * Location.t
-  | Lifused of ident * t
-  (* | Levent of t * Lambda.lambda_event 
-     [Levent] in the branch hurt pattern match, 
-     we should use record for trivial debugger info
-  *)
-
-
-module Prim : sig 
-  type t = primitive
-  val js_is_nil : t
-  val js_is_undef : t 
-  val js_is_nil_undef : t 
-end
-
-
-type binop = t -> t -> t 
-
-type triop = t -> t -> t -> t 
-
-type unop = t ->  t
-
-val inner_map : (t -> t) -> t -> t
-val inner_iter : (t -> unit) -> t -> unit 
-val free_variables : t -> Ident_set.t
-val check : string -> t -> t 
-type bindings = (Ident.t * t) list
-
-val scc : bindings -> t -> t  -> t 
-
-val var : ident -> t
-val const : Lambda.structured_constant -> t
-
-val apply : t -> t list -> Location.t -> apply_status -> t
-val function_ : 
-  arity:int ->
-  kind:Lambda.function_kind -> params:ident list -> body:t -> t
-
-val let_ : Lambda.let_kind -> ident -> t -> t -> t
-val letrec : (ident * t) list -> t -> t
-val if_ : triop
-val switch : t -> switch  -> t 
-val stringswitch : t -> (string * t) list -> t option -> t 
-
-val true_ : t 
-val false_ : t 
-val unit : t 
-
-val sequor : binop
-val sequand : binop
-val not_ : Location.t ->  unop
-val seq : binop
-val while_ : binop
-val event : t -> Lambda.lambda_event -> t  
-val try_ : t -> ident -> t  -> t 
-val ifused : ident -> t -> t
-val assign : ident -> t -> t 
-
-val send : 
-  Lambda.meth_kind ->
-  t -> t -> t list -> 
-  Location.t -> t 
-
-val prim : primitive:primitive -> args:t list -> Location.t  ->  t
-
-val staticcatch : 
-  t -> int * ident list -> t -> t
-
-val staticraise : 
-  int -> t list -> t
-
-val for_ : 
-  ident ->
-  t  ->
-  t -> Asttypes.direction_flag -> t -> t 
-
-
-
-
-
-val convert : Lambda.lambda -> t 
-
-end = struct
-#1 "lam.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-type array_kind = Lambda.array_kind
-type boxed_integer = Lambda.boxed_integer
-type comparison = Lambda.comparison 
-type bigarray_kind = Lambda.bigarray_kind
-type bigarray_layout = Lambda.bigarray_layout
-type compile_time_constant = Lambda.compile_time_constant
-
-type tag_info = Lambda.tag_info
-type mutable_flag = Asttypes.mutable_flag
-type field_dbg_info = Lambda.field_dbg_info 
-type set_field_dbg_info = Lambda.set_field_dbg_info
-
-type ident = Ident.t
-
-type function_arities = 
-  | Determin of bool * (int * Ident.t list option) list  * bool
-  | NA 
-
-type primitive = 
-  | Pbytes_to_string
-  | Pbytes_of_string
-  (* Globals *)
-  | Pgetglobal of ident
-  | Psetglobal of ident
-  | Pglobal_exception of ident       
-  (* Operations on heap blocks *)
-  | Pmakeblock of int * tag_info * mutable_flag
-  | Pfield of int * field_dbg_info
-  | Psetfield of int * bool * set_field_dbg_info
-  (* could have field info at least for record *)
-  | Pfloatfield of int * field_dbg_info
-  | Psetfloatfield of int * set_field_dbg_info
-  | Pduprecord of Types.record_representation * int
-  (* Force lazy values *)
-  | Plazyforce
-  (* External call *)
-  | Pccall of  Primitive.description
-  (* Exceptions *)
-  | Praise
-  (* Boolean operations *)
-  | Psequand | Psequor | Pnot
-  (* Integer operations *)
-  | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
-  | Pandint | Porint | Pxorint
-  | Plslint | Plsrint | Pasrint
-  | Pintcomp of comparison
-  | Poffsetint of int
-  | Poffsetref of int
-  (* Float operations *)
-  | Pintoffloat | Pfloatofint
-  | Pnegfloat | Pabsfloat
-  | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
-  | Pfloatcomp of comparison
-  (* String operations *)
-  | Pstringlength 
-  | Pstringrefu 
-  | Pstringrefs
-  | Pstringadd  
-  | Pbyteslength
-  | Pbytesrefu
-  | Pbytessetu 
-  | Pbytesrefs
-  | Pbytessets
-  (* Array operations *)
-  | Pmakearray of array_kind
-  | Parraylength of array_kind
-  | Parrayrefu of array_kind
-  | Parraysetu of array_kind
-  | Parrayrefs of array_kind
-  | Parraysets of array_kind
-  (* Test if the argument is a block or an immediate integer *)
-  | Pisint
-  (* Test if the (integer) argument is outside an interval *)
-  | Pisout
-  (* Bitvect operations *)
-  | Pbittest
-  (* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
-  | Pbintofint of boxed_integer
-  | Pintofbint of boxed_integer
-  | Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
-  | Pnegbint of boxed_integer
-  | Paddbint of boxed_integer
-  | Psubbint of boxed_integer
-  | Pmulbint of boxed_integer
-  | Pdivbint of boxed_integer
-  | Pmodbint of boxed_integer
-  | Pandbint of boxed_integer
-  | Porbint of boxed_integer
-  | Pxorbint of boxed_integer
-  | Plslbint of boxed_integer
-  | Plsrbint of boxed_integer
-  | Pasrbint of boxed_integer
-  | Pbintcomp of boxed_integer * comparison
-  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
-  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
-  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
-  (* size of the nth dimension of a big array *)
-  | Pbigarraydim of int
-  (* load/set 16,32,64 bits from a string: (unsafe)*)
-  | Pstring_load_16 of bool
-  | Pstring_load_32 of bool
-  | Pstring_load_64 of bool
-  | Pstring_set_16 of bool
-  | Pstring_set_32 of bool
-  | Pstring_set_64 of bool
-  (* load/set 16,32,64 bits from a
-     (char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
-  | Pbigstring_load_16 of bool
-  | Pbigstring_load_32 of bool
-  | Pbigstring_load_64 of bool
-  | Pbigstring_set_16 of bool
-  | Pbigstring_set_32 of bool
-  | Pbigstring_set_64 of bool
-  (* Compile time constants *)
-  | Pctconst of compile_time_constant
-  (* byte swap *)
-  | Pbswap16
-  | Pbbswap of boxed_integer
-  (* Integer to external pointer *)
-
-  | Pdebugger 
-  | Pjs_unsafe_downgrade of string * Location.t
-  | Pinit_mod
-  | Pupdate_mod
-  | Pjs_fn_make of int 
-  | Pjs_fn_run of int 
-  | Pjs_fn_method of int 
-  | Pjs_fn_runmethod of int
+  | Pdebugger 
+  | Pjs_unsafe_downgrade of string * Location.t
+  | Pinit_mod
+  | Pupdate_mod
+  | Pjs_fn_make of int 
+  | Pjs_fn_run of int 
+  | Pjs_fn_method of int 
+  | Pjs_fn_runmethod of int
 
 type apply_status =
   | App_na
@@ -63588,7 +62339,13 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc  : t =
       prim ~primitive:(Pglobal_exception id) ~args loc       
     else       
       prim ~primitive:(Pgetglobal id) ~args loc
-  | Psetglobal id -> prim ~primitive:(Psetglobal id) ~args loc
+  | Psetglobal id -> 
+    (* we discard [Psetglobal] in the beginning*)
+    begin match args with 
+    | [biglambda] -> biglambda
+    | _ -> assert false 
+    end
+    (* prim ~primitive:(Psetglobal id) ~args loc *)
   | Pmakeblock (tag,info, mutable_flag) 
     -> prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
   | Pfield (id,info) 
@@ -64079,8 +62836,8 @@ let to_file name (v : t) =
   close_out oc 
 
 end
-module Ext_pp : sig 
-#1 "ext_pp.mli"
+module Config_util : sig 
+#1 "config_util.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -64112,63 +62869,437 @@ module Ext_pp : sig
 
 
 
-(** A simple pretty printer
-    
-    Advantage compared with [Format], 
-    [P.newline] does not screw the layout, have better control when do a newline (sicne JS has ASI)
-    Easy to tweak
+(** A simple wrapper around [Config] module in compiler-libs, so that the search path
+    is the same
+*)
 
-    {ul 
-    {- be a little smarter}
-    {- buffer the last line, so that  we can do a smart newline, when it's really safe to do so}
-    }
+
+val find_opt : string -> string option
+(** [find filename] Input is a file name, output is absolute path *)
+
+
+val find_cmj : string -> Js_cmj_format.t
+
+end = struct
+#1 "config_util.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+
+
+
+let find_in_path_uncap path name =
+  let uname = String.uncapitalize name in
+  let rec try_dir = function
+    | [] -> None
+    | dir::rem ->      
+      let ufullname = Filename.concat dir uname in
+      if Sys.file_exists ufullname then Some ufullname
+      else 
+        let fullname = Filename.concat dir name   in
+        if Sys.file_exists fullname then Some fullname
+        else try_dir rem
+  in try_dir path
+
+
+
+(* ATTENTION: lazy to wait [Config.load_path] populated *)
+let find_opt file =  find_in_path_uncap !Config.load_path file 
+
+
+
+
+(* strategy:
+   If not installed, use the distributed [cmj] files, 
+   make sure that the distributed files are platform independent
 *)
-type t
+let find_cmj file = 
+  match find_opt file with
+  | Some f
+    -> 
+    Js_cmj_format.from_file f             
+  | None -> 
+    (* ONLY read the stored cmj data in browser environment *)
 
-val indent_length : int 
+        Bs_exception.error (Cmj_not_found file)
+        
 
-val string : t -> string -> unit
 
-val space :  t -> unit
 
-val nspace : t -> int ->  unit
+end
+module Hash_set_poly : sig 
+#1 "hash_set_poly.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-val group : t -> int -> (unit -> 'a) -> 'a
-(** [group] will record current indentation 
-    and indent futher
+
+type   'a t 
+
+val create : int -> 'a t
+
+val clear : 'a t -> unit
+
+val reset : 'a t -> unit
+
+val copy : 'a t -> 'a t
+
+val add : 'a t -> 'a  -> unit
+val remove : 'a t -> 'a -> unit
+
+val mem : 'a t -> 'a -> bool
+
+val iter : ('a -> unit) -> 'a t -> unit
+
+val elements : 'a t -> 'a list
+
+val length : 'a t -> int 
+
+val stats:  'a t -> Hashtbl.statistics
+
+end = struct
+#1 "hash_set_poly.ml"
+# 1 "ext/hash_set.cppo.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+# 50
+external seeded_hash_param :
+  int -> int -> int -> 'a -> int = "caml_hash" "noalloc"
+let key_index (h :  _ Hash_set_gen.t ) (key : 'a) =
+  seeded_hash_param 10 100 0 key land (Array.length h.data - 1)
+let eq_key = (=)
+type  'a t = 'a Hash_set_gen.t 
+
+
+# 59
+let create = Hash_set_gen.create
+let clear = Hash_set_gen.clear
+let reset = Hash_set_gen.reset
+let copy = Hash_set_gen.copy
+let iter = Hash_set_gen.iter
+let fold = Hash_set_gen.fold
+let length = Hash_set_gen.length
+let stats = Hash_set_gen.stats
+let elements = Hash_set_gen.elements
+
+
+
+let remove (h : _ Hash_set_gen.t) key =  
+  let i = key_index h key in
+  let h_data = h.data in
+  let old_h_size = h.size in 
+  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
+  if old_h_size <> h.size then  
+    Array.unsafe_set h_data i new_bucket
+
+
+
+let add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
+    end
+
+let check_add (h : _ Hash_set_gen.t) key =
+  let i = key_index h key  in 
+  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
+    begin 
+      h.data.(i) <- key :: h.data.(i);
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
+      true 
+    end
+  else false 
+
+
+let mem (h :  _ Hash_set_gen.t) key =
+  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
+
+  
+
+end
+module Js_call_info : sig 
+#1 "js_call_info.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+
+
+
+
+
+(** Type for collecting call site information, used in JS IR *) 
+
+type arity = 
+  | Full 
+  | NA 
+
+
+type call_info = 
+  | Call_ml (* called by plain ocaml expression *)
+  | Call_builtin_runtime (* built-in externals *)
+  | Call_na 
+  (* either from [@@bs.val] or not available, 
+     such calls does not follow such rules
+     {[ fun x y -> f x y === f ]} when [f] is an atom     
+  *) 
+
+
+type t = { 
+  call_info : call_info;
+  arity : arity;
+
+}
+
+val dummy : t
+val builtin_runtime_call : t
+
+val ml_full_call : t 
+
+end = struct
+#1 "js_call_info.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+
+
+
+
+
+type arity = 
+  | Full 
+  | NA 
+
+type call_info = 
+  | Call_ml (* called by plain ocaml expression *)
+  | Call_builtin_runtime (* built-in externals *)
+  | Call_na 
+  (* either from [@@bs.val] or not available, 
+     such calls does not follow such rules
+     {[ fun x y -> (f x y) === f ]} when [f] is an atom     
+
+  *) 
+
+type t = { 
+  call_info : call_info;
+  arity : arity
+}
+
+let dummy = { arity = NA; call_info = Call_na }
+
+let builtin_runtime_call = {arity = Full; call_info = Call_builtin_runtime}
+
+let ml_full_call = {arity = Full; call_info = Call_ml}
+
+end
+module Js_closure : sig 
+#1 "js_closure.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+
+
+
+
+
+(** Define a type used in JS IR to help convert lexical scope to JS [var] 
+    based scope convention
  *)
 
-val vgroup : t -> int -> (unit -> 'a) -> 'a
+type t = {
+  mutable outer_loop_mutable_values :  Ident_set.t 
+}
 
-val paren : t -> (unit -> 'a) -> 'a
+val empty : unit -> t
 
-val brace : t -> (unit -> 'a) -> 'a
+val get_lexical_scope : t -> Ident_set.t
 
-val paren_group : t -> int -> (unit -> 'a) -> 'a
+val set_lexical_scope : t -> Ident_set.t -> unit
 
-val paren_vgroup : t -> int -> (unit -> 'a) -> 'a
+end = struct
+#1 "js_closure.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-val brace_group : t -> int -> (unit -> 'a) -> 'a
 
-val brace_vgroup : t -> int -> (unit -> 'a) -> 'a
 
-val bracket_group : t -> int -> (unit -> 'a) -> 'a
 
-val bracket_vgroup : t -> int -> (unit -> 'a) -> 'a
 
-val newline : t -> unit
 
-val force_newline : t -> unit
-(** [force_newline] Always print a newline *)
 
-val from_channel : out_channel -> t
 
-val from_buffer : Buffer.t -> t
+type t = {
+  mutable outer_loop_mutable_values :  Ident_set.t ;
+}
 
-val flush : t -> unit -> unit
+let empty () = {
+  outer_loop_mutable_values  = Ident_set.empty
+}
+
+let set_lexical_scope t v = t.outer_loop_mutable_values <- v 
+
+let get_lexical_scope t = t.outer_loop_mutable_values 
 
-end = struct
-#1 "ext_pp.ml"
+end
+module Js_fun_env : sig 
+#1 "js_fun_env.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -64200,145 +63331,39 @@ end = struct
 
 
 
-module L = struct 
-  let space = " "
-  let indent_str = "  "
-end
-
-let indent_length = String.length L.indent_str 
-
-type t = {
-  output_string : string -> unit;
-  output_char : char -> unit; 
-  flush : unit -> unit;
-  mutable indent_level : int;
-  mutable last_new_line : bool; 
-  (* only when we print newline, we print the indent *)
-}
-
-let from_channel chan = { 
-  output_string = (fun  s -> output_string chan s); 
-  output_char = (fun c -> output_char chan c);
-  flush = (fun _ -> flush chan);
-  indent_level = 0 ;
-  last_new_line = false;
-}
-
-
-let from_buffer buf = {
-  output_string = (fun s -> Buffer.add_string buf s);
-  output_char = (fun  c -> Buffer.add_char buf c);
-  flush = (fun _ -> ());
-  indent_level = 0;
-  last_new_line = false;
-}
-
-(* If we have [newline] in [s], 
-   all indentations will be broken 
-   in the future, we can detect this in [s]
- *)
-let string t s = 
-  t.output_string  s ;
-  t.last_new_line <- false
-
-let newline t = 
-  if not t.last_new_line then 
-    begin
-      t.output_char  '\n';
-      for i = 0 to t.indent_level - 1 do 
-        t.output_string  L.indent_str;
-      done;
-      t.last_new_line <- true
-    end
+(** Define type t used in JS IR to collect some meta data for a function, like its closures, etc 
+  *)
 
-let force_newline t = 
-  t.output_char  '\n';
-  for i = 0 to t.indent_level - 1 do 
-    t.output_string  L.indent_str;
-  done
+type t 
 
-let space t  = 
-  string t L.space
+val empty :  ?immutable_mask:bool array  -> int -> t
 
-let nspace  t n  = 
-  string  t (String.make n ' ')
+val is_tailcalled : t -> bool
 
-let group t i action = 
-  if i = 0 then action ()
-  else 
-    let old = t.indent_level in
-    t.indent_level <- t.indent_level + i;
-    Ext_pervasives.finally () (fun _ -> t.indent_level <- old) action 
+val is_empty : t -> bool 
 
-let vgroup = group
+val set_unbounded :  t -> Ident_set.t -> unit
 
-let paren t action = 
-  string t "(";
-  let v = action () in
-  string t ")";
-  v 
 
-let brace fmt u = 
-  string fmt "{";
-  (* break1 fmt ; *)
-  let v = u () in
-  string fmt "}";
-  v 
 
-let bracket fmt u = 
-  string fmt "[";
-  let v = u () in
-  string fmt "]";
-  v 
+val set_lexical_scope : t -> Ident_set.t -> unit
 
-let brace_vgroup st n action = 
-  string st "{";
-  let v = vgroup st n (fun _ -> 
-    newline st; 
-    let v =  action () in
-    v
-              ) in
-  force_newline st;
-  string st "}";
-  v
+val get_lexical_scope : t -> Ident_set.t
 
-let bracket_vgroup st n action = 
-  string st "[";
-  let v = vgroup st n (fun _ -> 
-    newline st; 
-    let v =  action () in
-    v
-              ) in
-  force_newline st;
-  string st "]";
-  v
+val to_string : t -> string
 
-let bracket_group st n action = 
-  group st n (fun _ -> bracket st action)
+val mark_unused : t -> int -> unit 
 
-let paren_vgroup st n action = 
-  string st "(";
-  let v = group st n (fun _ -> 
-    newline st; 
-    let v = action () in
-    v
-                     ) in
-  newline st;
-  string st ")";
-  v 
-let paren_group st n action = group st n (fun _ -> paren st action)
+val get_unused : t -> int -> bool
 
-let brace_group st n action = 
-  group st n (fun _ -> brace st action )
+val get_mutable_params : Ident.t list -> t -> Ident.t list
 
-let indent t n = 
-  t.indent_level <- t.indent_level + n 
+val get_unbounded : t -> Ident_set.t
 
-let flush t () = t.flush ()
+val get_length : t -> int
 
-end
-module Ext_int : sig 
-#1 "ext_int.mli"
+end = struct
+#1 "js_fun_env.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -64364,46 +63389,97 @@ module Ext_int : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-type t = int
-val compare : t -> t -> int 
-val equal : t -> t -> bool 
 
-end = struct
-#1 "ext_int.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
 
-type t = int
 
-let compare (x : t) (y : t) = Pervasives.compare x y 
 
-let equal (x : t) (y : t) = x = y
+
+(* Make it mutable so that we can do
+   in-place change without constructing a new one
+  -- however, it's a design choice -- to be reviewed later
+*)
+
+type immutable_mask = 
+  | All_immutable_and_no_tail_call 
+     (** iff not tailcalled 
+         if tailcalled, in theory, it does not need change params, 
+         for example
+         {[
+         let rec f  (n : int ref) = 
+            if !n > 0 then decr n; print_endline "hi"
+            else  f n
+         ]}
+         in this case, we still create [Immutable_mask], 
+         since the inline behavior is slightly different
+      *)
+  | Immutable_mask of bool array
+
+type t = { 
+  mutable unbounded : Ident_set.t;
+  mutable bound_loop_mutable_values : Ident_set.t; 
+  used_mask : bool array;
+  immutable_mask : immutable_mask; 
+}
+(** Invariant: unused param has to be immutable *)
+
+let empty ?immutable_mask n = { 
+  unbounded =  Ident_set.empty ;
+  used_mask = Array.make n false;
+  immutable_mask = 
+    (match immutable_mask with 
+     | Some x -> Immutable_mask x 
+     | None -> All_immutable_and_no_tail_call
+    );
+  bound_loop_mutable_values =Ident_set.empty;
+}
+
+let is_tailcalled x = x.immutable_mask <> All_immutable_and_no_tail_call
+
+let mark_unused  t i = 
+  t.used_mask.(i) <- true
+
+let get_unused t i = 
+  t.used_mask.(i)
+
+let get_length t = Array.length t.used_mask
+
+let to_string env =  
+  String.concat "," 
+    (List.map (fun (id : Ident.t) -> Printf.sprintf "%s/%d" id.name id.stamp)
+       (Ident_set.elements  env.unbounded ))
+
+let get_mutable_params (params : Ident.t list) (x : t ) = 
+  match x.immutable_mask with 
+  | All_immutable_and_no_tail_call -> []
+  | Immutable_mask xs -> 
+      Ext_list.filter_mapi 
+        (fun i p -> if not xs.(i) then Some p else None)  params
+
+
+let get_unbounded t = t.unbounded
+
+let set_unbounded env v = 
+  (* Ext_log.err "%s -- set @." (to_string env); *)
+  (* if Ident_set.is_empty env.bound then *)
+  env.unbounded <- v 
+ (* else assert false *)
+
+let set_lexical_scope env bound_loop_mutable_values = 
+  env.bound_loop_mutable_values <- bound_loop_mutable_values
+
+let get_lexical_scope env =  
+  env.bound_loop_mutable_values
+
+(* TODO:  can be refined if it 
+    only enclose toplevel variables 
+ *)
+let is_empty t = Ident_set.is_empty t.unbounded
 
 end
-module Int_map : sig 
-#1 "int_map.mli"
+module Js_op
+= struct
+#1 "js_op.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -64435,174 +63511,237 @@ module Int_map : sig
 
 
 
-include Map_gen.S with type key = int
 
-end = struct
-#1 "int_map.ml"
 
-# 2 "ext/map.cppo.ml"
-(* we don't create [map_poly], since some operations require raise an exception which carries [key] *)
+(** Define some basic types used in JS IR *)
 
+type binop =
+  | Eq  
+  (* acutally assignment ..
+     TODO: move it into statement, so that all expressions 
+     are side efffect free (except function calls)
+   *)
 
-  
-# 13
-  type key = int
-  let compare_key = Ext_int.compare
+  | Or
+  | And
+  | EqEqEq
+  | NotEqEq
+  | InstanceOf
 
-# 22
-type 'a t = (key,'a) Map_gen.t
-exception Duplicate_key of key 
+  | Lt
+  | Le
+  | Gt
+  | Ge
 
-let empty = Map_gen.empty 
-let is_empty = Map_gen.is_empty
-let iter = Map_gen.iter
-let fold = Map_gen.fold
-let for_all = Map_gen.for_all 
-let exists = Map_gen.exists 
-let singleton = Map_gen.singleton 
-let cardinal = Map_gen.cardinal
-let bindings = Map_gen.bindings
-let keys = Map_gen.keys
-let choose = Map_gen.choose 
-let partition = Map_gen.partition 
-let filter = Map_gen.filter 
-let map = Map_gen.map 
-let mapi = Map_gen.mapi
-let bal = Map_gen.bal 
-let height = Map_gen.height 
-let max_binding_exn = Map_gen.max_binding_exn
-let min_binding_exn = Map_gen.min_binding_exn
+  | Bor
+  | Bxor
+  | Band
+  | Lsl
+  | Lsr
+  | Asr
 
+  | Plus
+  | Minus
+  | Mul
+  | Div
+  | Mod
 
-let rec add x data (tree : _ Map_gen.t as 'a) : 'a = match tree with 
-  | Empty ->
-    Node(Empty, x, data, Empty, 1)
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Node(l, x, data, r, h)
-    else if c < 0 then
-      bal (add x data l) v d r
-    else
-      bal l v d (add x data r)
+(**
+note that we don't need raise [Div_by_zero] in BuckleScript
 
+{[
+let add x y = x + y  (* | 0 *)
+let minus x y = x - y (* | 0 *)
+let mul x y = x * y   (* caml_mul | Math.imul *)
+let div x y = x / y (* caml_div (x/y|0)*)
+let imod x y = x mod y  (* caml_mod (x%y) (zero_divide)*)
 
-let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a = 
-  match tree with 
-  | Empty ->
-    Node(Empty, x, data (), Empty, 1)
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Node(l, x, replace  d , r, h)
-    else if c < 0 then
-      bal (adjust x data replace l) v d r
-    else
-      bal l v d (adjust x data replace r)
+let bor x y = x lor y   (* x  | y *)
+let bxor x y = x lxor y (* x ^ y *)
+let band x y = x land y (* x & y *)
+let ilnot  y  = lnot y (* let lnot x = x lxor (-1) *)
+let ilsl x y = x lsl y (* x << y*)
+let ilsr x y = x lsr y  (* x >>> y | 0 *)
+let iasr  x y = x asr y (* x >> y *)
+]}
 
 
-let rec find_exn x (tree : _ Map_gen.t )  = match tree with 
-  | Empty ->
-    raise Not_found
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then d
-    else find_exn x (if c < 0 then l else r)
+Note that js treat unsigned shift 0 bits in a special way
+   Unsigned shifts convert their left-hand side to Uint32, 
+   signed shifts convert it to Int32.
+   Shifting by 0 digits returns the converted value.
+   {[
+    function ToUint32(x) {
+        return x >>> 0;
+    }
+    function ToInt32(x) {
+        return x >> 0;
+    }
+   ]}
+   So in Js, [-1 >>>0] will be the largest Uint32, while [-1>>0] will remain [-1]
+   and [-1 >>> 0 >> 0 ] will be [-1]
+*)
+type int_op = 
+    
+  | Bor
+  | Bxor
+  | Band
+  | Lsl
+  | Lsr
+  | Asr
 
-let rec find_opt x (tree : _ Map_gen.t )  = match tree with 
-  | Empty -> None 
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then Some d
-    else find_opt x (if c < 0 then l else r)
+  | Plus
+      (* for [+], given two numbers 
+         x + y | 0
+       *)
+  | Minus
+      (* x - y | 0 *)
+  | Mul
+      (* *)
+  | Div
+      (* x / y | 0 *)
+  | Mod
+      (* x  % y *)
 
-let rec find_default x (tree : _ Map_gen.t ) default     = match tree with 
-  | Empty -> default  
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then  d
-    else find_default x   (if c < 0 then l else r) default
+(* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Expressions_and_Operators#Bitwise_operators
+    {[
+    ~
+    ]}
+    ~0xff -> -256
+    design; make sure each operation type is consistent
+ *)
+type level = 
+  | Log 
+  | Info
+  | Warn
+  | Error
 
-let rec mem x (tree : _ Map_gen.t )   = match tree with 
-  | Empty ->
-    false
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    c = 0 || mem x (if c < 0 then l else r)
+type kind = 
+  | Ml
+  | Runtime 
+  | External of string
 
-let rec remove x (tree : _ Map_gen.t as 'a) : 'a = match tree with 
-  | Empty ->
-    Empty
-  | Node(l, v, d, r, h) ->
-    let c = compare_key x v in
-    if c = 0 then
-      Map_gen.merge l r
-    else if c < 0 then
-      bal (remove x l) v d r
-    else
-      bal l v d (remove x r)
+type property = Lambda.let_kind = 
+  | Strict
+  | Alias
+  | StrictOpt 
+  | Variable
 
 
-let rec split x (tree : _ Map_gen.t as 'a) : 'a * _ option * 'a  = match tree with 
-  | Empty ->
-    (Empty, None, Empty)
-  | Node(l, v, d, r, _) ->
-    let c = compare_key x v in
-    if c = 0 then (l, Some d, r)
-    else if c < 0 then
-      let (ll, pres, rl) = split x l in (ll, pres, Map_gen.join rl v d r)
-    else
-      let (lr, pres, rr) = split x r in (Map_gen.join l v d lr, pres, rr)
+type property_name = (* private *)
+  (* TODO: FIXME [caml_uninitialized_obj] seems to be a bug*)
+  | Key of string
+  | Int_key of int 
+  | Tag 
+  | Length
+
+type 'a access = 
+  | Getter
+  | Setter
+type jsint = Int32.t
+
+type int_or_char = 
+    { i : jsint; 
+      (* we can not use [int] on 32 bit platform, if we dont use 
+          [Int32.t], we need a configuration step          
+      *)
+      c : char option
+    }
+
+ (* literal char *)
+type float_lit = { f :  string }
+type number = 
+  | Float of float_lit 
+  | Int of int_or_char
+  | Uint of int32
+  | Nint of nativeint
+  (* becareful when constant folding +/-, 
+     since we treat it as js nativeint, bitwise operators:
+     https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators
+     The operands of all bitwise operators are converted to signed 32-bit integers in two's complement format.'
+  *)      
+
+type mutable_flag = 
+  | Mutable
+  | Immutable
+  | NA
+
+(* 
+    {[
+    let rec x = 1 :: y 
+    and y = 1 :: x
+    ]}
+ *)
+type recursive_info = 
+  | SingleRecursive 
+  | NonRecursie
+  | NA
+
+type used_stats = 
+  | Dead_pure 
+        (* only [Dead] should be taken serious, 
+            other status can be converted during
+            inlining
+            -- all exported symbols can not be dead
+            -- once a symbole is called Dead_pure, 
+            it can not be alive anymore, we should avoid iterating it
+            
+          *)
+  | Dead_non_pure 
+      (* we still need iterating it, 
+         just its bindings does not make sense any more *)
+  | Exported (* Once it's exported, shall we change its status anymore? *)
+      (* In general, we should count in one pass, and eliminate code in another 
+         pass, you can not do it in a single pass, however, some simple 
+         dead code can be detected in a single pass
+       *)
+  | Once_pure (* used only once so that, if we do the inlining, it will be [Dead] *)
+  | Used (**)
+  | Scanning_pure
+  | Scanning_non_pure
+  | NA
 
-let rec merge f (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
-  match (s1, s2) with
-  | (Empty, Empty) -> Empty
-  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
-    let (l2, d2, r2) = split v1 s2 in
-    Map_gen.concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
-  | (_, Node (l2, v2, d2, r2, h2)) ->
-    let (l1, d1, r1) = split v2 s1 in
-    Map_gen.concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
-  | _ ->
-    assert false
 
-let rec disjoint_merge  (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
-  match (s1, s2) with
-  | (Empty, Empty) -> Empty
-  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
-    begin match split v1 s2 with 
-    | l2, None, r2 -> 
-      Map_gen.join (disjoint_merge  l1 l2) v1 d1 (disjoint_merge r1 r2)
-    | _, Some _, _ ->
-      raise (Duplicate_key  v1)
-    end        
-  | (_, Node (l2, v2, d2, r2, h2)) ->
-    begin match  split v2 s1 with 
-    | (l1, None, r1) -> 
-      Map_gen.join (disjoint_merge  l1 l2) v2 d2 (disjoint_merge  r1 r2)
-    | (_, Some _, _) -> 
-      raise (Duplicate_key v2)
-    end
-  | _ ->
-    assert false
+type ident_info = {
+    (* mutable recursive_info : recursive_info; *)
+    mutable used_stats : used_stats;
+  }
 
+type exports = Ident.t list 
 
+type module_id = { id : Ident.t; kind  : kind}
 
-let compare cmp m1 m2 = Map_gen.compare compare_key cmp m1 m2
+type required_modules = module_id list
 
-let equal cmp m1 m2 = Map_gen.equal compare_key cmp m1 m2 
 
-let add_list (xs : _ list ) init = 
-  List.fold_left (fun acc (k,v) -> add k v acc) init xs 
+type tag_info = Lambda.tag_info = 
+  | Blk_constructor of string * int
+  | Blk_tuple
+  | Blk_array
+  | Blk_variant of string 
+  | Blk_record of string array
+  | Blk_module of string list option
+  | Blk_na
 
-let of_list xs = add_list xs empty
+type length_object = 
+  | Array 
+  | String
+  | Bytes
+  | Function
+  | Caml_block
 
-let of_array xs = 
-  Array.fold_left (fun acc (k,v) -> add k v acc) empty xs
+type code_info = 
+  | Exp (* of int option *)
+  | Stmt
+(** TODO: define constant - for better constant folding  *)
+(* type constant =  *)
+(*   | Const_int of int *)
+(*   | Const_ *)
 
 end
-module Ext_pp_scope : sig 
-#1 "ext_pp_scope.mli"
+module J
+= struct
+#1 "j.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -64634,113 +63773,374 @@ module Ext_pp_scope : sig
 
 
 
-(** Scope type to improve identifier name printing
- *) 
+(** Javascript IR
+  
+    It's a subset of Javascript AST specialized for OCaml lambda backend
 
-(** Defines scope type [t], so that the pretty printer would print more beautiful code: 
-    
-    print [identifer] instead of [identifier$1234] when it can
- *)
+    Note it's not exactly the same as Javascript, the AST itself follows lexical
+    convention and [Block] is just a sequence of statements, which means it does 
+    not introduce new scope
+*)
 
-type t 
+type label = string
 
-val empty : t 
+and binop = Js_op.binop
 
-val add_ident : Ident.t -> t -> int * t
+and int_op = Js_op.int_op
+ 
+and kind = Js_op.kind
 
-val sub_scope : t -> Ident_set.t -> t
+and property = Js_op.property
 
-val merge : Ident_set.t -> t -> t
+and number = Js_op.number 
 
-val print : Format.formatter -> t -> unit
+and mutable_flag = Js_op.mutable_flag 
 
-end = struct
-#1 "ext_pp_scope.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+and ident_info = Js_op.ident_info
 
+and exports = Js_op.exports
 
+and tag_info = Js_op.tag_info 
+ 
+and required_modules = Js_op.required_modules
 
+and code_info = Js_op.code_info 
+(** object literal, if key is ident, in this case, it might be renamed by 
+    Google Closure  optimizer,
+    currently we always use quote
+ *)
+and property_name =  Js_op.property_name
+and jsint = Js_op.jsint
+and ident = Ident.t 
 
+and vident = 
+  | Id of ident
+  | Qualified of ident * kind * string option
+    (* Since camldot is only available for toplevel module accessors,
+       we don't need print  `A.length$2`
+       just print `A.length` - it's guarateed to be unique
+       
+       when the third one is None, it means the whole module 
 
+       TODO: 
+       invariant, when [kind] is [Runtime], then we can ignore [ident], 
+       since all [runtime] functions are unique, when do the 
+       pattern match we can ignore the first one for simplicity
+       for example       
+       {[
+         Qualified (_, Runtime, Some "caml_int_compare")         
+       ]}       
+     *)
 
+and exception_ident = ident 
 
+and for_ident = ident 
 
-type t =  
-    int  Int_map.t String_map.t
+and for_direction = Asttypes.direction_flag
 
-let empty = 
-  String_map.empty 
+and property_map = 
+    (property_name * expression) list
+and length_object = Js_op.length_object
+and expression_desc =
+  | Math of string * expression list
+  | Length of expression * length_object
+  | Char_of_int of expression
+  | Char_to_int of expression 
+  | Array_of_size of expression 
+    (* used in [js_create_array] primitive, note having
+       uninitilized array is not as bad as in ocaml, 
+       since GC does not rely on it
+     *)
+  | Array_copy of expression (* shallow copy, like [x.slice] *)
+  | Array_append of expression * expression (* For [caml_array_append]*)
+  (* | Tag_ml_obj of expression *)
+  | String_append of expression * expression 
 
-let rec print fmt v = 
-  Format.fprintf fmt "@[<v>{"  ;
-  String_map.iter (fun k m -> 
-      Format.fprintf fmt "%s: @[%a@],@ " k print_int_map m       
-    )  v;
-  Format.fprintf fmt "}@]"  
-and print_int_map fmt m = 
-  Int_map.iter (fun k v -> 
-      Format.fprintf fmt "%d - %d" k v       
-    ) m    
+  | Int_of_boolean of expression 
+  | Anything_to_number of expression
+  | Bool of bool (* js true/false*)
+  (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence 
+     [typeof] is an operator     
+  *)
+  | Typeof of expression
+  | Caml_not of expression (* 1 - v *)
+  | Js_not of expression (* !v *)
+  | String_of_small_int_array of expression 
+    (* String.fromCharCode.apply(null, args) *)
+    (* Convert JS boolean into OCaml boolean 
+       like [+true], note this ast talks using js
+       terminnology unless explicity stated                       
+     *)
+  | Json_stringify of expression 
+  (* TODO: in the future, it might make sense to group primitivie by type,
+     which makes optimizations easier
+     {[ JSON.stringify(value, replacer[, space]) ]}
+  *)
+  | Anything_to_string of expression
+  (* for debugging utitlites, 
+     TODO:  [Dump] is not necessary with this primitive 
+     Note that the semantics is slightly different from [JSON.stringify]     
+     {[
+       JSON.stringify("x")       
+     ]}
+     {[
+       ""x""       
+     ]}     
+     {[
+       JSON.stringify(undefined)       
+     ]}     
+     {[
+       undefined       
+     ]}
+     {[ '' + undefined
+     ]}     
+     {[ 'undefined'
+     ]}     
+  *)      
+  | Dump of Js_op.level * expression list
+  (* TODO: 
+     add 
+     {[ Assert of bool * expression ]}     
+  *)              
+    (* to support 
+       val log1 : 'a -> unit
+       val log2 : 'a -> 'b -> unit 
+       val log3 : 'a -> 'b -> 'c -> unit 
+     *)
 
-let add_ident (id : Ident.t) (cxt : t) : int * t = 
-  match String_map.find_exn id.name cxt with 
-  | exception Not_found -> (0, String_map.add id.name Int_map.(add id.stamp 0  empty) cxt )
-  | imap -> (
-    match Int_map.find_exn id.stamp imap with
-    | exception Not_found ->
-      let v = Int_map.cardinal imap in
-      v, String_map.add id.name (Int_map.add id.stamp v imap) cxt
-    | i -> i, cxt
-  )
+  (* TODO: Add some primitives so that [js inliner] can do a better job *)  
+  | Seq of expression * expression
+  | Cond of expression * expression * expression
+  | Bin of binop * expression * expression
 
-let of_list lst cxt = 
-  List.fold_left (fun scope i -> snd (add_ident i scope)) cxt lst 
+  (* [int_op] will guarantee return [int32] bits 
+     https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators  *)
+  (* | Int32_bin of int_op * expression * expression *)
+  | FlatCall of expression * expression 
+    (* f.apply(null,args) -- Fully applied guaranteed 
+       TODO: once we know args's shape --
+       if it's know at compile time, we can turn it into
+       f(args[0], args[1], ... )
+     *)
+  | Bind of expression * expression
+  (* {[ Bind (a,b) ]}
+     is literally
+     {[ a.bind(b) ]}
+  *)
+  | Call of expression * expression list * Js_call_info.t
+    (* Analysze over J expression is hard since, 
+        some primitive  call is translated 
+        into a plain call, it's better to keep them
+    *) 
+  | String_access of expression * expression 
+  | Access of expression * expression 
+    (* Invariant: 
+       The second argument has to be type of [int],
+       This can be constructed either in a static way [E.index] or a dynamic way 
+       [E.access]
+     *)
+  | Dot of expression * string * bool
+    (* The third argument bool indicates whether we should 
+       print it as 
+       a["idd"] -- false
+       or 
+       a.idd  -- true
+       There are several kinds of properties
+       1. OCaml module dot (need to be escaped or not)
+          All exported declarations have to be OCaml identifiers
+       2. Javascript dot (need to be preserved/or using quote)
+     *)
+  | New of expression * expression list option (* TODO: option remove *)
+  | Var of vident
+  | Fun of bool * ident list  * block * Js_fun_env.t
+  (* The first parameter by default is false, 
+     it will be true when it's a method
+  *)
+  | Str of bool * string 
+    (* A string is UTF-8 encoded, the string may contain
+       escape sequences.
+       The first argument is used to mark it is non-pure, please
+       don't optimize it, since it does have side effec, 
+       examples like "use asm;" and our compiler may generate "error;..." 
+       which is better to leave it alone
+     *)
+  | Raw_js_code of string * code_info
+  (* literally raw JS code 
+  *)
+  | Array of expression list * mutable_flag
+  | Caml_block of expression list * mutable_flag * expression * tag_info 
+  (* The third argument is [tag] , forth is [tag_info] *)
+  | Caml_uninitialized_obj of expression * expression
+  (* [tag] and [size] tailed  for [Obj.new_block] *)
 
-let merge set cxt  = 
-  Ident_set.fold (fun ident acc -> snd (add_ident ident acc)) set  cxt 
+  (* For setter, it still return the value of expression, 
+     we can not use 
+     {[
+       type 'a access = Get | Set of 'a
+     ]}
+     in another module, since it will break our code generator
+     [Caml_block_tag] can return [undefined], 
+     you have to use [E.tag] in a safe way     
+  *)
+  | Caml_block_tag of expression
+  | Caml_block_set_tag of expression * expression
+  | Caml_block_set_length of expression * expression
+  (* It will just fetch tag, to make it safe, when creating it, 
+     we need apply "|0", we don't do it in the 
+     last step since "|0" can potentially be optimized
+  *)      
+  | Number of number
+  | Object of property_map
 
-(* Assume that all idents are already in the scope
-   so both [param/0] and [param/1] are in idents, we don't need 
-   update twice,  once is enough
+and for_ident_expression = expression (* pure*)
+
+and finish_ident_expression = expression (* pure *)
+(* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/block
+   block can be nested, specified in ES3 
  *)
-let sub_scope (scope : t) ident_collection : t =
-  let cxt = empty in
-  Ident_set.fold (fun (i : Ident.t) acc -> 
-    match String_map.find_exn i.name scope with 
-    | exception Not_found -> assert false 
-    | imap -> ( 
-      (* They are the same if already there*)
-      match String_map.find_exn i.name acc with 
-      | exception Not_found -> String_map.add i.name imap acc
-      | _ -> acc  (* TODO: optimization *) 
-    )
-  ) ident_collection cxt 
 
+(* Delay some units like [primitive] into JS layer ,
+   benefit: better cross module inlining, and smaller IR size?
+ *)
+
+(* 
+  [closure] captured loop mutable values in the outer loop
+
+  check if it contains loop mutable values, happens in nested loop
+  when closured, it's no longer loop mutable value. 
+  which means the outer loop mutable value can not peek into the inner loop
+  {[
+  var i = f ();
+  for(var finish = 32; i < finish; ++i){
+  }
+  ]}
+  when [for_ident_expression] is [None], [var i] has to 
+  be initialized outside, so 
+
+  {[
+  var i = f ()
+  (function (xxx){
+  for(var finish = 32; i < finish; ++i)
+  }(..i))
+  ]}
+  This happens rare it's okay
+
+  this is because [i] has to be initialized outside, if [j] 
+  contains a block side effect
+  TODO: create such example
+*)
+
+(* Since in OCaml, 
+   
+  [for i = 0 to k end do done ]
+  k is only evaluated once , to encode this invariant in JS IR,
+  make sure [ident] is defined in the first b
+
+  TODO: currently we guarantee that [bound] was only 
+  excecuted once, should encode this in AST level
+*)
+
+(* Can be simplified to keep the semantics of OCaml
+   For (var i, e, ...){
+     let  j = ... 
+   }
+
+   if [i] or [j] is captured inside closure
+
+   for (var i , e, ...){
+     (function (){
+     })(i)
+   }
+*)
+
+(* Single return is good for ininling..
+   However, when you do tail-call optmization
+   you loose the expression oriented semantics
+   Block is useful for implementing goto
+   {[
+   xx:{
+   break xx;
+   }
+   ]}
+*)
+
+
+and statement_desc =
+  | Block of block
+  | Variable of variable_declaration
+        (* Function declaration and Variable declaration  *)
+  | Exp of expression
+  | If of expression * block * block option
+  | While of label option *  expression * block 
+        * Js_closure.t (* check if it contains loop mutable values, happens in nested loop *)
+  | ForRange of for_ident_expression option * finish_ident_expression * 
+        for_ident  *  for_direction * block
+        * Js_closure.t  
+  | Continue of label 
+  | Break (* only used when inline a fucntion *)
+  | Return of return_expression   (* Here we need track back a bit ?, move Return to Function ...
+                              Then we can only have one Return, which is not good *)
+  | Int_switch of expression * int case_clause list * block option 
+  | String_switch of expression * string case_clause list * block option 
+  | Throw of expression
+  | Try of block * (exception_ident * block) option * block option
+  | Debugger
+and return_expression = {
+ (* since in ocaml, it's expression oriented langauge, [return] in
+    general has no jumps, it only happens when we do 
+    tailcall conversion, in that case there is a jump.
+    However, currently  a single [break] is good to cover
+    our compilation strategy 
+
+    Attention: we should not insert [break] arbitrarily, otherwise 
+    it would break the semantics
+    A more robust signature would be 
+    {[ goto : label option ; ]}
+  *)
+  return_value : expression
+}   
+
+and expression = {
+  expression_desc : expression_desc; 
+  comment : string option;
+} 
+
+and statement = { 
+  statement_desc :  statement_desc; 
+  comment : string option;
+}
+
+and variable_declaration = { 
+  ident : ident ;
+  value : expression  option;
+  property : property;
+  ident_info : ident_info;
+}
+
+and 'a case_clause = { 
+  case : 'a ; 
+  body : block * bool ;  (* true means break *)
+}
+
+(* TODO: For efficency: block should not be a list, it should be able to 
+   be concatenated in both ways 
+ *)
+and block =  statement list
 
+and program = {
+  name :  string;
 
+  block : block ;
+  exports : exports ;
+  export_set : Ident_set.t ;
 
+}
+and deps_program = 
+  {
+    program : program ; 
+    modules : required_modules ;
+    side_effect : string option (* None: no, Some reason  *)
+  }
 
 end
 module Js_fold
@@ -67460,266 +66860,6 @@ let not_implemented ?comment (s : string) =
              Js_fun_env.empty 0)
     } []
 
-end
-module Js_number : sig 
-#1 "js_number.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-
-
-type t  = float 
-
-
-val to_string : t -> string
-
-
-val caml_float_literal_to_js_string : string -> string
-
-end = struct
-#1 "js_number.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-
-type t = float 
-
-
-(* http://www.ecma-international.org/ecma-262/5.1/#sec-7.8.3 
-   http://caml.inria.fr/pub/docs/manual-ocaml/lex.html
-   {[
-     float-literal ::= [-](0...9){0...9|_}[.{0...9|_}][(e|E)][(e|E)[+|-](0...9){0...9|_}]     
-   ]}   
-   In ocaml, the interpretation of floating-point literals that
-   fall outside the range of representable floating-point values is undefined.
-   Also, (_) are accepted   
-
-   see https://github.com/ocaml/ocaml/pull/268 that ocaml will have HEXADECIMAL notation 
-   support in 4.3
-
-   The Hex part is quite different   
- *)
-
-
-
-let to_string v =
-  if v = infinity
-  then "Infinity"
-  else if v = neg_infinity
-  then "-Infinity"
-  else if v <> v
-  then "NaN"
-  else
-    let vint = (int_of_float v)
-    (* TODO: check if 32-bits will loose some precision *)               
-    in
-    if float_of_int  vint = v
-    then
-      string_of_int vint
-    else
-      let s1 = Printf.sprintf "%.12g" v in
-      if v = float_of_string s1
-      then s1
-      else
-        let s2 = Printf.sprintf "%.15g" v in
-        if v = float_of_string s2
-        then s2
-        else  Printf.sprintf "%.18g" v
-
-
-
-let caml_float_literal_to_js_string v = 
-  let len = String.length v in
-  if len >= 2 && 
-    v.[0] = '0' &&
-    (v.[1] = 'x' || v.[1] = 'X') then  
-    assert false 
-   (* TODO: catchup when upgraded to 4.3 
-      it does not make sense too much since js dos not 
-      support it natively
-    *)    
-  else    
-
-    let rec aux buf i = 
-      if i >= len then buf
-      else 
-        let x = v.[i] in
-        if x = '_' then
-          aux buf (i + 1)
-        else if   x  = '.' && i = len - 1  then
-          buf
-        else 
-          begin
-            Buffer.add_char buf x ;
-            aux buf ( i + 1) 
-          end in
-    Buffer.contents (aux  (Buffer.create len) 0)
-
-
-end
-module Config_util : sig 
-#1 "config_util.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-
-
-
-(** A simple wrapper around [Config] module in compiler-libs, so that the search path
-    is the same
-*)
-
-
-val find_opt : string -> string option
-(** [find filename] Input is a file name, output is absolute path *)
-
-
-val find_cmj : string -> Js_cmj_format.t
-
-end = struct
-#1 "config_util.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-
-let find_in_path_uncap path name =
-  let uname = String.uncapitalize name in
-  let rec try_dir = function
-    | [] -> None
-    | dir::rem ->      
-      let ufullname = Filename.concat dir uname in
-      if Sys.file_exists ufullname then Some ufullname
-      else 
-        let fullname = Filename.concat dir name   in
-        if Sys.file_exists fullname then Some fullname
-        else try_dir rem
-  in try_dir path
-
-
-
-(* ATTENTION: lazy to wait [Config.load_path] populated *)
-let find_opt file =  find_in_path_uncap !Config.load_path file 
-
-
-
-
-(* strategy:
-   If not installed, use the distributed [cmj] files, 
-   make sure that the distributed files are platform independent
-*)
-let find_cmj file = 
-  match find_opt file with
-  | Some f
-    -> 
-    Js_cmj_format.from_file f             
-  | None -> 
-    (* ONLY read the stored cmj data in browser environment *)
-
-        Bs_exception.error (Cmj_not_found file)
-        
-
-
-
 end
 module Ident_hashtbl : sig 
 #1 "ident_hashtbl.mli"
@@ -67852,6 +66992,197 @@ let of_list2 ks vs =
   map
 
 
+end
+module Ident_map : sig 
+#1 "ident_map.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+include Map_gen.S with type key = Ident.t
+end = struct
+#1 "ident_map.ml"
+
+# 2 "ext/map.cppo.ml"
+(* we don't create [map_poly], since some operations require raise an exception which carries [key] *)
+
+
+  
+# 16
+  type key = Ident.t
+  let compare_key = Ext_ident.compare
+
+# 22
+type 'a t = (key,'a) Map_gen.t
+exception Duplicate_key of key 
+
+let empty = Map_gen.empty 
+let is_empty = Map_gen.is_empty
+let iter = Map_gen.iter
+let fold = Map_gen.fold
+let for_all = Map_gen.for_all 
+let exists = Map_gen.exists 
+let singleton = Map_gen.singleton 
+let cardinal = Map_gen.cardinal
+let bindings = Map_gen.bindings
+let keys = Map_gen.keys
+let choose = Map_gen.choose 
+let partition = Map_gen.partition 
+let filter = Map_gen.filter 
+let map = Map_gen.map 
+let mapi = Map_gen.mapi
+let bal = Map_gen.bal 
+let height = Map_gen.height 
+let max_binding_exn = Map_gen.max_binding_exn
+let min_binding_exn = Map_gen.min_binding_exn
+
+
+let rec add x data (tree : _ Map_gen.t as 'a) : 'a = match tree with 
+  | Empty ->
+    Node(Empty, x, data, Empty, 1)
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Node(l, x, data, r, h)
+    else if c < 0 then
+      bal (add x data l) v d r
+    else
+      bal l v d (add x data r)
+
+
+let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a = 
+  match tree with 
+  | Empty ->
+    Node(Empty, x, data (), Empty, 1)
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Node(l, x, replace  d , r, h)
+    else if c < 0 then
+      bal (adjust x data replace l) v d r
+    else
+      bal l v d (adjust x data replace r)
+
+
+let rec find_exn x (tree : _ Map_gen.t )  = match tree with 
+  | Empty ->
+    raise Not_found
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then d
+    else find_exn x (if c < 0 then l else r)
+
+let rec find_opt x (tree : _ Map_gen.t )  = match tree with 
+  | Empty -> None 
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then Some d
+    else find_opt x (if c < 0 then l else r)
+
+let rec find_default x (tree : _ Map_gen.t ) default     = match tree with 
+  | Empty -> default  
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then  d
+    else find_default x   (if c < 0 then l else r) default
+
+let rec mem x (tree : _ Map_gen.t )   = match tree with 
+  | Empty ->
+    false
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    c = 0 || mem x (if c < 0 then l else r)
+
+let rec remove x (tree : _ Map_gen.t as 'a) : 'a = match tree with 
+  | Empty ->
+    Empty
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Map_gen.merge l r
+    else if c < 0 then
+      bal (remove x l) v d r
+    else
+      bal l v d (remove x r)
+
+
+let rec split x (tree : _ Map_gen.t as 'a) : 'a * _ option * 'a  = match tree with 
+  | Empty ->
+    (Empty, None, Empty)
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then (l, Some d, r)
+    else if c < 0 then
+      let (ll, pres, rl) = split x l in (ll, pres, Map_gen.join rl v d r)
+    else
+      let (lr, pres, rr) = split x r in (Map_gen.join l v d lr, pres, rr)
+
+let rec merge f (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
+  match (s1, s2) with
+  | (Empty, Empty) -> Empty
+  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+    let (l2, d2, r2) = split v1 s2 in
+    Map_gen.concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+  | (_, Node (l2, v2, d2, r2, h2)) ->
+    let (l1, d1, r1) = split v2 s1 in
+    Map_gen.concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+  | _ ->
+    assert false
+
+let rec disjoint_merge  (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
+  match (s1, s2) with
+  | (Empty, Empty) -> Empty
+  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+    begin match split v1 s2 with 
+    | l2, None, r2 -> 
+      Map_gen.join (disjoint_merge  l1 l2) v1 d1 (disjoint_merge r1 r2)
+    | _, Some _, _ ->
+      raise (Duplicate_key  v1)
+    end        
+  | (_, Node (l2, v2, d2, r2, h2)) ->
+    begin match  split v2 s1 with 
+    | (l1, None, r1) -> 
+      Map_gen.join (disjoint_merge  l1 l2) v2 d2 (disjoint_merge  r1 r2)
+    | (_, Some _, _) -> 
+      raise (Duplicate_key v2)
+    end
+  | _ ->
+    assert false
+
+
+
+let compare cmp m1 m2 = Map_gen.compare compare_key cmp m1 m2
+
+let equal cmp m1 m2 = Map_gen.equal compare_key cmp m1 m2 
+
+let add_list (xs : _ list ) init = 
+  List.fold_left (fun acc (k,v) -> add k v acc) init xs 
+
+let of_list xs = add_list xs empty
+
+let of_array xs = 
+  Array.fold_left (fun acc (k,v) -> add k v acc) empty xs
+
 end
 module Lam_analysis : sig 
 #1 "lam_analysis.mli"
@@ -68079,7 +67410,8 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Plazyforce 
       | Psetfield _ 
       | Psetfloatfield _
-      | Psetglobal _ -> false 
+      (* | Psetglobal _  *)
+        -> false 
     )
   | Llet (_,_, arg,body) -> no_side_effects arg && no_side_effects body 
   | Lswitch (_,_) -> false 
@@ -68710,7 +68042,7 @@ let primitive ppf (prim : Lam.primitive) = match prim with
   | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
   | Pglobal_exception id ->
     fprintf ppf "global exception %a" Ident.print id                       
-  | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
+  (* | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id *)
   | Pmakeblock(tag, _, Immutable) -> fprintf ppf "makeblock %i" tag
   | Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag
   | Pfield (n,_) -> fprintf ppf "field %i" n
@@ -69101,11 +68433,12 @@ let rec flat (acc : (left * Lam.t) list ) (lam : Lam.t) =
 
 let lambda_as_module env  ppf (lam : Lam.t) = 
   try
-  match lam with
-  | Lprim {primitive = Psetglobal id ; args =  [biglambda]; _}
-  (* might be wrong in toplevel *) ->
+  (* match lam with *)
+  (* | Lprim {primitive = Psetglobal id ; args =  [biglambda]; _} *)
+  (* might be wrong in toplevel *) 
+  (* -> *)
       
-      begin match flat [] biglambda  with 
+      begin match flat [] lam  with 
       | (Nop, Lprim {primitive = Pmakeblock (_, _, _); args =  toplevels; _})
         :: rest ->
           (* let spc = ref false in *)
@@ -69124,7 +68457,7 @@ let lambda_as_module env  ppf (lam : Lam.t) =
           
       | _ -> raise Not_a_module
       end
-  | _ -> raise Not_a_module
+  (* | _ -> raise Not_a_module *)
   with _ -> 
     env_lambda env ppf lam;
     fprintf ppf "; lambda-failure"
@@ -69141,6 +68474,71 @@ let seriaize env (filename : string) (lam : Lam.t) : unit =
     Format.set_margin old
   end
 
+end
+module Ext_int : sig 
+#1 "ext_int.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+type t = int
+val compare : t -> t -> int 
+val equal : t -> t -> bool 
+
+end = struct
+#1 "ext_int.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+type t = int
+
+let compare (x : t) (y : t) = Pervasives.compare x y 
+
+let equal (x : t) (y : t) = x = y
+
 end
 module Int_hash_set : sig 
 #1 "int_hash_set.mli"
@@ -70475,7096 +69873,8356 @@ let debugger : t =
   }
 
 end
-module Hash_set_poly : sig 
-#1 "hash_set_poly.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-type   'a t 
-
-val create : int -> 'a t
-
-val clear : 'a t -> unit
-
-val reset : 'a t -> unit
-
-val copy : 'a t -> 'a t
-
-val add : 'a t -> 'a  -> unit
-val remove : 'a t -> 'a -> unit
-
-val mem : 'a t -> 'a -> bool
-
-val iter : ('a -> unit) -> 'a t -> unit
-
-val elements : 'a t -> 'a list
-
-val length : 'a t -> int 
-
-val stats:  'a t -> Hashtbl.statistics
-
-end = struct
-#1 "hash_set_poly.ml"
-# 1 "ext/hash_set.cppo.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-# 50
-external seeded_hash_param :
-  int -> int -> int -> 'a -> int = "caml_hash" "noalloc"
-let key_index (h :  _ Hash_set_gen.t ) (key : 'a) =
-  seeded_hash_param 10 100 0 key land (Array.length h.data - 1)
-let eq_key = (=)
-type  'a t = 'a Hash_set_gen.t 
-
-
-# 59
-let create = Hash_set_gen.create
-let clear = Hash_set_gen.clear
-let reset = Hash_set_gen.reset
-let copy = Hash_set_gen.copy
-let iter = Hash_set_gen.iter
-let fold = Hash_set_gen.fold
-let length = Hash_set_gen.length
-let stats = Hash_set_gen.stats
-let elements = Hash_set_gen.elements
-
-
-
-let remove (h : _ Hash_set_gen.t) key =  
-  let i = key_index h key in
-  let h_data = h.data in
-  let old_h_size = h.size in 
-  let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in
-  if old_h_size <> h.size then  
-    Array.unsafe_set h_data i new_bucket
-
-
-
-let add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h
-    end
-
-let check_add (h : _ Hash_set_gen.t) key =
-  let i = key_index h key  in 
-  if not (Hash_set_gen.small_bucket_mem eq_key key  (Array.unsafe_get h.data i)) then 
-    begin 
-      h.data.(i) <- key :: h.data.(i);
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h;
-      true 
-    end
-  else false 
-
-
-let mem (h :  _ Hash_set_gen.t) key =
-  Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) 
-
-  
-
-end
-module Type_int_to_string
-= struct
-#1 "type_int_to_string.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-let name_of_signature_item (x : Types.signature_item )=
-  match x with 
-  | Sig_value (i,_) 
-  | Sig_module (i,_,_) -> i 
-  | Sig_typext (i,_,_) -> i 
-  | Sig_modtype(i,_) -> i 
-  | Sig_class (i,_,_) -> i 
-  | Sig_class_type(i,_,_) -> i 
-  | Sig_type(i,_,_) -> i  
-
-
-(** It should be safe to replace Pervasives[], 
-    we should test cases  like module Pervasives = List *)
-let serializable_signature =
-  (fun x ->
-     match (x : Types.signature_item) with 
-     | Sig_value(_, {val_kind = Val_prim _}) -> false
-     | Sig_typext _ 
-     | Sig_module _
-     | Sig_class _ 
-     | Sig_value _ -> true
-     | _ -> false)
-  
-let filter_serializable_signatures (signature : Types.signature)
-  : Types.signature = 
-  List.filter serializable_signature signature
-
-end
-module Type_util : sig 
-#1 "type_util.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
-
-
-
-
-(** Utilities for quering typing inforaation from {!Env.t}, this part relies
-    on compiler API
-*)
-
+module Printlambda : sig 
+#1 "printlambda.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-val get_name : Types.signature -> int -> string
+open Lambda
 
+open Format
 
-(* Input path is a global module 
-    TODO: it should be fine for local module*)
-val find_serializable_signatures_by_path :
-  Ident.t -> Env.t -> Types.signature option
+val structured_constant: formatter -> structured_constant -> unit
 
+val env_lambda : Env.t -> formatter -> lambda -> unit
+val lambda : formatter -> lambda -> unit
+val primitive: formatter -> primitive -> unit
 
-(* val find_name : *)
-(*   Ident.t -> int -> Env.t -> string option *)
+val lambda_as_module : Env.t  -> Format.formatter -> Lambda.lambda -> unit
 
 
+val seriaize: Env.t -> string -> lambda -> unit
 
+val serialize_raw_js: 
+    (Env.t -> Types.signature ->  string  -> lambda  -> unit) ref
+val serialize_js: (Env.t -> string  -> lambda  -> unit) ref
 
 end = struct
-#1 "type_util.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-(* Input path is a global module 
-    TODO: it should be fine for local module
-*)
-let find_serializable_signatures_by_path v (env : Env.t) 
-  : Types.signature option = 
-  match Env.find_module (Pident v) env with 
-  | exception Not_found -> None 
-  | {md_type = Mty_signature signature; _} -> 
-    Some (Type_int_to_string.filter_serializable_signatures signature)
-  (** TODO: refine *)
-  | _ -> Ext_log.err __LOC__  "@[impossible path %s@]@."
-           (Ident.name v) ; assert false 
-
-let rec dump_summary fmt (x : Env.summary) = 
-  match x with 
-  | Env_empty -> ()
-  | Env_value(s,id,value_description) -> 
-    dump_summary fmt s ;
-    Printtyp.value_description id fmt value_description
-  | _ -> ()
+#1 "printlambda.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+[@@@ocaml.warning "-40"]
+open Format
+open Asttypes
+open Primitive
+open Types
+open Lambda
 
-(** Used in [Pgetglobal] *)
-let get_name  (serializable_sigs : Types.signature) (pos : int) = 
-  Ident.name @@ Type_int_to_string.name_of_signature_item @@ List.nth  serializable_sigs  pos
 
-(* let find_name id pos env = *)
-(*   match find_serializable_signatures_by_path id env with *)
-(*   | Some signatures -> *)
-(*     Some (get_name signatures pos) *)
-(*   | None -> None       *)
+let rec struct_const ppf = function
+  | Const_base(Const_int n) -> fprintf ppf "%i" n
+  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
+  | Const_immstring s -> fprintf ppf "#%S" s
+  | Const_base(Const_float f) -> fprintf ppf "%s" f
+  | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
+  | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
+  | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
+  | Const_pointer (n,_) -> fprintf ppf "%ia" n
+  | Const_block(tag,_, []) ->
+      fprintf ppf "[%i]" tag
+  | Const_block(tag,_, sc1::scl) ->
+      let sconsts ppf scl =
+        List.iter (fun sc -> fprintf ppf "@ %a" struct_const sc) scl in
+      fprintf ppf "@[<1>[%i:@ @[%a%a@]]@]" tag struct_const sc1 sconsts scl
+  | Const_float_array [] ->
+      fprintf ppf "[| |]"
+  | Const_float_array (f1 :: fl) ->
+      let floats ppf fl =
+        List.iter (fun f -> fprintf ppf "@ %s" f) fl in
+      fprintf ppf "@[<1>[|@[%s%a@]|]@]" f1 floats fl
 
+let boxed_integer_name = function
+  | Pnativeint -> "nativeint"
+  | Pint32 -> "int32"
+  | Pint64 -> "int64"
 
+let print_boxed_integer name ppf bi =
+  fprintf ppf "%s_%s" (boxed_integer_name bi) name
 
-    
+let print_boxed_integer_conversion ppf bi1 bi2 =
+  fprintf ppf "%s_of_%s" (boxed_integer_name bi2) (boxed_integer_name bi1)
 
+let boxed_integer_mark name = function
+  | Pnativeint -> Printf.sprintf "Nativeint.%s" name
+  | Pint32 -> Printf.sprintf "Int32.%s" name
+  | Pint64 -> Printf.sprintf "Int64.%s" name
 
-end
-module Lam_compile_env : sig 
-#1 "lam_compile_env.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let print_boxed_integer name ppf bi =
+  fprintf ppf "%s" (boxed_integer_mark name bi);;
 
+let print_bigarray name unsafe kind ppf layout =
+  fprintf ppf "Bigarray.%s[%s,%s]"
+    (if unsafe then "unsafe_"^ name else name)
+    (match kind with
+     | Pbigarray_unknown -> "generic"
+     | Pbigarray_float32 -> "float32"
+     | Pbigarray_float64 -> "float64"
+     | Pbigarray_sint8 -> "sint8"
+     | Pbigarray_uint8 -> "uint8"
+     | Pbigarray_sint16 -> "sint16"
+     | Pbigarray_uint16 -> "uint16"
+     | Pbigarray_int32 -> "int32"
+     | Pbigarray_int64 -> "int64"
+     | Pbigarray_caml_int -> "camlint"
+     | Pbigarray_native_int -> "nativeint"
+     | Pbigarray_complex32 -> "complex32"
+     | Pbigarray_complex64 -> "complex64")
+    (match layout with
+    |  Pbigarray_unknown_layout -> "unknown"
+     | Pbigarray_c_layout -> "C"
+     | Pbigarray_fortran_layout -> "Fortran")
 
+let record_rep ppf r =
+  match r with
+  | Record_regular -> fprintf ppf "regular"
+  | Record_float -> fprintf ppf "float"
+;;
 
+let string_of_loc_kind = function
+  | Loc_FILE -> "loc_FILE"
+  | Loc_LINE -> "loc_LINE"
+  | Loc_MODULE -> "loc_MODULE"
+  | Loc_POS -> "loc_POS"
+  | Loc_LOC -> "loc_LOC"
 
+let primitive ppf = function
+  | Pidentity -> fprintf ppf "id"
+  | Pbytes_to_string -> fprintf ppf "bytes_to_string"
+  | Pbytes_of_string -> fprintf ppf "bytes_of_string"
+  | Pignore -> fprintf ppf "ignore"
+  | Prevapply  -> fprintf ppf "revapply"
+  | Pdirapply  -> fprintf ppf "dirapply"
+  | Ploc kind -> fprintf ppf "%s" (string_of_loc_kind kind)
+  | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
+  | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
+  | Pmakeblock(tag, _, Immutable) -> fprintf ppf "makeblock %i" tag
+  | Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag
+  | Pfield (n,_) -> fprintf ppf "field %i" n
+  | Psetfield(n, ptr, _) ->
+      let instr = if ptr then "setfield_ptr " else "setfield_imm " in
+      fprintf ppf "%s%i" instr n
+  | Pfloatfield (n,_) -> fprintf ppf "floatfield %i" n
+  | Psetfloatfield (n,_) -> fprintf ppf "setfloatfield %i" n
+  | Pduprecord (rep, size) -> fprintf ppf "duprecord %a %i" record_rep rep size
+  | Plazyforce -> fprintf ppf "force"
+  | Pccall p -> fprintf ppf "%s" p.prim_name
+  | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
+  | Psequand -> fprintf ppf "&&"
+  | Psequor -> fprintf ppf "||"
+  | Pnot -> fprintf ppf "not"
+  | Pnegint -> fprintf ppf "~"
+  | Paddint -> fprintf ppf "+"
+  | Psubint -> fprintf ppf "-"
+  | Pmulint -> fprintf ppf "*"
+  | Pdivint -> fprintf ppf "/"
+  | Pmodint -> fprintf ppf "mod"
+  | Pandint -> fprintf ppf "and"
+  | Porint -> fprintf ppf "or"
+  | Pxorint -> fprintf ppf "xor"
+  | Plslint -> fprintf ppf "lsl"
+  | Plsrint -> fprintf ppf "lsr"
+  | Pasrint -> fprintf ppf "asr"
+  | Pintcomp(Ceq) -> fprintf ppf "=="
+  | Pintcomp(Cneq) -> fprintf ppf "!="
+  | Pintcomp(Clt) -> fprintf ppf "<"
+  | Pintcomp(Cle) -> fprintf ppf "<="
+  | Pintcomp(Cgt) -> fprintf ppf ">"
+  | Pintcomp(Cge) -> fprintf ppf ">="
+  | Poffsetint n -> fprintf ppf "%i+" n
+  | Poffsetref n -> fprintf ppf "+:=%i"n
+  | Pintoffloat -> fprintf ppf "int_of_float"
+  | Pfloatofint -> fprintf ppf "float_of_int"
+  | Pnegfloat -> fprintf ppf "~."
+  | Pabsfloat -> fprintf ppf "abs."
+  | Paddfloat -> fprintf ppf "+."
+  | Psubfloat -> fprintf ppf "-."
+  | Pmulfloat -> fprintf ppf "*."
+  | Pdivfloat -> fprintf ppf "/."
+  | Pfloatcomp(Ceq) -> fprintf ppf "==."
+  | Pfloatcomp(Cneq) -> fprintf ppf "!=."
+  | Pfloatcomp(Clt) -> fprintf ppf "<."
+  | Pfloatcomp(Cle) -> fprintf ppf "<=."
+  | Pfloatcomp(Cgt) -> fprintf ppf ">."
+  | Pfloatcomp(Cge) -> fprintf ppf ">=."
+  | Pstringlength -> fprintf ppf "string.length"
+  | Pstringrefu -> fprintf ppf "string.unsafe_get"
+  | Pstringsetu -> fprintf ppf "string.unsafe_set"
+  | Pstringrefs -> fprintf ppf "string.get"
+  | Pstringsets -> fprintf ppf "string.set"
+  | Pbyteslength -> fprintf ppf "bytes.length"
+  | Pbytesrefu -> fprintf ppf "bytes.unsafe_get"
+  | Pbytessetu -> fprintf ppf "bytes.unsafe_set"
+  | Pbytesrefs -> fprintf ppf "bytes.get"
+  | Pbytessets -> fprintf ppf "bytes.set"
 
+  | Parraylength _ -> fprintf ppf "array.length"
+  | Pmakearray _ -> fprintf ppf "makearray "
+  | Parrayrefu _ -> fprintf ppf "array.unsafe_get"
+  | Parraysetu _ -> fprintf ppf "array.unsafe_set"
+  | Parrayrefs _ -> fprintf ppf "array.get"
+  | Parraysets _ -> fprintf ppf "array.set"
+  | Pctconst c ->
+     let const_name = match c with
+       | Big_endian -> "big_endian"
+       | Word_size -> "word_size"
+       | Ostype_unix -> "ostype_unix"
+       | Ostype_win32 -> "ostype_win32"
+       | Ostype_cygwin -> "ostype_cygwin" in
+     fprintf ppf "sys.constant_%s" const_name
+  | Pisint -> fprintf ppf "isint"
+  | Pisout -> fprintf ppf "isout"
+  | Pbittest -> fprintf ppf "testbit"
+  | Pbintofint bi -> print_boxed_integer "of_int" ppf bi
+  | Pintofbint bi -> print_boxed_integer "to_int" ppf bi
+  | Pcvtbint (bi1, bi2) -> print_boxed_integer_conversion ppf bi1 bi2
+  | Pnegbint bi -> print_boxed_integer "neg" ppf bi
+  | Paddbint bi -> print_boxed_integer "add" ppf bi
+  | Psubbint bi -> print_boxed_integer "sub" ppf bi
+  | Pmulbint bi -> print_boxed_integer "mul" ppf bi
+  | Pdivbint bi -> print_boxed_integer "div" ppf bi
+  | Pmodbint bi -> print_boxed_integer "mod" ppf bi
+  | Pandbint bi -> print_boxed_integer "and" ppf bi
+  | Porbint bi -> print_boxed_integer "or" ppf bi
+  | Pxorbint bi -> print_boxed_integer "xor" ppf bi
+  | Plslbint bi -> print_boxed_integer "lsl" ppf bi
+  | Plsrbint bi -> print_boxed_integer "lsr" ppf bi
+  | Pasrbint bi -> print_boxed_integer "asr" ppf bi
+  | Pbintcomp(bi, Ceq) -> print_boxed_integer "==" ppf bi
+  | Pbintcomp(bi, Cneq) -> print_boxed_integer "!=" ppf bi
+  | Pbintcomp(bi, Clt) -> print_boxed_integer "<" ppf bi
+  | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi
+  | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi
+  | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi
+  | Pbigarrayref(unsafe, n, kind, layout) ->
+      print_bigarray "get" unsafe kind ppf layout
+  | Pbigarrayset(unsafe, n, kind, layout) ->
+      print_bigarray "set" unsafe kind ppf layout
+  | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
+  | Pstring_load_16(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get16"
+     else fprintf ppf "string.get16"
+  | Pstring_load_32(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get32"
+     else fprintf ppf "string.get32"
+  | Pstring_load_64(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_get64"
+     else fprintf ppf "string.get64"
+  | Pstring_set_16(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_set16"
+     else fprintf ppf "string.set16"
+  | Pstring_set_32(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_set32"
+     else fprintf ppf "string.set32"
+  | Pstring_set_64(unsafe) ->
+     if unsafe then fprintf ppf "string.unsafe_set64"
+     else fprintf ppf "string.set64"
+  | Pbigstring_load_16(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get16"
+     else fprintf ppf "bigarray.array1.get16"
+  | Pbigstring_load_32(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get32"
+     else fprintf ppf "bigarray.array1.get32"
+  | Pbigstring_load_64(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_get64"
+     else fprintf ppf "bigarray.array1.get64"
+  | Pbigstring_set_16(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set16"
+     else fprintf ppf "bigarray.array1.set16"
+  | Pbigstring_set_32(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set32"
+     else fprintf ppf "bigarray.array1.set32"
+  | Pbigstring_set_64(unsafe) ->
+     if unsafe then fprintf ppf "bigarray.array1.unsafe_set64"
+     else fprintf ppf "bigarray.array1.set64"
+  | Pbswap16 -> fprintf ppf "bswap16"
+  | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
+  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
 
+type print_kind = 
+  | Alias 
+  | Strict 
+  | StrictOpt 
+  | Variable 
+  | Recursive 
 
+let kind = function
+  | Alias -> "a"
+  | Strict -> ""
+  | StrictOpt -> "o"
+  | Variable -> "v" 
+  | Recursive -> "r"
 
-(** Helper for global Ocaml module index into meaningful names  *) 
+let to_print_kind (k : Lambda.let_kind) : print_kind = 
+  match k with 
+  | Alias -> Alias 
+  | Strict -> Strict
+  | StrictOpt -> StrictOpt
+  | Variable -> Variable
+  
+let rec aux (acc : (print_kind * Ident.t * lambda ) list) lam = 
+  match lam with 
+  | Llet (str3, id3, arg3, body3) ->
+      aux ((to_print_kind str3,id3, arg3)::acc) body3
+  | Lletrec (bind_args, body) ->
+      aux 
+        (List.map (fun (id,l) -> (Recursive,id,l)) bind_args 
+         @ acc) body
+  | e ->  (acc , e) 
 
-type primitive_description =  Primitive.description
+type left_var = 
+    {
+     kind : print_kind ;
+     id : Ident.t
+   }
 
-type key = 
-  Ident.t * Env.t * bool 
-  (** the boolean is expand or not
-      when it's passed as module, it should be expanded, 
-      otherwise for alias, [include Array], it's okay to return an identifier
-      TODO: be more clear about its concept
-  *)
-  (** we need register which global variable is an dependency *)
+type left = 
+  | Id of left_var
+  | Nop
 
 
-type ident_info = {
-  id : Ident.t;
-  name : string;
-  signatures : Types.signature;
-  arity : Lam.function_arities; 
-  closed_lambda : Lam.t option 
-}
 
-type module_info = {
-  signature :  Types.signature ;
-  pure : bool 
-}
 
-type _ t = 
-  | No_env :  Js_cmj_format.t t 
-  | Has_env : Env.t  -> module_info t 
+let  flatten lam : (print_kind * Ident.t * lambda ) list * lambda = 
+  match lam with 
+  | Llet(str,id, arg, body) ->
+      aux [to_print_kind str, id, arg] body
+  | Lletrec(bind_args, body) ->
+      aux 
+        (List.map (fun (id,l) -> (Recursive, id,l)) bind_args) 
+        body
+  | _ -> assert false
 
-val find_and_add_if_not_exist : 
-  Ident.t * int -> 
-  Env.t -> 
-  not_found:(Ident.t -> 'a) -> 
-  found:(ident_info -> 'a) -> 'a
+        
+let get_string ((id : Ident.t), (pos : int)) (env : Env.t) : string = 
+  match  Env.find_module (Pident id) env with 
+  | {md_type = Mty_signature signature  ; _ } -> 
+      (* Env.prefix_idents, could be cached  *)
+      let serializable_sigs = 
+        List.filter (fun x ->
+            match x with 
+            | Sig_typext _ 
+            | Sig_module _
+            | Sig_class _ -> true
+            | Sig_value(_, {val_kind = Val_prim _}) -> false
+            | Sig_value _ -> true
+            | _ -> false
+                    ) signature  in
+      (begin match List.nth  serializable_sigs  pos  with 
+      | Sig_value (i,_) 
+      | Sig_module (i,_,_) -> i 
+      | Sig_typext (i,_,_) -> i 
+      | Sig_modtype(i,_) -> i 
+      | Sig_class (i,_,_) -> i 
+      | Sig_class_type(i,_,_) -> i 
+      | Sig_type(i,_,_) -> i 
+      end).name
+  | _ -> assert false
 
-val query_and_add_if_not_exist : 
-  Lam_module_ident.t ->
-  'a t -> not_found:(unit -> 'b) ->
-  found:('a -> 'b) -> 'b
 
-val add_js_module : ?id:Ident.t -> string  -> Ident.t 
-(** add third party dependency *)
 
-(* The other dependencies are captured by querying 
-   either when [access] or when expansion, 
-   however such dependency can be removed after inlining etc.
+let lambda use_env env ppf v  =
+  let rec lam ppf = function
+  | Lvar id ->
+      Ident.print ppf id
+  | Lconst cst ->
+      struct_const ppf cst
+  | Lapply(lfun, largs, _) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(apply@ %a%a)@]" lam lfun lams largs
+  | Lfunction(kind, params, body) ->
+      let pr_params ppf params =
+        match kind with
+        | Curried ->
+            List.iter (fun param -> fprintf ppf "@ %a" Ident.print param) params
+        | Tupled ->
+            fprintf ppf " (";
+            let first = ref true in
+            List.iter
+              (fun param ->
+                if !first then first := false else fprintf ppf ",@ ";
+                Ident.print ppf param)
+              params;
+            fprintf ppf ")" in
+      fprintf ppf "@[<2>(function%a@ %a)@]" pr_params params lam body
+  | Llet _ | Lletrec _ as x ->
+      let args, body =   flatten x  in
+      let bindings ppf id_arg_list =
+        let spc = ref false in
+        List.iter
+          (fun (k, id, l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<2>%a =%s@ %a@]" Ident.print id (kind k) lam l)
+          id_arg_list in
+      fprintf ppf
+        "@[<2>(let@ (@[<hv 1>%a@]" bindings (List.rev args);
+      fprintf ppf ")@ %a)@]"  lam body
+  | Lprim(Pfield (n,_), [ Lprim(Pgetglobal id,[],_)],_) when use_env ->
+      fprintf ppf "%s.%s/%d" id.name (get_string (id,n) env) n
 
-   When we register such compile time dependency we classified 
-   it as 
-   Visit (ml), Builtin(built in js), External()
+  | Lprim(Psetfield (n,_,_), [ Lprim(Pgetglobal id,[],_) ;  e ], _) when use_env  ->
+      fprintf ppf "@[<2>(%s.%s/%d <- %a)@]" id.name (get_string (id,n) env) n
+        lam e
+  | Lprim(prim, largs,_) ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(%a%a)@]" primitive prim lams largs
+  | Lswitch(larg, sw) ->
+      let switch ppf sw =
+        let spc = ref false in
+        List.iter
+         (fun (n, l) ->
+           if !spc then fprintf ppf "@ " else spc := true;
+           fprintf ppf "@[<hv 1>case int %i:@ %a@]" n lam l)
+         sw.sw_consts;
+        List.iter
+          (fun (n, l) ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<hv 1>case tag %i:@ %a@]" n lam l)
+          sw.sw_blocks ;
+        begin match sw.sw_failaction with
+        | None  -> ()
+        | Some l ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<hv 1>default:@ %a@]" lam l
+        end in
+      fprintf ppf
+       "@[<1>(%s %a@ @[<v 0>%a@])@]"
+       (match sw.sw_failaction with None -> "switch*" | _ -> "switch")
+       lam larg switch sw
+  | Lstringswitch(arg, cases, default,_) ->
+      let switch ppf cases =
+        let spc = ref false in
+        List.iter
+         (fun (s, l) ->
+           if !spc then fprintf ppf "@ " else spc := true;
+           fprintf ppf "@[<hv 1>case \"%s\":@ %a@]" (String.escaped s) lam l)
+          cases;
+        begin match default with
+        | Some default ->
+            if !spc then fprintf ppf "@ " else spc := true;
+            fprintf ppf "@[<hv 1>default:@ %a@]" lam default
+        | None -> ()
+        end in
+      fprintf ppf
+       "@[<1>(stringswitch %a@ @[<v 0>%a@])@]" lam arg switch cases
+  | Lstaticraise (i, ls)  ->
+      let lams ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      fprintf ppf "@[<2>(exit@ %d%a)@]" i lams ls;
+  | Lstaticcatch(lbody, (i, vars), lhandler) ->
+      fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%d%a)@ %a)@]"
+        lam lbody i
+        (fun ppf vars -> match vars with
+          | [] -> ()
+          | _ ->
+              List.iter
+                (fun x -> fprintf ppf " %a" Ident.print x)
+                vars)
+        vars
+        lam lhandler
+  | Ltrywith(lbody, param, lhandler) ->
+      fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]"
+        lam lbody Ident.print param lam lhandler
+  | Lifthenelse(lcond, lif, lelse) ->
+      fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" lam lcond lam lif lam lelse
+  | Lsequence(l1, l2) ->
+      fprintf ppf "@[<2>(seq@ %a@ %a)@]" lam l1 sequence l2
+  | Lwhile(lcond, lbody) ->
+      fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody
+  | Lfor(param, lo, hi, dir, body) ->
+      fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
+       Ident.print param lam lo
+       (match dir with Upto -> "to" | Downto -> "downto")
+       lam hi lam body
+  | Lassign(id, expr) ->
+      fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
+  | Lsend (k, met, obj, largs, _) ->
+      let args ppf largs =
+        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
+      let kind =
+        if k = Self then "self" else if k = Cached then "cache" else "" in
+      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
+  | Levent(expr, _ev) ->
+      lam ppf expr
+      (* let kind = *)
+      (*  match ev.lev_kind with *)
+      (*  | Lev_before -> "before" *)
+      (*  | Lev_after _  -> "after" *)
+      (*  | Lev_function -> "funct-body" in *)
+      (* fprintf ppf "@[<2>(%s %s(%i)%s:%i-%i@ %a)@]" kind *)
+      (*         ev.lev_loc.Location.loc_start.Lexing.pos_fname *)
+      (*         ev.lev_loc.Location.loc_start.Lexing.pos_lnum *)
+      (*         (if ev.lev_loc.Location.loc_ghost then "<ghost>" else "") *)
+      (*         ev.lev_loc.Location.loc_start.Lexing.pos_cnum *)
+      (*         ev.lev_loc.Location.loc_end.Lexing.pos_cnum *)
+      (*         lam expr *)
+  | Lifused(id, expr) ->
+      fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr
 
-   For external, we never remove, we only consider 
-   remove dependency for Runtime and Visit, so 
-   when compile OCaml to Javascript, we only need 
-   pay attention to for those modules are actually used or not
-*)
+and sequence ppf = function
+  | Lsequence(l1, l2) ->
+      fprintf ppf "%a@ %a" sequence l1 sequence l2
+  | l ->
+      lam ppf l
+  in 
+  lam ppf v
 
-val reset : unit -> unit 
+let structured_constant = struct_const
 
-val is_pure : Lam_module_ident.t -> bool
+let env_lambda = lambda true 
+let lambda = lambda false Env.empty
 
-val get_package_path_from_cmj : 
-  Lam_module_ident.system -> Lam_module_ident.t -> 
-  Js_config.info_query
+let rec flatten_seq acc lam =
+  match lam with 
+  | Lsequence(l1,l2) -> 
+      flatten_seq (flatten_seq acc l1) l2
+  | x -> x :: acc 
 
+exception Not_a_module
 
-(* The second argument is mostly from [runtime] modules 
-    will change the input [hard_dependencies]
-*)
-val get_requried_modules : 
-  Env.t ->
-  Lam_module_ident.t list ->
-  Lam_module_ident.t Hash_set_poly.t -> 
-  Lam_module_ident.t list
+let rec flat (acc : (left * lambda) list ) (lam : lambda) = 
+  match lam with 
+  | Llet (str,id,arg,body) ->
+      flat ( (Id {kind = to_print_kind str;  id}, arg) :: acc) body 
+  | Lletrec (bind_args, body) ->
+      flat ( List.map (fun (id, arg ) -> (Id {kind = Recursive;  id}, arg)) bind_args @ acc) body 
+  | Lsequence (l,r) -> 
+      flat (flat acc l) r
+  | x -> (Nop, x) :: acc 
 
-end = struct
-#1 "lam_compile_env.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let lambda_as_module env  ppf lam = 
+  try
+  match lam with
+  | Lprim(Psetglobal(id), [biglambda],_)  (* might be wrong in toplevel *) ->
+      
+      begin match flat [] biglambda  with 
+      | (Nop, Lprim (Pmakeblock (_, _, _), toplevels,_)) :: rest ->
+          (* let spc = ref false in *)
+          List.iter
+            (fun (left, l) ->
+              match left with 
+              | Id { kind = k; id } ->
+                  fprintf ppf "@[<2>%a =%s@ %a@]@." Ident.print id (kind k) (env_lambda env) l
+              | Nop -> 
 
+                  fprintf ppf "@[<2>%a@]@."   (env_lambda env) l
+            )
 
+            @@ List.rev rest
+          
+          
+      | _ -> raise Not_a_module
+      end
+  | _ -> raise Not_a_module
+  with _ -> 
+    env_lambda env ppf lam;
+    fprintf ppf "; lambda-failure"
+let seriaize env (filename : string) (lam : Lambda.lambda) : unit =
+  let ou = open_out filename  in
+  let old = Format.get_margin () in
+  let () = Format.set_margin 10000 in
+  let fmt = Format.formatter_of_out_channel ou in
+  begin
+    (* lambda_as_module env fmt lambda; *)
+    lambda fmt lam;
+    Format.pp_print_flush fmt ();
+    close_out ou;
+    Format.set_margin old
+  end
 
+let serialize_raw_js = ref(fun _ _ _ _ -> ())    
+let serialize_js = ref (fun _ _ _ -> ())
 
+end
+module Switch : sig 
+#1 "switch.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Luc Maranget, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+(*
+  This module transforms generic switches in combinations
+  of if tests and switches.
+*)
 
+(* For detecting action sharing, object style *)
 
+(* Store for actions in object style:
+  act_store : store an action, returns index in table
+              In case an action with equal key exists, returns index
+              of the stored action. Otherwise add entry in table.
+  act_store_shared : This stored action will always be shared.
+  act_get   : retrieve table
+  act_get_shared : retrieve table, with sharing explicit
+*)
 
-module E = Js_exp_make  
-module S = Js_stmt_make
+type 'a shared = Shared of 'a | Single of 'a
 
-type module_id = Lam_module_ident.t
+type 'a t_store =
+    {act_get : unit -> 'a array ;
+     act_get_shared : unit -> 'a shared array ;
+     act_store : 'a -> int ;
+     act_store_shared : 'a -> int ; }
 
-type ml_module_info = { 
-  signatures : Types.signature ;
-  cmj_table : Js_cmj_format.t
-}
+exception Not_simple
 
-type env_value = 
-  | Visit of ml_module_info
-  | Runtime  of bool * Js_cmj_format.t
-  (** A built in module probably from our runtime primitives, 
-      so it does not have any [signature]
-  *)
-  | External  
-  (** Also a js file, but this belong to third party 
-  *)
+module type Stored = sig
+  type t
+  type key
+  val make_key : t -> key option
+end
 
-type module_info = {
-  signature :  Types.signature ;
-  pure : bool 
-}
+module Store(A:Stored) :
+    sig
+      val mk_store : unit -> A.t t_store
+    end
 
-type primitive_description =  Primitive.description
+(* Arguments to the Make functor *)
+module type S =
+  sig
+    (* type of basic tests *)
+    type primitive
+    (* basic tests themselves *)
+    val eqint : primitive
+    val neint : primitive
+    val leint : primitive
+    val ltint : primitive
+    val geint : primitive
+    val gtint : primitive
+    (* type of actions *)
+    type act
 
-type key = 
-  Ident.t * Env.t  * bool (** we need register which global variable is an dependency *)
+    (* Various constructors, for making a binder,
+        adding one integer, etc. *)
+    val bind : act -> (act -> act) -> act
+    val make_const : int -> act
+    val make_offset : act -> int -> act
+    val make_prim : primitive -> act list -> act
+    val make_isout : act -> act -> act
+    val make_isin : act -> act -> act
+    val make_if : act -> act -> act -> act
+   (* construct an actual switch :
+      make_switch arg cases acts
+      NB:  cases is in the value form *)
+    val make_switch :
+        act -> int array -> act array -> act
+   (* Build last minute sharing of action stuff *)
+   val make_catch : act -> int * (act -> act)
+   val make_exit : int -> act
 
+  end
 
-type ident_info = {
-  id : Ident.t;
-  name : string;
-  signatures : Types.signature;
-  arity : Lam.function_arities; 
-  closed_lambda : Lam.t option 
-}
 
 (*
-   refer: [Env.find_pers_struct]
-   [ find_in_path_uncap !load_path (name ^ ".cmi")]
+  Make.zyva arg low high cases actions where
+    - arg is the argument of the switch.
+    - low, high are the interval limits.
+    - cases is a list of sub-interval and action indices
+    - actions is an array of actions.
+
+  All these arguments specify a switch construct and zyva
+  returns an action that performs the switch,
 *)
+module Make :
+  functor (Arg : S) ->
+    sig
+(* Standard entry point, sharing is tracked *)
+      val zyva :
+          (int * int) ->
+           Arg.act ->
+           (int * int * int) array ->
+           Arg.act t_store ->
+           Arg.act
 
+(* Output test sequence, sharing tracked *)
+     val test_sequence :
+           Arg.act ->
+           (int * int * int) array ->
+           Arg.act t_store ->
+           Arg.act
+    end
 
+end = struct
+#1 "switch.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Luc Maranget, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-let cached_tbl  = Lam_module_ident.Hash.create 31
 
-(* For each compilation we need reset to make it re-entrant *)
-let reset () = 
-  Lam_module_ident.Hash.clear cached_tbl 
+type 'a shared = Shared of 'a | Single of 'a
 
-(* FIXME: JS external instead *)
-let add_js_module ?id module_name = 
-  let id = 
-    match id with
-    | None -> Ext_ident.create_js_module module_name 
-    | Some id -> id in
-  Lam_module_ident.Hash.replace cached_tbl (Lam_module_ident.of_external id module_name) External;
-  id  
+let share_out = function
+  | Shared act|Single act -> act
 
 
+type 'a t_store =
+    {act_get : unit -> 'a array ;
+     act_get_shared : unit -> 'a shared array ;
+     act_store : 'a -> int ;
+     act_store_shared : 'a -> int ; }
 
-let add_cached_tbl = Lam_module_ident.Hash.add cached_tbl
+exception Not_simple
 
-let find_and_add_if_not_exist (id, pos) env ~not_found ~found =
-  let oid  = Lam_module_ident.of_ml id in
-  begin match Lam_module_ident.Hash.find_opt cached_tbl oid with 
-    | None -> 
-      let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in
-      begin match
-          Type_util.find_serializable_signatures_by_path
-            ( id) env with 
-      | None -> not_found id 
-      | Some signature -> 
-        add_cached_tbl oid (Visit {signatures = signature; 
-                                   cmj_table ;  } ) ;
-        let name =  (Type_util.get_name signature pos ) in
-        let arity, closed_lambda =        
-          begin match String_map.find_opt name cmj_table.values with
-            | Some {arity; closed_lambda} -> arity, closed_lambda
-            | None -> NA, None 
-          end in
-        found {id; 
-               name ;
-               signatures = signature ;
-               arity ;
-               closed_lambda = 
-                 if Js_config.get_cross_module_inline () then
-                   closed_lambda
-                 else None
-              }
-      end
-    | Some (Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } ) -> 
-      let name = (Type_util.get_name serializable_sigs pos ) in
-      let arity , closed_lambda =  (
-        match  String_map.find_opt name values with
-        | Some {arity; closed_lambda;_} -> 
-          arity, closed_lambda 
-        | None -> (NA, None)
-      ) in
-      found { id;
-              name; 
-              signatures = serializable_sigs;
-              arity;
-              closed_lambda = 
-                if Js_config.get_cross_module_inline () then
-                  closed_lambda
-                else None
-              (* TODO shall we cache the arity ?*) 
-            } 
-    | Some (Runtime _) -> assert false
-    | Some External  -> assert false
-  end
+module type Stored = sig
+  type t
+  type key
+  val make_key : t -> key option
+end
 
+module Store(A:Stored) = struct
+  module AMap =
+    Map.Make(struct type t = A.key let compare = Pervasives.compare end)
 
-(* TODO: it does not make sense to cache
-   [Runtime] 
-   and [externals]*)
-type _ t = 
-  | No_env :  Js_cmj_format.t t 
-  | Has_env : Env.t  -> module_info t 
+  type intern =
+      { mutable map : (bool * int)  AMap.t ;
+        mutable next : int ;
+        mutable acts : (bool * A.t) list; }
 
+  let mk_store () =
+    let st =
+      { map = AMap.empty ;
+        next = 0 ;
+        acts = [] ; } in
 
-let query_and_add_if_not_exist (type u)
-    (oid : Lam_module_ident.t) 
-    (env : u t) ~not_found ~found:(found : u -> _) =
-  match Lam_module_ident.Hash.find_opt cached_tbl oid with 
-  | None -> 
-    begin match oid.kind with
-      | Runtime  -> 
-        let cmj_table = 
-          Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in           
-        add_cached_tbl oid (Runtime (true,cmj_table)) ; 
-        begin match env with 
-        | Has_env _ -> 
-          found {signature = []; pure = true}
-        | No_env -> 
-          found cmj_table
-        end
-      | Ml 
-        -> 
-        let cmj_table = 
-          Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in           
-        begin match env with 
-          | Has_env env -> 
-            begin match 
-                Type_util.find_serializable_signatures_by_path ( oid.id) env with 
-            | None -> not_found () (* actually when [not_found] in the call site, we throw... *)
-            | Some signature -> 
-              add_cached_tbl oid (Visit {signatures = signature; cmj_table }) ;
-              found  { signature ; pure = cmj_table.effect = None} 
-            end
-          | No_env -> 
-            found cmj_table
-        end
+    let add mustshare act =
+      let i = st.next in
+      st.acts <- (mustshare,act) :: st.acts ;
+      st.next <- i+1 ;
+      i in
 
-      | External _  -> 
-        add_cached_tbl oid External;
-        (** This might be wrong, if we happen to expand  an js module
-            we should assert false (but this in general should not happen)
-        *)
-        begin match env with 
-        | Has_env _ 
-          -> 
-          found {signature = []; pure = false}
-        | No_env -> 
-          found (Js_cmj_format.no_pure_dummy)
+    let store mustshare act = match A.make_key act with
+    | Some key ->
+        begin try
+          let (shared,i) = AMap.find key st.map in
+          if not shared then st.map <- AMap.add key (true,i) st.map ;
+          i
+        with Not_found ->
+          let i = add mustshare act in
+          st.map <- AMap.add key (mustshare,i) st.map ;
+          i
         end
+    | None ->
+        add mustshare act
 
-    end
-  | Some (Visit {signatures  ; cmj_table =  cmj_table; _}) -> 
-    begin match env with 
-      | Has_env _ -> 
-        found   { signature =  signatures  ; pure = (cmj_table.effect = None)} 
-      | No_env  -> found cmj_table
-    end
+    and get () = Array.of_list (List.rev_map (fun (_,act) -> act) st.acts)
 
-  | Some (Runtime (pure, cmj_table)) -> 
-    begin match env with 
-      | Has_env _ -> 
-        found {signature = []  ; pure }
-      | No_env -> 
-        found cmj_table
-    end
-  | Some External -> 
-    begin match env with 
-    | Has_env _ -> 
-      found {signature = []  ; pure  = false}
-    | No_env -> found Js_cmj_format.no_pure_dummy
-    end
+    and get_shared () =
+      let acts =
+        Array.of_list
+          (List.rev_map
+             (fun (shared,act) ->
+               if shared then Shared act else Single act)
+             st.acts) in
+      AMap.iter
+        (fun _ (shared,i) ->
+          if shared then match acts.(i) with
+          | Single act -> acts.(i) <- Shared act
+          | Shared _ -> ())
+        st.map ;
+      acts in
+    {act_store = store false ; act_store_shared = store true ;
+     act_get = get; act_get_shared = get_shared; }
+end
 
-(* Conservative interface *)
-let is_pure id  = 
-  query_and_add_if_not_exist id No_env
-    ~not_found:(fun _ -> false) 
-    ~found:(fun x -> x.effect = None)
 
 
-    
+module type S =
+ sig
+   type primitive
+   val eqint : primitive
+   val neint : primitive
+   val leint : primitive
+   val ltint : primitive
+   val geint : primitive
+   val gtint : primitive
+   type act
 
-let get_package_path_from_cmj module_system ( id : Lam_module_ident.t) = 
-  query_and_add_if_not_exist id No_env
-    ~not_found:(fun _ -> `NotFound) 
-    ~found:(fun x -> Js_config.query_package_infos x.npm_package_path module_system)
+   val bind : act -> (act -> act) -> act
+   val make_const : int -> act
+   val make_offset : act -> int -> act
+   val make_prim : primitive -> act list -> act
+   val make_isout : act -> act -> act
+   val make_isin : act -> act -> act
+   val make_if : act -> act -> act -> act
+   val make_switch : act -> int array -> act array -> act
+   val make_catch : act -> int * (act -> act)
+   val make_exit : int -> act
+ end
+
+(* The module will ``produce good code for the case statement'' *)
+(*
+  Adaptation of
+   R.L. Berstein
+   ``Producing good code for the case statement''
+   Sofware Practice and Experience, 15(10) (1985)
+ and
+   D.L. Spuler
+    ``Two-Way Comparison Search Trees, a Generalisation of Binary Search Trees
+      and Split Trees''
+    ``Compiler Code Generation for Multiway Branch Statement as
+      a Static Search Problem''
+   Technical Reports, James Cook University
+*)
+(*
+  Main adaptation is considering interval tests
+ (implemented as one addition + one unsigned test and branch)
+  which leads to exhaustive search for finding the optimal
+  test sequence in small cases and heuristics otherwise.
+*)
+module Make (Arg : S) =
+  struct
+
+    type 'a inter =
+        {cases : (int * int * int) array ;
+          actions : 'a array}
 
+type 'a t_ctx =  {off : int ; arg : 'a}
 
-(* TODO: [env] is not hard dependency *)
+let cut = ref 8
+and more_cut = ref 16
+
+let pint chan i =
+  if i = min_int then Printf.fprintf chan "-oo"
+  else if i=max_int then Printf.fprintf chan "oo"
+  else Printf.fprintf chan "%d" i
+
+let pcases chan cases =
+  for i =0 to Array.length cases-1 do
+    let l,h,act = cases.(i) in
+    if l=h then
+      Printf.fprintf chan "%d:%d " l act
+    else
+      Printf.fprintf chan "%a..%a:%d " pint l pint h act
+  done
 
-let get_requried_modules env (extras : module_id list ) (hard_dependencies 
-  : _ Hash_set_poly.t) : module_id list =  
+    let prerr_inter i = Printf.fprintf stderr
+        "cases=%a" pcases i.cases
 
-  let mem (x : Lam_module_ident.t) = 
-    not (is_pure x ) || Hash_set_poly.mem hard_dependencies  x 
-  in
-  Lam_module_ident.Hash.iter (fun (id : module_id)  _  ->
-      if mem id 
-      then Hash_set_poly.add hard_dependencies id) cached_tbl ;
-  List.iter (fun id -> 
-      if mem id 
-      then Hash_set_poly.add hard_dependencies id
-    ) extras;
-  Hash_set_poly.elements hard_dependencies
+let get_act cases i =
+  let _,_,r = cases.(i) in
+  r
+and get_low cases i =
+  let r,_,_ = cases.(i) in
+  r
 
-end
-module Js_program_loader : sig 
-#1 "js_program_loader.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+type ctests = {
+    mutable n : int ;
+    mutable ni : int ;
+  }
 
+let too_much = {n=max_int ; ni=max_int}
 
+let ptests chan {n=n ; ni=ni} =
+  Printf.fprintf chan "{n=%d ; ni=%d}" n ni
 
+let pta chan t =
+  for i =0 to Array.length t-1 do
+    Printf.fprintf chan "%d: %a\n" i ptests t.(i)
+  done
 
+let count_tests s =
+  let r =
+    Array.init
+      (Array.length s.actions)
+      (fun _ -> {n=0 ; ni=0 }) in
+  let c = s.cases in
+  let imax = Array.length c-1 in
+  for i=0 to imax do
+    let l,h,act = c.(i) in
+    let x = r.(act) in
+    x.n <- x.n+1 ;
+    if l < h && i<> 0 && i<>imax then
+      x.ni <- x.ni+1 ;
+  done ;
+  r
 
 
+let less_tests c1 c2 =
+  if c1.n < c2.n then
+    true
+  else if c1.n = c2.n then begin
+    if c1.ni < c2.ni then
+      true
+    else
+      false
+  end else
+    false
 
+and eq_tests c1 c2 = c1.n = c2.n && c1.ni=c2.ni
 
-(** A module to create the whole JS program IR with [requires] and [exports] *)
+let min_tests c1 c2 = if less_tests c1 c2 then c1 else c2
 
-(* TODO: 
-   1. support es6 modle
-   2. make sure exported have its origin name, 
-      this makes it easier to read code 
- *)
+let less2tests (c1,d1) (c2,d2) =
+  if eq_tests c1 c2 then
+    less_tests d1 d2
+  else
+    less_tests c1 c2
 
-val make_program : 
-    string -> 
-    Ident.t list -> J.block -> J.program
+let add_test t1 t2 =
+  t1.n <- t1.n + t2.n ;
+  t1.ni <- t1.ni + t2.ni ;
 
-val decorate_deps : 
-  J.required_modules ->
-  string option ->
-  J.program -> J.deps_program
+type t_ret = Inter of int * int  | Sep of int | No
 
-val string_of_module_id :
-  output_prefix:string ->
-  Lam_module_ident.system -> Lam_module_ident.t -> string
+let pret chan = function
+  | Inter (i,j)-> Printf.fprintf chan "Inter %d %d" i j
+  | Sep i -> Printf.fprintf chan "Sep %d" i
+  | No -> Printf.fprintf chan "No"
 
-end = struct
-#1 "js_program_loader.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let coupe cases i =
+  let l,_,_ = cases.(i) in
+  l,
+  Array.sub cases 0 i,
+  Array.sub cases i (Array.length cases-i)
 
 
+let case_append c1 c2 =
+  let len1 = Array.length c1
+  and len2 = Array.length c2 in
+  match len1,len2 with
+  | 0,_ -> c2
+  | _,0 -> c1
+  | _,_ ->
+      let l1,h1,act1 = c1.(Array.length c1-1)
+      and l2,h2,act2 = c2.(0) in
+      if act1 = act2 then
+        let r = Array.make (len1+len2-1) c1.(0) in
+        for i = 0 to len1-2 do
+          r.(i) <- c1.(i)
+        done ;
 
+        let l =
+          if len1-2 >= 0 then begin
+            let _,h,_ = r.(len1-2) in
+            if h+1 < l1 then
+              h+1
+            else
+              l1
+          end else
+            l1
+        and h =
+          if 1 < len2-1 then begin
+            let l,_,_ = c2.(1) in
+            if h2+1 < l then
+              l-1
+            else
+              h2
+          end else
+            h2 in
+        r.(len1-1) <- (l,h,act1) ;
+        for i=1 to len2-1  do
+          r.(len1-1+i) <- c2.(i)
+        done ;
+        r
+      else if h1 > l1 then
+        let r = Array.make (len1+len2) c1.(0) in
+        for i = 0 to len1-2 do
+          r.(i) <- c1.(i)
+        done ;
+        r.(len1-1) <- (l1,l2-1,act1) ;
+        for i=0 to len2-1  do
+          r.(len1+i) <- c2.(i)
+        done ;
+        r
+      else if h2 > l2 then
+        let r = Array.make (len1+len2) c1.(0) in
+        for i = 0 to len1-1 do
+          r.(i) <- c1.(i)
+        done ;
+        r.(len1) <- (h1+1,h2,act2) ;
+        for i=1 to len2-1  do
+          r.(len1+i) <- c2.(i)
+        done ;
+        r
+      else
+        Array.append c1 c2
 
 
+let coupe_inter i j cases =
+  let lcases = Array.length cases in
+  let low,_,_ = cases.(i)
+  and _,high,_ = cases.(j) in
+  low,high,
+  Array.sub cases i (j-i+1),
+  case_append (Array.sub cases 0 i) (Array.sub cases (j+1) (lcases-(j+1)))
 
+type kind = Kvalue of int | Kinter of int | Kempty
 
+let pkind chan = function
+  | Kvalue i ->Printf.fprintf chan "V%d" i
+  | Kinter i -> Printf.fprintf chan "I%d" i
+  | Kempty -> Printf.fprintf chan "E"
 
-module E = Js_exp_make
-module S = Js_stmt_make
+let rec pkey chan  = function
+  | [] -> ()
+  | [k] -> pkind chan k
+  | k::rem ->
+      Printf.fprintf chan "%a %a" pkey rem pkind k
 
+let t = Hashtbl.create 17
 
+let make_key  cases =
+  let seen = ref []
+  and count = ref 0 in
+  let rec got_it act = function
+    | [] ->
+        seen := (act,!count):: !seen ;
+        let r = !count in
+        incr count ;
+        r
+    | (act0,index) :: rem ->
+        if act0 = act then
+          index
+        else
+          got_it act rem in
 
-(** Design guides:
-    1. We don't want to force user to have 
-       [-bs-package-name] and [-bs-package-output] set
+  let make_one l h act =
+    if l=h then
+      Kvalue (got_it act !seen)
+    else
+      Kinter (got_it act !seen) in
 
-       [bsc.exe -c hello.ml] should just work 
-       by producing a [hello.js] file in the same directory
+  let rec make_rec i pl =
+    if i < 0 then
+      []
+    else
+      let l,h,act = cases.(i) in
+      if pl = h+1 then
+        make_one l h act::make_rec (i-1) l
+      else
+        Kempty::make_one l h act::make_rec (i-1) l in
 
-    Some designs due to legacy reasons that we don't have all runtime
-    written in OCaml, so it might only have js files (no cmjs) for Runtime kind
-    {[
-      begin match Config_util.find file with   
-        (* maybe from third party library*)
-        (* Check: be consistent when generating js files
-           A.ml -> a.js
-           a.ml -> a.js
-           check generated [js] file if it's capital or not
-           Actually, we can not tell its original name just from [id], 
-           so we just always general litte_case.js
-        *)
-        | file ->
-          rebase (`File file)
-        (* for some primitive files, no cmj support *)
-        | exception Not_found ->
-          Ext_pervasives.failwithf ~loc:__LOC__ 
-            "@[%s not found in search path - while compiling %s @] "
-            file !Location.input_name 
-      end
+  let l,h,act = cases.(Array.length cases-1) in
+  make_one l h act::make_rec (Array.length cases-2) l
 
-    ]}
 
-*)
+    let same_act t =
+      let len = Array.length t in
+      let a = get_act t (len-1) in
+      let rec do_rec i =
+        if i < 0 then true
+        else
+          let b = get_act t i in
+          b=a && do_rec (i-1) in
+      do_rec (len-2)
 
-let (//) = Filename.concat 
 
-let string_of_module_id ~output_prefix
-    (module_system : Lam_module_ident.system)
-    (x : Lam_module_ident.t) : string =
+(*
+  Intervall test x in [l,h] works by checking x-l in [0,h-l]
+   * This may be false for arithmetic modulo 2^31
+   * Subtracting l may change the relative ordering of values
+     and invalid the invariant that matched values are given in
+     increasing order
 
+   To avoid this, interval check is allowed only when the
+   integers indeed present in the whole case interval are
+   in [-2^16 ; 2^16]
 
-    let result = 
-      match x.kind  with 
-      | Runtime  
-      | Ml  -> 
-        let id = x.id in
-        let modulename = String.uncapitalize id.name in
-        let js_file = Printf.sprintf "%s.js" modulename in
-        let rebase package_dir dep =
-          let current_unit_dir =
-            `Dir (Js_config.get_output_dir ~pkg_dir:package_dir module_system output_prefix) in
-          Ext_filename.node_relative_path  current_unit_dir dep 
-        in 
-        let dependency_pkg_info = 
-          Lam_compile_env.get_package_path_from_cmj module_system x 
-        in
-        let current_pkg_info = 
-          Js_config.get_current_package_name_and_path module_system  
-        in
-        begin match module_system,  dependency_pkg_info, current_pkg_info with
-          | _, `NotFound , _ -> 
-            Ext_pervasives.failwithf ~loc:__LOC__ 
-              " @[%s not found in search path - while compiling %s @] "
-              js_file !Location.input_name 
-          | `Goog , `Found (package_name, x), _  -> 
-            package_name  ^ "." ^  String.uncapitalize id.name
-          | `Goog, (`Empty | `Package_script _), _ 
-            -> 
-            Ext_pervasives.failwithf ~loc:__LOC__ 
-              " @[%s was not compiled with goog support  in search path - while compiling %s @] "
-              js_file !Location.input_name 
-          | (`AmdJS | `NodeJS),
-            ( `Empty | `Package_script _) ,
-            `Found _  -> 
-            Ext_pervasives.failwithf ~loc:__LOC__
-              "@[dependency %s was compiled in script mode - while compiling %s in package mode @]"
-              js_file !Location.input_name
-          | _ , _, `NotFound -> assert false 
-          | (`AmdJS | `NodeJS), 
-            `Found(package_name, x),
-            `Found(current_package, path) -> 
-            if  current_package = package_name then 
-              let package_dir = Lazy.force Ext_filename.package_dir in
-              rebase package_dir (`File (package_dir // x // modulename)) 
-            else 
-              package_name // x // modulename
-          | (`AmdJS | `NodeJS), `Found(package_name, x), 
-            `Package_script(current_package)
-            ->    
-            if current_package = package_name then 
-              let package_dir = Lazy.force Ext_filename.package_dir in
-              rebase package_dir (`File (
-                  package_dir // x // modulename)) 
-            else 
-              package_name // x // modulename
-          | (`AmdJS | `NodeJS), `Found(package_name, x), `Empty 
-            ->    package_name // x // modulename
-          |  (`AmdJS | `NodeJS), 
-             (`Empty | `Package_script _) , 
-             (`Empty  | `Package_script _)
-            -> 
-            begin match Config_util.find_opt js_file with 
-              | Some file -> 
-                let package_dir = Lazy.force Ext_filename.package_dir in
-                rebase package_dir (`File file) 
-              | None -> 
-                Bs_exception.error (Js_not_found js_file)
-            end
-        end
-      | External name -> name in 
-    if Js_config.is_windows then Ext_filename.replace_backward_slash result 
-    else result 
+   This condition is checked by zyva
+*)
 
+let inter_limit = 1 lsl 16
 
+let ok_inter = ref false
 
-(* support es6 modules instead
-   TODO: enrich ast to support import export 
-   http://www.ecma-international.org/ecma-262/6.0/#sec-imports
-   For every module, we need [Ident.t] for accessing and [filename] for import, 
-   they are not necessarily the same.
+let rec opt_count top cases =
+  let key = make_key cases in
+  try
+    let r = Hashtbl.find t key in
+    r
+  with
+  | Not_found ->
+      let r =
+        let lcases = Array.length cases in
+        match lcases with
+        | 0 -> assert false
+        | _ when same_act cases -> No, ({n=0; ni=0},{n=0; ni=0})
+        | _ ->
+            if lcases < !cut then
+              enum top cases
+            else if lcases < !more_cut then
+              heuristic top cases
+            else
+              divide top cases in
+      Hashtbl.add t key r ;
+      r
 
-   Es6 modules is not the same with commonjs, we use commonjs currently
-   (play better with node)
+and divide top cases =
+  let lcases = Array.length cases in
+  let m = lcases/2 in
+  let _,left,right = coupe cases m in
+  let ci = {n=1 ; ni=0}
+  and cm = {n=1 ; ni=0}
+  and _,(cml,cleft) = opt_count false left
+  and _,(cmr,cright) = opt_count false right in
+  add_test ci cleft ;
+  add_test ci cright ;
+  if less_tests cml cmr then
+    add_test cm cmr
+  else
+    add_test cm cml ;
+  Sep m,(cm, ci)
 
-   FIXME: the module order matters?
-*)
+and heuristic top cases =
+  let lcases = Array.length cases in
 
-let make_program name  export_idents block : J.program = 
+  let sep,csep = divide false cases
 
-  {
-    name;
+  and inter,cinter =
+    if !ok_inter then begin
+      let _,_,act0 = cases.(0)
+      and _,_,act1 = cases.(lcases-1) in
+      if act0 = act1 then begin
+        let low, high, inside, outside = coupe_inter 1 (lcases-2) cases in
+        let _,(cmi,cinside) = opt_count false inside
+        and _,(cmo,coutside) = opt_count false outside
+        and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
+        and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
+        add_test cij cinside ;
+        add_test cij coutside ;
+        if less_tests cmi cmo then
+          add_test cmij cmo
+        else
+          add_test cmij cmi ;
+        Inter (1,lcases-2),(cmij,cij)
+      end else
+        Inter (-1,-1),(too_much, too_much)
+    end else
+      Inter (-1,-1),(too_much, too_much) in
+  if less2tests csep cinter then
+    sep,csep
+  else
+    inter,cinter
 
-    exports = export_idents ; 
-    export_set = Ident_set.of_list export_idents;
-    block = block;
 
-  }
-let decorate_deps modules side_effect program : J.deps_program = 
+and enum top cases =
+  let lcases = Array.length cases in
+  let lim, with_sep =
+    let best = ref (-1) and best_cost = ref (too_much,too_much) in
 
-  { program ; modules ; side_effect }
+    for i = 1 to lcases-(1) do
+      let _,left,right = coupe cases i in
+      let ci = {n=1 ; ni=0}
+      and cm = {n=1 ; ni=0}
+      and _,(cml,cleft) = opt_count false left
+      and _,(cmr,cright) = opt_count false right in
+      add_test ci cleft ;
+      add_test ci cright ;
+      if less_tests cml cmr then
+        add_test cm cmr
+      else
+        add_test cm cml ;
 
+      if
+        less2tests (cm,ci) !best_cost
+      then begin
+        if top then
+          Printf.fprintf stderr "Get it: %d\n" i ;
+        best := i ;
+        best_cost := (cm,ci)
+      end
+    done ;
+    !best, !best_cost in
 
-end
-module Js_dump : sig 
-#1 "js_dump.mli"
-(* BuckleScript compiler
- * Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * 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.
- *)
-(* Authors: Jérôme Vouillon, Hongbo Zhang  *)
+  let ilow, ihigh, with_inter =
+    if not !ok_inter then
+      let rlow = ref (-1) and rhigh = ref (-1)
+      and best_cost= ref (too_much,too_much) in
+      for i=1 to lcases-2 do
+        let low, high, inside, outside = coupe_inter i i cases in
+         if low=high then begin
+           let _,(cmi,cinside) = opt_count false inside
+           and _,(cmo,coutside) = opt_count false outside
+           and cmij = {n=1 ; ni=0}
+           and cij = {n=1 ; ni=0} in
+           add_test cij cinside ;
+           add_test cij coutside ;
+           if less_tests cmi cmo then
+             add_test cmij cmo
+           else
+             add_test cmij cmi ;
+           if less2tests (cmij,cij) !best_cost then begin
+             rlow := i ;
+             rhigh := i ;
+             best_cost := (cmij,cij)
+           end
+         end
+      done ;
+      !rlow, !rhigh, !best_cost
+    else
+      let rlow = ref (-1) and rhigh = ref (-1)
+      and best_cost= ref (too_much,too_much) in
+      for i=1 to lcases-2 do
+        for j=i to lcases-2 do
+          let low, high, inside, outside = coupe_inter i j cases in
+          let _,(cmi,cinside) = opt_count false inside
+          and _,(cmo,coutside) = opt_count false outside
+          and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
+          and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
+          add_test cij cinside ;
+          add_test cij coutside ;
+          if less_tests cmi cmo then
+            add_test cmij cmo
+          else
+            add_test cmij cmi ;
+          if less2tests (cmij,cij) !best_cost then begin
+            rlow := i ;
+            rhigh := j ;
+            best_cost := (cmij,cij)
+          end
+        done
+      done ;
+      !rlow, !rhigh, !best_cost in
+  let r = ref (Inter (ilow,ihigh)) and rc = ref with_inter in
+  if less2tests with_sep !rc then begin
+    r := Sep lim ; rc := with_sep
+  end ;
+  !r, !rc
 
+    let make_if_test test arg i ifso ifnot =
+      Arg.make_if
+        (Arg.make_prim test [arg ; Arg.make_const i])
+        ifso ifnot
 
+    let make_if_lt arg i  ifso ifnot = match i with
+    | 1 ->
+        make_if_test Arg.leint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.ltint arg i ifso ifnot
 
-(** Print JS IR to vanilla Javascript code *)
+    and make_if_le arg i ifso ifnot = match i with
+    | -1 ->
+        make_if_test Arg.ltint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.leint arg i ifso ifnot
 
+    and make_if_gt arg i  ifso ifnot = match i with
+    | -1 ->
+        make_if_test Arg.geint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.gtint arg i ifso ifnot
 
+    and make_if_ge arg i  ifso ifnot = match i with
+    | 1 ->
+        make_if_test Arg.gtint arg 0 ifso ifnot
+    | _ ->
+        make_if_test Arg.geint arg i ifso ifnot
 
-val pp_deps_program :
-  output_prefix:string ->
-  Lam_module_ident.system -> J.deps_program -> Ext_pp.t -> unit
+    and make_if_eq  arg i ifso ifnot =
+      make_if_test Arg.eqint arg i ifso ifnot
 
-val dump_deps_program :
-  output_prefix:string ->
-  Lam_module_ident.system  -> J.deps_program -> out_channel -> unit
+    and make_if_ne  arg i ifso ifnot =
+      make_if_test Arg.neint arg i ifso ifnot
 
-(** 2 functions Only used for debugging *)
-val string_of_block : J.block -> string
+    let do_make_if_out h arg ifso ifno =
+      Arg.make_if (Arg.make_isout h arg) ifso ifno
 
-val dump_program : J.program -> out_channel -> unit
+    let make_if_out ctx l d mk_ifso mk_ifno = match l with
+    | 0 ->
+        do_make_if_out
+          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
+    | _ ->
+        Arg.bind
+          (Arg.make_offset ctx.arg (-l))
+          (fun arg ->
+            let ctx = {off= (-l+ctx.off) ; arg=arg} in
+            do_make_if_out
+              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
 
-val string_of_expression : J.expression -> string
+    let do_make_if_in h arg ifso ifno =
+      Arg.make_if (Arg.make_isin h arg) ifso ifno
 
-end = struct
-#1 "js_dump.ml"
-(* BuckleScript compiler
- * Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * 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.
- *)
-(* Authors: Jérôme Vouillon, Hongbo Zhang  *)
+    let make_if_in ctx l d mk_ifso mk_ifno = match l with
+    | 0 ->
+        do_make_if_in
+          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
+    | _ ->
+        Arg.bind
+          (Arg.make_offset ctx.arg (-l))
+          (fun arg ->
+            let ctx = {off= (-l+ctx.off) ; arg=arg} in
+            do_make_if_in
+              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
 
+    let rec c_test ctx ({cases=cases ; actions=actions} as s) =
+      let lcases = Array.length cases in
+      assert(lcases > 0) ;
+      if lcases = 1 then
+        actions.(get_act cases 0) ctx
 
+      else begin
 
+        let w,c = opt_count false cases in
 (*
-  http://stackoverflow.com/questions/2846283/what-are-the-rules-for-javascripts-automatic-semicolon-insertion-asi
-  ASI catch up
-  {[
-  a=b
-  ++c
-  ---
-  a=b ++c
-  ====================
-  a ++
-  ---
-  a 
-  ++
-  ====================
-  a --
-  ---
-  a 
-  --
-  ====================
-  (continue/break/return/throw) a
-  ---
-  (continue/break/return/throw)
-  a
-  ====================
-  ]}
-
-*)
+  Printf.fprintf stderr
+  "off=%d tactic=%a for %a\n"
+  ctx.off pret w pcases cases ;
+  *)
+    match w with
+    | No -> actions.(get_act cases 0) ctx
+    | Inter (i,j) ->
+        let low,high,inside, outside = coupe_inter i j cases in
+        let _,(cinside,_) = opt_count false inside
+        and _,(coutside,_) = opt_count false outside in
+(* Costs are retrieved to put the code with more remaining tests
+   in the privileged (positive) branch of ``if'' *)
+        if low=high then begin
+          if less_tests coutside cinside then
+            make_if_eq
+              ctx.arg
+              (low+ctx.off)
+              (c_test ctx {s with cases=inside})
+              (c_test ctx {s with cases=outside})
+          else
+            make_if_ne
+              ctx.arg
+              (low+ctx.off)
+              (c_test ctx {s with cases=outside})
+              (c_test ctx {s with cases=inside})
+        end else begin
+          if less_tests coutside cinside then
+            make_if_in
+              ctx
+              (low+ctx.off)
+              (high-low)
+              (fun ctx -> c_test ctx {s with cases=inside})
+              (fun ctx -> c_test ctx {s with cases=outside})
+          else
+            make_if_out
+              ctx
+              (low+ctx.off)
+              (high-low)
+              (fun ctx -> c_test ctx {s with cases=outside})
+              (fun ctx -> c_test ctx {s with cases=inside})
+        end
+    | Sep i ->
+        let lim,left,right = coupe cases i in
+        let _,(cleft,_) = opt_count false left
+        and _,(cright,_) = opt_count false right in
+        let left = {s with cases=left}
+        and right = {s with cases=right} in
 
-(* module P = Ext_format *)
-module P = Ext_pp
-module E = Js_exp_make 
-module S = Js_stmt_make 
+        if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
+          make_if_ne
+            ctx.arg 0
+            (c_test ctx right) (c_test ctx left)
+        else if less_tests cright cleft then
+          make_if_lt
+            ctx.arg (lim+ctx.off)
+            (c_test ctx left) (c_test ctx right)
+        else
+          make_if_ge
+             ctx.arg (lim+ctx.off)
+            (c_test ctx right) (c_test ctx left)
 
-module L = struct
-  let function_ = "function"
-  let var = "var" (* should be able to switch to [let] easily*)
-  let return = "return"
-  let eq = "="
-  let require = "require"
-  let goog_require = "goog.require" 
-  let goog_module = "goog.module"
-  let lparen = "("
-  let rparen = ")"
-  let exports = "exports"
-  let dot = "."
-  let comma = ","
-  let colon = ":"
-  let throw = "throw"
-  let default = "default"
-  let length = "length"
-  let char_code_at = "charCodeAt"
-  let new_ = "new"
-  let array = "Array"
-  let question = "?"      
-  let plusplus = "++"
-  let minusminus = "--"
-  let semi = ";"
-  let else_ = "else"
-  let if_ = "if"
-  let this = "this"
-  let while_ = "while"
-  let empty_block = "empty_block"
-  let start_block = "start_block"
-  let end_block = "end_block"
-  let json = "JSON"
-  let stringify = "stringify"
-  let console = "console"
-  let define = "define"
-  let break = "break"
-  let continue = "continue"
-  let switch = "switch"
-  let strict_directive = "'use strict';"
-  let true_ = "true"
-  let false_ = "false"
-  let app = Literals.app (* curry arbitrary args *)
-  let app_array = Literals.app_array
-  let debugger = "debugger"
-  let tag = "tag"
-  let bind = "bind"
-  let math = "Math"
-  let apply = "apply"
-  let null = "null"
-  let string_cap = "String"
-  let fromCharcode = "fromCharCode"
-  let eq = "="
-  let le = "<="
-  let ge = ">="
-  let plus_plus = "++" (* FIXME: use (i = i + 1 | 0) instead *)
-  let minus_minus = "--"
-  let caml_block = "Block"
-  let caml_block_create = "__"
-end
-let return_indent = (String.length L.return / Ext_pp.indent_length) 
+  end
 
-let throw_indent = (String.length L.throw / Ext_pp.indent_length) 
 
+(* Minimal density of switches *)
+let theta = ref 0.33333
 
-let semi f = P.string f L.semi
+(* Minmal number of tests to make a switch *)
+let switch_min = ref 3
 
-let op_prec, op_str  =
-  Js_op_util.(op_prec, op_str)
+(* Particular case 0, 1, 2 *)
+let particular_case cases i j =
+  j-i = 2 &&
+  (let l1,h1,act1 = cases.(i)
+  and  l2,h2,act2 = cases.(i+1)
+  and  l3,h3,act3 = cases.(i+2) in
+  l1+1=l2 && l2+1=l3 && l3=h3 &&
+  act1 <> act3)
 
-let best_string_quote s =
-  let simple = ref 0 in
-  let double = ref 0 in
-  for i = 0 to String.length s - 1 do
-    match s.[i] with
-    | '\'' -> incr simple
-    | '"' -> incr double
-    | _ -> ()
-  done;
-  if !simple < !double
-  then '\''
-  else '"'
+let approx_count cases i j n_actions =
+  let l = j-i+1 in
+  if l < !cut then
+     let _,(_,{n=ntests}) = opt_count false (Array.sub cases i l) in
+     ntests
+  else
+    l-1
 
+(* Sends back a boolean that says whether is switch is worth or not *)
 
-(**
-   same as {!Js_dump.ident} except it generates a string instead of doing the printing
+let dense {cases=cases ; actions=actions} i j =
+  if i=j then true
+  else
+    let l,_,_ = cases.(i)
+    and _,h,_ = cases.(j) in
+    let ntests =  approx_count cases i j (Array.length actions) in
+(*
+  (ntests+1) >= theta * (h-l+1)
 *)
-let str_of_ident (cxt : Ext_pp_scope.t) (id : Ident.t)   =
-  if Ext_ident.is_js id then (* reserved by compiler *)
-     ( id.name , cxt) 
-  else 
-    (* For fast/debug mode, we can generate the name as 
-       [Printf.sprintf "%s$%d" name id.stamp] which is 
-       not relevant to the context       
-    *)    
-    let name = Ext_ident.convert true id.name in
-    let i,new_cxt = Ext_pp_scope.add_ident  id cxt in
-    (* Attention: 
-       $$Array.length, due to the fact that global module is 
-       always printed in the begining(via imports), so you get a gurantee, 
-       (global modules will not be printed as [List$1]) 
-
-       However, this means we loose the ability of dynamic loading, is it a big 
-       deal? we can fix this by a scanning first, since we already know which 
-       modules are global
-
-       check [test/test_global_print.ml] for regression
-
-    *)
-    (if i == 0 then 
-       name 
-     else
-       Printf.sprintf"%s$%d" name i), new_cxt 
-
-
-let ident (cxt : Ext_pp_scope.t) f (id : Ident.t) : Ext_pp_scope.t  =
-  let str, cxt = str_of_ident cxt id in
-  P.string f str; 
-  cxt   
-
-(** Avoid to allocate single char string too many times*)
-let array_str1 =
-  Array.init 256 (fun i -> String.make 1 (Char.chr i)) 
+    particular_case cases i j ||
+    (ntests >= !switch_min &&
+    float_of_int ntests +. 1.0 >=
+    !theta *. (float_of_int h -. float_of_int l +. 1.0))
 
-(** For conveting 
- 
+(* Compute clusters by dynamic programming
+   Adaptation of the correction to Bernstein
+   ``Correction to `Producing Good Code for the Case Statement' ''
+   S.K. Kannan and T.A. Proebsting
+   Software Practice and Exprience Vol. 24(2) 233 (Feb 1994)
 *)
-let array_conv =
-  [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "a"; "b"; "c"; "d";
-    "e"; "f"|]
-
 
+let comp_clusters ({cases=cases ; actions=actions} as s) =
+  let len = Array.length cases in
+  let min_clusters = Array.make len max_int
+  and k = Array.make len 0 in
+  let get_min i = if i < 0 then 0 else min_clusters.(i) in
 
-(* https://mathiasbynens.be/notes/javascript-escapes *)
-let pp_string f ?(quote='"') ?(utf=false) s =
-  let pp_raw_string f ?(utf=false) s = 
-    let l = String.length s in
-    for i = 0 to l - 1 do
-      let c = String.unsafe_get s i in
-      match c with
-      | '\b' -> P.string f "\\b"
-      | '\012' -> P.string f "\\f"
-      | '\n' -> P.string f "\\n"
-      | '\r' -> P.string f "\\r"
-      | '\t' -> P.string f "\\t"
-      (* This escape sequence is not supported by IE < 9
-               | '\011' -> "\\v"
-         IE < 9 treats '\v' as 'v' instead of a vertical tab ('\x0B'). 
-         If cross-browser compatibility is a concern, use \x0B instead of \v.
+  for i = 0 to len-1 do
+    for j = 0 to i do
+      if
+        dense s j i &&
+        get_min (j-1) + 1 < min_clusters.(i)
+      then begin
+        k.(i) <- j ;
+        min_clusters.(i) <- get_min (j-1) + 1
+      end
+    done ;
+  done ;
+  min_clusters.(len-1),k
 
-         Another thing to note is that the \v and \0 escapes are not allowed in JSON strings.
-      *)
-      | '\000' when i = l - 1 || (let next = String.unsafe_get s (i + 1) in (next < '0' || next > '9'))
-        -> P.string f "\\0"
+(* Assume j > i *)
+let make_switch  {cases=cases ; actions=actions} i j =
+  let ll,_,_ = cases.(i)
+  and _,hh,_ = cases.(j) in
+  let tbl = Array.make (hh-ll+1) 0
+  and t = Hashtbl.create 17
+  and index = ref 0 in
+  let get_index act =
+    try
+      Hashtbl.find t act
+    with
+    | Not_found ->
+        let i = !index in
+        incr index ;
+        Hashtbl.add t act i ;
+        i in
 
-      | '\\' when not utf -> P.string f "\\\\"
+  for k=i to j do
+    let l,h,act = cases.(k) in
+    let index = get_index act in
+    for kk=l-ll to h-ll do
+      tbl.(kk) <- index
+    done
+  done ;
+  let acts = Array.make !index actions.(0) in
+  Hashtbl.iter
+    (fun act i -> acts.(i) <- actions.(act))
+    t ;
+  (fun ctx ->
+    match -ll-ctx.off with
+    | 0 -> Arg.make_switch ctx.arg tbl acts
+    | _ ->
+        Arg.bind
+          (Arg.make_offset ctx.arg (-ll-ctx.off))
+          (fun arg -> Arg.make_switch arg tbl acts))
 
 
-      | '\000' .. '\031'  | '\127'->
-        let c = Char.code c in
-        P.string f "\\x";
-        P.string f (Array.unsafe_get array_conv (c lsr 4));
-        P.string f (Array.unsafe_get array_conv (c land 0xf))
-      | '\128' .. '\255' when not utf ->
-        let c = Char.code c in
-        P.string f "\\x";
-        P.string f (Array.unsafe_get array_conv (c lsr 4));
-        P.string f (Array.unsafe_get array_conv (c land 0xf))
-      (* | '\'' -> P.string f "\\'" *)
-      (* | '\"' -> P.string f "\\\"" *)
-      | _ ->
-        begin 
-          (if c = quote  then
-             P.string f "\\");           
-          P.string f (Array.unsafe_get array_str1 (Char.code c))
-        end
-    done
-  in
-  let quote_s = String.make 1 quote in
-  P.string f quote_s;
-  pp_raw_string f ~utf s ;
-  P.string f quote_s
-;;
+let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
+  let len = Array.length cases in
+  let r = Array.make n_clusters (0,0,0)
+  and t = Hashtbl.create 17
+  and index = ref 0
+  and bidon = ref (Array.length actions) in
+  let get_index act =
+    try
+      let i,_ = Hashtbl.find t act in
+      i
+    with
+    | Not_found ->
+        let i = !index in
+        incr index ;
+        Hashtbl.add
+          t act
+          (i,(fun _ -> actions.(act))) ;
+        i
+  and add_index act =
+    let i = !index in
+    incr index ;
+    incr bidon ;
+    Hashtbl.add t !bidon (i,act) ;
+    i in
 
-let property_string f s = 
-  if Ext_ident.property_no_need_convert s  then 
-    P.string f s
-  else 
-    pp_string f ~utf:true ~quote:(best_string_quote s) s
+  let rec zyva j ir =
+    let i = k.(j) in
+    begin if i=j then
+      let l,h,act = cases.(i) in
+      r.(ir) <- (l,h,get_index act)
+    else (* assert i < j *)
+      let l,_,_ = cases.(i)
+      and _,h,_ = cases.(j) in
+      r.(ir) <- (l,h,add_index (make_switch s i j))
+    end ;
+    if i > 0 then zyva (i-1) (ir-1) in
 
-(* TODO: check utf's correct semantics *)
-let pp_quote_string f s = 
-  pp_string f ~utf:false ~quote:(best_string_quote s ) s 
+  zyva (len-1) (n_clusters-1) ;
+  let acts = Array.make !index (fun _ -> assert false) in
+  Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
+  {cases = r ; actions = acts}
+;;
 
-let rec comma_idents  cxt f (ls : Ident.t list)  =
-  match ls with
-  | [] -> cxt
-  | [x] -> ident cxt f x
-  | y :: ys ->
-    let cxt = ident cxt f y in
-    P.string f L.comma;
-    comma_idents cxt f ys  
-let ipp_ident cxt f id un_used = 
-  if un_used then 
-    ident cxt f (Ext_ident.make_unused ())
-  else 
-    ident cxt f id  
-let rec formal_parameter_list cxt (f : P.t) method_ l env =
-  let offset = if method_ then 1 else 0 in   
-  let rec aux i cxt l = 
-    match l with
-    | []     -> cxt
-    | [id]    -> ipp_ident cxt f id (Js_fun_env.get_unused env i)
-    | id :: r -> 
-      let cxt = ipp_ident cxt f id (Js_fun_env.get_unused env i) in
-      P.string f L.comma; P.space f;
-      aux (i + 1) cxt  r
-  in
-  match l with 
-  | [] -> cxt 
-  | [i] -> 
-    (** necessary, since some js libraries like [mocha]...*)
-    if Js_fun_env.get_unused env offset then cxt else ident cxt f i 
-  | _ -> 
-    aux offset cxt l  
 
+let do_zyva (low,high) arg cases actions =
+  let old_ok = !ok_inter in
+  ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
+  if !ok_inter <> old_ok then Hashtbl.clear t ;
 
-(* IdentMap *)
+  let s = {cases=cases ; actions=actions} in
 (*
-f/122 --> 
-  f/122 is in the map 
-  if in, use the old mapping
-  else 
-    check  f,
-     if in last bumped id
-     else 
-        use "f", register it 
-
-  check "f"       
-         if not , use "f", register stamp -> 0 
-         else 
-           check stamp 
-             if in  use it 
-             else check last bumped id, increase it and register
+  Printf.eprintf "ZYVA: %b\n" !ok_inter ;
+  pcases stderr cases ;
+  prerr_endline "" ;
 *)
-type name =
-  | No_name
-  | Name_top  of Ident.t
-  | Name_non_top of Ident.t
-
+  let n_clusters,k = comp_clusters s in
+  let clusters = make_clusters s n_clusters k in
+  let r = c_test {arg=arg ; off=0} clusters in
+  r
 
-(* TODO: refactoring 
-   Note that {!pp_function} could print both statement and expression when [No_name] is given 
-*)
-let rec pp_function method_
-    cxt (f : P.t) ?(name=No_name)  return 
-    (l : Ident.t list) (b : J.block) (env : Js_fun_env.t ) =  
-  match b, (name,  return)  with 
-  | [ {statement_desc =
-         Return {return_value = 
-                   {expression_desc = 
-                      Call(({expression_desc = Var v ; _} as function_), 
-                           ls , 
-                           {arity = ( Full | NA as arity(* see #234*)); 
-                            (* TODO: need a case to justify it*)
-                            call_info = 
-                              (Call_builtin_runtime | Call_ml )})}}}],
-    ((_, false) | (No_name, true))  
-    when
-      not method_ && 
-      Ext_list.for_all2_no_exn (fun a b -> 
-          match b.J.expression_desc with 
-          | Var (Id i) -> Ident.same a i 
-          | _ -> false) l ls ->
-    let optimize  len p cxt f v =
-      if p then
-        begin           
-          P.string f Js_config.curry;
-          P.string f L.dot;
-          P.string f "__";
-          P.string f (Printf.sprintf "%d" len);
-          P.paren_group f 1 (fun _ -> arguments cxt f [function_])            
-        end              
-      else
-        vident cxt f v
-    in
-    let len = List.length l in (* length *)           
-    begin match name with 
-      | Name_top i | Name_non_top i  -> 
-        P.string f L.var; 
-        P.space f ; 
-        let cxt = ident cxt f i in
-        P.space f ;
-        P.string f L.eq;
-        P.space f ;
-        let cxt = optimize len (arity = NA && len <= 8) cxt f v in 
-        semi f ;
-        cxt
-      | No_name ->
-        if return then 
-          begin 
-            P.string f L.return ;
-            P.space f;
-          end;
-        optimize len (arity = NA && len <=8) cxt f v 
-    end
-  | _, _  -> 
+let abstract_shared actions =
+  let handlers = ref (fun x -> x) in
+  let actions =
+    Array.map
+      (fun act -> match  act with
+      | Single act -> act
+      | Shared act ->
+          let i,h = Arg.make_catch act in
+          let oh = !handlers in
+          handlers := (fun act -> h (oh act)) ;
+          Arg.make_exit i)
+      actions in
+  !handlers,actions
 
-    let set_env : Ident_set.t = (** identifiers will be printed following*)
-      match name with 
-      | No_name ->
-        Js_fun_env.get_unbounded env 
-      | Name_top id | Name_non_top id -> Ident_set.add id (Js_fun_env.get_unbounded env )
-    in
-    (* the context will be continued after this function *)
-    let outer_cxt = Ext_pp_scope.merge set_env cxt in  
+let zyva lh arg cases actions =
+  let actions = actions.act_get_shared () in
+  let hs,actions = abstract_shared actions in
+  hs (do_zyva lh arg cases actions)
 
-    (* the context used to be printed inside this function
+and test_sequence arg cases actions =
+  let actions = actions.act_get_shared () in
+  let hs,actions = abstract_shared actions in
+  let old_ok = !ok_inter in
+  ok_inter := false ;
+  if !ok_inter <> old_ok then Hashtbl.clear t ;
+  let s =
+    {cases=cases ;
+    actions=Array.map (fun act -> (fun _ -> act)) actions} in
+(*
+  Printf.eprintf "SEQUENCE: %b\n" !ok_inter ;
+  pcases stderr cases ;
+  prerr_endline "" ;
+*)
+  hs (c_test {arg=arg ; off=0} s)
+;;
 
-       when printing a function, 
-       only the enclosed variables and function name matters, 
-       if the function does not capture any variable, then the context is empty     
-    *)
-    let inner_cxt = Ext_pp_scope.sub_scope outer_cxt set_env in
+end
 
+end
+module Typeopt : sig 
+#1 "typeopt.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-    (* (if not @@ Js_fun_env.is_empty env then *)
-    (* pp_comment  f (Some (Js_fun_env.to_string env))) ; *)
-    let param_body () = 
-      if method_ then begin
-        let cxt = P.paren_group f 1 (fun _ -> 
-            formal_parameter_list inner_cxt  f method_ (List.tl l) env )
-        in
-        P.space f ;
-        ignore @@ P.brace_vgroup f 1 (fun _ ->
-            let cxt =
-              if not (Js_fun_env.get_unused env 0) then
-                begin               
-                  P.string f L.var ; 
-                  P.space f; 
-                  let cxt = ident cxt f (List.hd l) in 
-                  P.space f ; 
-                  P.string f L.eq ; 
-                  P.space f ;
-                  P.string f L.this;
-                  P.space f ; 
-                  semi f ;
-                  P.newline f ;
-                  cxt ;                
-                end
-              else
-                cxt
-            in
-            statement_list false cxt f b 
-          );
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
 
-      end
-      else begin  
-        let cxt = P.paren_group f 1 (fun _ -> 
-            formal_parameter_list inner_cxt  f method_ l env )
-        in
-        P.space f ;
-        ignore @@ P.brace_vgroup f 1 (fun _ -> statement_list false cxt f b );
-      end
-    in
-    let lexical = Js_fun_env.get_lexical_scope env in
-    let enclose  lexical  return = 
-        let handle lexical = 
-          if  Ident_set.is_empty lexical  
-          then
-            begin 
-              if return then 
-                begin 
-                  P.string f L.return ;
-                  P.space f
-                end ;
+val has_base_type : Typedtree.expression -> Path.t -> bool
+val maybe_pointer : Typedtree.expression -> bool
+val array_kind : Typedtree.expression -> Lambda.array_kind
+val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
+val bigarray_kind_and_layout :
+      Typedtree.expression -> Lambda.bigarray_kind * Lambda.bigarray_layout
 
-              begin match name with 
-              | No_name -> 
-                P.string f L.function_;
-                P.space f ;
-                param_body ();
-                (* semi f ; *)
-              | Name_non_top x  -> 
-                P.string f L.var ;
-                P.space f ; 
-                ignore @@ ident inner_cxt f x ; 
-                P.space f ;
-                P.string f L.eq ;
-                P.space f ; 
-                P.string f L.function_;
-                P.space f ;
-                param_body ();
-                semi f ;
-              | Name_top x  -> 
-                P.string f L.function_;
-                P.space f ;
-                ignore (ident inner_cxt f x);
-                param_body ();
-              end;
-          end
-          else
-            (* print as 
-               {[(function(x,y){...} (x,y))]}           
-            *)
-            let lexical = Ident_set.elements lexical in
-            (if return then
-               begin 
-                 P.string f L.return ; 
-                 P.space f
-               end
-             else 
-               begin match name with
-                 | No_name -> ()
-                 | Name_non_top name | Name_top name->
-                   P.string f L.var;
-                   P.space f;
-                   ignore @@ ident inner_cxt f name ;
-                   P.space f ;
-                   P.string f L.eq;
-                   P.space f ;
-               end
-            )   
-            ;
-            P.string f L.lparen;
-            P.string f L.function_; 
-            P.string f L.lparen;
-            ignore @@ comma_idents inner_cxt f lexical;
-            P.string f L.rparen;
-            P.brace_vgroup f 0  (fun _ -> 
-                begin 
-                  P.string f L.return ;
-                  P.space f;
-                  P.string f L.function_;
-                  P.space f ;
-                  (match name with 
-                   | No_name  -> () 
-                   | Name_non_top x | Name_top x -> ignore (ident inner_cxt f x));
-                  param_body ()
-                end);
-            P.string f L.lparen;
-            ignore @@ comma_idents inner_cxt f lexical;
-            P.string f L.rparen;
-            P.string f L.rparen;
-            begin match name with 
-              | No_name -> () (* expression *)
-              | _ -> semi f (* has binding, a statement *)
-            end
-        in 
-        begin match name with 
-          | Name_top name | Name_non_top name  when Ident_set.mem name lexical ->
-            (*TODO: when calculating lexical we should not include itself *)
-            let lexical =  (Ident_set.remove name lexical) in
-            handle lexical
-          | _ -> handle lexical 
-        end
-    in
-    enclose lexical return 
-    ;
-    outer_cxt
+end = struct
+#1 "typeopt.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+(* Auxiliaries for type-based optimizations, e.g. array kinds *)
 
-(* Assume the cond would not change the context, 
-    since it can be either [int] or [string]
- *)
-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) -> 
-  let cxt = 
-    P.group f 1 @@ fun _ -> 
-      P.group f 1 @@ (fun _ -> 
-        P.string f "case ";
-        pp_cond  f e;
-        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
-  in
-  P.newline f;
-  cxt 
+open Path
+open Types
+open Typedtree
+open Lambda
 
-and loop  :  'a . Ext_pp_scope.t ->
-  P.t -> (P.t -> 'a -> unit) -> 'a J.case_clause list -> Ext_pp_scope.t
-      = fun  cxt  f pp_cond cases ->
-  match cases with 
-  | [] -> cxt 
-  | [x] -> output_one cxt f pp_cond x
-  | x::xs ->
-      let cxt = output_one cxt f pp_cond x 
-      in loop  cxt f pp_cond  xs 
+let scrape env ty =
+  (Ctype.repr (Ctype.expand_head_opt env (Ctype.correct_levels ty))).desc
 
-and vident cxt f  (v : J.vident) =
-  begin match v with 
-  | Id v | Qualified(v, _, None) ->  
-      ident cxt f v
-  | Qualified (id,_, Some name) ->
-      let cxt = ident cxt f id in
-      P.string f L.dot;
-      P.string f (Ext_ident.convert true name);
-      cxt
-  end
+let has_base_type exp base_ty_path =
+  match scrape exp.exp_env exp.exp_type with
+  | Tconstr(p, _, _) -> Path.same p base_ty_path
+  | _ -> false
 
-and expression l cxt  f (exp : J.expression) : Ext_pp_scope.t = 
-  pp_comment_option f exp.comment ;
-  expression_desc cxt l f exp.expression_desc
+let maybe_pointer exp =
+  match scrape exp.exp_env exp.exp_type with
+  | Tconstr(p, args, abbrev) ->
+      not (Path.same p Predef.path_int) &&
+      not (Path.same p Predef.path_char) &&
+      begin try
+        match Env.find_type p exp.exp_env with
+        | {type_kind = Type_variant []} -> true (* type exn *)
+        | {type_kind = Type_variant cstrs} ->
+            List.exists (fun c -> c.Types.cd_args <> []) cstrs
+        | _ -> true
+      with Not_found -> true
+        (* This can happen due to e.g. missing -I options,
+           causing some .cmi files to be unavailable.
+           Maybe we should emit a warning. *)
+      end
+  | _ -> true
 
-and
-  expression_desc cxt (l:int) f x : Ext_pp_scope.t  =
-  match x with
-  | Var v ->
-    vident cxt f v 
-  | Bool b -> 
-    (if  b then P.string f L.true_ else P.string f L.false_ ) ; cxt 
-  | Seq (e1, e2) ->
-    let action () = 
-      let cxt = expression 0 cxt f e1 in
-      P.string f L.comma ;
-      P.space f ;
-      expression 0 cxt f e2  in
-    if l > 0 then 
-      P.paren_group f 1 action
-    else action ()
+let array_element_kind env ty =
+  match scrape env ty with
+  | Tvar _ | Tunivar _ ->
+      Pgenarray
+  | Tconstr(p, args, abbrev) ->
+      if Path.same p Predef.path_int || Path.same p Predef.path_char then
+        Pintarray
+      else if Path.same p Predef.path_float then
+        Pfloatarray
+      else if Path.same p Predef.path_string
+           || Path.same p Predef.path_array
+           || Path.same p Predef.path_nativeint
+           || Path.same p Predef.path_int32
+           || Path.same p Predef.path_int64 then
+        Paddrarray
+      else begin
+        try
+          match Env.find_type p env with
+            {type_kind = Type_abstract} ->
+              Pgenarray
+          | {type_kind = Type_variant cstrs}
+            when List.for_all (fun c -> c.Types.cd_args = []) cstrs ->
+              Pintarray
+          | {type_kind = _} ->
+              Paddrarray
+        with Not_found ->
+          (* This can happen due to e.g. missing -I options,
+             causing some .cmi files to be unavailable.
+             Maybe we should emit a warning. *)
+          Pgenarray
+      end
+  | _ ->
+      Paddrarray
 
-  | Fun (method_, l, b, env) ->  (* TODO: dump for comments *)
-      pp_function method_ cxt f false  l b env
-  (* TODO: 
-     when [e] is [Js_raw_code] with arity
-     print it in a more precise way
-     It seems the optimizer already did work to make sure
-     {[
-       Call (Raw_js_code (s, Exp i), el, {Full})
-         when List.length el = i
-     ]}
-  *)
+let array_kind_gen ty env =
+  match scrape env ty with
+  | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
+    when Path.same p Predef.path_array ->
+      array_element_kind env elt_ty
+  | _ ->
+      (* This can happen with e.g. Obj.field *)
+      Pgenarray
 
-  | Call (e, el, info) ->
-    let action () = 
-      P.group f 1 (fun _ -> 
-          match info, el  with
-          | {arity  = Full }, _ 
-          | _, [] -> 
-            let cxt = expression 15 cxt f e in 
-            P.paren_group f 1 (fun _ -> arguments cxt  f el )  
+let array_kind exp = array_kind_gen exp.exp_type exp.exp_env
 
-          | _ , _ -> 
-            (* ipp_comment f (Some "!") *)
-            P.string f  Js_config.curry; 
-            P.string f L.dot;
-            let len = List.length el in
-            if 1 <= len && len <= 8 then  
-              begin
-                P.string f L.app;
-                P.string f (Printf.sprintf "%d" len);
-                P.paren_group f 1 (fun _ -> arguments cxt f (e::el))
-              end
-            else 
-              begin 
-                P.string f  L.app_array;                
-                P.paren_group f 1 (fun _ -> arguments cxt f [ e ; E.arr Mutable el])
-              end)
-    in
-    if l > 15 then P.paren_group f 1 action   
-    else action ()
-  | Bind (a,b) -> 
-    (* a.bind(b)
-       {[ fun b -> a.bind(b) ==? a.bind ]}
-    *)
-    begin
-      expression_desc cxt l f  
-        (Call ({expression_desc = Dot(a,L.bind, true); comment = None }, [b], 
-               {arity = Full; call_info = Call_na}))
-    end    
+let array_pattern_kind pat = array_kind_gen pat.pat_type pat.pat_env
 
-  | FlatCall(e,el) -> 
-    P.group f 1 (fun _ -> 
-        let cxt = expression 15 cxt f e in
-        P.string f L.dot; 
-        P.string f L.apply;
-        P.paren_group f 1 (fun _ ->
-            P.string f L.null;
-            P.string f L.comma;
-            P.space f ; 
-            expression 1 cxt f el
-          )
-      )
-  | String_of_small_int_array ({expression_desc = desc } as e) -> 
-    let action () = 
-      P.group f 1 (fun _ -> 
-          P.string f L.string_cap; 
-          P.string f L.dot ;
-          P.string f L.fromCharcode;
-          begin match desc with 
-            | Array (el, _mutable)
-              ->
-              P.paren_group f 1 (fun _ -> arguments cxt f el)
-            | _ -> 
-              P.string f L.dot ;
-              P.string f L.apply; 
-              P.paren_group f 1 (fun _ -> 
-                  P.string f L.null;
-                  P.string f L.comma;
-                  expression 1 cxt  f e  )
-          end ) 
-    in
-      if l > 15 then P.paren_group f 1 action   
-      else action ()
+let bigarray_decode_type env ty tbl dfl =
+  match scrape env ty with
+  | Tconstr(Pdot(Pident mod_id, type_name, _), [], _)
+    when Ident.name mod_id = "Bigarray" ->
+      begin try List.assoc type_name tbl with Not_found -> dfl end
+  | _ ->
+      dfl
 
+let kind_table =
+  ["float32_elt", Pbigarray_float32;
+   "float64_elt", Pbigarray_float64;
+   "int8_signed_elt", Pbigarray_sint8;
+   "int8_unsigned_elt", Pbigarray_uint8;
+   "int16_signed_elt", Pbigarray_sint16;
+   "int16_unsigned_elt", Pbigarray_uint16;
+   "int32_elt", Pbigarray_int32;
+   "int64_elt", Pbigarray_int64;
+   "int_elt", Pbigarray_caml_int;
+   "nativeint_elt", Pbigarray_native_int;
+   "complex32_elt", Pbigarray_complex32;
+   "complex64_elt", Pbigarray_complex64]
 
-  | Array_append (e, el) -> 
-    P.group f 1 (fun _ -> 
-        let cxt = expression 15 cxt f e in
-        P.string f ".concat";
-        P.paren_group f 1 (fun _ -> arguments cxt f [el]))
+let layout_table =
+  ["c_layout", Pbigarray_c_layout;
+   "fortran_layout", Pbigarray_fortran_layout]
 
-  | Array_copy e -> 
-    P.group f 1 (fun _ -> 
-        let cxt = expression 15 cxt f e in
-        P.string f ".slice";
-        P.string f "()" ;
-        cxt 
-      )
+let bigarray_kind_and_layout exp =
+  match scrape exp.exp_env exp.exp_type with
+  | Tconstr(p, [caml_type; elt_type; layout_type], abbrev) ->
+      (bigarray_decode_type exp.exp_env elt_type kind_table Pbigarray_unknown,
+       bigarray_decode_type exp.exp_env layout_type layout_table
+                            Pbigarray_unknown_layout)
+  | _ ->
+      (Pbigarray_unknown, Pbigarray_unknown_layout)
 
-  | Dump (level, el) -> 
-    let obj = 
-      match level with 
-      | Log -> "log"
-      | Info -> "info"
-      | Warn -> "warn"
-      | Error -> "error" in
-    P.group f 1 (fun _ -> 
-        P.string f L.console;
-        P.string f L.dot;
-        P.string f obj ;
-        P.paren_group f 1 (fun _ -> arguments cxt f el))
-  | Json_stringify e 
-    -> 
-    P.group f 1 (fun _ -> 
-        P.string f L.json ;
-        P.string f L.dot;
-        P.string f L.stringify; 
-        P.paren_group f 1 (fun _ -> expression 0 cxt f e )        
-      )    
-  | Char_to_int e -> 
-    begin match e.expression_desc with 
-      | String_access (a,b) -> 
-        P.group f 1 (fun _ -> 
-            let cxt = expression 15 cxt f a in
-            P.string f L.dot;
-            P.string f L.char_code_at;
-            P.paren_group f 1 (fun _ -> expression 0 cxt f b);
-          )
-      | _ -> 
-        P.group f 1 (fun _ -> 
-            let cxt = expression 15 cxt f e in
-            P.string f L.dot;
-            P.string f L.char_code_at;
-            P.string f "(0)";
-            cxt)
-    end
+end
+module Matching : sig 
+#1 "matching.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-  | Char_of_int e -> 
-    P.group f 1 (fun _ -> 
-        P.string f L.string_cap;
-        P.string f L.dot;
-        P.string f L.fromCharcode;
-        P.paren_group f 1 (fun _ -> arguments cxt f [e])
-      )
+(* Compilation of pattern-matching *)
 
+open Typedtree
+open Lambda
 
-  | Math (name, el) -> 
-    P.group f 1 (fun _ ->
-        P.string f L.math;
-        P.string f L.dot;
-        P.string f name;
-        P.paren_group f 1 (fun _ -> arguments cxt f el)
-      )
 
-  | Str (_, s) ->
-    (*TODO --
-       when utf8-> it will not escape '\\' which is definitely not we want
-     *)
-    let quote = best_string_quote s in 
-    pp_string f (* ~utf:(kind = `Utf8) *) ~quote s; cxt 
-  | Raw_js_code (s,info) -> 
-    begin match info with 
-    | Exp -> 
-      P.string f "("; 
-      P.string f s ; 
-      P.string f ")";
-      cxt 
-    | Stmt -> 
-      P.newline f  ;
-      P.string f s ;
-      P.newline f ;
-      cxt 
-    end
-  | Number v ->
-    let s = 
-      match v with 
-      | Float {f = v} -> 
-        Js_number.caml_float_literal_to_js_string v 
-       (* attach string here for float constant folding?*)
-      | Int { i = v; _} 
-        -> Int32.to_string v (* check , js convention with ocaml lexical convention *)
-      | Uint i
-        -> Format.asprintf "%lu" i              
-      | Nint i -> Nativeint.to_string i 
-    in
-    let need_paren =
-      if s.[0] = '-'
-      then l > 13  (* Negative numbers may need to be parenthesized. *)
-      else l = 15  (* Parenthesize as well when followed by a dot. *)
-           && s.[0] <> 'I' (* Infinity *)
-           && s.[0] <> 'N' (* NaN *)
-    in
-    let action = fun _ -> P.string f s  in
-    (
-      if need_paren 
-      then P.paren f  action
-      else action ()
-    ); 
-    cxt 
-  | J.Anything_to_number e 
-  | Int_of_boolean e -> 
-    let action () = 
-      P.group f 0 @@ fun _ -> 
-        P.string f "+" ;
-        expression 13 cxt f e 
-    in
-    (* need to tweak precedence carefully 
-       here [++x --> +(+x)]
-    *)
-    if l > 12 
-    then P.paren_group f 1 action 
-    else action ()
-  | Caml_not e ->
-    expression_desc cxt l f (Bin (Minus, E.one_int_literal, e))
+(* Entry points to match compiler *)
+val for_function:
+        Location.t -> int ref option -> lambda -> (pattern * lambda) list ->
+        partial -> lambda
+val for_trywith:
+        lambda -> (pattern * lambda) list -> lambda
+val for_let:
+        Location.t -> lambda -> pattern -> lambda -> lambda
+val for_multiple_match:
+        Location.t -> lambda list -> (pattern * lambda) list -> partial ->
+        lambda
 
-  | Js_not e ->
-    let action () = 
-      P.string f "!" ;
-      expression 13 cxt f e 
-    in
-    if l > 13 
-    then P.paren_group f 1 action 
-    else action ()
-  | Typeof e 
-    -> 
-    P.string f "typeof"; 
-    P.space f;
-    expression 13 cxt f e     
-  | Caml_block_set_tag(a,b) -> 
-    expression_desc cxt l f 
-      (Bin(Eq, 
-           {expression_desc = Caml_block_tag a; comment = None},
-           b
-          ))
-  | Caml_block_set_length(a,b) -> 
-    expression_desc cxt l f 
-      (Bin(Eq, 
-           {expression_desc = Length (a,Caml_block); comment = None},
-           b
-          ))
-  | Bin (Eq, {expression_desc = Var i },
-         {expression_desc = 
-            (
-              Bin(
-                (Plus as op), {expression_desc = Var j}, delta)
-            | Bin(
-                (Plus as op), delta, {expression_desc = Var j})
-            | Bin(
-                (Minus as op), {expression_desc = Var j}, delta)
-            )
-         })
-    when Js_op_util.same_vident i j -> 
-    (* TODO: parenthesize when necessary *)
-    begin match delta, op with 
-      | {expression_desc = Number (Int { i =  1l; _})}, Plus
-        (* TODO: float 1. instead, 
-             since in JS, ++ is a float operation           
-        *)        
-      | {expression_desc = Number (Int { i =  -1l; _})}, Minus
-        ->
-        P.string f L.plusplus;
-        P.space f ; 
-        vident cxt f i
+val for_tupled_function:
+        Location.t -> Ident.t list -> (pattern list * lambda) list ->
+        partial -> lambda
 
-      | {expression_desc = Number (Int { i =  -1l; _})}, Plus
-      | {expression_desc = Number (Int { i =  1l; _})}, Minus
-        -> 
-        P.string f L.minusminus; 
-        P.space f ; 
-        vident cxt f i;
-      | _, _ -> 
-        let cxt = vident cxt f i in
-        P.space f ;
-        if op = Plus then P.string f "+=" 
-        else P.string f "-=";
-        P.space f ; 
-        expression 13 cxt  f delta
-    end
-  | Bin (Eq, {expression_desc = Access({expression_desc = Var i; _},
-                                       {expression_desc = Number (Int {i = k0 })}
-                                      ) },
-         {expression_desc = 
-            (Bin((Plus as op), 
-                 {expression_desc = Access(
-                      {expression_desc = Var j; _},
-                      {expression_desc = Number (Int {i = k1; })}
-                    ); _}, delta)
-            | Bin((Plus as op), delta,
-                  {expression_desc = Access(
-                       {expression_desc = Var j; _},
-                       {expression_desc = Number (Int {i = k1; })}
-                     ); _})
-            | Bin((Minus as op), 
-                  {expression_desc = Access(
-                       {expression_desc = Var j; _},
-                       {expression_desc = Number (Int {i = k1; })}
-                     ); _}, delta)
+exception Cannot_flatten
 
-            )})
-    when  k0 = k1 && Js_op_util.same_vident i j 
-    (* Note that 
-       {[x = x + 1]}
-       is exactly the same  (side effect, and return value)
-       as {[ ++ x]}
-       same to 
-       {[ x = x + a]}
-       {[ x += a ]}
-       they both return the modified value too
-    *)
-    (* TODO:
-       handle parens..
-    *)
-    ->
-    let aux cxt f vid i = 
-      let cxt = vident cxt f vid in
-      P.string f "[";
-      P.string f (Int32.to_string  i);
-      P.string f"]"; 
-      cxt in
-    (** TODO: parenthesize when necessary *)
+val flatten_pattern: int -> pattern -> pattern list
 
-    begin match delta, op with 
-      | {expression_desc = Number (Int { i =  1l; _})}, Plus
-      | {expression_desc = Number (Int { i =  -1l; _})}, Minus
-        ->
-        P.string f L.plusplus;
-        P.space f ; 
-        aux cxt f i k0
-      | {expression_desc = Number (Int { i =  -1l; _})}, Plus
-      | {expression_desc = Number (Int { i =  1l; _})}, Minus
-        -> 
-        P.string f L.minusminus; 
-        P.space f ; 
-        aux cxt f  i k0
-      | _, _ -> 
-        let cxt = aux cxt f i k0 in
-        P.space f ;
-        if op = Plus then P.string f "+=" 
-        else P.string f "-=";
-        P.space f ; 
-        expression 13 cxt  f delta
-    end
-  | Anything_to_string e -> 
-    (* Note that we should not apply any smart construtor here, 
-       it's purely  a convenice for pretty-printing
-    *)    
-    expression_desc cxt l f (Bin (Plus, {expression_desc = Str (true,""); comment = None}, e))    
+(* Expand stringswitch to  string test tree *)
+val expand_stringswitch:
+    Location.t -> lambda -> (string * lambda) list -> lambda option -> lambda
 
-  | Bin (Minus, {expression_desc = Number (Int {i=0l;_} | Float {f = "0."})}, e) 
-      (* TODO:
-         Handle multiple cases like
-         {[ 0. - x ]}
-         {[ 0.00 - x ]}
-         {[ 0.000 - x ]}
-       *)
-    ->
-    let action () = 
-      P.string f "-" ;
-      expression 13 cxt f e 
-    in
-    if l > 13 then P.paren_group f 1 action 
-    else action ()
+val inline_lazy_force : lambda -> Location.t -> lambda
 
-  | Bin (op, e1, e2) ->
-    let (out, lft, rght) = op_prec op in
-    let need_paren =
-      l > out || (match op with Lsl | Lsr | Asr -> true | _ -> false) in
+end = struct
+#1 "matching.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-    let action () = 
-      (* We are more conservative here, to make the generated code more readable
-          to the user
-       *)
+(* Compilation of pattern matching *)
 
-      let cxt = expression lft cxt  f e1 in
-      P.space f; 
-      P.string f (op_str op);
-      P.space f;
-      expression rght cxt   f e2 
-    in
-    if need_paren 
-    then P.paren_group f 1 action 
-    else action ()
+open Misc
+open Asttypes
+open Primitive
+open Types
+open Typedtree
+open Lambda
+open Parmatch
+open Printf
 
-  | String_append (e1, e2) -> 
-    let op : Js_op.binop = Plus in
-    let (out, lft, rght) = op_prec op in
-    let need_paren =
-      l > out || (match op with Lsl | Lsr | Asr -> true | _ -> false) in
 
-    let action () = 
-      let cxt = expression  lft cxt f e1 in
-      P.space f ;
-      P.string f "+";
-      P.space f;
-      expression rght  cxt   f e2 
-    in
-    if need_paren then P.paren_group f 1 action else action ()
+let dbg = false
 
-  | Array (el,_) ->
-    (** TODO: simplify for singleton list *)
-    begin match el with 
-      | []| [ _ ] -> P.bracket_group f 1 @@ fun _ -> array_element_list  cxt f el 
-      | _ -> P.bracket_vgroup f 1 @@ fun _ -> array_element_list  cxt f el 
-    end
-  | Caml_uninitialized_obj (tag, size) 
-    ->  (* FIXME *)
-    expression_desc cxt l f (Object [Length, size ; Tag, tag])    
-  | Caml_block( el, mutable_flag, tag, tag_info) 
-    -> 
-    (* Note that, if we ignore more than tag [0] we loose some information 
-       with regard tag  *)
-    begin match tag.expression_desc, tag_info with 
+(*  See Peyton-Jones, ``The Implementation of functional programming
+    languages'', chapter 5. *)
+(*
+  Bon, au commencement du monde c'etait vrai.
+  Now, see Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001
+*)
 
-    | 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.arr mutable_flag el])
-    end
-  | Caml_block_tag e ->
-    P.group f 1 (fun _ ->  
-        let cxt = expression 15 cxt f  e in
-        P.string f L.dot ;
-        P.string f L.tag ;
-        cxt)
-  | Access (e, e') 
+(*
+   Many functions on the various data structures of the algorithm :
+     - Pattern matrices.
+     - Default environments: mapping from matrices to exit numbers.
+     - Contexts:  matrices whose column are partitioned into
+       left and right.
+     - Jump summaries: mapping from exit numbers to contexts
+*)
+
+let string_of_lam lam =
+  Printlambda.lambda Format.str_formatter lam ;
+  Format.flush_str_formatter ()
 
-  | String_access (e,e')
-    ->
-    let action () = 
-      P.group f 1 @@ fun _ -> 
-        let cxt = expression 15 cxt f e in
-        P.bracket_group f 1 @@ fun _ -> 
-          expression 0 cxt f e' 
-    in
-    if l > 15 then P.paren_group f 1 action else action ()
+type matrix = pattern list list
 
-  | Length (e, _) -> 
-    let action () =  (** Todo: check parens *)
-      let cxt = expression 15 cxt f e in
-      P.string f L.dot;
-      P.string f L.length;
-      cxt  in
-    if l > 15 then P.paren_group f 1 action else action ()
+let add_omega_column pss = List.map (fun ps -> omega::ps) pss
 
-  | Dot (e, s,normal) ->
-    let action () = 
-      let cxt = expression 15 cxt f e in
-      if Ext_ident.property_no_need_convert s  then
-        begin 
-          P.string f L.dot;
-          P.string f s; 
-        end
-      else
-        begin 
-          P.bracket_group f 1 @@ fun _ ->
-          pp_string f (* ~utf:(kind = `Utf8) *) ~quote:( best_string_quote s) s
-        end;
-      (* See [Js_program_loader.obj_of_exports] 
-         maybe in the ast level we should have 
-         refer and export
-      *)
-      cxt in
-    if l > 15 then P.paren_group f 1 action else action ()
+type ctx = {left:pattern list ; right:pattern list}
 
-  | New (e,  el) ->
-    let action () = 
-      P.group f 1 @@ fun _ -> 
-        P.string f L.new_;
-        P.space f;
-        let cxt = expression 16 cxt f e in
-        P.paren_group f 1 @@ fun _ -> 
-          match el with 
-          | Some el  -> arguments cxt f el  
-          | None -> cxt
-    in
-    if l > 15 then P.paren_group f 1 action else action ()
+let pretty_ctx ctx =
+  List.iter
+    (fun {left=left ; right=right} ->
+      prerr_string "LEFT:" ;
+      pretty_line left ;
+      prerr_string " RIGHT:" ;
+      pretty_line right ;
+      prerr_endline "")
+    ctx
 
-  | Array_of_size e ->
-    let action () = 
-      P.group f 1 @@ fun _ -> 
-        P.string f L.new_;
-        P.space f;
-        P.string f L.array;
-        P.paren_group f 1 @@ fun _ -> expression 0 cxt f e
-    in
-    if l > 15 then P.paren_group f 1 action else action ()
+let le_ctx c1 c2 =
+  le_pats c1.left c2.left &&
+  le_pats c1.right c2.right
 
-  | Cond (e, e1, e2) ->
-    let action () = 
-      (* P.group f 1 @@ fun _ ->  *)
-      let cxt =  expression 3 cxt f e in
-      P.space f;
-      P.string f L.question; 
-      P.space f;
-      (* 
-            [level 1] is correct, however
-            to make nice indentation , force nested conditional to be parenthesized
-          *)
-      let cxt = (P.group f 1 @@ fun _ -> expression 3 cxt f e1) in
-      (* let cxt = (P.group f 1 @@ fun _ -> expression 1 cxt f e1) in *)
-      P.space f;
-      P.string f L.colon;
-      P.space f ; 
+let lshift {left=left ; right=right} = match right with
+| x::xs -> {left=x::left ; right=xs}
+| _ ->  assert false
 
-      (* idem *)
-      P.group f 1 @@ fun _ -> expression 3 cxt f e2
-      (* P.group f 1 @@ fun _ -> expression 1 cxt f e2 *)
-    in
-    if l > 2 then P.paren_vgroup f 1 action else action ()
+let lforget {left=left ; right=right} = match right with
+| x::xs -> {left=omega::left ; right=xs}
+|  _ -> assert false
 
-  | Object lst ->
-    begin
-      match lst with 
-      | [] -> P.string f "{ }" ; cxt 
-      | _ -> 
-        P.brace_vgroup f 1 @@ fun _ -> 
-        property_name_and_value_list cxt f lst
-    end
+let rec small_enough n = function
+  | [] -> true
+  | _::rem ->
+      if n <= 0 then false
+      else small_enough (n-1) rem
 
-and property_name cxt f (s : J.property_name) : unit =
-  match s with
-  | Tag -> P.string f L.tag
-  | Length -> P.string f L.length
-  | Key s -> 
-    property_string  f s 
-  | Int_key i -> P.string f (string_of_int i)
+let ctx_lshift ctx =
+  if small_enough 31 ctx then
+    List.map lshift ctx
+  else (* Context pruning *) begin
+    get_mins le_ctx (List.map lforget ctx)
+  end
 
-and property_name_and_value_list cxt f l : Ext_pp_scope.t =
-  match l with
-  | [] -> cxt
-  | [(pn, e)] ->
-    property_name cxt  f pn ;
-    P.string f L.colon;
-    P.space f;
-    expression 1 cxt f e 
-  | (pn, e) :: r ->
-    property_name cxt f pn ; 
-    P.string f L.colon;
-    P.space f;
-    let cxt = expression 1 cxt f e in
-    P.string f L.comma;
-    P.newline f;
-    property_name_and_value_list cxt f r
+let  rshift {left=left ; right=right} = match left with
+| p::ps -> {left=ps ; right=p::right}
+| _ -> assert false
 
-and array_element_list cxt f el : Ext_pp_scope.t =
-  match el with
-  | []     -> cxt 
-  | [e]    ->  expression 1 cxt f e
-  | e :: r ->
-    let cxt =  expression 1 cxt f e 
-    in
-    P.string f L.comma; P.newline f; array_element_list cxt f r
+let ctx_rshift ctx = List.map rshift ctx
 
-and arguments cxt f l : Ext_pp_scope.t =
-  match l with
-  | []     -> cxt 
-  | [e]    ->   expression 1 cxt f e
-  | e :: r -> 
-    let cxt =   expression 1 cxt f e in
-    P.string f L.comma; P.space f; arguments cxt f r
+let rec nchars n ps =
+  if n <= 0 then [],ps
+  else match ps with
+  | p::rem ->
+    let chars, cdrs = nchars (n-1) rem in
+    p::chars,cdrs
+  | _ -> assert false
 
-and variable_declaration top cxt f 
-    (variable : J.variable_declaration) : Ext_pp_scope.t = 
-  (* TODO: print [const/var] for different backends  *)
-  match variable with
-  | {ident = i; value =  None; ident_info ; _} -> 
-    if ident_info.used_stats = Dead_pure 
-    then cxt
-    else 
-      begin
-        P.string f L.var;
-        P.space f;
-        let cxt = ident cxt  f i in
-        semi f ; 
-        cxt
-      end 
-  | { ident = name; value =  Some e; ident_info = {used_stats; _}} ->
-    begin match used_stats with
-      | Dead_pure -> 
-        cxt 
-      | Dead_non_pure -> 
-        (* Make sure parens are added correctly *)
-        statement_desc top cxt f (J.Exp e)
-      | _ -> 
-        begin match e, top  with 
-          | {expression_desc = Fun (method_, params, b, env ); comment = _}, _ -> 
-            pp_function method_ cxt f 
-              ~name:(if top then Name_top name else Name_non_top name) 
-              false params b env 
-          | _, _ -> 
-              P.string f L.var;
-              P.space f;
-              let cxt = ident cxt f name in
-              P.space f ;
-              P.string f L.eq;
-              P.space f ;
-              let cxt = expression 1 cxt f e in
-              semi f;
-              cxt 
-        end
-    end
-and ipp_comment : 'a . P.t -> 'a  -> unit = fun   f comment -> 
-  ()
+let  rshift_num n {left=left ; right=right} =
+  let shifted,left = nchars n left in
+  {left=left ; right = shifted@right}
 
+let ctx_rshift_num n ctx = List.map (rshift_num n) ctx
 
-(** don't print a new line -- ASI 
-    FIXME: this still does not work in some cases...
-    {[
-    return /* ... */
-    [... ]
-    ]}
-*)
+(* Recombination of contexts (eg: (_,_)::p1::p2::rem ->  (p1,p2)::rem)
+  All mutable fields are replaced by '_', since side-effects in
+  guards can alter these fields *)
 
-and pp_comment f comment = 
-  if String.length comment > 0 then 
-    P.string f "/* "; P.string f comment ; P.string f " */" 
+let combine {left=left ; right=right} = match left with
+| p::ps -> {left=ps ; right=set_args_erase_mutable p right}
+| _ -> assert false
 
-and pp_comment_option f comment  = 
-    match comment with 
-    | None -> ()
-    | Some x -> pp_comment f x
-and statement top cxt f 
-    ({statement_desc = s;  comment ; _} : J.statement)  : Ext_pp_scope.t =
+let ctx_combine ctx = List.map combine ctx
 
-  pp_comment_option f comment ;
-  statement_desc top cxt f s 
+let ncols = function
+  | [] -> 0
+  | ps::_ -> List.length ps
 
-and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t = 
-  match s with
-  | Block [] -> 
-      ipp_comment f  L.empty_block; (* debugging*)
-      cxt
-  | Exp {expression_desc = Var _;}
-    -> (* Does it make sense to optimize here? *)
-      semi f; cxt 
 
-  | Block b -> (* No braces needed here *)
-      ipp_comment f L.start_block;
-      let cxt = statement_list top cxt  f b in
-      ipp_comment f  L.end_block;
-      cxt
-  | Variable l ->
-      variable_declaration top cxt  f l
-  | Exp e ->
-    (* Parentheses are required when the expression
-       starts syntactically with "{" or "function" 
-       TODO:  be more conservative, since Google Closure will handle
-       the precedence correctly, we also need people read the code..
-       Here we force parens for some alien operators
+exception NoMatch
+exception OrPat
 
-       If we move assign into a statement, will be less?
-       TODO: construct a test case that do need parenthesisze for expression
-       IIE does not apply (will be inlined?)
-    *)
+let filter_matrix matcher pss =
 
-    let rec need_paren  (e : J.expression) =
-      match e.expression_desc with
-      | Call ({expression_desc = Fun _; },_,_) -> true
-      | Caml_uninitialized_obj _ 
-      | Raw_js_code (_, Exp) 
-      | Fun _ | Object _ -> true
-      | Raw_js_code (_,Stmt)
-      | Caml_block_set_tag _ 
-      | Length _ 
-      | Caml_block_set_length _ 
-      | Anything_to_string _ 
-      | String_of_small_int_array _
-      | Call _ 
-      | Array_append _ 
-      | Array_copy _ 
-      | Caml_block_tag _ 
-      | Seq _
-      | Dot _
-      | Cond _
-      | Bin _ 
-      | String_access _ 
-      | Access _
-      | Array_of_size _ 
-      | String_append _ 
-      | Char_of_int _ 
-      | Char_to_int _
-      | Dump _
-      | Json_stringify _ 
-      | Math _
-      | Var _ 
-      | Str _ 
-      | Array _ 
-      | Caml_block  _ 
-      | FlatCall _ 
-      | Typeof _
-      | Bind _ 
-      | Number _
-      | Caml_not _ (* FIXME*)
-      | Js_not _ 
-      | Bool _
-      | New _ 
-      | J.Anything_to_number _ 
-      | Int_of_boolean _ -> false
-      (* e = function(x){...}(x);  is good
-       *)
-    in
-    let cxt = 
-      (
-        if need_paren  e 
-        then (P.paren_group f 1)
-        else (P.group f 0)
-      ) (fun _ -> expression 0 cxt f e ) in
-    semi f;
-    cxt 
+  let rec filter_rec = function
+    | (p::ps)::rem ->
+        begin match p.pat_desc with
+        | Tpat_alias (p,_,_) ->
+            filter_rec ((p::ps)::rem)
+        | Tpat_var _ ->
+            filter_rec ((omega::ps)::rem)
+        | _ ->
+            begin
+              let rem = filter_rec rem in
+              try
+                matcher p ps::rem
+              with
+              | NoMatch -> rem
+              | OrPat   ->
+                match p.pat_desc with
+                | Tpat_or (p1,p2,_) -> filter_rec [(p1::ps) ;(p2::ps)]@rem
+                | _ -> assert false
+            end
+        end
+    | [] -> []
+    | _ ->
+        pretty_matrix pss ;
+        fatal_error "Matching.filter_matrix" in
+  filter_rec pss
 
-  | If (e, s1,  s2) -> (* TODO: always brace those statements *)
-    P.string f L.if_;
-    P.space f;
-    let cxt = P.paren_group f 1 @@ fun _ -> expression 0 cxt f e in
-    P.space f;
-    let cxt =
-      block cxt f s1
-    in
-    begin match s2 with 
-     | None | (Some []) 
-     | Some [{statement_desc = (Block [] | Exp {expression_desc = Var _;} ); }]
-       -> P.newline f; cxt
-     | Some [{statement_desc = If _} as nest]
-     | Some [{statement_desc = Block [ {statement_desc = If _ ; _} as nest] ; _}]
-       ->
-       P.newline f;
-       P.string f L.else_;
-       P.space f;
-       statement false cxt f nest 
-     | Some s2 -> 
-       P.newline f;
-       P.string f L.else_;
-       P.space f ;
-       block  cxt f s2 
-    end
+let make_default matcher env =
+  let rec make_rec = function
+    | [] -> []
+    | ([[]],i)::_ -> [[[]],i]
+    | (pss,i)::rem ->
+        let rem = make_rec rem in
+        match filter_matrix matcher pss with
+        | [] -> rem
+        | ([]::_) -> ([[]],i)::rem
+        | pss -> (pss,i)::rem in
+  make_rec env
 
-  | While (label, e, s, _env) ->  (*  FIXME: print scope as well *)
-      begin 
-        (match label with 
-        | Some i ->
-            P.string f i ; 
-            P.string f L.colon;
-            P.newline f ;
-        | None -> ());
-        let cxt = 
-          match e.expression_desc with
-          | Number (Int {i = 1l}) ->
-              P.string f L.while_;
-              P.string f "(";
-              P.string f L.true_;
-              P.string f ")"; 
-              P.space f ;
-              cxt 
-          | _ -> 
-              P.string f L.while_;
-              let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e in
-              P.space f ; 
-              cxt 
-        in
-        let cxt = block cxt f s in
-        semi f;
-        cxt
+let ctx_matcher p =
+  let p = normalize_pat p in
+  match p.pat_desc with
+  | Tpat_construct (_, cstr,omegas) ->
+      begin match cstr.cstr_tag with
+      | Cstr_extension _ ->
+          let nargs = List.length omegas in
+          (fun q rem -> match q.pat_desc with
+          | Tpat_construct (_, cstr',args)
+            when List.length args = nargs ->
+                p,args @ rem
+          | Tpat_any -> p,omegas @ rem
+          | _ -> raise NoMatch)
+      | _ ->
+          (fun q rem -> match q.pat_desc with
+          | Tpat_construct (_, cstr',args)
+            when cstr.cstr_tag=cstr'.cstr_tag ->
+              p,args @ rem
+          | Tpat_any -> p,omegas @ rem
+          | _ -> raise NoMatch)
       end
-  | ForRange (for_ident_expression, finish, id, direction, s, env) -> 
-    let action cxt  = 
-      P.vgroup f 0 @@ fun _ -> 
-        let cxt = P.group f 0 @@ fun _ -> 
-            (* The only place that [semi] may have semantics here *)
-            P.string f "for";
-            P.paren_group f 1 @@ fun _ -> 
-              let cxt, new_id = 
-                (match for_ident_expression, finish.expression_desc with 
-                 | Some ident_expression , (Number _ | Var _ ) -> 
-                   P.string f L.var;
-                   P.space f;
-                   let cxt  =  ident cxt f id in
-                   P.space f; 
-                   P.string f L.eq;
-                   P.space f;
-                   expression 0 cxt f ident_expression, None
-                 | Some ident_expression, _ -> 
-                   P.string f L.var;
-                   P.space f;
-                   let cxt  =  ident cxt f id in
-                   P.space f;
-                   P.string f L.eq;
-                   P.space f; 
-                   let cxt = expression 1 cxt f ident_expression in
-                   P.space f ; 
-                   P.string f L.comma;
-                   let id = Ext_ident.create (Ident.name id ^ "_finish") in
-                   let cxt = ident cxt f id in
-                   P.space f ; 
-                   P.string f L.eq;
-                   P.space f;
-                   expression 1 cxt f finish, Some id
-                 | None, (Number _ | Var _) -> 
-                   cxt, None 
-                 | None , _ -> 
-                   P.string f L.var;
-                   P.space f ;
-                   let id = Ext_ident.create (Ident.name id ^ "_finish") in
-                   let cxt = ident cxt f id in
-                   P.space f ; 
-                   P.string f L.eq ; 
-                   P.space f ; 
-                   expression 15 cxt f finish, Some id
-                ) in
+  | Tpat_constant cst ->
+      (fun q rem -> match q.pat_desc with
+      | Tpat_constant cst' when const_compare cst cst' = 0 ->
+          p,rem
+      | Tpat_any -> p,rem
+      | _ -> raise NoMatch)
+  | Tpat_variant (lab,Some omega,_) ->
+      (fun q rem -> match q.pat_desc with
+      | Tpat_variant (lab',Some arg,_) when lab=lab' ->
+          p,arg::rem
+      | Tpat_any -> p,omega::rem
+      | _ -> raise NoMatch)
+  | Tpat_variant (lab,None,_) ->
+      (fun q rem -> match q.pat_desc with
+      | Tpat_variant (lab',None,_) when lab=lab' ->
+          p,rem
+      | Tpat_any -> p,rem
+      | _ -> raise NoMatch)
+  | Tpat_array omegas ->
+      let len = List.length omegas in
+      (fun q rem -> match q.pat_desc with
+      | Tpat_array args when List.length args=len ->
+          p,args @ rem
+      | Tpat_any -> p, omegas @ rem
+      | _ -> raise NoMatch)
+  | Tpat_tuple omegas ->
+      (fun q rem -> match q.pat_desc with
+      | Tpat_tuple args -> p,args @ rem
+      | _          -> p, omegas @ rem)
+  | Tpat_record (l,_) -> (* Records are normalized *)
+      (fun q rem -> match q.pat_desc with
+      | Tpat_record (l',_) ->
+          let l' = all_record_args l' in
+          p, List.fold_right (fun (_, _,p) r -> p::r) l' rem
+      | _ -> p,List.fold_right (fun (_, _,p) r -> p::r) l rem)
+  | Tpat_lazy omega ->
+      (fun q rem -> match q.pat_desc with
+      | Tpat_lazy arg -> p, (arg::rem)
+      | _          -> p, (omega::rem))
+ | _ -> fatal_error "Matching.ctx_matcher"
 
-              semi f ; 
-              P.space f;
-              let cxt = ident cxt f id in
-              P.space f;
-              let right_prec  = 
 
-                match direction with 
-                | Upto -> 
-                  let (_,_,right) = op_prec Le  in
-                  P.string f L.le;
-                  right
-                | Downto -> 
-                  let (_,_,right) = op_prec Ge in
-                  P.string f L.ge ;
-                  right
-              in
-              P.space f ; 
-              let cxt  = 
-                match new_id with 
-                | Some i -> expression   right_prec cxt  f (E.var i)
-                | None -> expression  right_prec cxt  f finish
-              in
-              semi f; 
-              P.space f;
-              let ()  = 
-                match direction with 
-                | Upto -> P.string f L.plus_plus
-                | Downto -> P.string f L.minus_minus in
-              ident cxt f id
-        in
-        block  cxt f s  in
-    let lexical = Js_closure.get_lexical_scope env in
-    if Ident_set.is_empty lexical 
-    then action cxt
-    else 
-      (* unlike function, 
-         [print for loop] has side effect, 
-         we should take it out
-      *)
-      let inner_cxt = Ext_pp_scope.merge lexical cxt in
-      let lexical = Ident_set.elements lexical in
-      let _enclose action inner_cxt lexical   = 
-        let rec aux  cxt f ls  =
-          match ls with
-          | [] -> cxt
-          | [x] -> ident cxt f x
-          | y :: ys ->
-            let cxt = ident cxt f y in
-            P.string f L.comma;
-            aux cxt f ys  in
-        P.vgroup f 0
-          (fun _ ->
-             (
-               P.string f "(function(";
-               ignore @@ aux inner_cxt f lexical;
-               P.string f ")";
-               let cxt = P.brace_vgroup f 0  (fun _ -> action inner_cxt) in
-               P.string f "(";
-               ignore @@ aux inner_cxt f lexical;
-               P.string f ")";
-               P.string f ")";
-               semi f;
-               cxt
-             )) 
-      in
-      _enclose action inner_cxt lexical
 
-  | Continue s ->
-    P.string f L.continue;
-    P.space f ;
-    P.string f s;
-    semi f;
-    P.newline f;
-    cxt
-  | Debugger
-    -> 
-    P.newline f ;
-    P.string f L.debugger;
-    semi f ;
-    P.newline f;
-    cxt 
-  | Break
-    ->
-    P.string f L.break;
-    P.space f ;
-    semi f;
-    P.newline f; 
-    cxt
 
-  | Return {return_value = e} ->
-    begin match e with
-      | {expression_desc = Fun (method_,  l, b, env); _} ->
-        let cxt =
-          pp_function method_ cxt f true l b env in
-        semi f ; cxt 
-      | e ->
-        P.string f L.return ;
-        P.space f ;
+let filter_ctx q ctx =
 
-        (* P.string f "return ";(\* ASI -- when there is a comment*\) *)
-        P.group f return_indent @@ fun _ -> 
-          let cxt =  expression 0 cxt f e in
-          semi f;
-          cxt 
-          (* There MUST be a space between the return and its
-             argument. A line return will not work *)
-    end
-  | Int_switch (e, cc, def) ->
-    P.string f L.switch;  
-    P.space f;
-    let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e 
-    in
-    P.space f;
-    P.brace_vgroup f 1 @@ fun _ -> 
-      let cxt = loop cxt f (fun f i -> P.string f (string_of_int i) ) cc in
-      (match def with
-       | None -> cxt
-       | Some def ->
-         P.group f 1 @@ fun _ -> 
-           P.string f L.default;
-           P.string f L.colon;
-           P.newline f;
-           statement_list  false cxt  f def 
-      )
+  let matcher = ctx_matcher q in
 
-  | String_switch (e, cc, def) ->
-    P.string f L.switch;
-    P.space f;
-    let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e 
-    in
-    P.space f;
-    P.brace_vgroup f 1 @@ fun _ -> 
-      let cxt = loop cxt f (fun f i -> pp_quote_string f i ) cc in
-      (match def with
-       | None -> cxt
-       | Some def ->
-         P.group f 1 @@ fun _ -> 
-           P.string f L.default;
-           P.string f L.colon;
-           P.newline f;
-           statement_list  false cxt  f def )
+  let rec filter_rec = function
+    | ({right=p::ps} as l)::rem ->
+        begin match p.pat_desc with
+        | Tpat_or (p1,p2,_) ->
+            filter_rec ({l with right=p1::ps}::{l with right=p2::ps}::rem)
+        | Tpat_alias (p,_,_) ->
+            filter_rec ({l with right=p::ps}::rem)
+        | Tpat_var _ ->
+            filter_rec ({l with right=omega::ps}::rem)
+        | _ ->
+            begin let rem = filter_rec rem in
+            try
+              let to_left, right = matcher p ps in
+              {left=to_left::l.left ; right=right}::rem
+            with
+            | NoMatch -> rem
+            end
+        end
+    | [] -> []
+    | _ ->  fatal_error "Matching.filter_ctx" in
 
-  | Throw e ->
-    P.string f L.throw;
-    P.space f ;
-    P.group f throw_indent @@ fun _ -> 
+  filter_rec ctx
 
-      let cxt = expression 0 cxt f e in
-      semi f ; cxt 
+let select_columns pss ctx =
+  let n = ncols pss in
+  List.fold_right
+    (fun ps r ->
+      List.fold_right
+        (fun {left=left ; right=right} r ->
+          let transfert, right = nchars n right in
+          try
+            {left = lubs transfert ps @ left ; right=right}::r
+          with
+          | Empty -> r)
+        ctx r)
+    pss []
 
-  (* There must be a space between the return and its
-     argument. A line return would not work *)
-  | Try (b, ctch, fin) ->
-    P.vgroup f 0 @@ fun _-> 
-      P.string f "try";
-      P.space f ; 
-      let cxt = block cxt f b in
-      let cxt = 
-        match ctch with
-        | None ->
-          cxt
-        | Some (i, b) ->
-          P.newline f;
-          P.string f "catch (";
-          let cxt = ident cxt f i in
-          P.string f ")";
-          block cxt f b
-      in 
-      begin match fin with
-        | None -> cxt
-        | Some b ->
-          P.group f 1 @@ fun _ -> 
-            P.string f "finally";
-            P.space f;
-            block cxt f b 
-      end
-(* similar to [block] but no braces *)
-and statement_list top cxt f  b =
-  match b with
-  | []     -> cxt
-  | [s]    -> statement top  cxt f  s
-  | s :: r -> 
-    let cxt = statement top cxt f s in
-    P.newline f;
-    (if top then P.force_newline f);
-    statement_list top cxt f  r
+let ctx_lub p ctx =
+  List.fold_right
+    (fun {left=left ; right=right} r ->
+      match right with
+      | q::rem ->
+          begin try
+            {left=left ; right = lub p q::rem}::r
+          with
+          | Empty -> r
+          end
+      | _ -> fatal_error "Matching.ctx_lub")
+    ctx []
 
-and block cxt f b =
-  (* This one is for '{' *)
-  P.brace_vgroup f 1 (fun _ -> statement_list false cxt   f b )
+let ctx_match ctx pss =
+  List.exists
+    (fun {right=qs} ->
+      List.exists
+        (fun ps -> compats qs ps)
+        pss)
+    ctx
 
+type jumps = (int * ctx list) list
 
-let exports cxt f (idents : Ident.t list) = 
-  let outer_cxt, reversed_list, margin = 
-    List.fold_left (fun (cxt, acc, len ) (id : Ident.t) -> 
-        let s = Ext_ident.convert true id.name in        
-        let str,cxt  = str_of_ident cxt id in         
-        cxt, ( (s,str) :: acc ) , max len (String.length s)   )
-      (cxt, [], 0)  idents in    
-  P.newline f ;
-  Ext_list.rev_iter (fun (s,export) -> 
-      P.group f 0 @@ (fun _ ->  
-          P.string f L.exports;
-          P.string f L.dot;
-          P.string f s; 
-          P.nspace f (margin - String.length s +  1) ;
-          P.string f L.eq;
-          P.space f;
-          P.string f export;          
-          semi f;);
-      P.newline f;
-    ) reversed_list;
-  outer_cxt  
+let pretty_jumps (env : jumps) = match env with
+| [] -> ()
+| _ ->
+    List.iter
+      (fun (i,ctx) ->
+        Printf.fprintf stderr "jump for %d\n" i ;
+        pretty_ctx ctx)
+      env
 
 
-(* Node style *)
-let requires require_lit cxt f (modules : (Ident.t * string) list ) =
-  P.newline f ; 
-  (* the context used to print the following program *)  
-  let outer_cxt, reversed_list, margin  =
-    List.fold_left
-      (fun (cxt, acc, len) (id,s) ->
-         let str, cxt = str_of_ident cxt id  in
-         cxt, ((str,s) :: acc), (max len (String.length str))
-      )
-      (cxt, [], 0)  modules in
-  P.force_newline f ;    
-  Ext_list.rev_iter (fun (s,file) ->
-      P.string f L.var;
-      P.space f ;
-      P.string f s ;
-      P.nspace f (margin - String.length s + 1) ;
-      P.string f L.eq;
-      P.space f;
-      P.string f require_lit;
-      P.paren_group f 0 @@ (fun _ ->
-          pp_string f ~utf:true ~quote:(best_string_quote s) file  );
-      semi f ;
-      P.newline f ;
-    ) reversed_list;
-  outer_cxt
+let rec jumps_extract i = function
+  | [] -> [],[]
+  | (j,pss) as x::rem as all ->
+      if i=j then pss,rem
+      else if j < i then [],all
+      else
+        let r,rem = jumps_extract i rem in
+        r,(x::rem)
 
-let program f cxt   ( x : J.program ) = 
-  let () = P.force_newline f in
-  let cxt =  statement_list true cxt f x.block  in
-  let () = P.force_newline f in
-  exports cxt f x.exports
+let rec jumps_remove i = function
+  | [] -> []
+  | (j,_)::rem when i=j -> rem
+  | x::rem -> x::jumps_remove i rem
 
-let goog_program ~output_prefix f goog_package (x : J.deps_program)  = 
-  P.newline f ;
-  P.string f L.goog_module;
-  P.string f "(";
-  P.string f (Printf.sprintf "%S" goog_package);
-  P.string f ")";
-  semi f ;
-  let cxt = 
-    requires
-      L.goog_require
-      Ext_pp_scope.empty
-      f 
-      (List.map 
-         (fun x -> 
-            Lam_module_ident.id x,
-            Js_program_loader.string_of_module_id
-              ~output_prefix `Goog x)
-         x.modules) 
-  in
-  program f cxt x.program  
+let jumps_empty = []
+and jumps_is_empty = function
+  |  [] -> true
+  |  _ -> false
 
-let node_program ~output_prefix f ( x : J.deps_program) = 
-  let cxt = 
-    requires 
-      L.require
-      Ext_pp_scope.empty
-      f
-      (List.map 
-         (fun x -> 
-            Lam_module_ident.id x,
-            Js_program_loader.string_of_module_id
-              ~output_prefix
-              `NodeJS x)
-         x.modules)
-  in
-  program f cxt x.program  
+let jumps_singleton i = function
+  | []  -> []
+  | ctx ->  [i,ctx]
 
+let jumps_add i pss jumps = match pss with
+| [] -> jumps
+| _  ->
+    let rec add = function
+      | [] -> [i,pss]
+      | (j,qss) as x::rem as all ->
+          if j > i then x::add rem
+      else if j < i then (i,pss)::all
+      else (i,(get_mins le_ctx (pss@qss)))::rem in
+    add jumps
 
-let amd_program ~output_prefix f (  x : J.deps_program) = 
-  P.newline f ; 
-  let cxt = Ext_pp_scope.empty in
-  P.vgroup f 1 @@ fun _ -> 
-  P.string f L.define;
-  P.string f "([";
-  P.string f (Printf.sprintf "%S" L.exports);
 
-  List.iter (fun x ->
-      let s = Js_program_loader.string_of_module_id ~output_prefix `AmdJS x in
-      P.string f L.comma ;
-      P.space f; 
-      pp_string f ~utf:true ~quote:(best_string_quote s) s;
-    ) x.modules ;
-  P.string f "]";
-  P.string f L.comma;
-  P.newline f;
-  P.string f L.function_;
-  P.string f "(";
-  P.string f L.exports;
+let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with
+| [],_ -> env2
+| _,[] -> env1
+| ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) ->
+    if i1=i2 then
+      (i1,get_mins le_ctx (pss1@pss2))::jumps_union rem1 rem2
+    else if i1 > i2 then
+      x1::jumps_union rem1 env2
+    else
+      x2::jumps_union env1 rem2
 
-  let cxt = 
-    List.fold_left (fun cxt x ->         
-        let id = Lam_module_ident.id x in
-        P.string f L.comma;
-        P.space f ; 
-        ident cxt f id
-      ) cxt x.modules     
-  in
-  P.string f ")";
-  let v = P.brace_vgroup f 1 @@ (fun _ -> 
-      let () = P.string f L.strict_directive in 
-      program f cxt x.program
-    ) in
-  P.string f ")";
-  v
 
-(** Make sure github linguist happy
-    {[
-      require('Linguist')
-      Linguist::FileBlob.new('jscomp/test/test_u.js').generated?
-    ]}
-*)
-let bs_header = 
-  "// Generated by BUCKLESCRIPT VERSION " ^
-  Bs_version.version ^
-  " , PLEASE EDIT WITH CARE"
+let rec merge = function
+  | env1::env2::rem ->  jumps_union env1 env2::merge rem
+  | envs -> envs
 
-let pp_deps_program
-    ~output_prefix
-    (kind : Lam_module_ident.system )
-    (program  : J.deps_program) (f : Ext_pp.t) = 
-  begin
-    if not !Js_config.no_version_header then 
-      begin 
-        P.string f bs_header;
-        P.newline f
-      end ; 
-    P.string f L.strict_directive; 
-    P.newline f ;    
-    ignore (match kind with 
-     | `AmdJS -> 
-       amd_program ~output_prefix f program
-     | `NodeJS -> 
-       node_program ~output_prefix f program
-     | `Goog  -> 
-       let goog_package = 
-         let v = Js_config.get_module_name () in
-         match Js_config.get_package_name () with 
-         | None 
-           -> v 
-         | Some x -> x ^ "." ^ v 
-       in 
-       goog_program ~output_prefix f goog_package  program
-      ) ;
-    P.newline f ;
-    P.string f (
-      match program.side_effect with
-      | None -> "/* No side effect */"
-      | Some v -> Printf.sprintf "/* %s Not a pure module */" v );
-    P.newline f;
-    P.flush f ()
-  end
+let rec jumps_unions envs = match envs with
+  | [] -> []
+  | [env] -> env
+  | _ -> jumps_unions (merge envs)
 
-let dump_program (x : J.program) oc = 
-  ignore (program (P.from_channel oc)  Ext_pp_scope.empty  x )
+let jumps_map f env =
+  List.map
+    (fun (i,pss) -> i,f pss)
+    env
 
-let dump_deps_program
-    ~output_prefix
-    kind
-    x 
-    (oc : out_channel) = 
-  pp_deps_program ~output_prefix  kind x (P.from_channel oc)
+(* Pattern matching before any compilation *)
+
+type pattern_matching =
+  { mutable cases : (pattern list * lambda) list;
+    args : (lambda * let_kind) list ;
+    default : (matrix * int) list}
+
+(* Pattern matching after application of both the or-pat rule and the
+   mixture rule *)
+
+type pm_or_compiled =
+  {body : pattern_matching ;
+   handlers : (matrix * int * Ident.t list * pattern_matching) list ;
+   or_matrix : matrix ; }
+
+type pm_half_compiled =
+  | PmOr of pm_or_compiled
+  | PmVar of pm_var_compiled
+  | Pm of pattern_matching
+
+and pm_var_compiled =
+    {inside : pm_half_compiled ; var_arg : lambda ; }
+
+type pm_half_compiled_info =
+    {me : pm_half_compiled ;
+     matrix : matrix ;
+     top_default : (matrix * int) list ; }
+
+let pretty_cases cases =
+  List.iter
+    (fun ((ps),l) ->
+      List.iter
+        (fun p ->
+          Parmatch.top_pretty Format.str_formatter p ;
+          prerr_string " " ;
+          prerr_string (Format.flush_str_formatter ()))
+        ps ;
+(*
+      prerr_string " -> " ;
+      Printlambda.lambda Format.str_formatter l ;
+      prerr_string (Format.flush_str_formatter ()) ;
+*)
+      prerr_endline "")
+    cases
 
-let string_of_block  block  
-  = 
-  let buffer  = Buffer.create 50 in
-  begin
-    let f = P.from_buffer buffer in
-    let _scope =  statement_list true Ext_pp_scope.empty  f block in
-    P.flush  f ();
-    Buffer.contents buffer     
-  end
+let pretty_def def =
+  prerr_endline "+++++ Defaults +++++" ;
+  List.iter
+    (fun (pss,i) ->
+      Printf.fprintf stderr "Matrix for %d\n"  i ;
+      pretty_matrix pss)
+    def ;
+  prerr_endline "+++++++++++++++++++++"
 
+let pretty_pm pm = pretty_cases pm.cases
 
-let string_of_expression e =
-  let buffer  = Buffer.create 50 in
-  begin
-    let f = P.from_buffer buffer in
-    let _scope =  expression 0  Ext_pp_scope.empty  f e in
-    P.flush  f ();
-    Buffer.contents buffer     
-  end
 
- 
+let rec pretty_precompiled = function
+  | Pm pm ->
+      prerr_endline "++++ PM ++++" ;
+      pretty_pm pm
+  | PmVar x ->
+      prerr_endline "++++ VAR ++++" ;
+      pretty_precompiled x.inside
+  | PmOr x ->
+      prerr_endline "++++ OR ++++" ;
+      pretty_pm x.body ;
+      pretty_matrix x.or_matrix ;
+      List.iter
+        (fun (_,i,_,pm) ->
+          eprintf "++ Handler %d ++\n" i ;
+          pretty_pm pm)
+        x.handlers
 
-end
-module Js_fold_basic : sig 
-#1 "js_fold_basic.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let pretty_precompiled_res first nexts =
+  pretty_precompiled first ;
+  List.iter
+    (fun (e, pmh) ->
+      eprintf "** DEFAULT %d **\n" e ;
+      pretty_precompiled pmh)
+    nexts
 
 
 
+(* Identifing some semantically equivalent lambda-expressions,
+   Our goal here is also to
+   find alpha-equivalent (simple) terms *)
 
+(* However, as shown by PR#6359 such sharing may hinders the
+   lambda-code invariant that all bound idents are unique,
+   when switchs are compiled to test sequences.
+   The definitive fix is the systematic introduction of exit/catch
+   in case action sharing is present.
+*)
 
 
+module StoreExp =
+  Switch.Store
+    (struct
+      type t = lambda
+      type key = lambda
+      let make_key = Lambda.make_key
+    end)
 
 
-(** A module to calculate hard dependency based on JS IR in module [J] *)
+let make_exit i = Lstaticraise (i,[])
 
-val depends_j : J.expression -> Ident_set.t -> Ident_set.t
+(* Introduce a catch, if worth it *)
+let make_catch d k = match d with
+| Lstaticraise (_,[]) -> k d
+| _ ->
+    let e = next_raise_count () in
+    Lstaticcatch (k (make_exit e),(e,[]),d)
 
-val calculate_hard_dependencies : J.block -> Lam_module_ident.t Hash_set_poly.t
+(* Introduce a catch, if worth it, delayed version *)
+let rec as_simple_exit = function
+  | Lstaticraise (i,[]) -> Some i
+  | Llet (Alias,_,_,e) -> as_simple_exit e
+  | _ -> None
 
-end = struct
-#1 "js_fold_basic.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+let make_catch_delayed handler = match as_simple_exit handler with
+| Some i -> i,(fun act -> act)
+| None ->
+    let i = next_raise_count () in
+(*
+    Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler);
+*)
+    i,
+    (fun body -> match body with
+    | Lstaticraise (j,_) ->
+        if i=j then handler else body
+    | _ -> Lstaticcatch (body,(i,[]),handler))
 
 
+let raw_action l =
+  match make_key l with | Some l -> l | None -> l
 
 
+let tr_raw act = match make_key act with
+| Some act -> act
+| None -> raise Exit
 
+let same_actions = function
+  | [] -> None
+  | [_,act] -> Some act
+  | (_,act0) :: rem ->
+      try
+        let raw_act0 = tr_raw act0 in
+        let rec s_rec = function
+          | [] -> Some act0
+          | (_,act)::rem ->
+              if raw_act0 = tr_raw act then
+                s_rec rem
+              else
+                None in
+        s_rec rem
+      with
+      | Exit -> None
 
 
+(* Test for swapping two clauses *)
 
-class count_deps (add : Ident.t -> unit )  = 
-  object(self)
-    inherit  Js_fold.fold as super
-    method! expression lam = 
-      match lam.expression_desc with 
-      | Fun (_, _, block, _) -> self#block block
-      (** Call 
-          actually depends on parameter, 
-          since closure 
-          {[
-            n = n - 1
-                    acc = () => n 
-          ]}
-          should be 
+let up_ok_action act1 act2 =
+  try
+    let raw1 = tr_raw act1
+    and raw2 = tr_raw act2 in
+    raw1 = raw2
+  with
+  | Exit -> false
 
-          {[
-            acc = (function (n) {() => n} (n))
-              n = n - 1
-          ]}
-      *)
-      | _ -> super#expression lam
-    method! ident x = add x ; self
-  end
+(* Nothing is kown about exception/extension patterns,
+   because of potential rebind *)
+let rec exc_inside p = match p.pat_desc with
+  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
+  | Tpat_any|Tpat_constant _|Tpat_var _
+  | Tpat_construct (_,_,[])
+  | Tpat_variant (_,None,_)
+    -> false
+  | Tpat_construct (_,_,ps)
+  | Tpat_tuple ps
+  | Tpat_array ps
+      -> exc_insides ps
+  | Tpat_variant (_, Some q,_)
+  | Tpat_alias (q,_,_)
+  | Tpat_lazy q
+    -> exc_inside q
+  | Tpat_record (lps,_) ->
+      List.exists (fun (_,_,p) -> exc_inside p) lps
+  | Tpat_or (p1,p2,_) -> exc_inside p1 || exc_inside p2
 
-class count_hard_dependencies = 
-  object(self)
-    inherit  Js_fold.fold as super
-    val hard_dependencies = Hash_set_poly.create 17
-    method! vident vid = 
-      match vid with 
-      | Qualified (id,kind,_) ->
-          Hash_set_poly.add  hard_dependencies (Lam_module_ident.mk kind id); self
-      | Id id -> self
-    method! expression x = 
-      match  x with
-      | {expression_desc = Call (_,_, {arity = NA}); _}
-        (* see [Js_exp_make.runtime_var_dot] *)
-        -> 
-        Hash_set_poly.add hard_dependencies 
-          (Lam_module_ident.of_runtime (Ext_ident.create_js Js_config.curry));
-        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}*)
-            -> ()
-          | _, _
-            -> 
-            Hash_set_poly.add hard_dependencies 
-              (Lam_module_ident.of_runtime (Ext_ident.create_js Js_config.block));
-        end;
-        super#expression x 
-      | _ -> super#expression x
-    method get_hard_dependencies = hard_dependencies
-  end
+and exc_insides ps = List.exists exc_inside ps
 
-let calculate_hard_dependencies block = 
-  ((new count_hard_dependencies)#block block) # get_hard_dependencies
+let up_ok (ps,act_p) l =
+  if exc_insides ps then match l with [] -> true | _::_ -> false
+  else
+    List.for_all
+      (fun (qs,act_q) ->
+        up_ok_action act_p act_q ||
+        not (Parmatch.compats ps qs))
+      l
 
-(*
-   Given a set of [variables], count which variables  [lam] will depend on
-   Invariant:
-   [variables] are parameters which means immutable so that [Call] 
-   will not depend [variables]
 
+(*
+   Simplify fonction normalize the first column of the match
+     - records are expanded so that they posses all fields
+     - aliases are removed and replaced by bindings in actions.
+   However or-patterns are simplified differently,
+     - aliases are not removed
+     - or patterns (_|p) are changed into _
 *)
-let depends_j (lam : J.expression) (variables : Ident_set.t) = 
-  let v = ref Ident_set.empty in
-  let add id = 
-    if Ident_set.mem id variables then 
-      v := Ident_set.add id !v 
-  in
-  ignore @@ (new count_deps add ) # expression lam ;
-  !v
 
+exception Var of pattern
 
-end
-module Lam_compile_defs : sig 
-#1 "lam_compile_defs.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
+let simplify_or p =
+  let rec simpl_rec p = match p with
+    | {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p)
+    | {pat_desc = Tpat_alias (q,id,s)} ->
+        begin try
+          {p with pat_desc = Tpat_alias (simpl_rec q,id,s)}
+        with
+        | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id,s)})
+        end
+    | {pat_desc = Tpat_or (p1,p2,o)} ->
+        let q1 = simpl_rec p1 in
+        begin try
+          let q2 = simpl_rec p2 in
+          {p with pat_desc = Tpat_or (q1, q2, o)}
+        with
+        | Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)})
+        end
+    | {pat_desc = Tpat_record (lbls,closed)} ->
+        let all_lbls = all_record_args lbls in
+        {p with pat_desc=Tpat_record (all_lbls, closed)}
+    | _ -> p in
+  try
+    simpl_rec p
+  with
+  | Var p -> p
 
+let simplify_cases args cls = match args with
+| [] -> assert false
+| (arg,_)::_ ->
+    let rec simplify = function
+      | [] -> []
+      | ((pat :: patl, action) as cl) :: rem ->
+          begin match pat.pat_desc with
+          | Tpat_var (id, _) ->
+              (omega :: patl, bind Alias id arg action) ::
+              simplify rem
+          | Tpat_any ->
+              cl :: simplify rem
+          | Tpat_alias(p, id,_) ->
+              simplify ((p :: patl, bind Alias id arg action) :: rem)
+          | Tpat_record ([],_) ->
+              (omega :: patl, action)::
+              simplify rem
+          | Tpat_record (lbls, closed) ->
+              let all_lbls = all_record_args lbls in
+              let full_pat =
+                {pat with pat_desc=Tpat_record (all_lbls, closed)} in
+              (full_pat::patl,action)::
+              simplify rem
+          | Tpat_or _ ->
+              let pat_simple  = simplify_or pat in
+              begin match pat_simple.pat_desc with
+              | Tpat_or _ ->
+                  (pat_simple :: patl, action) ::
+                  simplify rem
+              | _ ->
+                  simplify ((pat_simple::patl,action) :: rem)
+              end
+          | _ -> cl :: simplify rem
+          end
+      | _ -> assert false in
 
+    simplify cls
 
 
 
+(* Once matchings are simplified one easily finds
+   their nature *)
 
+let rec what_is_cases cases = match cases with
+| ({pat_desc=Tpat_any} :: _, _) :: rem -> what_is_cases rem
+| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_,_))}::_),_)::_
+  -> assert false (* applies to simplified matchings only *)
+| (p::_,_)::_ -> p
+| [] -> omega
+| _ -> assert false
 
-(** Type defintion to keep track of compilation state 
-  *)
 
-(** Some types are defined in this module to help avoiding generating unnecessary symbols 
-    (generating too many symbols will make the output code unreadable)
-*)
 
-type jbl_label = int 
+(* A few operation on default environments *)
+let as_matrix cases = get_mins le_pats (List.map (fun (ps,_) -> ps) cases)
 
+(* For extension matching, record no imformation in matrix *)
+let as_matrix_omega cases =
+  get_mins le_pats
+    (List.map
+       (fun (ps,_) ->
+         match ps with
+         | [] -> assert false
+         | _::ps -> omega::ps)
+       cases)
 
+let cons_default matrix raise_num default =
+  match matrix with
+  | [] -> default
+  | _ -> (matrix,raise_num)::default
 
-type value = {
-    exit_id : Ident.t ; 
-    args : Ident.t list ;
-    order_id : int
-  }
+let default_compat p def =
+  List.fold_right
+    (fun (pss,i) r ->
+      let qss =
+        List.fold_right
+          (fun qs r -> match qs with
+            | q::rem when Parmatch.compat p q -> rem::r
+            | _ -> r)
+          pss [] in
+      match qss with
+      | [] -> r
+      | _  -> (qss,i)::r)
+    def []
 
-type let_kind = Lambda.let_kind
+(* Or-pattern expansion, variables are a complication w.r.t. the article *)
+let rec extract_vars r p = match p.pat_desc with
+| Tpat_var (id, _) -> IdentSet.add id r
+| Tpat_alias (p, id,_ ) ->
+    extract_vars (IdentSet.add id r) p
+| Tpat_tuple pats ->
+    List.fold_left extract_vars r pats
+| Tpat_record (lpats,_) ->
+    List.fold_left
+      (fun r (_, _, p) -> extract_vars r p)
+      r lpats
+| Tpat_construct (_, _, pats) ->
+    List.fold_left extract_vars r pats
+| Tpat_array pats ->
+    List.fold_left extract_vars r pats
+| Tpat_variant (_,Some p, _) -> extract_vars r p
+| Tpat_lazy p -> extract_vars r p
+| Tpat_or (p,_,_) -> extract_vars r p
+| Tpat_constant _|Tpat_any|Tpat_variant (_,None,_) -> r
 
-type st = 
-  | EffectCall
-  | Declare of let_kind * J.ident (* bound value *)
-  | NeedValue 
-  | Assign of J.ident 
-  (** when use [Assign], var is not needed, since it's already declared 
-      make sure all [Assign] are declared first, otherwise you are creating global variables
-   *)
+exception Cannot_flatten
 
-type return_label = {
-  id : Ident.t;
-  label : J.label;
-  params : Ident.t list;
-  immutable_mask : bool array;
-  mutable new_params : Ident.t Ident_map.t ;
-  mutable triggered : bool
-}
+let mk_alpha_env arg aliases ids =
+  List.map
+    (fun id -> id,
+      if List.mem id aliases then
+        match arg with
+        | Some v -> v
+        | _      -> raise Cannot_flatten
+      else
+        Ident.create (Ident.name id))
+    ids
 
-type return_type = 
-  | False 
-  | True of return_label option (* anonoymous function does not have identifier *)
+let rec explode_or_pat arg patl mk_action rem vars aliases = function
+  | {pat_desc = Tpat_or (p1,p2,_)} ->
+      explode_or_pat
+        arg patl mk_action
+        (explode_or_pat arg patl mk_action rem vars aliases p2)
+        vars aliases p1
+  | {pat_desc = Tpat_alias (p,id, _)} ->
+      explode_or_pat arg patl mk_action rem vars (id::aliases) p
+  | {pat_desc = Tpat_var (x, _)} ->
+      let env = mk_alpha_env arg (x::aliases) vars in
+      (omega::patl,mk_action (List.map snd env))::rem
+  | p ->
+      let env = mk_alpha_env arg aliases vars in
+      (alpha_pat env p::patl,mk_action (List.map snd env))::rem
 
-(* delegate to the callee to generate expression 
-      Invariant: [output] should return a trailing expression
-  *)
+let pm_free_variables {cases=cases} =
+  List.fold_right
+    (fun (_,act) r -> IdentSet.union (free_variables act) r)
+    cases IdentSet.empty
 
-module HandlerMap : Map.S with type key = jbl_label
 
-type cxt = {
-  st : st ;
-  should_return : return_type;
-  jmp_table : value  HandlerMap.t ;
-  meta : Lam_stats.meta ;
-}
+(* Basic grouping predicates *)
+let pat_as_constr = function
+  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr
+  | _ -> fatal_error "Matching.pat_as_constr"
 
-val empty_handler_map : value HandlerMap.t 
+let group_constant = function
+  | {pat_desc= Tpat_constant _} -> true
+  | _                           -> false
 
-val add_jmps :
-    Ident.t * (HandlerMap.key * 'a * Ident.t list) list ->
-    value HandlerMap.t -> value HandlerMap.t * (int * 'a) list
+and group_constructor = function
+  | {pat_desc = Tpat_construct (_,_,_)} -> true
+  | _ -> false
 
+and group_variant = function
+  | {pat_desc = Tpat_variant (_, _, _)} -> true
+  | _ -> false
 
-end = struct
-#1 "lam_compile_defs.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+and group_var = function
+  | {pat_desc=Tpat_any} -> true
+  | _ -> false
 
+and group_tuple = function
+  | {pat_desc = (Tpat_tuple _|Tpat_any)} -> true
+  | _ -> false
 
+and group_record = function
+  | {pat_desc = (Tpat_record _|Tpat_any)} -> true
+  | _ -> false
 
+and group_array = function
+  | {pat_desc=Tpat_array _} -> true
+  | _ -> false
 
+and group_lazy = function
+  | {pat_desc = Tpat_lazy _} -> true
+  | _ -> false
 
+let get_group p = match p.pat_desc with
+| Tpat_any -> group_var
+| Tpat_constant _ -> group_constant
+| Tpat_construct _ -> group_constructor
+| Tpat_tuple _ -> group_tuple
+| Tpat_record _ -> group_record
+| Tpat_array _ -> group_array
+| Tpat_variant (_,_,_) -> group_variant
+| Tpat_lazy _ -> group_lazy
+|  _ -> fatal_error "Matching.get_group"
 
 
 
-type jbl_label = int 
+let is_or p = match p.pat_desc with
+| Tpat_or _ -> true
+| _ -> false
 
-module HandlerMap = Map.Make(struct 
-  type t = jbl_label
-  let compare x y= compare (x:t) y 
-end )
+(* Conditions for appending to the Or matrix *)
+let conda p q = not (compat p q)
+and condb act ps qs =  not (is_guarded act) && Parmatch.le_pats qs ps
 
-type value = {
-    exit_id : Ident.t ;
-    args : Ident.t list ;
-    order_id : int
-  }
+let or_ok p ps l =
+  List.for_all
+    (function
+      | ({pat_desc=Tpat_or _} as q::qs,act) ->
+          conda p q || condb act ps qs
+      | _ -> true)
+    l
 
-(* delegate to the callee to generate expression 
-      Invariant: [output] should return a trailing expression
- *)
-type return_label = {
-  id : Ident.t;
-  label : J.label;
-  params : Ident.t list;
-  immutable_mask : bool array; 
-  mutable new_params : Ident.t Ident_map.t;  
-  mutable triggered : bool
-}
+(* Insert or append a pattern in the Or matrix *)
 
-type return_type = 
-  | False 
-  | True of return_label option 
-   (* have a mutable field to notifiy it's actually triggered *)
-   (* anonoymous function does not have identifier *)
+let equiv_pat p q = le_pat p q && le_pat q p
 
-type let_kind = Lambda.let_kind
+let rec get_equiv p l = match l with
+  | (q::_,_) as cl::rem ->
+      if equiv_pat p q then
+        let others,rem = get_equiv p rem in
+        cl::others,rem
+      else
+        [],l
+  | _ -> [],l
 
-type st = 
-  | EffectCall
-  | Declare of let_kind * J.ident (* bound value *)
-  | NeedValue 
-  | Assign of J.ident (* when use [Assign], var is not needed, since it's already declared  *)
 
-type cxt = {
-  st : st ;
-  should_return : return_type;
-  jmp_table : value  HandlerMap.t ;
-  meta : Lam_stats.meta ;
-  (* include_alias :  *)
-  (*   (\** It's correct to add more, we can do this in lambda optimization pass *)
-  (*    *\) *)
-  (*   (Ident.t , Ident.t) Hashtbl.t *)
-  (* Used when compiling [Lstaticraise]  *)
-}
+let insert_or_append p ps act ors no =
+  let rec attempt seen = function
+    | (q::qs,act_q) as cl::rem ->
+        if is_or q then begin
+          if compat p q then
+            if
+              IdentSet.is_empty (extract_vars IdentSet.empty p) &&
+              IdentSet.is_empty (extract_vars IdentSet.empty q) &&
+              equiv_pat p q
+            then (* attempt insert, for equivalent orpats with no variables *)
+              let _, not_e = get_equiv q rem in
+              if
+                or_ok p ps not_e && (* check append condition for head of O *)
+                List.for_all        (* check insert condition for tail of O *)
+                  (fun cl -> match cl with
+                  | (q::_,_) -> not (compat p q)
+                  | _        -> assert false)
+                  seen
+              then (* insert *)
+                List.rev_append seen ((p::ps,act)::cl::rem), no
+              else (* fail to insert or append *)
+                ors,(p::ps,act)::no
+            else if condb act_q ps qs then (* check condition (b) for append *)
+              attempt (cl::seen) rem
+            else
+              ors,(p::ps,act)::no
+          else (* p # q, go on with append/insert *)
+            attempt (cl::seen) rem
+        end else (* q is not a or-pat, go on with append/insert *)
+          attempt (cl::seen) rem
+    | _  -> (* [] in fact *)
+        (p::ps,act)::ors,no in (* success in appending *)
+  attempt [] ors
 
-let empty_handler_map = HandlerMap.empty
+(* Reconstruct default information from half_compiled  pm list *)
 
+let rec rebuild_matrix pmh = match pmh with
+  | Pm pm -> as_matrix pm.cases
+  | PmOr {or_matrix=m} -> m
+  | PmVar x -> add_omega_column  (rebuild_matrix x.inside)
 
-let add_jmps (exit_id, code_table)   
-    (m : value HandlerMap.t) = 
-  (* always keep key id positive, specifically no [0] generated
-   *)
-  let map, _, handlers = 
-    List.fold_left 
-           (fun (acc,prev_order_id, handlers) 
-               (l,lam, args)   -> 
-                 let order_id = prev_order_id + 1 in
-                 (HandlerMap.add l {exit_id ; args; order_id } acc, 
-                  order_id ,
-                  (order_id, lam) :: handlers))
-      (m,
-       HandlerMap.cardinal m,
-       []
-      )
-      code_table in
-  map, List.rev handlers
+let rec rebuild_default nexts def = match nexts with
+| [] -> def
+| (e, pmh)::rem ->
+    (add_omega_column (rebuild_matrix pmh), e)::
+    rebuild_default rem def
 
-end
-module Js_output : sig 
-#1 "js_output.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let rebuild_nexts arg nexts k =
+  List.fold_right
+    (fun (e, pm) k -> (e, PmVar {inside=pm ; var_arg=arg})::k)
+    nexts k
 
 
+(*
+  Split a matching.
+    Splitting is first directed by or-patterns, then by
+    tests (e.g. constructors)/variable transitions.
 
+    The approach is greedy, every split function attempt to
+    raise rows as much as possible in the top matrix,
+    then splitting applies again to the remaining rows.
 
+    Some precompilation of or-patterns and
+    variable pattern occurs. Mostly this means that bindings
+    are performed now,  being replaced by let-bindings
+    in actions (cf. simplify_cases).
 
+    Additionally, if the match argument is a variable, matchings whose
+    first column is made of variables only are splitted further
+    (cf. precompile_var).
 
+*)
 
 
-(** The intemediate output when compiling lambda into JS IR *)
+let rec split_or argo cls args def =
 
-(* Hongbo Should we rename this module js_of_lambda since it looks like it's 
-   containing that step
- *)
+  let cls = simplify_cases args cls in
 
-type st = Lam_compile_defs.st 
+  let rec do_split before ors no = function
+    | [] ->
+        cons_next
+          (List.rev before) (List.rev ors) (List.rev no)
+    | ((p::ps,act) as cl)::rem ->
+        if up_ok cl no then
+          if is_or p then
+            let ors, no = insert_or_append p ps act ors no in
+            do_split before ors no rem
+          else begin
+            if up_ok cl ors then
+              do_split (cl::before) ors no rem
+            else if or_ok p ps ors then
+              do_split before (cl::ors) no rem
+            else
+              do_split before ors (cl::no) rem
+          end
+        else
+          do_split before ors (cl::no) rem
+    | _ -> assert false
 
-type finished = 
-  | True 
-  | False 
-  | Dummy (* Have no idea, so that when [++] is applied, always use the other *)
+  and cons_next yes yesor = function
+    | [] ->
+        precompile_or argo yes yesor args def []
+    | rem ->
+        let {me=next ; matrix=matrix ; top_default=def},nexts =
+          do_split [] [] [] rem in
+        let idef = next_raise_count () in
+        precompile_or
+          argo yes yesor args
+          (cons_default matrix idef def)
+          ((idef,next)::nexts) in
 
-type t  =  { 
-  block : J.block ;
-  value : J.expression option;
-  finished : finished
-}
+  do_split [] [] [] cls
 
-val make : ?value: J.expression -> ?finished:finished -> J.block -> t
+(* Ultra-naive spliting, close to semantics, used for extension,
+   as potential rebind prevents any kind of optimisation *)
 
-val of_stmt : ?value: J.expression -> ?finished:finished -> J.statement -> t
+and split_naive cls args def k =
 
-val of_block : ?value:J.expression -> ?finished:finished -> J.block -> t
+  let rec split_exc cstr0 yes = function
+    | [] ->
+        let yes = List.rev yes in
+        { me = Pm {cases=yes; args=args; default=def;} ;
+          matrix = as_matrix_omega yes ;
+          top_default=def},
+        k
+    | (p::_,_ as cl)::rem ->
+        if group_constructor p then
+          let cstr = pat_as_constr p in
+          if cstr = cstr0 then split_exc cstr0 (cl::yes) rem
+          else
+            let yes = List.rev yes in
+            let {me=next ; matrix=matrix ; top_default=def}, nexts =
+              split_exc cstr [cl] rem in
+            let idef = next_raise_count () in
+            let def = cons_default matrix idef def in
+            { me = Pm {cases=yes; args=args; default=def} ;
+              matrix = as_matrix_omega yes ;
+              top_default = def; },
+            (idef,next)::nexts
+        else
+          let yes = List.rev yes in
+          let {me=next ; matrix=matrix ; top_default=def}, nexts =
+              split_noexc [cl] rem in
+            let idef = next_raise_count () in
+            let def = cons_default matrix idef def in
+            { me = Pm {cases=yes; args=args; default=def} ;
+              matrix = as_matrix_omega yes ;
+              top_default = def; },
+            (idef,next)::nexts
+    | _ -> assert false
 
-val to_block : t -> J.block
+  and split_noexc yes = function
+    | [] -> precompile_var args (List.rev yes) def k
+    | (p::_,_ as cl)::rem ->
+        if group_constructor p then
+          let yes= List.rev yes in
+          let {me=next; matrix=matrix; top_default=def;},nexts =
+            split_exc (pat_as_constr p) [cl] rem in
+          let idef = next_raise_count () in
+          precompile_var
+            args yes
+            (cons_default matrix idef def)
+            ((idef,next)::nexts)
+        else split_noexc (cl::yes) rem
+    | _ -> assert false in
 
-val to_break_block : t -> J.block * bool 
+  match cls with
+  | [] -> assert false
+  | (p::_,_ as cl)::rem ->
+      if group_constructor p then
+        split_exc (pat_as_constr p) [cl] rem
+      else
+        split_noexc [cl] rem
+  | _ -> assert false
 
-module Ops : sig 
-  val (++) : t -> t -> t 
-end
+and split_constr cls args def k =
+  let ex_pat = what_is_cases cls in
+  match ex_pat.pat_desc with
+  | Tpat_any -> precompile_var args cls def k
+  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) ->
+      split_naive cls args def k
+  | _ ->
 
-val dummy : t 
+      let group = get_group ex_pat in
 
+      let rec split_ex yes no = function
+        | [] ->
+            let yes = List.rev yes and no = List.rev no in
+            begin match no with
+            | [] ->
+                {me = Pm {cases=yes ; args=args ; default=def} ;
+                  matrix = as_matrix yes ;
+                  top_default = def},
+                k
+            | cl::rem ->
+                begin match yes with
+                | [] ->
+                    (* Could not success in raising up a constr matching up *)
+                    split_noex [cl] [] rem
+                | _ ->
+                    let {me=next ; matrix=matrix ; top_default=def}, nexts =
+                      split_noex [cl] [] rem in
+                    let idef = next_raise_count () in
+                    let def = cons_default matrix idef def in
+                    {me = Pm {cases=yes ; args=args ; default=def} ;
+                      matrix = as_matrix yes ;
+                      top_default = def },
+                    (idef, next)::nexts
+                end
+            end
+        | (p::_,_) as cl::rem ->
+            if group p && up_ok cl no then
+              split_ex (cl::yes) no rem
+            else
+              split_ex yes (cl::no) rem
+        | _ -> assert false
 
-val handle_name_tail :
-    Lam_compile_defs.st ->
-    Lam_compile_defs.return_type ->
-    Lam.t ->  J.expression -> t
+      and split_noex yes no = function
+        | [] ->
+            let yes = List.rev yes and no = List.rev no in
+            begin match no with
+            | [] -> precompile_var args yes def k
+            | cl::rem ->
+                let {me=next ; matrix=matrix ; top_default=def}, nexts =
+                  split_ex [cl] [] rem in
+                let idef = next_raise_count () in
+                precompile_var
+                  args yes
+                  (cons_default matrix idef def)
+                  ((idef,next)::nexts)
+            end
+        | [ps,_ as cl]
+            when List.for_all group_var ps && yes <> [] ->
+       (* This enables an extra division in some frequent case :
+          last row is made of variables only *)
+              split_noex yes (cl::no) []
+        | (p::_,_) as cl::rem ->
+            if not (group p) && up_ok cl no then
+              split_noex (cl::yes) no rem
+            else
+              split_noex yes (cl::no) rem
+        | _ -> assert false in
 
-val handle_block_return : 
-    Lam_compile_defs.st ->
-    Lam_compile_defs.return_type ->
-    Lam.t ->
-    J.block -> J.expression -> t
+      match cls with
+      | ((p::_,_) as cl)::rem ->
+          if group p then split_ex [cl] [] rem
+          else split_noex [cl] [] rem
+      | _ ->  assert false
 
-val concat : t list -> t
+and precompile_var  args cls def k = match args with
+| []  -> assert false
+| _::((Lvar v as av,_) as arg)::rargs ->
+    begin match cls with
+    | [ps,_] -> (* as splitted as it can *)
+        dont_precompile_var args cls def k
+    | _ ->
+(* Precompile *)
+        let var_cls =
+          List.map
+            (fun (ps,act) -> match ps with
+            | _::ps -> ps,act | _     -> assert false)
+            cls
+        and var_def = make_default (fun _ rem -> rem) def in
+        let {me=first ; matrix=matrix}, nexts =
+          split_or (Some v) var_cls (arg::rargs) var_def in
 
-val to_string : t -> string
+(* Compute top information *)
+        match nexts with
+        | [] -> (* If you need *)
+            dont_precompile_var args cls def k
+        | _  ->
+            let rfirst =
+              {me = PmVar {inside=first ; var_arg = av} ;
+                matrix = add_omega_column matrix ;
+                top_default = rebuild_default nexts def ; }
+            and rnexts = rebuild_nexts av nexts k in
+            rfirst, rnexts
+    end
+|  _ ->
+    dont_precompile_var args cls def k
 
-end = struct
-#1 "js_output.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+and dont_precompile_var args cls def k =
+  {me =  Pm {cases = cls ; args = args ; default = def } ;
+    matrix=as_matrix cls ;
+    top_default=def},k
 
+and is_exc p = match p.pat_desc with
+| Tpat_or (p1,p2,_) -> is_exc p1 || is_exc p2
+| Tpat_alias (p,v,_) -> is_exc p
+| Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
+| _ -> false
 
+and precompile_or argo cls ors args def k = match ors with
+| [] -> split_constr cls args def k
+| _  ->
+    let rec do_cases = function
+      | ({pat_desc=Tpat_or _} as orp::patl, action)::rem ->
+          let do_opt = not (is_exc orp) in
+          let others,rem =
+            if do_opt then get_equiv orp rem
+            else [],rem in
+          let orpm =
+            {cases =
+              (patl, action)::
+              List.map
+                (function
+                  | (_::ps,action) -> ps,action
+                  | _ -> assert false)
+                others ;
+              args = (match args with _::r -> r | _ -> assert false) ;
+              default = default_compat (if do_opt then orp else omega) def} in
+          let vars =
+            IdentSet.elements
+              (IdentSet.inter
+                 (extract_vars IdentSet.empty orp)
+                 (pm_free_variables orpm)) in
+          let or_num = next_raise_count () in
+          let new_patl = Parmatch.omega_list patl in
 
+          let mk_new_action vs =
+            Lstaticraise
+              (or_num, List.map (fun v -> Lvar v) vs) in
 
+          let do_optrec,body,handlers = do_cases rem in
+          do_opt && do_optrec,
+          explode_or_pat
+            argo new_patl mk_new_action body vars [] orp,
+          let mat = if do_opt then [[orp]] else [[omega]] in
+          ((mat, or_num, vars , orpm):: handlers)
+      | cl::rem ->
+          let b,new_ord,new_to_catch = do_cases rem in
+          b,cl::new_ord,new_to_catch
+      | [] -> true,[],[] in
 
+    let do_opt,end_body, handlers = do_cases ors in
+    let matrix = (if do_opt then as_matrix else as_matrix_omega) (cls@ors)
+    and body = {cases=cls@end_body ; args=args ; default=def} in
+    {me = PmOr {body=body ; handlers=handlers ; or_matrix=matrix} ;
+      matrix=matrix ;
+      top_default=def},
+    k
 
+let split_precompile argo pm =
+  let {me=next}, nexts = split_or argo pm.cases pm.args pm.default  in
+  if dbg && (nexts <> [] || (match next with PmOr _ -> true | _ -> false))
+  then begin
+    prerr_endline "** SPLIT **" ;
+    pretty_pm pm ;
+    pretty_precompiled_res  next nexts
+  end ;
+  next, nexts
 
 
-module E = Js_exp_make 
-module S = Js_stmt_make 
+(* General divide functions *)
 
-type finished = 
-  | True 
-  | False 
-  | Dummy (* Have no idea, so that when [++] is applied, always use the other *)
+let add_line patl_action pm = pm.cases <- patl_action :: pm.cases; pm
 
-type t  =  { 
-  block : J.block ;
-  value : J.expression option;
-  finished : finished ; 
-    (** When [finished] is true the block is already terminated, value does not make sense
-        default is false, false is  an conservative approach 
-     *)
-}
+type cell =
+  {pm : pattern_matching ;
+  ctx : ctx list ;
+  pat : pattern}
 
-type st = Lam_compile_defs.st 
+let add make_matching_fun division eq_key key patl_action args =
+  try
+    let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in
+    cell.pm.cases <- patl_action :: cell.pm.cases;
+    division
+  with Not_found ->
+    let cell = make_matching_fun args in
+    cell.pm.cases <- [patl_action] ;
+    (key, cell) :: division
 
-let make ?value ?(finished=False) block = {block ; value ; finished }
 
-let of_stmt ?value ?(finished = False) stmt = {block = [stmt] ; value ; finished }
+let divide make eq_key get_key get_args ctx pm =
 
-let of_block ?value ?(finished = False) block = 
-  {block  ; value ; finished }
+  let rec divide_rec = function
+    | (p::patl,action) :: rem ->
+        let this_match = divide_rec rem in
+        add
+          (make p pm.default ctx)
+          this_match eq_key (get_key p) (get_args p patl,action) pm.args
+    | _ -> [] in
 
-let dummy = {value = None; block = []; finished = Dummy }
+  divide_rec pm.cases
 
-let handle_name_tail 
-    (name : st)
-    (should_return : Lam_compile_defs.return_type)
-    lam (exp : J.expression) : t =
-  begin match name, should_return with 
-  | EffectCall, False -> 
-      if Lam_analysis.no_side_effects lam 
-      then dummy
-      else {block = []; value  = Some exp ; finished = False}
-  | EffectCall, True _ ->
-      make [S.return  exp] ~finished:True
-  | Declare (kind, n), False -> 
-      make [ S.define ~kind n  exp]
-  | Assign n ,False -> 
-      make [S.assign n exp ]
-  | (Declare _ | Assign _ ), True _ -> 
-      make [S.unknown_lambda lam] ~finished:True
-  | NeedValue, _ -> {block = []; value = Some exp; finished = False }
-  end
 
-let handle_block_return 
-    (st : st) 
-    (should_return : Lam_compile_defs.return_type)
-    (lam : Lam.t) (block : J.block) exp : t = 
-  match st, should_return with 
-  | Declare (kind,n), False -> 
-    make (block @ [ S.define ~kind  n exp])
-  | Assign n, False -> make (block @ [S.assign n exp])
-  | (Declare _ | Assign _), True _ -> make [S.unknown_lambda lam] ~finished:True
-  | EffectCall, False -> make block ~value:exp
-  | EffectCall, True _ -> make (block @ [S.return exp]) ~finished:True
-  | NeedValue, _ ->  make block ~value:exp
+let divide_line make_ctx make get_args pat ctx pm =
+  let rec divide_rec = function
+    | (p::patl,action) :: rem ->
+        let this_match = divide_rec rem in
+        add_line (get_args p patl, action) this_match
+    | _ -> make pm.default pm.args in
 
-let statement_of_opt_expr (x : J.expression option) : J.statement =
-  match x with 
-  | None -> S.empty ()
-  | Some x when Js_analyzer.no_side_effect_expression x -> S.empty ()
-        (* TODO, pure analysis in lambda instead *)
-  | Some x -> S.exp x 
+  {pm = divide_rec pm.cases ;
+  ctx=make_ctx ctx ;
+  pat=pat}
 
-let rec unroll_block (block : J.block) = 
-  match block with 
-  | [{statement_desc = Block block}] -> unroll_block block 
-  |  _ -> block 
 
-let to_block ( x : t)  : J.block = 
-  match x with 
-  | {block; value = opt; finished} ->
-      let block = unroll_block block in
-      if finished = True  then block
-      else 
-        begin match opt with 
-        | None -> block (* TODO, pure analysis in lambda instead *)
-        | Some x when Js_analyzer.no_side_effect_expression x -> block
-        | Some x -> block @ [S.exp x ]
-        end
 
-let to_break_block (x : t) : J.block * bool = 
-    match x with 
-    | {finished = True; block ; _ } -> 
-        unroll_block block, false 
-       (* value does not matter when [finished] is true
-           TODO: check if it has side efects
-        *)
-    | {block; value =  None; finished } -> 
-        let block = unroll_block block in 
-        block, (match finished with | True -> false | (False | Dummy)  -> true  )
+(* Then come various functions,
+   There is one set of functions per matching style
+   (constants, constructors etc.)
 
-    | {block; value = opt; _} -> 
-        let block = unroll_block block in
-        block @ [statement_of_opt_expr opt], true
+   - matcher function are arguments to make_default (for defaukt handlers)
+   They may raise NoMatch or OrPat and perform the full
+   matching (selection + arguments).
 
-let rec append  (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 
-          (* 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 
-        then z
-            (* It would optimize cases like [module aliases]
-                Bigarray, List 
-             *)
-        else
-          {block = []; value = Some (E.seq e1 e2); finished}
-          (* {block = [S.exp e1]; value =  Some e2(\* (E.seq e1 e2) *\); finished} *)
 
-       (** TODO: make everything expression make inlining hard, and code not readable?
+   - get_args and get_key are for the compiled matrices, note that
+   selection and geting arguments are separed.
 
-           1. readability pends on how we print the expression 
-           2. inlining needs generate symbols, which are statements, type mismatch
-              we need capture [Exp e]
+   - make_ _matching combines the previous functions for produicing
+   new  ``pattern_matching'' records.
+*)
 
-           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} *)
 
-    | {block = block1; value = opt_e1; _},  {block = block2; value = opt_e2; finished} -> 
-        let block1 = unroll_block block1 in
-        make (block1 @ (statement_of_opt_expr opt_e1  :: unroll_block block2))
-          ?value:opt_e2 ~finished
 
+let rec matcher_const cst p rem = match p.pat_desc with
+| Tpat_or (p1,p2,_) ->
+    begin try
+      matcher_const cst p1 rem with
+    | NoMatch -> matcher_const cst p2 rem
+    end
+| Tpat_constant c1 when const_compare c1 cst = 0 -> rem
+| Tpat_any    -> rem
+| _ -> raise NoMatch
 
-module Ops = struct 
-  let (++)  (x : t ) (y : t ) : t =  append x y 
-end
+let get_key_constant caller = function
+  | {pat_desc= Tpat_constant cst} -> cst
+  | p ->
+      prerr_endline ("BAD: "^caller) ;
+      pretty_pat p ;
+      assert false
 
-(* Fold right is more efficient *)
-let concat (xs : t list) : t = 
-  List.fold_right (fun x acc -> append x  acc) xs dummy
+let get_args_constant _ rem = rem
 
-let to_string x   = 
-  Js_dump.string_of_block (to_block x)
+let make_constant_matching p def ctx = function
+    [] -> fatal_error "Matching.make_constant_matching"
+  | (_ :: argl) ->
+      let def =
+        make_default
+          (matcher_const (get_key_constant "make" p)) def
+      and ctx =
+        filter_ctx p  ctx in
+      {pm = {cases = []; args = argl ; default = def} ;
+        ctx = ctx ;
+        pat = normalize_pat p}
 
-end
-module Js_pass_debug : sig 
-#1 "js_pass_debug.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
 
 
+let divide_constant ctx m =
+  divide
+    make_constant_matching
+    (fun c d -> const_compare c d = 0) (get_key_constant "divide")
+    get_args_constant
+    ctx m
 
+(* Matching against a constructor *)
 
 
-val dump : string  -> J.program -> J.program 
+let make_field_args loc binding_kind arg first_pos last_pos argl =
+  let rec make_args pos =
+    if pos > last_pos
+    then argl
+    else (Lprim(Pfield (pos, Fld_na (* TODO*) ), [arg],loc), binding_kind) :: make_args (pos + 1)
+  in make_args first_pos
 
-end = struct
-#1 "js_pass_debug.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let get_key_constr = function
+  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag
+  | _ -> assert false
 
+let get_args_constr p rem = match p with
+| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem
+| _ -> assert false
 
+let matcher_constr cstr = match cstr.cstr_arity with
+| 0 ->
+    let rec matcher_rec q rem = match q.pat_desc with
+    | Tpat_or (p1,p2,_) ->
+        begin
+          try
+            matcher_rec p1 rem
+          with
+          | NoMatch -> matcher_rec p2 rem
+        end
+    | Tpat_construct (_, cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag ->
+        rem
+    | Tpat_any -> rem
+    | _ -> raise NoMatch in
+    matcher_rec
+| 1 ->
+    let rec matcher_rec q rem = match q.pat_desc with
+    | Tpat_or (p1,p2,_) ->
+        let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
+        and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
+        begin match r1,r2 with
+        | None, None -> raise NoMatch
+        | Some r1, None -> r1
+        | None, Some r2 -> r2
+        | Some (a1::rem1), Some (a2::_) ->
+            {a1 with
+             pat_loc = Location.none ;
+             pat_desc = Tpat_or (a1, a2, None)}::
+            rem
+        | _, _ -> assert false
+        end
+    | Tpat_construct (_, cstr1, [arg])
+      when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem
+    | Tpat_any -> omega::rem
+    | _ -> raise NoMatch in
+    matcher_rec
+| _ ->
+    fun q rem -> match q.pat_desc with
+    | Tpat_or (_,_,_) -> raise OrPat
+    | Tpat_construct (_, cstr1, args)
+      when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
+    | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
+    | _        -> raise NoMatch
 
+let make_constr_matching p def ctx = function
+    [] -> fatal_error "Matching.make_constr_matching"
+  | ((arg, mut) :: argl) ->
+      let cstr = pat_as_constr p in
+      let newargs =
+        match cstr.cstr_tag with
+          Cstr_constant _ | Cstr_block _ ->
+            make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl
+        | Cstr_extension _ ->
+            make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl in
+      {pm=
+        {cases = []; args = newargs;
+          default = make_default (matcher_constr cstr) def} ;
+        ctx =  filter_ctx p ctx ;
+        pat=normalize_pat p}
 
 
+let divide_constructor ctx pm =
+  divide
+    make_constr_matching
+    (=) get_key_constr get_args_constr
+    ctx pm
 
-let log_counter = ref 0 
+(* Matching against a variant *)
 
-let dump name (prog : J.program) =
-    
-  begin
-    let () = 
-      if Js_config.is_same_file ()
-      then 
-        begin
-          incr log_counter ; 
-          Ext_pervasives.with_file_as_chan       
-            (Ext_filename.chop_extension ~loc:__LOC__ (Js_config.get_current_file()) ^
-             (Printf.sprintf ".%02d.%s.jsx"  !log_counter name)
-            ) (fun chan -> Js_dump.dump_program prog chan )
-        end in
-    prog    
-  end
+let rec matcher_variant_const lab p rem = match p.pat_desc with
+| Tpat_or (p1, p2, _) ->
+    begin
+      try
+        matcher_variant_const lab p1 rem
+      with
+      | NoMatch -> matcher_variant_const lab p2 rem
+    end
+| Tpat_variant (lab1,_,_) when lab1=lab -> rem
+| Tpat_any -> rem
+| _   -> raise NoMatch
 
- 
 
-end
-module Js_map
-= struct
-#1 "js_map.ml"
-(* BuckleScript compiler
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * 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.
- *)
-(* Author: Hongbo Zhang  *)
-(** GENERATED CODE, map visitor for JS IR  *)
-open J
-  
-class virtual map =
-  object ((o : 'self_type))
-    method string : string -> string = o#unknown
-    method option :
-      'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option =
-      fun _f_a ->
-        function | None -> None | Some _x -> let _x = _f_a o _x in Some _x
-    method list :
-      'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list =
-      fun _f_a ->
-        function
-        | [] -> []
-        | _x :: _x_i1 ->
-            let _x = _f_a o _x in
-            let _x_i1 = o#list _f_a _x_i1 in _x :: _x_i1
-    method int : int -> int = o#unknown
-    method bool : bool -> bool = function | false -> false | true -> true
-    method vident : vident -> vident =
-      function
-      | Id _x -> let _x = o#ident _x in Id _x
-      | Qualified (_x, _x_i1, _x_i2) ->
-          let _x = o#ident _x in
-          let _x_i1 = o#kind _x_i1 in
-          let _x_i2 = o#option (fun o -> o#string) _x_i2
-          in Qualified (_x, _x_i1, _x_i2)
-    method variable_declaration :
-      variable_declaration -> variable_declaration =
-      fun { ident = _x; value = _x_i1; property = _x_i2; ident_info = _x_i3 }
-        ->
-        let _x = o#ident _x in
-        let _x_i1 = o#option (fun o -> o#expression) _x_i1 in
-        let _x_i2 = o#property _x_i2 in
-        let _x_i3 = o#ident_info _x_i3
-        in
-          { ident = _x; value = _x_i1; property = _x_i2; ident_info = _x_i3;
-          }
-    method tag_info : tag_info -> tag_info = o#unknown
-    method statement_desc : statement_desc -> statement_desc =
-      function
-      | Block _x -> let _x = o#block _x in Block _x
-      | Variable _x -> let _x = o#variable_declaration _x in Variable _x
-      | Exp _x -> let _x = o#expression _x in Exp _x
-      | If (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#block _x_i1 in
-          let _x_i2 = o#option (fun o -> o#block) _x_i2
-          in If (_x, _x_i1, _x_i2)
-      | While (_x, _x_i1, _x_i2, _x_i3) ->
-          let _x = o#option (fun o -> o#label) _x in
-          let _x_i1 = o#expression _x_i1 in
-          let _x_i2 = o#block _x_i2 in
-          let _x_i3 = o#unknown _x_i3 in While (_x, _x_i1, _x_i2, _x_i3)
-      | ForRange (_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5) ->
-          let _x = o#option (fun o -> o#for_ident_expression) _x in
-          let _x_i1 = o#finish_ident_expression _x_i1 in
-          let _x_i2 = o#for_ident _x_i2 in
-          let _x_i3 = o#for_direction _x_i3 in
-          let _x_i4 = o#block _x_i4 in
-          let _x_i5 = o#unknown _x_i5
-          in ForRange (_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)
-      | Continue _x -> let _x = o#label _x in Continue _x
-      | Break -> Break
-      | Return _x -> let _x = o#return_expression _x in Return _x
-      | Int_switch (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 =
-            o#list
-              (fun o ->
-                 (* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-                 (** Javascript IR
-  
-    It's a subset of Javascript AST specialized for OCaml lambda backend
+let make_variant_matching_constant p lab def ctx = function
+    [] -> fatal_error "Matching.make_variant_matching_constant"
+  | ((arg, mut) :: argl) ->
+      let def = make_default (matcher_variant_const lab) def
+      and ctx = filter_ctx p ctx in
+      {pm={ cases = []; args = argl ; default=def} ;
+        ctx=ctx ;
+        pat = normalize_pat p}
 
-    Note it's not exactly the same as Javascript, the AST itself follows lexical
-    convention and [Block] is just a sequence of statements, which means it does 
-    not introduce new scope
-*)
-                 (** object literal, if key is ident, in this case, it might be renamed by 
-    Google Closure  optimizer,
-    currently we always use quote
- *)
-                 (* Since camldot is only available for toplevel module accessors,
-       we don't need print  `A.length$2`
-       just print `A.length` - it's guarateed to be unique
-       
-       when the third one is None, it means the whole module 
+let matcher_variant_nonconst lab p rem = match p.pat_desc with
+| Tpat_or (_,_,_) -> raise OrPat
+| Tpat_variant (lab1,Some arg,_) when lab1=lab -> arg::rem
+| Tpat_any -> omega::rem
+| _   -> raise NoMatch
 
-       TODO: 
-       invariant, when [kind] is [Runtime], then we can ignore [ident], 
-       since all [runtime] functions are unique, when do the 
-       pattern match we can ignore the first one for simplicity
-       for example       
-       {[
-         Qualified (_, Runtime, Some "caml_int_compare")         
-       ]}       
-     *)
-                 (* used in [js_create_array] primitive, note having
-       uninitilized array is not as bad as in ocaml, 
-       since GC does not rely on it
-     *)
-                 (* shallow copy, like [x.slice] *)
-                 (* For [caml_array_append]*)
-                 (* | Tag_ml_obj of expression *) (* js true/false*)
-                 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence 
-     [typeof] is an operator     
-  *)
-                 (* 1 - v *) (* !v *)
-                 (* String.fromCharCode.apply(null, args) *)
-                 (* Convert JS boolean into OCaml boolean 
-       like [+true], note this ast talks using js
-       terminnology unless explicity stated                       
-     *)
-                 (* TODO: in the future, it might make sense to group primitivie by type,
-     which makes optimizations easier
-     {[ JSON.stringify(value, replacer[, space]) ]}
-  *)
-                 (* for debugging utitlites, 
-     TODO:  [Dump] is not necessary with this primitive 
-     Note that the semantics is slightly different from [JSON.stringify]     
-     {[
-       JSON.stringify("x")       
-     ]}
-     {[
-       ""x""       
-     ]}     
-     {[
-       JSON.stringify(undefined)       
-     ]}     
-     {[
-       undefined       
-     ]}
-     {[ '' + undefined
-     ]}     
-     {[ 'undefined'
-     ]}     
-  *)
-                 (* TODO: 
-     add 
-     {[ Assert of bool * expression ]}     
-  *)
-                 (* to support 
-       val log1 : 'a -> unit
-       val log2 : 'a -> 'b -> unit 
-       val log3 : 'a -> 'b -> 'c -> unit 
-     *)
-                 (* TODO: Add some primitives so that [js inliner] can do a better job *)
-                 (* [int_op] will guarantee return [int32] bits 
-     https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators  *)
-                 (* | Int32_bin of int_op * expression * expression *)
-                 (* f.apply(null,args) -- Fully applied guaranteed 
-       TODO: once we know args's shape --
-       if it's know at compile time, we can turn it into
-       f(args[0], args[1], ... )
-     *)
-                 (* {[ Bind (a,b) ]}
-     is literally
-     {[ a.bind(b) ]}
-  *)
-                 (* Analysze over J expression is hard since, 
-        some primitive  call is translated 
-        into a plain call, it's better to keep them
-    *)
-                 (* Invariant: 
-       The second argument has to be type of [int],
-       This can be constructed either in a static way [E.index] or a dynamic way 
-       [E.access]
-     *)
-                 (* The third argument bool indicates whether we should 
-       print it as 
-       a["idd"] -- false
-       or 
-       a.idd  -- true
-       There are several kinds of properties
-       1. OCaml module dot (need to be escaped or not)
-          All exported declarations have to be OCaml identifiers
-       2. Javascript dot (need to be preserved/or using quote)
-     *)
-                 (* TODO: option remove *)
-                 (* The first parameter by default is false, 
-     it will be true when it's a method
-  *)
-                 (* A string is UTF-8 encoded, the string may contain
-       escape sequences.
-       The first argument is used to mark it is non-pure, please
-       don't optimize it, since it does have side effec, 
-       examples like "use asm;" and our compiler may generate "error;..." 
-       which is better to leave it alone
-     *)
-                 (* literally raw JS code 
-  *)
-                 (* The third argument is [tag] , forth is [tag_info] *)
-                 (* [tag] and [size] tailed  for [Obj.new_block] *)
-                 (* For setter, it still return the value of expression, 
-     we can not use 
-     {[
-       type 'a access = Get | Set of 'a
-     ]}
-     in another module, since it will break our code generator
-     [Caml_block_tag] can return [undefined], 
-     you have to use [E.tag] in a safe way     
-  *)
-                 (* It will just fetch tag, to make it safe, when creating it, 
-     we need apply "|0", we don't do it in the 
-     last step since "|0" can potentially be optimized
+
+let make_variant_matching_nonconst p lab def ctx = function
+    [] -> fatal_error "Matching.make_variant_matching_nonconst"
+  | ((arg, mut) :: argl) ->
+      let def = make_default (matcher_variant_nonconst lab) def
+      and ctx = filter_ctx p ctx in
+      {pm=
+        {cases = []; args = (Lprim(Pfield (1, Fld_na (* TODO*)), [arg], p.pat_loc), Alias) :: argl;
+          default=def} ;
+        ctx=ctx ;
+        pat = normalize_pat p}
+
+let get_key_variant p = match p.pat_desc with
+| Tpat_variant(lab, Some _ , _) ->  Cstr_block (Btype.hash_variant lab)
+| Tpat_variant(lab, None , _) -> Cstr_constant (Btype.hash_variant lab)
+|  _ -> assert false
+
+let divide_variant row ctx {cases = cl; args = al; default=def} =
+  let row = Btype.row_repr row in
+  let rec divide = function
+      ({pat_desc = Tpat_variant(lab, pato, _)} as p:: patl, action) :: rem ->
+        let variants = divide rem in
+        if try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
+        with Not_found -> true
+        then
+          variants
+        else begin
+          let tag = Btype.hash_variant lab in
+          match pato with
+            None ->
+              add (make_variant_matching_constant p lab def ctx) variants
+                (=) (Cstr_constant tag) (patl, action) al
+          | Some pat ->
+              add (make_variant_matching_nonconst p lab def ctx) variants
+                (=) (Cstr_block tag) (pat :: patl, action) al
+        end
+    | cl -> []
+  in
+  divide cl
+
+(*
+  Three ``no-test'' cases
   *)
-                 (* pure*) (* pure *)
-                 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/block
-   block can be nested, specified in ES3 
- *)
-                 (* Delay some units like [primitive] into JS layer ,
-   benefit: better cross module inlining, and smaller IR size?
- *)
-                 (* 
-  [closure] captured loop mutable values in the outer loop
 
-  check if it contains loop mutable values, happens in nested loop
-  when closured, it's no longer loop mutable value. 
-  which means the outer loop mutable value can not peek into the inner loop
-  {[
-  var i = f ();
-  for(var finish = 32; i < finish; ++i){
-  }
-  ]}
-  when [for_ident_expression] is [None], [var i] has to 
-  be initialized outside, so 
+(* Matching against a variable *)
 
-  {[
-  var i = f ()
-  (function (xxx){
-  for(var finish = 32; i < finish; ++i)
-  }(..i))
-  ]}
-  This happens rare it's okay
+let get_args_var _ rem = rem
 
-  this is because [i] has to be initialized outside, if [j] 
-  contains a block side effect
-  TODO: create such example
-*)
-                 (* Since in OCaml, 
-   
-  [for i = 0 to k end do done ]
-  k is only evaluated once , to encode this invariant in JS IR,
-  make sure [ident] is defined in the first b
 
-  TODO: currently we guarantee that [bound] was only 
-  excecuted once, should encode this in AST level
-*)
-                 (* Can be simplified to keep the semantics of OCaml
-   For (var i, e, ...){
-     let  j = ... 
-   }
+let make_var_matching def = function
+  | [] ->  fatal_error "Matching.make_var_matching"
+  | _::argl ->
+      {cases=[] ;
+        args = argl ;
+        default= make_default get_args_var def}
 
-   if [i] or [j] is captured inside closure
+let divide_var ctx pm =
+  divide_line ctx_lshift make_var_matching get_args_var omega ctx pm
 
-   for (var i , e, ...){
-     (function (){
-     })(i)
-   }
-*)
-                 (* Single return is good for ininling..
-   However, when you do tail-call optmization
-   you loose the expression oriented semantics
-   Block is useful for implementing goto
-   {[
-   xx:{
-   break xx;
-   }
-   ]}
-*)
-                 (* Function declaration and Variable declaration  *)
-                 (* check if it contains loop mutable values, happens in nested loop *)
-                 (* only used when inline a fucntion *)
-                 (* Here we need track back a bit ?, move Return to Function ...
-                              Then we can only have one Return, which is not good *)
-                 o#case_clause (fun o -> o#int))
-              _x_i1 in
-          let _x_i2 = o#option (fun o -> o#block) _x_i2
-          in Int_switch (_x, _x_i1, _x_i2)
-      | String_switch (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 =
-            o#list (fun o -> o#case_clause (fun o -> o#string)) _x_i1 in
-          let _x_i2 = o#option (fun o -> o#block) _x_i2
-          in String_switch (_x, _x_i1, _x_i2)
-      | Throw _x -> let _x = o#expression _x in Throw _x
-      | Try (_x, _x_i1, _x_i2) ->
-          let _x = o#block _x in
-          let _x_i1 =
-            o#option
-              (fun o (_x, _x_i1) ->
-                 let _x = o#exception_ident _x in
-                 let _x_i1 = o#block _x_i1 in (_x, _x_i1))
-              _x_i1 in
-          let _x_i2 = o#option (fun o -> o#block) _x_i2
-          in Try (_x, _x_i1, _x_i2)
-      | Debugger -> Debugger
-    method statement : statement -> statement =
-      fun { statement_desc = _x; comment = _x_i1 } ->
-        let _x = o#statement_desc _x in
-        let _x_i1 = o#option (fun o -> o#string) _x_i1
-        in { statement_desc = _x; comment = _x_i1; }
-    method return_expression : return_expression -> return_expression =
-      fun { return_value = _x } ->
-        let _x = o#expression _x in { return_value = _x; }
-    method required_modules : required_modules -> required_modules =
-      o#unknown
-    method property_name : property_name -> property_name = o#unknown
-    method property_map : property_map -> property_map =
-      o#list
-        (fun o (_x, _x_i1) ->
-           let _x = o#property_name _x in
-           let _x_i1 = o#expression _x_i1 in (_x, _x_i1))
-    method property : property -> property = o#unknown
-    method program : program -> program =
-      fun { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3 }
-        ->
-        let _x = o#string _x in
-        let _x_i1 = o#block _x_i1 in
-        let _x_i2 = o#exports _x_i2 in
-        let _x_i3 = o#unknown _x_i3
-        in { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3; }
-    method number : number -> number = o#unknown
-    method mutable_flag : mutable_flag -> mutable_flag = o#unknown
-    method length_object : length_object -> length_object = o#unknown
-    method label : label -> label = o#string
-    method kind : kind -> kind = o#unknown
-    method jsint : jsint -> jsint = o#unknown
-    method int_op : int_op -> int_op = o#unknown
-    method ident_info : ident_info -> ident_info = o#unknown
-    method ident : ident -> ident = o#unknown
-    method for_ident_expression :
-      for_ident_expression -> for_ident_expression = o#expression
-    method for_ident : for_ident -> for_ident = o#ident
-    method for_direction : for_direction -> for_direction = o#unknown
-    method finish_ident_expression :
-      finish_ident_expression -> finish_ident_expression = o#expression
-    method expression_desc : expression_desc -> expression_desc =
-      function
-      | Math (_x, _x_i1) ->
-          let _x = o#string _x in
-          let _x_i1 = o#list (fun o -> o#expression) _x_i1
-          in Math (_x, _x_i1)
-      | Length (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#length_object _x_i1 in Length (_x, _x_i1)
-      | Char_of_int _x -> let _x = o#expression _x in Char_of_int _x
-      | Char_to_int _x -> let _x = o#expression _x in Char_to_int _x
-      | Array_of_size _x -> let _x = o#expression _x in Array_of_size _x
-      | Array_copy _x -> let _x = o#expression _x in Array_copy _x
-      | Array_append (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Array_append (_x, _x_i1)
-      | String_append (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in String_append (_x, _x_i1)
-      | Int_of_boolean _x -> let _x = o#expression _x in Int_of_boolean _x
-      | Anything_to_number _x ->
-          let _x = o#expression _x in Anything_to_number _x
-      | Bool _x -> let _x = o#bool _x in Bool _x
-      | Typeof _x -> let _x = o#expression _x in Typeof _x
-      | Caml_not _x -> let _x = o#expression _x in Caml_not _x
-      | Js_not _x -> let _x = o#expression _x in Js_not _x
-      | String_of_small_int_array _x ->
-          let _x = o#expression _x in String_of_small_int_array _x
-      | Json_stringify _x -> let _x = o#expression _x in Json_stringify _x
-      | Anything_to_string _x ->
-          let _x = o#expression _x in Anything_to_string _x
-      | Dump (_x, _x_i1) ->
-          let _x = o#unknown _x in
-          let _x_i1 = o#list (fun o -> o#expression) _x_i1
-          in Dump (_x, _x_i1)
-      | Seq (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Seq (_x, _x_i1)
-      | Cond (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in
-          let _x_i2 = o#expression _x_i2 in Cond (_x, _x_i1, _x_i2)
-      | Bin (_x, _x_i1, _x_i2) ->
-          let _x = o#binop _x in
-          let _x_i1 = o#expression _x_i1 in
-          let _x_i2 = o#expression _x_i2 in Bin (_x, _x_i1, _x_i2)
-      | FlatCall (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in FlatCall (_x, _x_i1)
-      | Bind (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Bind (_x, _x_i1)
-      | Call (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#list (fun o -> o#expression) _x_i1 in
-          let _x_i2 = o#unknown _x_i2 in Call (_x, _x_i1, _x_i2)
-      | String_access (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in String_access (_x, _x_i1)
-      | Access (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Access (_x, _x_i1)
-      | Dot (_x, _x_i1, _x_i2) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#string _x_i1 in
-          let _x_i2 = o#bool _x_i2 in Dot (_x, _x_i1, _x_i2)
-      | New (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 =
-            o#option (fun o -> o#list (fun o -> o#expression)) _x_i1
-          in New (_x, _x_i1)
-      | Var _x -> let _x = o#vident _x in Var _x
-      | Fun (_x, _x_i1, _x_i2, _x_i3) ->
-          let _x = o#bool _x in
-          let _x_i1 = o#list (fun o -> o#ident) _x_i1 in
-          let _x_i2 = o#block _x_i2 in
-          let _x_i3 = o#unknown _x_i3 in Fun (_x, _x_i1, _x_i2, _x_i3)
-      | Str (_x, _x_i1) ->
-          let _x = o#bool _x in let _x_i1 = o#string _x_i1 in Str (_x, _x_i1)
-      | Raw_js_code (_x, _x_i1) ->
-          let _x = o#string _x in
-          let _x_i1 = o#code_info _x_i1 in Raw_js_code (_x, _x_i1)
-      | Array (_x, _x_i1) ->
-          let _x = o#list (fun o -> o#expression) _x in
-          let _x_i1 = o#mutable_flag _x_i1 in Array (_x, _x_i1)
-      | Caml_block (_x, _x_i1, _x_i2, _x_i3) ->
-          let _x = o#list (fun o -> o#expression) _x in
-          let _x_i1 = o#mutable_flag _x_i1 in
-          let _x_i2 = o#expression _x_i2 in
-          let _x_i3 = o#tag_info _x_i3
-          in Caml_block (_x, _x_i1, _x_i2, _x_i3)
-      | Caml_uninitialized_obj (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1
-          in Caml_uninitialized_obj (_x, _x_i1)
-      | Caml_block_tag _x -> let _x = o#expression _x in Caml_block_tag _x
-      | Caml_block_set_tag (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Caml_block_set_tag (_x, _x_i1)
-      | Caml_block_set_length (_x, _x_i1) ->
-          let _x = o#expression _x in
-          let _x_i1 = o#expression _x_i1 in Caml_block_set_length (_x, _x_i1)
-      | Number _x -> let _x = o#number _x in Number _x
-      | Object _x -> let _x = o#property_map _x in Object _x
-    method expression : expression -> expression =
-      fun { expression_desc = _x; comment = _x_i1 } ->
-        let _x = o#expression_desc _x in
-        let _x_i1 = o#option (fun o -> o#string) _x_i1
-        in { expression_desc = _x; comment = _x_i1; }
-    method exports : exports -> exports = o#unknown
-    method exception_ident : exception_ident -> exception_ident = o#ident
-    method deps_program : deps_program -> deps_program =
-      fun { program = _x; modules = _x_i1; side_effect = _x_i2 } ->
-        let _x = o#program _x in
-        let _x_i1 = o#required_modules _x_i1 in
-        let _x_i2 = o#option (fun o -> o#string) _x_i2
-        in { program = _x; modules = _x_i1; side_effect = _x_i2; }
-    method code_info : code_info -> code_info = o#unknown
-    method case_clause :
-      (* since in ocaml, it's expression oriented langauge, [return] in
-    general has no jumps, it only happens when we do 
-    tailcall conversion, in that case there is a jump.
-    However, currently  a single [break] is good to cover
-    our compilation strategy 
+(* Matching and forcing a lazy value *)
 
-    Attention: we should not insert [break] arbitrarily, otherwise 
-    it would break the semantics
-    A more robust signature would be 
-    {[ goto : label option ; ]}
-  *)
-        'a 'a_out.
-        ('self_type -> 'a -> 'a_out) -> 'a case_clause -> 'a_out case_clause =
-      fun _f_a { case = _x; 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; }
-    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 
- *)
-      o#list (fun o -> o#statement)
-    method binop : binop -> binop = o#unknown
-    method unknown : 'a. 'a -> 'a = fun x -> x
-  end
-  
+let get_arg_lazy p rem = match p with
+| {pat_desc = Tpat_any} -> omega :: rem
+| {pat_desc = Tpat_lazy arg} -> arg :: rem
+| _ ->  assert false
 
+let matcher_lazy p rem = match p.pat_desc with
+| Tpat_or (_,_,_)     -> raise OrPat
+| Tpat_var _          -> get_arg_lazy omega rem
+| _                   -> get_arg_lazy p rem
 
-end
-module Js_pass_flatten : sig 
-#1 "js_pass_flatten.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+(* Inlining the tag tests before calling the primitive that works on
+   lazy blocks. This is alse used in translcore.ml.
+   No call other than Obj.tag when the value has been forced before.
+*)
+
+let prim_obj_tag =
+  {prim_name = "caml_obj_tag";
+   prim_arity = 1; prim_alloc = false;
+   prim_native_name = "";
+   prim_native_float = false}
+
+let get_mod_field modname field =
+  lazy (
+    try
+      let mod_ident = Ident.create_persistent modname in
+      let env = Env.open_pers_signature modname Env.initial_safe_string in
+      let p = try
+        match Env.lookup_value (Longident.Lident field) env with
+        | (Path.Pdot(_,_,i), _) -> i
+        | _ -> fatal_error ("Primitive "^modname^"."^field^" not found.")
+      with Not_found ->
+        fatal_error ("Primitive "^modname^"."^field^" not found.")
+      in
+      Lprim(Pfield (p, Fld_na (* TODO - then we dont need query any more*)), 
+            [Lprim(Pgetglobal mod_ident, [], Location.none)], Location.none)
+    with Not_found -> fatal_error ("Module "^modname^" unavailable.")
+  )
 
+let code_force_lazy_block =
+  get_mod_field "CamlinternalLazy" "force_lazy_block"
+;;
 
+(* inline_lazy_force inlines the beginning of the code of Lazy.force. When
+   the value argument is tagged as:
+   - forward, take field 0
+   - lazy, call the primitive that forces (without testing again the tag)
+   - anything else, return it
 
+   Using Lswitch below relies on the fact that the GC does not shortcut
+   Forward(val_out_of_heap).
+*)
 
+let inline_lazy_force_cond arg loc =
+  let idarg = Ident.create "lzarg" in
+  let varg = Lvar idarg in
+  let tag = Ident.create "tag" in
+  let force_fun = Lazy.force code_force_lazy_block in
+  Llet(Strict, idarg, arg,
+       Llet(Alias, tag, Lprim(Pccall prim_obj_tag, [varg], loc),
+            Lifthenelse(
+              (* if (tag == Obj.forward_tag) then varg.(0) else ... *)
+              Lprim(Pintcomp Ceq,
+                    [Lvar tag; Lconst(Const_base(Const_int Obj.forward_tag))],
+                   loc),
+              Lprim(Pfield (0, Fld_na (* TODO: lazy *)), [varg],
+                   loc),
+              Lifthenelse(
+                (* ... if (tag == Obj.lazy_tag) then Lazy.force varg else ... *)
+                Lprim(Pintcomp Ceq,
+                      [Lvar tag; Lconst(Const_base(Const_int Obj.lazy_tag))],
+                     loc),
+                Lapply(force_fun, [varg], loc),
+                (* ... arg *)
+                  varg))))
 
+let inline_lazy_force_switch arg loc =
+  let idarg = Ident.create "lzarg" in
+  let varg = Lvar idarg in
+  let force_fun = Lazy.force code_force_lazy_block in
+  Llet(Strict, idarg, arg,
+       Lifthenelse(
+         Lprim(Pisint, [varg],loc), varg,
+         (Lswitch
+            (varg,
+             { sw_numconsts = 0; sw_consts = [];
+               sw_numblocks = 256;  (* PR#6033 - tag ranges from 0 to 255 *)
+               sw_blocks =
+                 [ (Obj.forward_tag, Lprim(Pfield (0, Fld_na (* TODO: lazy *)), [varg],loc));
+                   (Obj.lazy_tag,
+                    Lapply(force_fun, [varg], loc)) ];
+               sw_failaction = Some varg } ))))
 
+let inline_lazy_force arg loc =
+  if !Clflags.native_code then
+    (* Lswitch generates compact and efficient native code *)
+    inline_lazy_force_switch arg loc
+  else
+    (* generating bytecode: Lswitch would generate too many rather big
+       tables (~ 250 elts); conditionals are better *)
+    inline_lazy_force_cond arg loc
 
+let make_lazy_matching def = function
+    [] -> fatal_error "Matching.make_lazy_matching"
+  | (arg,mut) :: argl ->
+      { cases = [];
+        args =
+          (inline_lazy_force arg Location.none, Strict) :: argl;
+        default = make_default matcher_lazy def }
 
-(** A pass converting nested js statement into a flatten visual appearance 
+let divide_lazy p ctx pm =
+  divide_line
+    (filter_ctx p)
+    make_lazy_matching
+    get_arg_lazy
+    p ctx pm
 
-    Note this module is used to convert some nested expressions to flat statements, 
-    in general, it's more human readable, and since it generate flat statements, we can spot
-    some inline opportunities for the produced statemetns, 
-    (inline) expressions inside a nested expression would generate ugly code.
+(* Matching against a tuple pattern *)
 
-    Since we are aiming to flatten expressions, we should avoid some smart constructors in {!Js_helper}, 
-    it  tries to spit out expression istead of statements if it can
-*)
 
-val program : J.program -> J.program
+let get_args_tuple arity p rem = match p with
+| {pat_desc = Tpat_any} -> omegas arity @ rem
+| {pat_desc = Tpat_tuple args} ->
+    args @ rem
+| _ ->  assert false
 
-end = struct
-#1 "js_pass_flatten.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let matcher_tuple arity p rem = match p.pat_desc with
+| Tpat_or (_,_,_)     -> raise OrPat
+| Tpat_var _          -> get_args_tuple arity omega rem
+| _                   ->  get_args_tuple arity p rem
 
+let make_tuple_matching loc arity def = function
+    [] -> fatal_error "Matching.make_tuple_matching"
+  | (arg, mut) :: argl ->
+      let rec make_args pos =
+        if pos >= arity
+        then argl
+        else (Lprim(Pfield (pos, Fld_na (* TODO: tuple*)) , [arg], loc), Alias) :: make_args (pos + 1) in
+      {cases = []; args = make_args 0 ;
+        default=make_default (matcher_tuple arity) def}
 
 
+let divide_tuple arity p ctx pm =
+  divide_line
+    (filter_ctx p)
+    (make_tuple_matching p.pat_loc arity)
+    (get_args_tuple  arity) p ctx pm
 
+(* Matching against a record pattern *)
 
 
+let record_matching_line num_fields lbl_pat_list =
+  let patv = Array.make num_fields omega in
+  List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
+  Array.to_list patv
 
+let get_args_record num_fields p rem = match p with
+| {pat_desc=Tpat_any} ->
+    record_matching_line num_fields [] @ rem
+| {pat_desc=Tpat_record (lbl_pat_list,_)} ->
+    record_matching_line num_fields lbl_pat_list @ rem
+| _ -> assert false
 
-module E = Js_exp_make
-module S = Js_stmt_make 
+let matcher_record num_fields p rem = match p.pat_desc with
+| Tpat_or (_,_,_) -> raise OrPat
+| Tpat_var _      -> get_args_record num_fields omega rem
+| _               -> get_args_record num_fields p rem
 
-let flatten_map = 
-  object(self)
-    inherit Js_map.map as super
-    method! statement x = 
-      match x.statement_desc with 
-      |  Exp ({expression_desc = Seq _; _} as v) ->
-          (S.block ( List.rev_map (self#statement) (Js_analyzer.rev_flatten_seq v )))
-      |  Exp ({expression_desc = Cond(a,b,c); comment} ) -> 
-          (* Note that we need apply [self#statement] recursively *)
-          { statement_desc = If (a, [ self#statement (S.exp b)],  
-                                 Some [ self#statement (S.exp c)]); comment}
-          (* CHECK? Trick semantics difference *)
-          (* super#statement (S.if_ a ([ (\* self#statement *\) (S.exp b) ]) *)
-          (*     ~else_:([self#statement (S.exp c)]) *)
-          (*                 ) *)
+let make_record_matching loc all_labels def = function
+    [] -> fatal_error "Matching.make_record_matching"
+  | ((arg, mut) :: argl) ->
+      let rec make_args pos =
+        if pos >= Array.length all_labels then argl else begin
+          let lbl = all_labels.(pos) in
+          let access =
+            match lbl.lbl_repres with
+              Record_regular -> Pfield (lbl.lbl_pos, Fld_record lbl.lbl_name)
+            | Record_float -> Pfloatfield (lbl.lbl_pos, Fld_record lbl.lbl_name) in
+          let str =
+            match lbl.lbl_mut with
+              Immutable -> Alias
+            | Mutable -> StrictOpt in
+          (Lprim(access, [arg], loc), str) :: make_args(pos + 1)
+        end in
+      let nfields = Array.length all_labels in
+      let def= make_default (matcher_record nfields) def in
+      {cases = []; args = make_args 0 ; default = def}
 
-      |  Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} )
-        ->
-          let block = Js_analyzer.rev_flatten_seq v in
-          begin match block with
-          | {statement_desc = Exp last_one ; _} :: rest_rev
-            ->  
-              S.block (Ext_list.rev_map_append (self#statement) rest_rev 
-                [self#statement @@ S.exp (E.assign a  last_one)])
-                (* TODO: here we introduce a block, should avoid it *)
-              (* super#statement *)
-              (*   (S.block (List.rev_append rest_rev [S.exp (E.assign a  last_one)])) *)
-          | _ ->
-              assert false
-          end
-      | Return ( {return_value = {expression_desc = Cond (a,b,c);  comment}}) 
-        -> 
-          { statement_desc = If (a, [self#statement (S.return b)],  
-                                 Some [ self#statement (S.return c)]); comment}
 
-      | Return ({return_value = {expression_desc = Seq _; _} as v}) ->
-          let block = Js_analyzer.rev_flatten_seq v  in
-          begin match block with
-          | {statement_desc = Exp last_one ; _} :: rest_rev
-            ->  
-              super#statement 
-                (S.block (Ext_list.rev_map_append (self#statement) rest_rev [S.return last_one]))
-          | _ -> assert false
-          end
-      | Block [x]
-          -> 
-            self#statement x 
-      | _ -> super#statement x 
+let divide_record all_labels p ctx pm =
+  let get_args = get_args_record (Array.length all_labels) in
+  divide_line
+    (filter_ctx p)
+    (make_record_matching p.pat_loc all_labels)
+    get_args
+    p ctx pm
 
-    method! block b =
-      match b with
-      | {statement_desc = Block bs } :: rest ->
-          self#block ( bs @  rest)
-      | x::rest  
-        -> 
-          self#statement x :: self#block rest
-      | [] -> []
-  end
+(* Matching against an array pattern *)
 
-let program ( x : J.program) = flatten_map # program x 
+let get_key_array = function
+  | {pat_desc=Tpat_array patl} -> List.length patl
+  | _ -> assert false
 
-end
-module Js_pass_flatten_and_mark_dead : sig 
-#1 "js_pass_flatten_and_mark_dead.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let get_args_array p rem = match p with
+| {pat_desc=Tpat_array patl} -> patl@rem
+| _ -> assert false
 
+let matcher_array len p rem = match p.pat_desc with
+| Tpat_or (_,_,_) -> raise OrPat
+| Tpat_array args when List.length args=len -> args @ rem
+| Tpat_any -> Parmatch.omegas len @ rem
+| _ -> raise NoMatch
 
+let make_array_matching kind p def ctx = function
+  | [] -> fatal_error "Matching.make_array_matching"
+  | ((arg, mut) :: argl) ->
+      let len = get_key_array p in
+      let rec make_args pos =
+        if pos >= len
+        then argl
+        else (Lprim(Parrayrefu kind, [arg; Lconst(Const_base(Const_int pos))],p.pat_loc),
+              StrictOpt) :: make_args (pos + 1) in
+      let def = make_default (matcher_array len) def
+      and ctx = filter_ctx p ctx in
+      {pm={cases = []; args = make_args 0 ; default = def} ;
+        ctx=ctx ;
+        pat = normalize_pat p}
 
+let divide_array kind ctx pm =
+  divide
+    (make_array_matching kind)
+    (=) get_key_array get_args_array ctx pm
 
 
+(*
+   Specific string test sequence
+   Will be called by the bytecode compiler, from bytegen.ml.
+   The strategy is first dichotomic search (we perform 3-way tests
+   with compare_string), then sequence of equality tests
+   when there are less then T=strings_test_threshold static strings to match.
 
+  Increasing T entails (slightly) less code, decreasing T
+  (slightly) favors runtime speed.
+  T=8 looks a decent tradeoff.
+*)
 
+(* Utilities *)
 
-(** A pass to mark some declarations in JS IR as dead code *)
+let strings_test_threshold = 8
 
-val program :  J.program -> J.program
+let prim_string_notequal =
+  Pccall{prim_name = "caml_string_notequal";
+         prim_arity = 2; prim_alloc = false;
+         prim_native_name = ""; prim_native_float = false}
 
-end = struct
-#1 "js_pass_flatten_and_mark_dead.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let prim_string_compare =
+  Pccall{prim_name = "caml_string_compare";
+         prim_arity = 2; prim_alloc = false;
+         prim_native_name = ""; prim_native_float = false}
 
+let bind_sw arg k = match arg with
+| Lvar _ -> k arg
+| _ ->
+    let id = Ident.create "switch" in
+    Llet (Strict,id,arg,k (Lvar id))
 
 
+(* Sequential equality tests *)
 
+let make_string_test_sequence loc arg sw d =
+  let d,sw = match d with
+  | None ->
+      begin match sw with
+      | (_,d)::sw -> d,sw
+      | [] -> assert false
+      end
+  | Some d -> d,sw in
+  bind_sw arg
+    (fun arg ->
+      List.fold_right
+        (fun (s,lam) k ->
+          Lifthenelse
+            (Lprim
+               (prim_string_notequal,
+                [arg; Lconst (Const_immstring s)], loc),
+             k,lam))
+        sw d)
 
+let rec split k xs = match xs with
+| [] -> assert false
+| x0::xs ->
+    if k <= 1 then [],x0,xs
+    else
+      let xs,y0,ys = split (k-2) xs in
+      x0::xs,y0,ys
 
+let zero_lam  = Lconst (Const_base (Const_int 0))
 
+let tree_way_test loc arg lt eq gt =
+  Lifthenelse
+    (Lprim (Pintcomp Clt,[arg;zero_lam], loc),lt,
+     Lifthenelse(Lprim (Pintcomp Clt,[zero_lam;arg], loc),gt,eq))
 
-module E = Js_exp_make
-module S = Js_stmt_make
+(* Dichotomic tree *)
 
-class count  var = object (self : 'self)
-  val mutable appears = 0
-  inherit Js_fold.fold as super
-  method! ident  x =
-    (if Ident.same x var then
-      appears <- appears + 1); 
-    self
-  method get_appears = appears 
-end
 
-(* rewrite return for current block, but don't go into
-   inner function, mostly for inlinning
- *)
-class rewrite_return ?return_value ()=
-  let mk_return  = 
-    match return_value with 
-    | None -> fun e -> S.exp e 
-    | Some ident -> fun e -> S.define ~kind:Variable ident e in
-  object (self : 'self)
-    inherit Js_map.map as super
-    method! statement x =
-      match x.statement_desc with 
-      | Return {return_value = e} -> 
-          mk_return e 
-      | _ -> super#statement x 
-    method! expression x = x (* don't go inside *)
-  end  
+let rec do_make_string_test_tree loc arg sw delta d =
+  let len = List.length sw in
+  if len <= strings_test_threshold+delta then
+    make_string_test_sequence loc arg sw d
+  else
+    let lt,(s,act),gt = split len sw in
+    bind_sw
+      (Lprim
+         (prim_string_compare,
+          [arg; Lconst (Const_immstring s)], loc;))
+      (fun r ->
+        tree_way_test loc r
+          (do_make_string_test_tree  loc arg lt delta d)
+          act
+          (do_make_string_test_tree loc arg gt delta d))
 
-(* 
-    HERE we are using an object , so make sure to clean it up, 
-    remove stale cache
- *)
-let mark_dead = object (self)
-  inherit Js_fold.fold as super
+(* Entry point *)
+let expand_stringswitch loc arg sw d = match d with
+| None ->
+    bind_sw arg
+      (fun arg -> do_make_string_test_tree loc  arg sw 0 None)
+| Some e ->
+    bind_sw arg
+      (fun arg ->
+        make_catch e
+          (fun d -> do_make_string_test_tree loc arg sw 1 (Some d)))
 
-  val mutable name = ""
+(**********************)
+(* Generic test trees *)
+(**********************)
 
-  val mutable ident_use_stats : [`Info of J.ident_info | `Recursive] Ident_hashtbl.t
-      = Ident_hashtbl.create 17
-  
-  val mutable export_set : Ident_set.t = Ident_set.empty    
+(* Sharing *)
 
-  method mark_not_dead ident =
-    match Ident_hashtbl.find_opt ident_use_stats ident with
-    | None -> (* First time *)
-        Ident_hashtbl.add ident_use_stats ident `Recursive 
-        (* recursive identifiers *)
-    | Some `Recursive
-      -> ()
-    | Some (`Info x) ->  Js_op_util.update_used_stats x Used 
+(* Add handler, if shared *)
+let handle_shared () =
+  let hs = ref (fun x -> x) in
+  let handle_shared act = match act with
+  | Switch.Single act -> act
+  | Switch.Shared act ->
+      let i,h = make_catch_delayed act in
+      let ohs = !hs in
+      hs := (fun act -> h (ohs act)) ;
+      make_exit i in
+  hs,handle_shared
 
-  method scan b ident (ident_info : J.ident_info) = 
-    let is_export = Ident_set.mem ident export_set in
-    let () = 
-      if is_export (* && false *) then 
-        Js_op_util.update_used_stats ident_info Exported 
-    in
-    match Ident_hashtbl.find_opt ident_use_stats ident with
-    | Some (`Recursive) -> 
-        Js_op_util.update_used_stats ident_info Used; 
-        Ident_hashtbl.replace ident_use_stats ident (`Info ident_info)
-    | Some (`Info _) ->  
-        (** check [camlinternlFormat,box_type] inlined twice 
-            FIXME: seems we have redeclared identifiers
-         *)
-      if Js_config.get_diagnose () then 
-        Ext_log.warn __LOC__ "@[%s$%d in %s@]" ident.name ident.stamp name
-        (* assert false *)
-    | None ->  (* First time *)
-        Ident_hashtbl.add ident_use_stats ident (`Info ident_info);
-        Js_op_util.update_used_stats ident_info 
-          (if b then Scanning_pure else Scanning_non_pure)
-  method promote_dead = 
-    Ident_hashtbl.iter (fun _id (info : [`Info of J.ident_info  | `Recursive]) ->
-      match info  with 
-      | `Info ({used_stats = Scanning_pure} as info) -> 
-          Js_op_util.update_used_stats info Dead_pure
-      | `Info ({used_stats = Scanning_non_pure} as info) -> 
-          Js_op_util.update_used_stats info Dead_non_pure
-      | _ -> ())
-      ident_use_stats;
-    Ident_hashtbl.clear ident_use_stats (* clear to make it re-entrant *)
 
-  method! program x = 
-    export_set <- x.export_set ; 
-    name <- x.name;
-    super#program x 
+let share_actions_tree sw d =
+  let store = StoreExp.mk_store () in
+(* Default action is always shared *)
+  let d =
+    match d with
+    | None -> None
+    | Some d -> Some (store.Switch.act_store_shared d) in
+(* Store all other actions *)
+  let sw =
+    List.map  (fun (cst,act) -> cst,store.Switch.act_store act) sw in
 
-  method! ident x = 
-    self#mark_not_dead x ; self 
+(* Retrieve all actions, includint potentiel default *)
+  let acts = store.Switch.act_get_shared () in
 
-  method! variable_declaration vd =  
-    match vd with 
-    | { ident_info = {used_stats = Dead_pure } ; _}
-      -> self
-    | { ident_info = {used_stats = Dead_non_pure } ; value } -> 
-      begin match value with
-      | None -> self
-      | Some x -> self#expression x 
-      end
-    | {ident; ident_info ; value ; _} -> 
-      let pure = 
-        match value with 
-        | None  -> false 
-        | Some x -> ignore (self#expression x); Js_analyzer.no_side_effect_expression x in
-      self#scan pure ident ident_info; self
-end
+(* Array of actual actions *)
+  let hs,handle_shared = handle_shared () in
+  let acts = Array.map handle_shared acts in
 
-let mark_dead_code js = 
-  let _ =  (mark_dead#program js) in 
-  mark_dead#promote_dead;
-  js
-        
-(*
-   when we do optmizations, we might need track it will break invariant 
-   of other optimizations, especially for [mutable] meta data, 
-   for example, this pass will break [closure] information, 
-   it should be done before closure pass (even it does not use closure information)
+(* Recontruct default and switch list *)
+  let d = match d with
+  | None -> None
+  | Some d -> Some (acts.(d)) in
+  let sw = List.map (fun (cst,j) -> cst,acts.(j)) sw in
+  !hs,sw,d
 
-   Take away, it is really hard to change the code while collecting some information..
-   we should always collect info in a single pass
+(* Note: dichotomic search requires sorted input with no duplicates *)
+let rec uniq_lambda_list sw = match sw with
+  | []|[_] -> sw
+  | (c1,_ as p1)::((c2,_)::sw2 as sw1) ->
+      if const_compare c1 c2 = 0 then uniq_lambda_list (p1::sw2)
+      else p1::uniq_lambda_list sw1
 
-   Note that, we should avoid reuse object, i.e,
-   {[
-     let v = 
-       object 
-       end      
-   ]}   
-   Since user may use `bsc.exe -c xx.ml xy.ml xz.ml` and we need clean up state
- *)
-let subst_map name = object (self)
-  inherit Js_map.map as super
+let sort_lambda_list l =
+  let l =
+    List.stable_sort (fun (x,_) (y,_) -> const_compare x y) l in
+  uniq_lambda_list l
 
-  val mutable substitution :  J.expression Ident_hashtbl.t= Ident_hashtbl.create 17 
+let rec cut n l =
+  if n = 0 then [],l
+  else match l with
+    [] -> raise (Invalid_argument "cut")
+  | a::l -> let l1,l2 = cut (n-1) l in a::l1, l2
 
-  method get_substitution = substitution
+let rec do_tests_fail loc fail tst arg = function
+  | [] -> fail
+  | (c, act)::rem ->
+      Lifthenelse
+        (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
+         do_tests_fail loc fail tst arg rem,
+         act)
 
-  method add_substitue (ident : Ident.t) (e:J.expression) = 
-    Ident_hashtbl.replace  substitution ident e
+let rec do_tests_nofail loc tst arg = function
+  | [] -> fatal_error "Matching.do_tests_nofail"
+  | [_,act] -> act
+  | (c,act)::rem ->
+      Lifthenelse
+        (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
+         do_tests_nofail loc tst arg rem,
+         act)
 
-  method! statement v = 
-    match v.statement_desc with 
-    | Variable ({ident; ident_info = {used_stats = Dead_pure } ; _}) -> 
-      {v with statement_desc = Block []}
-    | Variable ({ident; ident_info = {used_stats = Dead_non_pure } ; value = None}) -> 
-      {v with statement_desc = Block []}
-    | Variable ({ident; ident_info = {used_stats = Dead_non_pure } ; value = Some x}) -> 
-      {v with statement_desc =  (Exp x)}
+let make_test_sequence loc fail tst lt_tst arg const_lambda_list =
+  let const_lambda_list = sort_lambda_list const_lambda_list in
+  let hs,const_lambda_list,fail =
+    share_actions_tree const_lambda_list fail in
 
-    | Variable ({ ident ; 
-                  property = (Strict | StrictOpt | Alias);
-                  value = Some (
-                      {expression_desc = (Caml_block ( _:: _ :: _ as ls, Immutable, tag, tag_info) 
-                                         )} as block)
-                } as variable) -> 
-      (** If we do this, we should prevent incorrect inlning to inline it into an array :) 
-          do it only when block size is larger than one
-      *)
+  let rec make_test_sequence const_lambda_list =
+    if List.length const_lambda_list >= 4 && lt_tst <> Pignore then
+      split_sequence const_lambda_list
+    else match fail with
+    | None -> do_tests_nofail loc tst arg const_lambda_list
+    | Some fail -> do_tests_fail loc fail tst arg const_lambda_list
 
-      let (_, e, bindings) = 
-        List.fold_left 
-          (fun  (i,e,  acc) (x : J.expression) -> 
-             match x.expression_desc with 
-             | J.Var _ | Number _ | Str _ 
-               -> 
-               (i + 1, x :: e, acc)
-             | _ ->                
-               (* tradeoff, 
-                   when the block is small, it does not make 
-                   sense too much -- 
-                   bottomline, when the block size is one, no need to do 
-                   this
-               *)
-               let v' = self#expression x in 
-               let match_id =
-                 Ext_ident.create
-                   (Printf.sprintf "%s_%03d"
-                      ident.name i) in
-               (i + 1, E.var match_id :: e, (match_id, v') :: acc)               
-          ) (0, [], []) ls  in
-      let e = 
-        {block with 
-         expression_desc = 
-           Caml_block(List.rev e, Immutable, tag, tag_info)
-        } in
-      let () = self#add_substitue ident e in
-      (* let bindings =  !bindings in *)
-      let original_statement = 
-        { v with 
-          statement_desc = Variable {variable with value =  Some   e }
-        } in
-      begin match bindings with 
-        | [] -> 
-          original_statement
-        | _ ->  
-          (* self#add_substitue ident e ; *)
-          S.block @@
-          (Ext_list.rev_map_acc [original_statement] (fun (id,v) -> 
-               S.define ~kind:Strict id v)  bindings  )
-      end
-    | _ -> super#statement v 
+  and split_sequence const_lambda_list =
+    let list1, list2 =
+      cut (List.length const_lambda_list / 2) const_lambda_list in
+    Lifthenelse(Lprim(lt_tst,[arg; Lconst(Const_base (fst(List.hd list2)))], loc),
+                make_test_sequence list1, make_test_sequence list2)
+  in
+  hs (make_test_sequence const_lambda_list)
 
-  method! expression x =
-    match x.expression_desc with 
-    | Access ({expression_desc = Var (Id (id))}, 
-              {expression_desc = Number (Int {i; _})}) -> 
-      begin match Ident_hashtbl.find_opt self#get_substitution id with 
-        | Some {expression_desc = Caml_block (ls, Immutable, _, _) } 
-          -> 
-          (* user program can be wrong, we should not 
-             turn a runtime crash into compile time crash : )
-          *)          
-          begin match List.nth ls (Int32.to_int i) with 
-            | {expression_desc = J.Var _ | Number _ | Str _ } as x 
-              -> x 
-            | exception _ ->
-              begin
-                Ext_log.err __LOC__ "suspcious code %s when compiling %s@."
-                  (Printf.sprintf "%s/%d" id.name id.stamp)
-                  name  ;
-                super#expression x ;
-              end
-            | _ -> 
-              (** we can do here, however, we should 
-                  be careful that it can only be done 
-                  when it's accessed once and the array is not escaped,
-                  otherwise, we redo the computation,
-                  or even better, we re-order
 
-                  {[
-                    var match = [/* tuple */0,Pervasives.string_of_int(f(1,2,3)),f3(2),arr];
+let rec explode_inter offset i j act k =
+  if i <= j then
+    explode_inter offset i (j-1) act ((j-offset,act)::k)
+  else
+    k
 
-                        var a = match[1];
+let max_vals cases acts =
+  let vals = Array.make (Array.length acts) 0 in
+  for i=Array.length cases-1 downto 0 do
+    let l,h,act = cases.(i) in
+    vals.(act) <- h - l + 1 + vals.(act)
+  done ;
+  let max = ref 0 in
+  for i = Array.length vals-1 downto 0 do
+    if vals.(i) >= vals.(!max) then
+      max := i
+  done ;
+  if vals.(!max) > 1 then
+    !max
+  else
+    -1
 
-                          var b = match[2];
+let as_int_list cases acts =
+  let default = max_vals cases acts in
+  let min_key,_,_ = cases.(0)
+  and _,max_key,_ = cases.(Array.length cases-1) in
 
-                  ]}
+  let rec do_rec i k =
+    if i >= 0 then
+      let low, high, act =  cases.(i) in
+      if act = default then
+        do_rec (i-1) k
+      else
+        do_rec (i-1) (explode_inter min_key low high acts.(act) k)
+    else
+      k in
+  min_key, max_key,do_rec (Array.length cases-1) [],
+  (if default >= 0 then Some acts.(default) else None)
 
-                  --->
 
-                  {[
-                    var match$1 = Pervasives.string_of_int(f(1,2,3));
-                        var match$2 = f3(2);
-                            var match = [/* tuple */0,match$1,match$2,arr];
-                                var a = match$1;
-                                  var b = match$2;
-                                    var arr = arr; 
-                  ]}
+module SArg = struct
+  type primitive = Lambda.primitive
 
-                  --> 
-                  since match$1 (after match is eliminated) is only called once 
-                  {[
-                    var a = Pervasives.string_of_int(f(1,2,3));
-                    var b = f3(2);
-                    var arr = arr; 
-                  ]}
+  let eqint = Pintcomp Ceq
+  let neint = Pintcomp Cneq
+  let leint = Pintcomp Cle
+  let ltint = Pintcomp Clt
+  let geint = Pintcomp Cge
+  let gtint = Pintcomp Cgt
 
-              *)
-              super#expression x 
-          end
-        | (Some _ | None) -> super#expression x 
-      end
-    | _ -> super#expression x
-end 
+  type act = Lambda.lambda
 
-(* Top down or bottom up ?*)
-(* A pass to support nullary argument in JS 
-    Nullary information can be done in one pass, 
-    there is no need to add another pass
- *)
+  let make_prim p args = Lprim (p,args, Location.none)
+  let make_offset arg n = match n with
+  | 0 -> arg
+  | _ -> Lprim (Poffsetint n,[arg], Location.none)
 
-let program  (js : J.program) = 
-  js 
-  |> (subst_map js.name )#program
-  |> mark_dead_code
-  (* |> mark_dead_code *)
-  (* mark dead code twice does have effect in some cases, however, we disabled it 
-    since the benefit is not obvious
-   *)
+  let bind arg body =
+    let newvar,newarg = match arg with
+    | Lvar v -> v,arg
+    | _      ->
+        let newvar = Ident.create "switcher" in
+        newvar,Lvar newvar in
+    bind Alias newvar arg (body newarg)
+  let make_const i = Lconst (Const_base (Const_int i))
+  let make_isout h arg = Lprim (Pisout, [h ; arg], Location.none)
+  let make_isin h arg = Lprim (Pnot,[make_isout h arg], Location.none)
+  let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
+  let make_switch arg cases acts =
+    let l = ref [] in
+    for i = Array.length cases-1 downto 0 do
+      l := (i,acts.(cases.(i))) ::  !l
+    done ;
+    Lswitch(arg,
+            {sw_numconsts = Array.length cases ; sw_consts = !l ;
+             sw_numblocks = 0 ; sw_blocks =  []  ;
+             sw_failaction = None})
+  let make_catch  = make_catch_delayed
+  let make_exit = make_exit
 
 end
-module Js_pass_scope : sig 
-#1 "js_pass_scope.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+(* Action sharing for Lswitch argument *)
+let share_actions_sw sw =
+(* Attempt sharing on all actions *)
+  let store = StoreExp.mk_store () in
+  let fail = match sw.sw_failaction with
+  | None -> None
+  | Some fail ->
+      (* Fail is translated to exit, whatever happens *)
+      Some (store.Switch.act_store_shared fail) in
+  let consts =
+    List.map
+      (fun (i,e) -> i,store.Switch.act_store e)
+      sw.sw_consts
+  and blocks =
+    List.map
+      (fun (i,e) -> i,store.Switch.act_store e)
+      sw.sw_blocks in
+  let acts = store.Switch.act_get_shared () in
+  let hs,handle_shared = handle_shared () in
+  let acts = Array.map handle_shared acts in
+  let fail = match fail with
+  | None -> None
+  | Some fail -> Some (acts.(fail)) in
+  !hs,
+  { sw with
+    sw_consts = List.map (fun (i,j) -> i,acts.(j)) consts ;
+    sw_blocks = List.map (fun (i,j) -> i,acts.(j)) blocks ;
+    sw_failaction = fail; }
+
+(* Reintroduce fail action in switch argument,
+   for the sake of avoiding carrying over huge switches *)
 
+let reintroduce_fail sw = match sw.sw_failaction with
+| None ->
+    let t = Hashtbl.create 17 in
+    let seen (_,l) = match as_simple_exit l with
+    | Some i ->
+        let old = try Hashtbl.find t i with Not_found -> 0 in
+        Hashtbl.replace t i (old+1)
+    | None -> () in
+    List.iter seen sw.sw_consts ;
+    List.iter seen sw.sw_blocks ;
+    let i_max = ref (-1)
+    and max = ref (-1) in
+    Hashtbl.iter
+      (fun i c ->
+        if c > !max then begin
+          i_max := i ;
+          max := c
+        end) t ;
+    if !max >= 3 then
+      let default = !i_max in
+      let remove =
+        List.filter
+          (fun (_,lam) -> match as_simple_exit lam with
+          | Some j -> j <> default
+          | None -> true) in
+      {sw with
+       sw_consts = remove sw.sw_consts ;
+       sw_blocks = remove sw.sw_blocks ;
+       sw_failaction = Some (make_exit default)}
+    else sw
+| Some _ -> sw
 
 
+module Switcher = Switch.Make(SArg)
+open Switch
 
+let lambda_of_int i =  Lconst (Const_base (Const_int i))
 
+let rec last def = function
+  | [] -> def
+  | [x,_] -> x
+  | _::rem -> last def rem
 
+let get_edges low high l = match l with
+| [] -> low, high
+| (x,_)::_ -> x, last high l
 
-(** A module to do scope analysis over JS IR *)
 
-val program : J.program ->  Ident_set.t
+let as_interval_canfail fail low high l =
+  let store = StoreExp.mk_store () in
 
-end = struct
-#1 "js_pass_scope.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+  let do_store tag act =
+    let i =  store.act_store act in
+(*
+    Printlambda.lambda Format.str_formatter act ;
+    eprintf "STORE [%s] %i %s\n" tag i (Format.flush_str_formatter ()) ;
+*)
+    i in
 
+  let rec nofail_rec cur_low cur_high cur_act = function
+    | [] ->
+        if cur_high = high then
+          [cur_low,cur_high,cur_act]
+        else
+          [(cur_low,cur_high,cur_act) ; (cur_high+1,high, 0)]
+    | ((i,act_i)::rem) as all ->
+        let act_index = do_store "NO" act_i in
+        if cur_high+1= i then
+          if act_index=cur_act then
+            nofail_rec cur_low i cur_act rem
+          else if act_index=0 then
+            (cur_low,i-1, cur_act)::fail_rec i i rem
+          else
+            (cur_low, i-1, cur_act)::nofail_rec i i act_index rem
+        else if act_index = 0 then
+          (cur_low, cur_high, cur_act)::
+          fail_rec (cur_high+1) (cur_high+1) all
+        else
+          (cur_low, cur_high, cur_act)::
+          (cur_high+1,i-1,0)::
+          nofail_rec i i act_index rem
 
+  and fail_rec cur_low cur_high = function
+    | [] -> [(cur_low, cur_high, 0)]
+    | (i,act_i)::rem ->
+        let index = do_store "YES" act_i in
+        if index=0 then fail_rec cur_low i rem
+        else
+          (cur_low,i-1,0)::
+          nofail_rec i i index rem in
 
+  let init_rec = function
+    | [] -> []
+    | (i,act_i)::rem ->
+        let index = do_store "INIT" act_i in
+        if index=0 then
+          fail_rec low i rem
+        else
+          if low < i then
+            (low,i-1,0)::nofail_rec i i index rem
+          else
+            nofail_rec i i index rem in
 
+  assert (do_store "FAIL" fail = 0) ; (* fail has action index 0 *)
+  let r = init_rec l in
+  Array.of_list r,  store
 
+let as_interval_nofail l =
+  let store = StoreExp.mk_store () in
 
+  let rec i_rec cur_low cur_high cur_act = function
+    | [] ->
+        [cur_low, cur_high, cur_act]
+    | (i,act)::rem ->
+        let act_index = store.act_store act in
+        if act_index = cur_act then
+          i_rec cur_low i cur_act rem
+        else
+          (cur_low, cur_high, cur_act)::
+          i_rec i i act_index rem in
+  let inters = match l with
+  | (i,act)::rem ->
+      let act_index = store.act_store act in
+      i_rec i i act_index rem
+  | _ -> assert false in
 
+  Array.of_list inters, store
 
-let _l idents = 
-  Ext_log.err __LOC__ "hey .. %s@." 
-    (String.concat "," @@ List.map (fun  i -> i.Ident.name ) idents) 
 
-(* 
+let sort_int_lambda_list l =
+  List.sort
+    (fun (i1,_) (i2,_) ->
+      if i1 < i2 then -1
+      else if i2 < i1 then 1
+      else 0)
+    l
 
-    Base line 
-    {[
-     for i = 1 to n do (function (i){...}(i))
-     done
-       (* This is okay, since all ocaml follow the lexical scope, 
-          for generrated code too (* TODO: check *)
-        *)
-    ]}
+let as_interval fail low high l =
+  let l = sort_int_lambda_list l in
+  get_edges low high l,
+  (match fail with
+  | None -> as_interval_nofail l
+  | Some act -> as_interval_canfail act low high l)
 
-  For nested loops 
-  {[
-   for i = 0 to n do 
-     for j = 0 to n do 
-       arrr.(j)<- ()=>{ i}
-     done
-   done
- ]}
-    Three kind of variables  (defined in the loop scope)
-    1. loop mutable variables 
-       As long as variables change per iteration, defined in a loop (in the same loop)
-        and captured by a closure
-       the loop, iff  be lexically scoped 
-       Tailcall parameters are considered defined inside the loop
-    - unless it's defined 
-       outside all the loops - note that for nested loops, if it's defined 
-       in the outerloop and captured by the inner loop, 
-       it still has to be lexically scoped. 
+let call_switcher fail arg low high int_lambda_list =
+  let edges, (cases, actions) =
+    as_interval fail low high int_lambda_list in
+  Switcher.zyva edges arg cases actions
 
-       How do we detect whether it is loop invariant or not 
-       - depend on loop variant 
-       - depend on mutuable valuse
-       - non pure (function call)
 
-       so we need collect mutable variables 
-       1. from lambda + loop (for/i) + tailcall params
-       2. defined in the loop and can not determine it is invariant  
-          in such cases we can determine it's immutable
-          1. const 
-          2. only depend on immutable values and no function call?
+let exists_ctx ok ctx =
+  List.exists
+    (function
+      | {right=p::_} -> ok p
+      | _ -> assert false)
+    ctx
 
-    ## The following would take advantage of nested loops 
-    2. loop invariant observable varaibles 
-        {[ 
-         var x = (console.log(3), 32)
-        ]}
-    3. loop invariant non-observable variables 
+let rec list_as_pat = function
+  | [] -> fatal_error "Matching.list_as_pat"
+  | [pat] -> pat
+  | pat::rem ->
+      {pat with pat_desc = Tpat_or (pat,list_as_pat rem,None)}
 
-    Invariant: 
-    loop invariant (observable or not) variables can not depend on 
-    loop mutable values so that once we detect loop Invariant variables 
-    all its dependency are loop invariant as well, so we can do loop 
-    Invariant code motion.
-    
-    TODO:
-    loop invariant can be layered, it will be loop invariant 
-    in the inner layer while loop variant in the outer layer.
-    {[
-    for i = 0 to 10 do 
-      for j  = 10 do 
-        let  k0 = param * 100 in (* loop invariant *)
-        let  k1 = i * i in (* inner loop invariant, loop variant *)
-        let  k2 = j * i in (* variant *)
-        ..
-      done 
-    done 
-    ]}
-*)
 
-let scope_pass  = 
-  object(self)
-    inherit Js_fold.fold as super
+let rec pat_as_list k = function
+  | {pat_desc=Tpat_or (p1,p2,_)} ->
+      pat_as_list (pat_as_list k p2) p1
+  | p -> p::k
 
-    val  defined_idents = Ident_set.empty 
-        
-    (** [used_idents] 
-        does not contain locally defined idents *)
-    val  used_idents = Ident_set.empty 
-    (** we need collect mutable values and loop defined varaibles *)    
-    val loop_mutable_values = Ident_set.empty 
+(* Extracting interesting patterns *)
+exception All
 
-    val mutable_values = Ident_set.empty      
+let rec extract_pat seen k p = match p.pat_desc with
+| Tpat_or (p1,p2,_) ->
+    let k1,seen1 = extract_pat seen k p1 in
+    extract_pat seen1 k1 p2
+| Tpat_alias (p,_,_) ->
+    extract_pat  seen k p
+| Tpat_var _|Tpat_any ->
+    raise All
+| _ ->
+    let q = normalize_pat p in
+    if  List.exists (compat q) seen then
+      k, seen
+    else
+      q::k, q::seen
 
-    val closured_idents = Ident_set.empty 
+let extract_mat seen pss =
+  let r,_ =
+    List.fold_left
+      (fun (k,seen) ps -> match ps with
+      | p::_ -> extract_pat seen k p
+      | _ -> assert false)
+      ([],seen)
+      pss in
+  r
 
-    (** check if in loop or not *)    
-    val in_loop = false 
 
-    method get_in_loop = in_loop
 
-    method get_defined_idents = defined_idents
+let complete_pats_constrs = function
+  | p::_ as pats ->
+      List.map
+        (pat_of_constr p)
+        (complete_constrs p (List.map get_key_constr pats))
+  | _ -> assert false
 
-    method get_used_idents = used_idents
 
-    method get_loop_mutable_values = loop_mutable_values 
+let mk_res get_key env last_choice idef cant_fail ctx =
 
-    method get_mutable_values = mutable_values 
+  let env,fail,jumps_fail = match last_choice with
+  | [] ->
+      env, None, jumps_empty
+  | [p] when group_var p ->
+      env,
+      Some (Lstaticraise (idef,[])),
+      jumps_singleton idef ctx
+  | _ ->
+      (idef,cant_fail,last_choice)::env,
+      None, jumps_empty in
+  let klist,jumps =
+    List.fold_right
+      (fun (i,cant_fail,pats) (klist,jumps) ->
+        let act = Lstaticraise (i,[])
+        and pat = list_as_pat pats in
+        let klist =
+          List.fold_right
+            (fun pat klist -> (get_key pat,act)::klist)
+            pats klist
+        and ctx = if cant_fail then ctx else ctx_lub pat ctx in
+        klist,jumps_add i ctx jumps)
+      env ([],jumps_fail) in
+  fail, klist, jumps
 
-    method get_closured_idents = closured_idents 
 
-    method with_in_loop b = 
-      if b = self#get_in_loop then self
-      else {< in_loop = b >}
-     (* Since it's loop mutable variable, for sure
-         it is mutable variable
-         *)       
-    method with_loop_mutable_values b = 
-      {< loop_mutable_values =  b >}
+(*
+     Following two ``failaction'' function compute n, the trap handler
+    to jump to in case of failure of elementary tests
+*)
 
-    method add_loop_mutable_variable id = 
-      {< loop_mutable_values = Ident_set.add id loop_mutable_values;
-         mutable_values = Ident_set.add id mutable_values
-         >}
+let mk_failaction_neg partial ctx def = match partial with
+| Partial ->
+    begin match def with
+    | (_,idef)::_ ->
+        Some (Lstaticraise (idef,[])),[],jumps_singleton idef ctx
+    | _ ->
+       (* Act as Total, this means
+          If no appropriate default matrix exists,
+          then this switch cannot fail *)
+        None, [], jumps_empty
+    end
+| Total ->
+    None, [], jumps_empty
 
-    method add_mutable_variable id = 
-      {< mutable_values = Ident_set.add id mutable_values >}
 
-    method add_defined_ident ident = 
-      {< defined_idents = Ident_set.add ident defined_idents >} 
 
-    method! expression x = 
-      match x.expression_desc with 
-      | Fun (_method_, params, block , env) -> 
-        (* Function is the only place to introduce a new scope in 
-            ES5
-            TODO: check 
-            {[ try .. catch(exn) {.. }]}
-            what's the scope of exn
-        *)
-        (* Note that [used_idents] is not complete
-            it ignores some locally defined idents *)
-        let param_set = Ident_set.of_list params in
-        let obj =  {<defined_idents = Ident_set.empty;
-                     (** pass [empty]
-                         so that we can check which parameter was actually used *)
-                     used_idents = Ident_set.empty ;
-                     in_loop = false;
-                     loop_mutable_values = Ident_set.empty;
-                     mutable_values = Ident_set.of_list (Js_fun_env.get_mutable_params params env) ; 
-                     closured_idents = Ident_set.empty; (* think about nested function*)
-                   >} # block block in
-        let defined_idents', used_idents' = 
-          obj#get_defined_idents, obj#get_used_idents  in
-        (* mark which param is used *)
-        params |> List.iteri 
-          (fun i v -> 
-             if not (Ident_set.mem v used_idents') then 
-               Js_fun_env.mark_unused env i) ;
-        let closured_idents' =  (* pass param_set down *)
-          Ident_set.(diff used_idents' (union defined_idents' param_set )) in
+(* Conforme a l'article et plus simple qu'avant *)
+and mk_failaction_pos partial seen ctx defs  =
+  if dbg then begin
+    prerr_endline "**POS**" ;
+    pretty_def defs ;
+    ()
+  end ;
+  let rec scan_def env to_test defs = match to_test,defs with
+  | ([],_)|(_,[]) ->
+      List.fold_left
+        (fun  (klist,jumps) (pats,i)->
+          let action = Lstaticraise (i,[]) in
+          let klist =
+            List.fold_right
+              (fun pat r -> (get_key_constr pat,action)::r)
+              pats klist
+          and jumps =
+            jumps_add i (ctx_lub (list_as_pat pats) ctx) jumps in
+          klist,jumps)
+        ([],jumps_empty) env
+  | _,(pss,idef)::rem ->
+      let now, later =
+        List.partition
+          (fun (p,p_ctx) -> ctx_match p_ctx pss) to_test in
+      match now with
+      | [] -> scan_def env to_test rem
+      | _  -> scan_def ((List.map fst now,idef)::env) later rem in
 
-        (* Noe that we don't know which variables are exactly mutable yet ..
-           due to the recursive thing
-         *)
-        Js_fun_env.set_unbounded env closured_idents'   ; 
-        let lexical_scopes = Ident_set.(inter closured_idents' self#get_loop_mutable_values) in
-        Js_fun_env.set_lexical_scope env lexical_scopes;
-        (* tailcall , note that these varibles are used in another pass *)
-        {< used_idents = 
-             Ident_set.union used_idents closured_idents' ;
-           (* There is a bug in ocaml -dsource*)           
-           closured_idents = Ident_set.union closured_idents closured_idents'
-        >}
-      | _ -> super#expression x 
-            (* TODO: most variables are immutable *)
+  scan_def
+    []
+    (List.map
+       (fun pat -> pat, ctx_lub pat ctx)
+       (complete_pats_constrs seen))
+    defs
 
-    method! variable_declaration x = 
-      match x with
-      | { ident ; value; property  }  -> 
-        let obj = 
-          (match self#get_in_loop, property with 
-           | true, Variable 
-             -> 
-             self#add_loop_mutable_variable ident 
-           | true, (Strict | StrictOpt | Alias)
-           (* Not real true immutable in javascript 
-               since it's in the loop 
 
-               TODO: we should also 
-           *)
-             -> 
-             begin match value with 
-               | None -> self#add_loop_mutable_variable ident
-               (* TODO: Check why assertion failure *)
-               (* self#add_loop_mutable_variable ident *) (* assert false *)
-               | Some x
-                 ->
-                 (** 
-                     when x is an immediate immutable value, 
-                     (like integer .. )
-                     not a reference, it should be Immutable
-                     or string, 
-                     type system might help here
-                     TODO:
-                 *)
-                 match x.expression_desc with
-                 | Fun _  | Number _ | Str _ 
-                   -> self 
-                 | _ -> 
-                   (* if Ident_set.(is_empty @@ *)
-                   (*   inter self#get_mutable_values  *)
-                   (*     ( ({<  *)
-                   (*         defined_idents = Ident_set.empty;  *)
-                   (*         used_idents = Ident_set.empty; *)
-                   (*         >} # expression x) # get_used_idents)) then *)
-                   (*   (\* FIXME: still need to check expression is pure or not*\) *)
-                   (*   self *)
-                   (* else  *)
-                   self#add_loop_mutable_variable ident
-             end
-           | false, Variable
-             -> 
-             self#add_mutable_variable ident      
-           | false, (Strict | StrictOpt | Alias)
-             -> self
-          )#add_defined_ident ident
-        in
-        begin match value with 
-          | None -> obj 
-          | Some x -> obj # expression x  
-        end 
+let combine_constant loc arg cst partial ctx def
+    (const_lambda_list, total, pats) =
+  let fail, to_add, local_jumps =
+    mk_failaction_neg partial ctx def in
+  let const_lambda_list = to_add@const_lambda_list in
+  let lambda1 =
+    match cst with
+    | Const_int _ ->
+        let int_lambda_list =
+          List.map (function Const_int n, l -> n,l | _ -> assert false)
+            const_lambda_list in
+        call_switcher fail arg min_int max_int int_lambda_list
+    | Const_char _ ->
+        let int_lambda_list =
+          List.map (function Const_char c, l -> (Char.code c, l)
+            | _ -> assert false)
+            const_lambda_list in
+        call_switcher fail arg 0 255 int_lambda_list
+    | Const_string _ ->
+(* Note as the bytecode compiler may resort to dichotmic search,
+   the clauses of strinswitch  are sorted with duplicate removed.
+   This partly applies to the native code compiler, which requires
+   no duplicates *)
+        let const_lambda_list = sort_lambda_list const_lambda_list in
+        let sw =
+          List.map
+            (fun (c,act) -> match c with
+            | Const_string (s,_) -> s,act
+            | _ -> assert false)
+            const_lambda_list in
+        let hs,sw,fail = share_actions_tree sw fail in
+        hs (Lstringswitch (arg,sw,fail,loc))
+    | Const_float _ ->
+        make_test_sequence loc 
+          fail
+          (Pfloatcomp Cneq) (Pfloatcomp Clt)
+          arg const_lambda_list
+    | Const_int32 _ ->
+        make_test_sequence loc
+          fail
+          (Pbintcomp(Pint32, Cneq)) (Pbintcomp(Pint32, Clt))
+          arg const_lambda_list
+    | Const_int64 _ ->
+        make_test_sequence loc
+          fail
+          (Pbintcomp(Pint64, Cneq)) (Pbintcomp(Pint64, Clt))
+          arg const_lambda_list
+    | Const_nativeint _ ->
+        make_test_sequence loc
+          fail
+          (Pbintcomp(Pnativeint, Cneq)) (Pbintcomp(Pnativeint, Clt))
+          arg const_lambda_list
+  in lambda1,jumps_union local_jumps total
 
-        
-    method! statement x = 
-      match x.statement_desc with 
-      | ForRange  (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *)
-          let obj = 
-            {< in_loop = true ;
-               loop_mutable_values = Ident_set.singleton loop_id ;
-               used_idents = Ident_set.empty; (* TODO: if unused, can we generate better code? *)
-               defined_idents = Ident_set.singleton loop_id ;
-               closured_idents = Ident_set.empty (* Think about nested for blocks *)
-                 (* Invariant: Finish id is never used *)
-                 >}
-              # statement_desc y in
 
-          let defined_idents', used_idents', closured_idents' = 
-            obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in
 
+let split_cases tag_lambda_list =
+  let rec split_rec = function
+      [] -> ([], [])
+    | (cstr, act) :: rem ->
+        let (consts, nonconsts) = split_rec rem in
+        match cstr with
+          Cstr_constant n -> ((n, act) :: consts, nonconsts)
+        | Cstr_block n    -> (consts, (n, act) :: nonconsts)
+        | _ -> assert false in
+  let const, nonconst = split_rec tag_lambda_list in
+  sort_int_lambda_list const,
+  sort_int_lambda_list nonconst
 
-          let lexical_scope =  Ident_set.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in
-          let () = Js_closure.set_lexical_scope a_env lexical_scope in
-          (* set scope *)
-          {< used_idents = Ident_set.union used_idents used_idents';
-             (* walk around ocaml -dsource bug 
-                {[ 
-                  Ident_set.(union used_idents used_idents)                  
-                ]}                
-             *)             
-             defined_idents = Ident_set.union defined_idents defined_idents';
-             (* TODO: if we our generated code also follow lexical scope,
-                this is not necessary ;
-                [varaibles] are mutable or not is known at definition
-              *)
-             closured_idents = Ident_set.union closured_idents lexical_scope
-             >}
+let split_extension_cases tag_lambda_list =
+  let rec split_rec = function
+      [] -> ([], [])
+    | (cstr, act) :: rem ->
+        let (consts, nonconsts) = split_rec rem in
+        match cstr with
+          Cstr_extension(path, true) -> ((path, act) :: consts, nonconsts)
+        | Cstr_extension(path, false) -> (consts, (path, act) :: nonconsts)
+        | _ -> assert false in
+  split_rec tag_lambda_list
 
-      | While (_label,pred,body, _env) ->  
-          (((self#expression pred)#with_in_loop true) # block  body )
-            #with_in_loop (self#get_in_loop)
-      | _ -> 
-          super#statement x 
 
-    method! exception_ident x = 
-      (* we can not simply skip it, since it can be used 
-          TODO: check loop exception
-          (loop {
-          excption(i){
-          () => {i}
-          } 
-          })
-       *)
-      {< used_idents = Ident_set.add x used_idents;
-         defined_idents = Ident_set.add x defined_idents
-         >}
-    method! for_ident x = {< loop_mutable_values = Ident_set.add x loop_mutable_values >}
+let combine_constructor loc arg ex_pat cstr partial ctx def
+    (tag_lambda_list, total1, pats) =
+  if cstr.cstr_consts < 0 then begin
+    (* Special cases for extensions *)
+    let fail, to_add, local_jumps =
+      mk_failaction_neg partial ctx def in
+    let tag_lambda_list = to_add@tag_lambda_list in
+    let lambda1 =
+      let consts, nonconsts = split_extension_cases tag_lambda_list in
+      let default, consts, nonconsts =
+        match fail with
+        | None ->
+            begin match consts, nonconsts with
+            | _, (_, act)::rem -> act, consts, rem
+            | (_, act)::rem, _ -> act, rem, nonconsts
+            | _ -> assert false
+            end
+        | Some fail -> fail, consts, nonconsts in
+      let nonconst_lambda =
+        match nonconsts with
+          [] -> default
+        | _ ->
+            let tag = Ident.create "tag" in
+            let tests =
+              List.fold_right
+                (fun (path, act) rem ->
+                   Lifthenelse(Lprim(Pintcomp Ceq,
+                                     [Lvar tag;
+                                      transl_path ex_pat.pat_env path], loc),
+                               act, rem))
+                nonconsts
+                default
+            in
+              Llet(Alias, tag, Lprim(Pfield (0, Fld_na), [arg], loc), tests)
+      in
+        List.fold_right
+          (fun (path, act) rem ->
+             Lifthenelse(Lprim(Pintcomp Ceq,
+                               [arg; transl_path ex_pat.pat_env path], loc),
+                         act, rem))
+          consts
+          nonconst_lambda
+    in
+    lambda1, jumps_union local_jumps total1
+  end else begin
+    (* Regular concrete type *)
+    let ncases = List.length tag_lambda_list
+    and nconstrs =  cstr.cstr_consts + cstr.cstr_nonconsts in
+    let sig_complete = ncases = nconstrs in
+    let fails,local_jumps =
+      if sig_complete then [],jumps_empty
+      else
+        mk_failaction_pos partial pats ctx def in
 
-    method! ident x = 
-      if Ident_set.mem x defined_idents then 
-        self
-      else {< used_idents = Ident_set.add x used_idents >}
+    let tag_lambda_list = fails @ tag_lambda_list in
+    let (consts, nonconsts) = split_cases tag_lambda_list in
+    let lambda1 =
+      match same_actions tag_lambda_list with
+      | Some act -> act
+      | _ ->
+          match
+            (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
+          with
+          | (1, 1, [0, act1], [0, act2]) ->
+              Lifthenelse(arg, act2, act1)
+          | (n,_,_,[])  ->
+              call_switcher None arg 0 (n-1) consts
+          | (n, _, _, _) ->
+              match same_actions nonconsts with
+              | None ->
+(* Emit a switch, as bytecode implements this sophisticated instruction *)
+                  let sw =
+                    {sw_numconsts = cstr.cstr_consts; sw_consts = consts;
+                     sw_numblocks = cstr.cstr_nonconsts; sw_blocks = nonconsts;
+                     sw_failaction = None} in
+                  let hs,sw = share_actions_sw sw in
+                  let sw = reintroduce_fail sw in
+                  hs (Lswitch (arg,sw))
+              | Some act ->
+                  Lifthenelse
+                    (Lprim (Pisint, [arg], loc),
+                     call_switcher
+                       None arg
+                       0 (n-1) consts,
+                     act) in
+    lambda1, jumps_union local_jumps total1
   end
 
-let program js = 
-  (scope_pass # program js ) # get_loop_mutable_values
-
-end
-module Js_pass_tailcall_inline : sig 
-#1 "js_pass_tailcall_inline.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
+let make_test_sequence_variant_constant fail arg int_lambda_list =
+  let _, (cases, actions) =
+    as_interval fail min_int max_int int_lambda_list in
+  Switcher.test_sequence arg cases actions
 
+let call_switcher_variant_constant fail arg int_lambda_list =
+  call_switcher fail arg min_int max_int int_lambda_list
 
 
+let call_switcher_variant_constr loc fail arg int_lambda_list =
+  let v = Ident.create "variant" in
+  Llet(Alias, v, Lprim(Pfield (0, Fld_na), [arg], loc),
+       call_switcher
+         fail (Lvar v) min_int max_int int_lambda_list)
 
+let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, pats) =
+  let row = Btype.row_repr row in
+  let num_constr = ref 0 in
+  if row.row_closed then
+    List.iter
+      (fun (_, f) ->
+        match Btype.row_field_repr f with
+          Rabsent | Reither(true, _::_, _, _) -> ()
+        | _ -> incr num_constr)
+      row.row_fields
+  else
+    num_constr := max_int;
+  let test_int_or_block arg if_int if_block =
+    Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in
+  let sig_complete =  List.length tag_lambda_list = !num_constr
+  and one_action = same_actions tag_lambda_list in
+  let fail, to_add, local_jumps =
+    if
+      sig_complete  || (match partial with Total -> true | _ -> false)
+    then
+      None, [], jumps_empty
+    else
+      mk_failaction_neg partial ctx def in
+  let tag_lambda_list = to_add@tag_lambda_list in
+  let (consts, nonconsts) = split_cases tag_lambda_list in
+  let lambda1 = match fail, one_action with
+  | None, Some act -> act
+  | _,_ ->
+      match (consts, nonconsts) with
+      | ([n, act1], [m, act2]) when fail=None ->
+          test_int_or_block arg act1 act2
+      | (_, []) -> (* One can compare integers and pointers *)
+          make_test_sequence_variant_constant fail arg consts
+      | ([], _) ->
+          let lam = call_switcher_variant_constr loc
+              fail arg nonconsts in
+          (* One must not dereference integers *)
+          begin match fail with
+          | None -> lam
+          | Some fail -> test_int_or_block arg fail lam
+          end
+      | (_, _) ->
+          let lam_const =
+            call_switcher_variant_constant
+              fail arg consts
+          and lam_nonconst =
+            call_switcher_variant_constr loc
+              fail arg nonconsts in
+          test_int_or_block arg lam_const lam_nonconst
+  in
+  lambda1, jumps_union local_jumps total1
 
 
+let combine_array loc arg kind partial ctx def
+    (len_lambda_list, total1, pats)  =
+  let fail, to_add, local_jumps = mk_failaction_neg partial  ctx def in
+  let len_lambda_list = to_add @ len_lambda_list in
+  let lambda1 =
+    let newvar = Ident.create "len" in
+    let switch =
+      call_switcher
+        fail (Lvar newvar)
+        0 max_int len_lambda_list in
+    bind
+      Alias newvar (Lprim(Parraylength kind, [arg], loc)) switch in
+  lambda1, jumps_union local_jumps total1
 
-(** This pass detect functions used once and if it is used in used
-    in the tail position, it will get inlined, this will help 
-    remove some common use cases like This
-    {[
-      let length x = 
-        let rec aux n x = 
-          match x with 
-          | [] -> n 
-          | _ :: rest -> aux (n + 1) rest in
-        aux 0 x         
-    ]} 
-*)
+(* Insertion of debugging events *)
 
-val tailcall_inline : J.program -> J.program 
+let rec event_branch repr lam =
+  begin match lam, repr with
+    (_, None) ->
+      lam
+  | (Levent(lam', ev), Some r) ->
+      incr r;
+      Levent(lam', {lev_loc = ev.lev_loc;
+                    lev_kind = ev.lev_kind;
+                    lev_repr = repr;
+                    lev_env = ev.lev_env})
+  | (Llet(str, id, lam, body), _) ->
+      Llet(str, id, lam, event_branch repr body)
+  | Lstaticraise _,_ -> lam
+  | (_, Some r) ->
+      Printlambda.lambda Format.str_formatter lam ;
+      fatal_error
+        ("Matching.event_branch: "^Format.flush_str_formatter ())
+  end
 
-end = struct
-#1 "js_pass_tailcall_inline.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+(*
+   This exception is raised when the compiler cannot produce code
+   because control cannot reach the compiled clause,
 
+   Unused is raised initialy in compile_test.
 
+   compile_list (for compiling switch results) catch Unused
 
+   comp_match_handlers (for compililing splitted matches)
+   may reraise Unused
 
 
-(* When we inline a function call, if we don't do a beta-reduction immediately, there is 
-   a chance that it is ignored, (we can not assume that each pass is robust enough)
+*)
 
-   After we do inlining, it makes sense to do another constant folding and propogation 
- *)
+exception Unused
 
-(* Check: shall we inline functions with while loop? if it is used only once, 
-   it makes sense to inline it
-*)
+let compile_list compile_fun division =
 
-module S = Js_stmt_make
-module E = Js_exp_make
+  let rec c_rec totals = function
+  | [] -> [], jumps_unions totals, []
+  | (key, cell) :: rem ->
+      begin match cell.ctx with
+      | [] -> c_rec totals rem
+      | _  ->
+          try
+            let (lambda1, total1) = compile_fun cell.ctx cell.pm in
+            let c_rem, total, new_pats =
+              c_rec
+                (jumps_map ctx_combine total1::totals) rem in
+            ((key,lambda1)::c_rem), total, (cell.pat::new_pats)
+          with
+          | Unused -> c_rec totals rem
+      end in
+  c_rec [] division
 
 
-(** Update ident info use cases, it is a non pure function, 
-    it will annotate [program] with some meta data
-    TODO: Ident Hashtbl could be improved, 
-    since in this case it can not be global?  
+let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
+  let rec do_rec r total_r = function
+    | [] -> r,total_r
+    | (mat,i,vars,pm)::rem ->
+        begin try
+          let ctx = select_columns mat ctx in
+          let handler_i, total_i = compile_fun ctx pm in
+          match raw_action r with
+          | Lstaticraise (j,args) ->
+              if i=j then
+                List.fold_right2 (bind Alias) vars args handler_i,
+                jumps_map (ctx_rshift_num (ncols mat)) total_i
+              else
+                do_rec r total_r rem
+          | _ ->
+              do_rec
+                (Lstaticcatch (r,(i,vars), handler_i))
+                (jumps_union
+                   (jumps_remove i total_r)
+                   (jumps_map (ctx_rshift_num (ncols mat)) total_i))
+              rem
+        with
+        | Unused ->
+            do_rec (Lstaticcatch (r, (i,vars), lambda_unit)) total_r rem
+        end in
+  do_rec lambda1 total1 to_catch
 
- *)
-let count_collects () = 
-  object (self)
-    inherit Js_fold.fold as super
-    (* collect used status*)
-    val stats : int ref Ident_hashtbl.t = Ident_hashtbl.create 83
-    (* collect all def sites *)
-    val defined_idents : J.variable_declaration Ident_hashtbl.t = Ident_hashtbl.create 83
 
-    val mutable export_set  : Ident_set.t = Ident_set.empty
-    val mutable name : string = ""
+let compile_test compile_fun partial divide combine ctx to_match =
+  let division = divide ctx to_match in
+  let c_div = compile_list compile_fun division in
+  match c_div with
+  | [],_,_ ->
+     begin match mk_failaction_neg partial ctx to_match.default with
+     | None,_,_ -> raise Unused
+     | Some l,_,total -> l,total
+     end
+  | _ ->
+      combine ctx to_match.default c_div
 
-    method add_use id = 
-      match Ident_hashtbl.find_opt stats id with
-      | None -> Ident_hashtbl.add stats id (ref 1)
-      | Some v -> incr v 
-    method! program x = 
-      export_set <- x.export_set ; 
-      name <- x.name;
-      super#program x
-    method! variable_declaration 
-        ({ident; value ; property  ; ident_info }  as v)
-      =  
-        Ident_hashtbl.add defined_idents ident v; 
-        match value with 
-        | None
-          -> 
-          self
-        | Some x
-          -> self#expression x 
-    method! ident id = self#add_use id; self
-    method get_stats = 
-      Ident_hashtbl.iter (fun ident (v : J.variable_declaration) -> 
-          if Ident_set.mem ident export_set then 
-            Js_op_util.update_used_stats v.ident_info Exported
-          else 
-            let pure = 
-              match v.value  with 
-              | None -> false  (* can not happen *)
-              | Some x -> Js_analyzer.no_side_effect_expression x  
-            in
-            match Ident_hashtbl.find_opt stats ident with 
-              | None -> 
-                Js_op_util.update_used_stats v.ident_info 
-                  (if pure then Dead_pure else Dead_non_pure)
-              | Some num -> 
-                if !num = 1 then 
-                  Js_op_util.update_used_stats v.ident_info 
-                    (if pure then Once_pure else Used) 
-        ) defined_idents; defined_idents
-  end
+(* Attempt to avoid some useless bindings by lowering them *)
 
+(* Approximation of v present in lam *)
+let rec approx_present v = function
+  | Lconst _ -> false
+  | Lstaticraise (_,args) ->
+      List.exists (fun lam -> approx_present v lam) args
+  | Lprim (_,args,_) ->
+      List.exists (fun lam -> approx_present v lam) args
+  | Llet (Alias, _, l1, l2) ->
+      approx_present v l1 || approx_present v l2
+  | Lvar vv -> Ident.same v vv
+  | _ -> true
 
-let get_stats program
-  =  ((count_collects ()) #program program) #get_stats
+let rec lower_bind v arg lam = match lam with
+| Lifthenelse (cond, ifso, ifnot) ->
+    let pcond = approx_present v cond
+    and pso = approx_present v ifso
+    and pnot = approx_present v ifnot in
+    begin match pcond, pso, pnot with
+    | false, false, false -> lam
+    | false, true, false ->
+        Lifthenelse (cond, lower_bind v arg ifso, ifnot)
+    | false, false, true ->
+        Lifthenelse (cond, ifso, lower_bind v arg ifnot)
+    | _,_,_ -> bind Alias v arg lam
+    end
+| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as sw))
+    when not (approx_present v ls) ->
+      Lswitch (ls, {sw with sw_consts = [i,lower_bind v arg act]})
+| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as sw))
+    when not (approx_present v ls) ->
+      Lswitch (ls, {sw with sw_blocks = [i,lower_bind v arg act]})
+| Llet (Alias, vv, lv, l) ->
+    if approx_present v lv then
+      bind Alias v arg lam
+    else
+      Llet (Alias, vv, lv, lower_bind v arg l)
+| _ ->
+    bind Alias v arg lam
 
+let bind_check str v arg lam = match str,arg with
+| _, Lvar _ ->bind str v arg lam
+| Alias,_ -> lower_bind v arg lam
+| _,_     -> bind str v arg lam
 
-(* 1. recursive value ? let rec x = 1 :: x
-    non-terminating
-    2. duplicative identifiers ..
-    remove it at the same time is a bit unsafe,
-    since we have to guarantee that the one use
-    case is substituted
-    we already have this? in [defined_idents]
-*)
+let comp_exit ctx m = match m.default with
+| (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx
+| _        -> fatal_error "Matching.comp_exit"
 
-(** There is a side effect when traversing dead code, since 
-   we assume that substitue a node would mark a node as dead node,
-  
-    so if we traverse a dead node, this would get a wrong result.
-   it does happen in such scenario
-   {[
-     let generic_basename is_dir_sep current_dir_name name =
-       let rec find_end n =
-         if n < 0 then String.sub name 0 1
-         else if is_dir_sep name n then find_end (n - 1)
-         else find_beg n (n + 1)
-       and find_beg n p =
-         if n < 0 then String.sub name 0 p
-         else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
-         else find_beg (n - 1) p
-       in
-       if name = ""
-       then current_dir_name
-       else find_end (String.length name - 1)
-   ]}
-   [find_beg] can potentially be expanded in [find_end] and in [find_end]'s expansion, 
-   if the order is not correct, or even worse, only the wrong one [find_beg] in [find_end] get expanded 
-   (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, 
-   while it is still called 
-*)
-let subst name export_set stats  = 
-  object (self)
-    inherit Js_map.map as super
-    method! statement st = 
-      match st with 
-      | {statement_desc =
-           Variable 
-             {value = _ ;
-              ident_info = {used_stats = Dead_pure}
-             } 
-        ; comment = _}
-        ->
-        S.block []
-      | {statement_desc = 
-           Variable { ident_info = {used_stats = Dead_non_pure} ;
-                      value = Some v  ; _ } 
-        ; _}
-        -> S.exp v
-      | _ -> super#statement st 
-    method! variable_declaration 
-        ({ident; value ; property  ; ident_info }  as v)
-      =  
-      (* TODO: replacement is a bit shaky, the problem is the lambda we stored is
-         not consistent after we did some subsititution, and the dead code removal
-         does rely on this (otherwise, when you do beta-reduction you have to regenerate names)
-      *)
-      let v = super # variable_declaration v in
-      Ident_hashtbl.add stats ident v; (* see #278 before changes *)
-      v
-    method! block bs = 
-      match bs with
-      | ({statement_desc = 
-            Variable ({value =
-                         Some ({expression_desc = Fun _; _ } as v )
-                      } as vd) ; comment = _} as st) :: rest  -> 
-        let is_export = Ident_set.mem vd.ident export_set in
-        if is_export then 
-          self#statement st :: self#block rest 
-        else 
-          begin 
-            match Ident_hashtbl.find_opt stats vd.ident with 
-            (* TODO: could be improved as [mem] *)
-            | None -> 
-              if Js_analyzer.no_side_effect_expression v 
-              then S.exp v  :: self#block rest 
-              else self#block rest 
 
-            | Some _ -> self#statement st  :: self#block rest 
-          end
 
-      | {statement_desc = 
-           Return {return_value = 
-                     {expression_desc = 
-                        Call({expression_desc = Var (Id id)},args,_info)}} }
-        as st 
-           :: rest 
-        -> 
-        begin match Ident_hashtbl.find_opt stats id with 
+let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs =
+  match next_matchs with
+  | [] -> comp_fun partial ctx arg first_match
+  | rem ->
+      let rec c_rec body total_body = function
+        | [] -> body, total_body
+        (* Hum, -1 meant never taken
+        | (-1,pm)::rem -> c_rec body total_body rem *)
+        | (i,pm)::rem ->
+            let ctx_i,total_rem = jumps_extract i total_body in
+            begin match ctx_i with
+            | [] -> c_rec body total_body rem
+            | _ ->
+                try
+                  let li,total_i =
+                    comp_fun
+                      (match rem with [] -> partial | _ -> Partial)
+                      ctx_i arg pm in
+                  c_rec
+                    (Lstaticcatch (body,(i,[]),li))
+                    (jumps_union total_i total_rem)
+                    rem
+                with
+                | Unused ->
+                    c_rec (Lstaticcatch (body,(i,[]),lambda_unit))
+                      total_rem  rem
+            end in
+   try
+      let first_lam,total = comp_fun Partial ctx arg first_match in
+      c_rec first_lam total rem
+   with Unused -> match next_matchs with
+   | [] -> raise Unused
+   | (_,x)::xs ->  comp_match_handlers comp_fun partial ctx arg x xs
 
-          | Some ({ value = 
-                Some {expression_desc = Fun (false, params, block, _env) ; comment = _}; 
-              (*TODO: don't inline method tail call yet, 
-                [this] semantics are weird 
-              *)              
-              property = (Alias | StrictOpt | Strict);
-              ident_info = {used_stats = Once_pure };
-              ident = _
-            } as v)
-            when Ext_list.same_length params args 
-            -> 
-            (* Ext_log.dwarn  __LOC__ "%s is dead \n %s " id.name  *)
-            (*   (Js_dump.string_of_block [st]); *)
-            Js_op_util.update_used_stats v.ident_info Dead_pure;
-            let block  = 
-              List.fold_right2 (fun param arg acc ->  S.define ~kind:Variable param arg :: acc)
-                params args  ( self#block block) (* see #278 before changes*)
-                                
-            in
-            (* Mark a function as dead means it will never be scanned, 
-               here we inline the function
-            *)
-            block @ self#block rest
-          | (None | Some _) ->
-            self#statement st :: self#block rest
-        end
-      | x :: xs 
-        ->
-        self#statement x :: self#block xs
-      | [] 
-        -> 
-        []
+(* To find reasonable names for variables *)
 
-  end
+let rec name_pattern default = function
+    (pat :: patl, action) :: rem ->
+      begin match pat.pat_desc with
+        Tpat_var (id, _) -> id
+      | Tpat_alias(p, id, _) -> id
+      | _ -> name_pattern default rem
+      end
+  | _ -> Ident.create default
 
+let arg_to_var arg cls = match arg with
+| Lvar v -> v,arg
+| _ ->
+    let v = name_pattern "match" cls in
+    v,Lvar v
 
-let tailcall_inline (program : J.program) = 
-  let _stats = get_stats program in
-  let _export_set = program.export_set in
-  program
-  |> (subst program.name _export_set _stats )# program
-  (* |> pass_beta #program *)
-    
 
-end
-module Js_shake : sig 
-#1 "js_shake.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+(*
+  The main compilation function.
+   Input:
+      repr=used for inserting debug events
+      partial=exhaustiveness information from Parmatch
+      ctx=a context
+      m=a pattern matching
 
+   Output: a lambda term, a jump summary {..., exit number -> context, .. }
+*)
 
+let rec compile_match repr partial ctx m = match m with
+| { cases = [] } -> comp_exit ctx m
+| { cases = ([], action) :: rem } ->
+    if is_guarded action then begin
+      let (lambda, total) =
+        compile_match None partial ctx { m with cases = rem } in
+      event_branch repr (patch_guarded lambda action), total
+    end else
+      (event_branch repr action, jumps_empty)
+| { args = (arg, str)::argl } ->
+    let v,newarg = arg_to_var arg m.cases in
+    let first_match,rem =
+      split_precompile (Some v)
+        { m with args = (newarg, Alias) :: argl } in
+    let (lam, total) =
+      comp_match_handlers
+        ((if dbg then do_compile_matching_pr else do_compile_matching) repr)
+        partial ctx newarg first_match rem in
+    bind_check str v arg lam, total
+| _ -> assert false
 
 
+(* verbose version of do_compile_matching, for debug *)
 
+and do_compile_matching_pr repr partial ctx arg x =
+  prerr_string "COMPILE: " ;
+  prerr_endline (match partial with Partial -> "Partial" | Total -> "Total") ;
+  prerr_endline "MATCH" ;
+  pretty_precompiled x ;
+  prerr_endline "CTX" ;
+  pretty_ctx ctx ;
+  let (_, jumps) as r =  do_compile_matching repr partial ctx arg x in
+  prerr_endline "JUMPS" ;
+  pretty_jumps jumps ;
+  r
 
+and do_compile_matching repr partial ctx arg pmh = match pmh with
+| Pm pm ->
+  let pat = what_is_cases pm.cases in
+  begin match pat.pat_desc with
+  | Tpat_any ->
+      compile_no_test
+        divide_var ctx_rshift repr partial ctx pm
+  | Tpat_tuple patl ->
+      compile_no_test
+        (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine
+        repr partial ctx pm
+  | Tpat_record ((_, lbl,_)::_,_) ->
+      compile_no_test
+        (divide_record lbl.lbl_all (normalize_pat pat))
+        ctx_combine repr partial ctx pm
+  | Tpat_constant cst ->
+      compile_test
+        (compile_match repr partial) partial
+        divide_constant
+        (combine_constant pat.pat_loc arg cst partial)
+        ctx pm
+  | Tpat_construct (_, cstr, _) ->
+      compile_test
+        (compile_match repr partial) partial
+        divide_constructor (combine_constructor pat.pat_loc arg pat cstr partial)
+        ctx pm
+  | Tpat_array _ ->
+      let kind = Typeopt.array_pattern_kind pat in
+      compile_test (compile_match repr partial) partial
+        (divide_array kind) (combine_array pat.pat_loc arg kind partial)
+        ctx pm
+  | Tpat_lazy _ ->
+      compile_no_test
+        (divide_lazy (normalize_pat pat))
+        ctx_combine repr partial ctx pm
+  | Tpat_variant(lab, _, row) ->
+      compile_test (compile_match repr partial) partial
+        (divide_variant !row)
+        (combine_variant pat.pat_loc !row arg partial)
+        ctx pm
+  | _ -> assert false
+  end
+| PmVar {inside=pmh ; var_arg=arg} ->
+    let lam, total =
+      do_compile_matching repr partial (ctx_lshift ctx) arg pmh in
+    lam, jumps_map ctx_rshift total
+| PmOr {body=body ; handlers=handlers} ->
+    let lam, total = compile_match repr partial ctx body in
+    compile_orhandlers (compile_match repr partial) lam total ctx handlers
 
+and compile_no_test divide up_ctx repr partial ctx to_match =
+  let {pm=this_match ; ctx=this_ctx } = divide ctx to_match in
+  let lambda,total = compile_match repr partial this_ctx this_match in
+  lambda, jumps_map up_ctx total
 
-(** A module to shake JS IR
-   
-    Tree shaking is not going to change the closure 
- *)
 
-val shake_program : J.program -> J.program
 
-end = struct
-#1 "js_shake.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+(* The entry points *)
 
+(*
+   If there is a guard in a matching or a lazy pattern,
+   then set exhaustiveness info to Partial.
+   (because of side effects, assume the worst).
 
+   Notice that exhaustiveness information is trusted by the compiler,
+   that is, a match flagged as Total should not fail at runtime.
+   More specifically, for instance if match y with x::_ -> x uis flagged
+   total (as it happens during JoCaml compilation) then y cannot be []
+   at runtime. As a consequence, the static Total exhaustiveness information
+   have to to be downgraded to Partial, in the dubious cases where guards
+   or lazy pattern execute arbitrary code that may perform side effects
+   and change the subject values.
+LM:
+   Lazy pattern was PR #5992, initial patch by lwp25.
+   I have  generalized teh patch, so as to also find mutable fields.
+*)
 
+let find_in_pat pred =
+  let rec find_rec p =
+    pred p.pat_desc ||
+    begin match p.pat_desc with
+    | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p ->
+        find_rec p
+    | Tpat_tuple ps|Tpat_construct (_,_,ps) | Tpat_array ps ->
+        List.exists find_rec ps
+    | Tpat_record (lpats,_) ->
+        List.exists
+          (fun (_, _, p) -> find_rec p)
+          lpats
+    | Tpat_or (p,q,_) ->
+        find_rec p || find_rec q
+    | Tpat_constant _ | Tpat_var _
+    | Tpat_any | Tpat_variant (_,None,_) -> false
+  end in
+  find_rec
 
+let is_lazy_pat = function
+  | Tpat_lazy _ -> true
+  | Tpat_alias _ | Tpat_variant _ | Tpat_record _
+  | Tpat_tuple _|Tpat_construct _ | Tpat_array _
+  | Tpat_or _ | Tpat_constant _ | Tpat_var _ | Tpat_any
+      -> false
 
+let is_lazy p = find_in_pat is_lazy_pat p
 
+let have_mutable_field p = match p with
+| Tpat_record (lps,_) ->
+    List.exists
+      (fun (_,lbl,_) ->
+        match lbl.Types.lbl_mut with
+        | Mutable -> true
+        | Immutable -> false)
+      lps
+| Tpat_alias _ | Tpat_variant _ | Tpat_lazy _
+| Tpat_tuple _|Tpat_construct _ | Tpat_array _
+| Tpat_or _
+| Tpat_constant _ | Tpat_var _ | Tpat_any
+  -> false
 
-(** we also need make it complete 
- *)
-let get_initial_exports 
-    count_non_variable_declaration_statement 
-    (export_set : Ident_set.t) (block : J.block ) = 
-  let result = List.fold_left 
-    (fun acc (st : J.statement) -> 
-      match st.statement_desc with
-      | Variable {ident ; value; _} ->
-          if Ident_set.mem ident acc then 
-            begin match value with
-            | None -> acc  
-            | Some x -> 
-              (* If not a function, we have to calcuate again and again 
-                  TODO: add hashtbl for a cache
-               *)
-                Ident_set.(
-                union (Js_analyzer.free_variables_of_expression empty empty x) acc)
-            end
-          else 
-            begin match value with
-            | None -> acc 
-            | Some x -> 
-                if Js_analyzer.no_side_effect_expression x then acc 
-                else 
-                  Ident_set.(
-                  union (Js_analyzer.free_variables_of_expression empty empty x) 
-                    (add ident acc))
-            end
-      | _ -> 
-          (* recalcuate again and again ... *)
-          if Js_analyzer.no_side_effect_statement st || (not count_non_variable_declaration_statement)
-          then acc
-          else Ident_set.(union (Js_analyzer.free_variables_of_statement empty empty st) acc)
-    ) export_set block  in result, Ident_set.(diff result export_set)
+let is_mutable p = find_in_pat have_mutable_field p
 
-let shake_program (program : J.program) = 
-  let debug_file = "pervasives.ml" in
+(* Downgrade Total when
+   1. Matching accesses some mutable fields;
+   2. And there are  guards or lazy patterns.
+*)
 
-  let _d () = 
-    if Ext_string.ends_with program.name  debug_file then 
-      Ext_log.err __LOC__ "@[%s@]@." program.name 
-  in
-  let shake_block block export_set = 
-    let block = List.rev @@ Js_analyzer.rev_toplevel_flatten block in 
-    let  loop block export_set : Ident_set.t = 
-      let rec aux acc block = 
-        let result, diff = get_initial_exports false acc block   in
-        (* let _d ()  =  *)
-        (*   if Ext_string.ends_with program.name  debug_file then  *)
-        (*     begin *)
-        (*       Ext_log.err "@[%a@]@." Ident_set.print result  ; *)
-        (*     end *)
-        (* in *)
-        if Ident_set.is_empty diff then 
-          result
-        else 
-          aux result block in
-      let first_iteration, delta  = get_initial_exports true export_set block  in
-      (* let _d ()  =  *)
-      (*   if Ext_string.ends_with program.name  debug_file then  *)
-      (*   begin   *)
-      (*     Ext_log.err "@[<v>%a@ %a@]@." *)
-      (*       Ident_set.print first_iteration   *)
-      (*       Ident_set.print delta (\* TODO: optimization, don't add persistent variables *\) *)
-      (*       ; *)
-      (*     Ext_log.err "init ---- @." *)
-      (*   end *)
-      (* in *)
+let check_partial is_mutable is_lazy pat_act_list = function
+  | Partial -> Partial
+  | Total ->
+      if
+        List.exists
+          (fun (pats, lam) ->
+            is_mutable pats && (is_guarded lam || is_lazy pats))
+          pat_act_list
+      then Partial
+      else Total
 
-      if not @@ Ident_set.is_empty delta then
-        aux first_iteration block 
-      else first_iteration in
+let check_partial_list =
+  check_partial (List.exists is_mutable) (List.exists is_lazy)
+let check_partial = check_partial is_mutable is_lazy
 
-    let really_set = loop block export_set in 
-    List.fold_right
-      (fun  (st : J.statement) acc -> 
-        match st.statement_desc with
-        | Variable {ident; value ; _} -> 
-            if Ident_set.mem ident really_set  then st:: acc 
-            else 
-              begin match value with 
-              | None -> acc 
-              | Some x -> 
-                  if Js_analyzer.no_side_effect_expression x then acc
-                  else st::acc
-              end
-        | _ -> if Js_analyzer.no_side_effect_statement st then acc else st::acc
-      ) block []
-  in
+(* have toplevel handler when appropriate *)
 
-  {program with block = shake_block program.block program.export_set}
+let start_ctx n = [{left=[] ; right = omegas n}]
 
-end
-module Js_arr : sig 
-#1 "js_arr.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let check_total total lambda i handler_fun =
+  if jumps_is_empty total then
+    lambda
+  else begin
+    Lstaticcatch(lambda, (i,[]), handler_fun())
+  end
 
+let compile_matching loc repr handler_fun arg pat_act_list partial =
+  let partial = check_partial pat_act_list partial in
+  match partial with
+  | Partial ->
+      let raise_num = next_raise_count () in
+      let pm =
+        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
+          args = [arg, Strict] ;
+          default = [[[omega]],raise_num]} in
+      begin try
+        let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
+        check_total total lambda raise_num handler_fun
+      with
+      | Unused -> assert false (* ; handler_fun() *)
+      end
+  | Total ->
+      let pm =
+        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
+          args = [arg, Strict] ;
+          default = []} in
+      let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
+      assert (jumps_is_empty total) ;
+      lambda
 
 
+let partial_function loc () =
+  (* [Location.get_pos_info] is too expensive *)
+  let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
+  Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+          [transl_normal_path Predef.path_match_failure;
+           Lconst(Const_block(0, Lambda.default_tag_info,
+              [Const_base(Const_string (fname, None));
+               Const_base(Const_int line);
+               Const_base(Const_int char)]))], loc)], loc)
 
+let for_function loc repr param pat_act_list partial =
+  compile_matching loc repr (partial_function loc) param pat_act_list partial
 
+(* In the following two cases, exhaustiveness info is not available! *)
+let for_trywith param pat_act_list =
+  compile_matching Location.none None
+    (fun () -> Lprim(Praise Raise_reraise, [param], Location.none))
+    param pat_act_list Partial
 
+let for_let loc param pat body =
+  compile_matching loc None (partial_function loc) param [pat, body] Partial
 
-val set_array : J.expression -> J.expression -> J.expression -> J.expression
+(* Handling of tupled functions and matchings *)
 
-val ref_array : J.expression -> J.expression -> J.expression
+(* Easy case since variables are available *)
+let for_tupled_function loc paraml pats_act_list partial =
+  let partial = check_partial_list pats_act_list partial in
+  let raise_num = next_raise_count () in
+  let omegas = [List.map (fun _ -> omega) paraml] in
+  let pm =
+    { cases = pats_act_list;
+      args = List.map (fun id -> (Lvar id, Strict)) paraml ;
+      default = [omegas,raise_num]
+    } in
+  try
+    let (lambda, total) = compile_match None partial
+        (start_ctx (List.length paraml)) pm in
+    check_total total lambda raise_num (partial_function loc)
+  with
+  | Unused -> partial_function loc ()
 
-end = struct
-#1 "js_arr.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
 
+let flatten_pattern size p = match p.pat_desc with
+| Tpat_tuple args -> args
+| Tpat_any -> omegas size
+| _ -> raise Cannot_flatten
 
+let rec flatten_pat_line size p k = match p.pat_desc with
+| Tpat_any ->  omegas size::k
+| Tpat_tuple args -> args::k
+| Tpat_or (p1,p2,_) ->  flatten_pat_line size p1 (flatten_pat_line size p2 k)
+| Tpat_alias (p,_,_) -> (* Note: if this 'as' pat is here, then this is a
+                           useless binding, solves PR #3780 *)
+    flatten_pat_line size p k
+| _ -> fatal_error "Matching.flatten_pat_line"
 
+let flatten_cases size cases =
+  List.map
+    (fun (ps,action) -> match ps with
+    | [p] -> flatten_pattern size p,action
+    | _ -> fatal_error "Matching.flatten_case")
+    cases
 
+let flatten_matrix size pss =
+  List.fold_right
+    (fun ps r -> match ps with
+    | [p] -> flatten_pat_line size p r
+    | _   -> fatal_error "Matching.flatten_matrix")
+    pss []
 
-module E = Js_exp_make
- 
-let set_array  e e0 e1 = 
-  E.assign (E.access e e0)  e1
+let flatten_def size def =
+  List.map
+    (fun (pss,i) -> flatten_matrix size pss,i)
+    def
 
-let ref_array  e e0 = 
-  E.access  e  e0
+let flatten_pm size args pm =
+    {args = args ; cases = flatten_cases size pm.cases ;
+     default = flatten_def size pm.default}
 
-end
-module Js_ast_util : sig 
-#1 "js_ast_util.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+let flatten_precompiled size args  pmh = match pmh with
+| Pm pm -> Pm (flatten_pm size args pm)
+| PmOr {body=b ; handlers=hs ; or_matrix=m} ->
+    PmOr
+      {body=flatten_pm size args b ;
+       handlers=
+         List.map
+          (fun (mat,i,vars,pm) -> flatten_matrix size mat,i,vars,pm)
+          hs ;
+       or_matrix=flatten_matrix size m ;}
+| PmVar _ -> assert false
 
-(** Simple expression, 
-    no computation involved so that  it is okay to be duplicated
+(*
+   compiled_flattened is a ``comp_fun'' argument to comp_match_handlers.
+   Hence it needs a fourth argument, which it ignores
 *)
-val is_simple_expression : J.expression -> bool 
-
-
 
-val named_expression : 
-  J.expression -> (J.statement * Ident.t) option
+let compile_flattened repr partial ctx _ pmh = match pmh with
+| Pm pm -> compile_match repr partial ctx pm
+| PmOr {body=b ; handlers=hs} ->
+    let lam, total = compile_match repr partial ctx b in
+    compile_orhandlers (compile_match repr partial) lam total ctx hs
+| PmVar _ -> assert false
 
-end = struct
-#1 "js_ast_util.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let do_for_multiple_match loc paraml pat_act_list partial =
+  let repr = None in
+  let partial = check_partial pat_act_list partial in
+  let raise_num,pm1 =
+    match partial with
+    | Partial ->
+        let raise_num = next_raise_count () in
+        raise_num,
+        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
+          args = [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), paraml, loc), Strict] ;
+          default = [[[omega]],raise_num] }
+    | _ ->
+        -1,
+        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
+          args = [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), paraml, loc), Strict] ;
+          default = [] } in
 
+  try
+    try
+(* Once for checking that compilation is possible *)
+      let next, nexts = split_precompile None pm1 in
 
+      let size = List.length paraml
+      and idl = List.map (fun _ -> Ident.create "match") paraml in
+      let args =  List.map (fun id -> Lvar id, Alias) idl in
 
+      let flat_next = flatten_precompiled size args next
+      and flat_nexts =
+        List.map
+          (fun (e,pm) ->  e,flatten_precompiled size args pm)
+          nexts in
 
+      let lam, total =
+        comp_match_handlers
+          (compile_flattened repr)
+          partial (start_ctx size) () flat_next flat_nexts in
+      List.fold_right2 (bind Strict) idl paraml
+        (match partial with
+        | Partial ->
+            check_total total lam raise_num (partial_function loc)
+        | Total ->
+            assert (jumps_is_empty total) ;
+            lam)
+    with Cannot_flatten ->
+      let (lambda, total) = compile_match None partial (start_ctx 1) pm1 in
+      begin match partial with
+      | Partial ->
+          check_total total lambda raise_num (partial_function loc)
+      | Total ->
+          assert (jumps_is_empty total) ;
+          lambda
+      end
+  with Unused ->
+    assert false (* ; partial_function loc () *)
 
+(* #PR4828: Believe it or not, the 'paraml' argument below
+   may not be side effect free. *)
 
-module E = Js_exp_make 
+let arg_to_var arg cls = match arg with
+| Lvar v -> v,arg
+| _ ->
+    let v = name_pattern "match" cls in
+    v,Lvar v
 
-module S = Js_stmt_make  
 
-let rec is_simple_expression (e : J.expression) = 
-  match e.expression_desc with  
-  | Var _ 
-  | Bool _ 
-  | Str _ 
-  | Number _ -> true
-  | Dot (e, _, _) -> is_simple_expression e 
-  | _ -> false 
+let param_to_var param = match param with
+| Lvar v -> v,None
+| _ -> Ident.create "match",Some param
 
-let rec named_expression (e : J.expression)
-  :  (J.statement  * Ident.t) option = 
-  if is_simple_expression e then 
-    None 
-  else 
-    let obj = Ext_ident.create Literals.tmp in
-    let obj_code = 
-      S.define
-        ~kind:Strict obj e in 
+let bind_opt (v,eo) k = match eo with
+| None -> k
+| Some e ->  Lambda.bind Strict v e k
 
-    Some (obj_code, obj)
+let for_multiple_match loc paraml pat_act_list partial =
+  let v_paraml = List.map param_to_var paraml in
+  let paraml = List.map (fun (v,_) -> Lvar v) v_paraml in
+  List.fold_right bind_opt v_paraml
+    (do_for_multiple_match loc paraml pat_act_list partial)
 
 end
-module Js_of_lam_array : sig 
-#1 "js_of_lam_array.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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 Translobj : sig 
+#1 "translobj.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+open Lambda
 
+val oo_prim: string -> lambda
 
+val share: structured_constant -> lambda
+val meth: lambda -> string -> lambda * lambda list
 
+val reset_labels: unit -> unit
+val transl_label_init: lambda -> lambda
+val transl_store_label_init:
+    Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
 
+val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
 
+val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
+val oo_add_class: Ident.t -> Env.t * bool
 
+val reset: unit -> unit
 
-(** Utilities for creating Array of JS IR *)
+end = struct
+#1 "translobj.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-val make_array : J.mutable_flag -> Lambda.array_kind -> J.expression list -> J.expression
-(** create an array *)
+open Misc
+open Primitive
+open Asttypes
+open Longident
+open Lambda
 
-val set_array : J.expression -> J.expression -> J.expression -> J.expression
-(** Here we don't care about [array_kind],  
-    In the future, we might used TypedArray for FloatArray
- *)
+(* Get oo primitives identifiers *)
 
-val ref_array :  J.expression -> J.expression -> J.expression
+let oo_prim name =
+  try
+    transl_normal_path
+      (fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
+  with Not_found ->
+    fatal_error ("Primitive " ^ name ^ " not found.")
 
-end = struct
-#1 "js_of_lam_array.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+(* Share blocks *)
 
+let consts : (structured_constant, Ident.t) Hashtbl.t = Hashtbl.create 17
 
+let share c =
+  match c with
+    Const_block (n, _,  l) when l <> [] ->
+      begin try
+        Lvar (Hashtbl.find consts c)
+      with Not_found ->
+        let id = Ident.create "shared" in
+        Hashtbl.add consts c id;
+        Lvar id
+      end
+  | _ -> Lconst c
 
+(* Collect labels *)
 
+let cache_required = ref false
+let method_cache = ref lambda_unit
+let method_count = ref 0
+let method_table = ref []
 
+let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
 
+let next_cache tag =
+  let n = !method_count in
+  incr method_count;
+  (tag, [!method_cache; Lconst(Const_base(Const_int n))])
 
+let rec is_path = function
+    Lvar _ | Lprim (Pgetglobal _, [], _) | Lconst _ -> true
+  | Lprim (Pfield _, [lam], _) -> is_path lam
+  | Lprim ((Parrayrefu _ | Parrayrefs _), [lam1; lam2], _) ->
+      is_path lam1 && is_path lam2
+  | _ -> false
 
-(*
-   construct array,
-   set array,
-   ref array,
+let meth obj lab =
+  let tag = meth_tag lab in
+  if not (!cache_required && !Clflags.native_code) then (tag, []) else
+  if not (is_path obj) then next_cache tag else
+  try
+    let r = List.assoc obj !method_table in
+    try
+      (tag, List.assoc tag !r)
+    with Not_found ->
+      let p = next_cache tag in
+      r := p :: !r;
+      p
+  with Not_found ->
+    let p = next_cache tag in
+    method_table := (obj, ref [p]) :: !method_table;
+    p
 
-   Also make sure, don't call any primitive array method, i.e [E.index] 
+let reset_labels () =
+  Hashtbl.clear consts;
+  method_count := 0;
+  method_table := []
 
-   We also need check primitive [caml_make_vect], i.e, 
-   [Caml_primitive['caml_make_vect']] see if it's correct 
+(* Insert labels *)
 
-   [caml_make_vect]
-   [caml_array_sub]
-   [caml_array_append]
-   [caml_array_concat]
-   [caml_make_float_vect]
-   [caml_array_blit]
+let string s = Lconst (Const_base (Const_string (s, None)))
+let int n = Lconst (Const_base (Const_int n))
 
-   research: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Typed_arrays
+let prim_makearray =
+  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false}
 
+(* Also use it for required globals *)
+let transl_label_init expr =
+  let expr =
+    Hashtbl.fold
+      (fun c id expr -> Llet(Alias, id, Lconst c, expr))
+      consts expr
+  in
+  let expr =
+    List.fold_right
+      (fun id expr -> Lsequence(Lprim(Pgetglobal id, [], Location.none), expr))
+      (Env.get_required_globals ()) expr
+  in
+  Env.reset_required_globals ();
+  reset_labels ();
+  expr
 
- *)
+let transl_store_label_init glob size f arg =
+  method_cache := Lprim(Pfield (size, Fld_na), [Lprim(Pgetglobal glob, [], Location.none)], Location.none);
+  let expr = f arg in
+  let (size, expr) =
+    if !method_count = 0 then (size, expr) else
+    (size+1,
+     Lsequence(
+     Lprim(Psetfield(size, false, Fld_set_na),
+           [Lprim(Pgetglobal glob, [], Location.none);
+            Lprim (Pccall prim_makearray, [int !method_count; int 0], Location.none)], Location.none),
+     expr))
+  in
+  (size, transl_label_init expr)
 
-module E  = Js_exp_make
+(* Share classes *)
 
+let wrapping = ref false
+let top_env = ref Env.empty
+let classes = ref []
+let method_ids = ref IdentSet.empty
 
-(* Parrayref(u|s) *)
-let make_array mt (kind : Lambda.array_kind) args = 
-  match kind with 
-  | Pgenarray
-  | Paddrarray -> E.arr ~comment:"array" mt args 
-  | Pintarray  -> E.arr ~comment:"int array" mt args 
-  | Pfloatarray -> E.arr ~comment:"float array" mt args
+let oo_add_class id =
+  classes := id :: !classes;
+  (!top_env, !cache_required)
 
-let set_array  e e0 e1 = 
-  E.assign (E.access e e0)  e1
+let oo_wrap env req f x =
+  if !wrapping then
+    if !cache_required then f x else
+    try cache_required := true; let lam = f x in cache_required := false; lam
+    with exn -> cache_required := false; raise exn
+  else try
+    wrapping := true;
+    cache_required := req;
+    top_env := env;
+    classes := [];
+    method_ids := IdentSet.empty;
+    let lambda = f x in
+    let lambda =
+      List.fold_left
+        (fun lambda id ->
+          Llet(StrictOpt, id,
+               Lprim(Pmakeblock(0, Lambda.default_tag_info, Mutable),
+                     [lambda_unit; lambda_unit; lambda_unit], Location.none),
+               lambda))
+        lambda !classes
+    in
+    wrapping := false;
+    top_env := Env.empty;
+    lambda
+  with exn ->
+    wrapping := false;
+    top_env := Env.empty;
+    raise exn
 
-let ref_array  e e0 = 
-  E.access  e  e0
+let reset () =
+  Hashtbl.clear consts;
+  cache_required := false;
+  method_cache := lambda_unit;
+  method_count := 0;
+  method_table := [];
+  wrapping := false;
+  top_env := Env.empty;
+  classes := [];
+  method_ids := IdentSet.empty
 
 end
-module Js_of_lam_record : sig 
-#1 "js_of_lam_record.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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 Translcore : sig 
+#1 "translcore.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+(* Translation from typed abstract syntax to lambda terms,
+   for the core language *)
 
+open Asttypes
+open Typedtree
+open Lambda
 
+val transl_exp: expression -> lambda
+val transl_apply: lambda -> (label * expression option * optional) list
+                  -> Location.t -> lambda
+val transl_let: rec_flag -> value_binding list -> lambda -> lambda
+val transl_primitive: Location.t -> Primitive.description -> lambda
 
+val check_recursive_lambda: Ident.t list -> lambda -> bool
 
-(** Utilities for compiling lambda record into JS IR *)
+type error =
+    Illegal_letrec_pat
+  | Illegal_letrec_expr
+  | Free_super_var
+  | Unknown_builtin_primitive of string
 
-(* val make : J.mutable_flag -> (string * J.expression) list -> J.expression *)
+exception Error of Location.t * error
 
+open Format
 
-val field : Lambda.field_dbg_info -> J.expression -> J.jsint ->J.expression
+val report_error: formatter -> error -> unit
 
-val copy : Js_exp_make.unary_op
+(* Forward declaration -- to be filled in by Translmod.transl_module *)
+val transl_module :
+      (module_coercion -> Path.t option -> module_expr -> lambda) ref
+val transl_object :
+      (Ident.t -> string list -> class_expr -> lambda) ref
 
 end = struct
-#1 "js_of_lam_record.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
-
+#1 "translcore.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+(* Translation from typed abstract syntax to lambda terms,
+   for the core language *)
 
+open Misc
+open Asttypes
+open Primitive
+open Types
+open Typedtree
+open Typeopt
+open Lambda
 
+type error =
+    Illegal_letrec_pat
+  | Illegal_letrec_expr
+  | Free_super_var
+  | Unknown_builtin_primitive of string
 
-module E = Js_exp_make 
+exception Error of Location.t * error
 
-let empty_record_info = Lambda.Blk_record [||] (* careful to share*)
+(* Forward declaration -- to be filled in by Translmod.transl_module *)
+let transl_module =
+  ref((fun cc rootpath modl -> assert false) :
+      module_coercion -> Path.t option -> module_expr -> lambda)
 
+let transl_object =
+  ref (fun id s cl -> assert false :
+       Ident.t -> string list -> class_expr -> lambda)
 
-(* TODO: add label to the comment *)
-(* let make  mutable_flag (args : (string * J.expression) list) = *)
-(*   E.make_block ~comment:"record"  *)
-(*     E.zero_int_literal empty_record_info (List.map snd args) mutable_flag *)
+(* Translation of primitives *)
 
+let comparisons_table = create_hashtable 11 [
+  "%equal",
+      (Pccall{prim_name = "caml_equal"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Ceq,
+       Pfloatcomp Ceq,
+       Pccall{prim_name = "caml_string_equal"; prim_arity = 2;
+              prim_alloc = false;
+              prim_native_name = ""; prim_native_float = false},
+       Pbintcomp(Pnativeint, Ceq),
+       Pbintcomp(Pint32, Ceq),
+       Pbintcomp(Pint64, Ceq),
+       true);
+  "%notequal",
+      (Pccall{prim_name = "caml_notequal"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Cneq,
+       Pfloatcomp Cneq,
+       Pccall{prim_name = "caml_string_notequal"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pbintcomp(Pnativeint, Cneq),
+       Pbintcomp(Pint32, Cneq),
+       Pbintcomp(Pint64, Cneq),
+       true);
+  "%lessthan",
+      (Pccall{prim_name = "caml_lessthan"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Clt,
+       Pfloatcomp Clt,
+       Pccall{prim_name = "caml_string_lessthan"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pbintcomp(Pnativeint, Clt),
+       Pbintcomp(Pint32, Clt),
+       Pbintcomp(Pint64, Clt),
+       false);
+  "%greaterthan",
+      (Pccall{prim_name = "caml_greaterthan"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Cgt,
+       Pfloatcomp Cgt,
+       Pccall{prim_name = "caml_string_greaterthan"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pbintcomp(Pnativeint, Cgt),
+       Pbintcomp(Pint32, Cgt),
+       Pbintcomp(Pint64, Cgt),
+       false);
+  "%lessequal",
+      (Pccall{prim_name = "caml_lessequal"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Cle,
+       Pfloatcomp Cle,
+       Pccall{prim_name = "caml_string_lessequal"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pbintcomp(Pnativeint, Cle),
+       Pbintcomp(Pint32, Cle),
+       Pbintcomp(Pint64, Cle),
+       false);
+  "%greaterequal",
+      (Pccall{prim_name = "caml_greaterequal"; prim_arity = 2;
+              prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pintcomp Cge,
+       Pfloatcomp Cge,
+       Pccall{prim_name = "caml_string_greaterequal"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pbintcomp(Pnativeint, Cge),
+       Pbintcomp(Pint32, Cge),
+       Pbintcomp(Pint64, Cge),
+       false);
+  "%compare",
+      (Pccall{prim_name = "caml_compare"; prim_arity = 2; prim_alloc = true;
+              prim_native_name = ""; prim_native_float = false},
+       Pccall{prim_name = "caml_int_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pccall{prim_name = "caml_float_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pccall{prim_name = "caml_string_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pccall{prim_name = "caml_nativeint_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pccall{prim_name = "caml_int32_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       Pccall{prim_name = "caml_int64_compare"; prim_arity = 2;
+              prim_alloc = false; prim_native_name = "";
+              prim_native_float = false},
+       false)
+]
 
+let primitives_table = create_hashtable 57 [
+  "%bytes_to_string", Pbytes_to_string;
+  "%bytes_of_string", Pbytes_of_string;
+  "%identity", Pidentity;
+  "%ignore", Pignore;
+  "%field0", Pfield (0, Fld_na);
+  "%field1", Pfield (1, Fld_na);
+  "%setfield0", Psetfield(0, true, Fld_set_na);
+  "%makeblock", Pmakeblock(0, Lambda.default_tag_info, Immutable);
+  "%makemutable", Pmakeblock(0,Lambda.default_tag_info,  Mutable);
+  "%raise", Praise Raise_regular;
+  "%reraise", Praise Raise_reraise;
+  "%raise_notrace", Praise Raise_notrace;
+  "%sequand", Psequand;
+  "%sequor", Psequor;
+  "%boolnot", Pnot;
+  "%big_endian", Pctconst Big_endian;
+  "%word_size", Pctconst Word_size;
+  "%ostype_unix", Pctconst Ostype_unix;
+  "%ostype_win32", Pctconst Ostype_win32;
+  "%ostype_cygwin", Pctconst Ostype_cygwin;
+  "%negint", Pnegint;
+  "%succint", Poffsetint 1;
+  "%predint", Poffsetint(-1);
+  "%addint", Paddint;
+  "%subint", Psubint;
+  "%mulint", Pmulint;
+  "%divint", Pdivint;
+  "%modint", Pmodint;
+  "%andint", Pandint;
+  "%orint", Porint;
+  "%xorint", Pxorint;
+  "%lslint", Plslint;
+  "%lsrint", Plsrint;
+  "%asrint", Pasrint;
+  "%eq", Pintcomp Ceq;
+  "%noteq", Pintcomp Cneq;
+  "%ltint", Pintcomp Clt;
+  "%leint", Pintcomp Cle;
+  "%gtint", Pintcomp Cgt;
+  "%geint", Pintcomp Cge;
+  "%incr", Poffsetref(1);
+  "%decr", Poffsetref(-1);
+  "%intoffloat", Pintoffloat;
+  "%floatofint", Pfloatofint;
+  "%negfloat", Pnegfloat;
+  "%absfloat", Pabsfloat;
+  "%addfloat", Paddfloat;
+  "%subfloat", Psubfloat;
+  "%mulfloat", Pmulfloat;
+  "%divfloat", Pdivfloat;
+  "%eqfloat", Pfloatcomp Ceq;
+  "%noteqfloat", Pfloatcomp Cneq;
+  "%ltfloat", Pfloatcomp Clt;
+  "%lefloat", Pfloatcomp Cle;
+  "%gtfloat", Pfloatcomp Cgt;
+  "%gefloat", Pfloatcomp Cge;
+  "%string_length", Pstringlength;
+  "%string_safe_get", Pstringrefs;
+  "%string_safe_set", Pstringsets;
+  "%string_unsafe_get", Pstringrefu;
+  "%string_unsafe_set", Pstringsetu;
 
-let field field_info  e i =
-  match field_info with 
-  | Lambda.Fld_na -> 
-    E.index e i 
-  | Lambda.Fld_record s 
-  | Lambda.Fld_module s 
-    -> E.index ~comment:s e i
+  "%bytes_length", Pbyteslength;
+  "%bytes_safe_get", Pbytesrefs;
+  "%bytes_safe_set", Pbytessets;
+  "%bytes_unsafe_get", Pbytesrefu;
+  "%bytes_unsafe_set", Pbytessetu;
 
-(**
-   used in [Pduprecord]
-   this is due to we encode record as an array, it is going to change
-   if we have another encoding       
-*)    
-let copy  = E.array_copy
+  "%array_length", Parraylength Pgenarray;
+  "%array_safe_get", Parrayrefs Pgenarray;
+  "%array_safe_set", Parraysets Pgenarray;
+  "%array_unsafe_get", Parrayrefu Pgenarray;
+  "%array_unsafe_set", Parraysetu Pgenarray;
+  "%obj_size", Parraylength Pgenarray;
+  "%obj_field", Parrayrefu Pgenarray;
+  "%obj_set_field", Parraysetu Pgenarray;
+  "%obj_is_int", Pisint;
+  "%lazy_force", Plazyforce;
+  "%nativeint_of_int", Pbintofint Pnativeint;
+  "%nativeint_to_int", Pintofbint Pnativeint;
+  "%nativeint_neg", Pnegbint Pnativeint;
+  "%nativeint_add", Paddbint Pnativeint;
+  "%nativeint_sub", Psubbint Pnativeint;
+  "%nativeint_mul", Pmulbint Pnativeint;
+  "%nativeint_div", Pdivbint Pnativeint;
+  "%nativeint_mod", Pmodbint Pnativeint;
+  "%nativeint_and", Pandbint Pnativeint;
+  "%nativeint_or",  Porbint Pnativeint;
+  "%nativeint_xor", Pxorbint Pnativeint;
+  "%nativeint_lsl", Plslbint Pnativeint;
+  "%nativeint_lsr", Plsrbint Pnativeint;
+  "%nativeint_asr", Pasrbint Pnativeint;
+  "%int32_of_int", Pbintofint Pint32;
+  "%int32_to_int", Pintofbint Pint32;
+  "%int32_neg", Pnegbint Pint32;
+  "%int32_add", Paddbint Pint32;
+  "%int32_sub", Psubbint Pint32;
+  "%int32_mul", Pmulbint Pint32;
+  "%int32_div", Pdivbint Pint32;
+  "%int32_mod", Pmodbint Pint32;
+  "%int32_and", Pandbint Pint32;
+  "%int32_or",  Porbint Pint32;
+  "%int32_xor", Pxorbint Pint32;
+  "%int32_lsl", Plslbint Pint32;
+  "%int32_lsr", Plsrbint Pint32;
+  "%int32_asr", Pasrbint Pint32;
+  "%int64_of_int", Pbintofint Pint64;
+  "%int64_to_int", Pintofbint Pint64;
+  "%int64_neg", Pnegbint Pint64;
+  "%int64_add", Paddbint Pint64;
+  "%int64_sub", Psubbint Pint64;
+  "%int64_mul", Pmulbint Pint64;
+  "%int64_div", Pdivbint Pint64;
+  "%int64_mod", Pmodbint Pint64;
+  "%int64_and", Pandbint Pint64;
+  "%int64_or",  Porbint Pint64;
+  "%int64_xor", Pxorbint Pint64;
+  "%int64_lsl", Plslbint Pint64;
+  "%int64_lsr", Plsrbint Pint64;
+  "%int64_asr", Pasrbint Pint64;
+  "%nativeint_of_int32", Pcvtbint(Pint32, Pnativeint);
+  "%nativeint_to_int32", Pcvtbint(Pnativeint, Pint32);
+  "%int64_of_int32", Pcvtbint(Pint32, Pint64);
+  "%int64_to_int32", Pcvtbint(Pint64, Pint32);
+  "%int64_of_nativeint", Pcvtbint(Pnativeint, Pint64);
+  "%int64_to_nativeint", Pcvtbint(Pint64, Pnativeint);
+  "%caml_ba_ref_1",
+    Pbigarrayref(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_ref_2",
+    Pbigarrayref(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_ref_3",
+    Pbigarrayref(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_1",
+    Pbigarrayset(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_2",
+    Pbigarrayset(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_3",
+    Pbigarrayset(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_1",
+    Pbigarrayref(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_2",
+    Pbigarrayref(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_3",
+    Pbigarrayref(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_1",
+    Pbigarrayset(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_2",
+    Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_3",
+    Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_dim_1", Pbigarraydim(1);
+  "%caml_ba_dim_2", Pbigarraydim(2);
+  "%caml_ba_dim_3", Pbigarraydim(3);
+  "%caml_string_get16", Pstring_load_16(false);
+  "%caml_string_get16u", Pstring_load_16(true);
+  "%caml_string_get32", Pstring_load_32(false);
+  "%caml_string_get32u", Pstring_load_32(true);
+  "%caml_string_get64", Pstring_load_64(false);
+  "%caml_string_get64u", Pstring_load_64(true);
+  "%caml_string_set16", Pstring_set_16(false);
+  "%caml_string_set16u", Pstring_set_16(true);
+  "%caml_string_set32", Pstring_set_32(false);
+  "%caml_string_set32u", Pstring_set_32(true);
+  "%caml_string_set64", Pstring_set_64(false);
+  "%caml_string_set64u", Pstring_set_64(true);
+  "%caml_bigstring_get16", Pbigstring_load_16(false);
+  "%caml_bigstring_get16u", Pbigstring_load_16(true);
+  "%caml_bigstring_get32", Pbigstring_load_32(false);
+  "%caml_bigstring_get32u", Pbigstring_load_32(true);
+  "%caml_bigstring_get64", Pbigstring_load_64(false);
+  "%caml_bigstring_get64u", Pbigstring_load_64(true);
+  "%caml_bigstring_set16", Pbigstring_set_16(false);
+  "%caml_bigstring_set16u", Pbigstring_set_16(true);
+  "%caml_bigstring_set32", Pbigstring_set_32(false);
+  "%caml_bigstring_set32u", Pbigstring_set_32(true);
+  "%caml_bigstring_set64", Pbigstring_set_64(false);
+  "%caml_bigstring_set64u", Pbigstring_set_64(true);
+  "%bswap16", Pbswap16;
+  "%bswap_int32", Pbbswap(Pint32);
+  "%bswap_int64", Pbbswap(Pint64);
+  "%bswap_native", Pbbswap(Pnativeint);
+  "%int_as_pointer", Pint_as_pointer;
+]
 
+let prim_makearray =
+  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false }
 
-end
-module Lam_beta_reduce_util : sig 
-#1 "lam_beta_reduce_util.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let prim_obj_dup =
+  { prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false }
 
+let find_primitive loc prim_name =
+  match prim_name with
+      "%revapply" -> Prevapply 
+    | "%apply" -> Pdirapply 
+    | "%loc_LOC" -> Ploc Loc_LOC
+    | "%loc_FILE" -> Ploc Loc_FILE
+    | "%loc_LINE" -> Ploc Loc_LINE
+    | "%loc_POS" -> Ploc Loc_POS
+    | "%loc_MODULE" -> Ploc Loc_MODULE
+    | name -> Hashtbl.find primitives_table name
 
+let transl_prim loc prim args =
+  let prim_name = prim.prim_name in
+  try
+    let (gencomp, intcomp, floatcomp, stringcomp,
+         nativeintcomp, int32comp, int64comp,
+         simplify_constant_constructor) =
+      Hashtbl.find comparisons_table prim_name in
+    begin match args with
+      [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}]
+      when simplify_constant_constructor ->
+        intcomp
+    | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}; arg2]
+      when simplify_constant_constructor ->
+        intcomp
+    | [arg1; {exp_desc = Texp_variant(_, None)}]
+      when simplify_constant_constructor ->
+        intcomp
+    | [{exp_desc = Texp_variant(_, None)}; exp2]
+      when simplify_constant_constructor ->
+        intcomp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_int
+                     || has_base_type arg1 Predef.path_char ->
+        intcomp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_float ->
+        floatcomp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_string ->
+        stringcomp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_nativeint ->
+        nativeintcomp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_int32 ->
+        int32comp
+    | [arg1; arg2] when has_base_type arg1 Predef.path_int64 ->
+        int64comp
+    | _ ->
+        gencomp
+    end
+  with Not_found ->
+  try
+    let p = find_primitive loc prim_name in
+    (* Try strength reduction based on the type of the argument *)
+    begin match (p, args) with
+        (Psetfield(n, _, dbg_info), [arg1; arg2]) -> Psetfield(n, maybe_pointer arg2, dbg_info)
+      | (Parraylength Pgenarray, [arg])   -> Parraylength(array_kind arg)
+      | (Parrayrefu Pgenarray, arg1 :: _) -> Parrayrefu(array_kind arg1)
+      | (Parraysetu Pgenarray, arg1 :: _) -> Parraysetu(array_kind arg1)
+      | (Parrayrefs Pgenarray, arg1 :: _) -> Parrayrefs(array_kind arg1)
+      | (Parraysets Pgenarray, arg1 :: _) -> Parraysets(array_kind arg1)
+      | (Pbigarrayref(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
+                      arg1 :: _) ->
+            let (k, l) = bigarray_kind_and_layout arg1 in
+            Pbigarrayref(unsafe, n, k, l)
+      | (Pbigarrayset(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
+                      arg1 :: _) ->
+            let (k, l) = bigarray_kind_and_layout arg1 in
+            Pbigarrayset(unsafe, n, k, l)
+      | _ -> p
+    end
+  with Not_found ->
+    if String.length prim_name > 0 && prim_name.[0] = '%' then
+      raise(Error(loc, Unknown_builtin_primitive prim_name));
+    Pccall prim
 
 
+(* Eta-expand a primitive without knowing the types of its arguments *)
 
+let transl_primitive loc p =
+  let prim =
+    try
+      let (gencomp, _, _, _, _, _, _, _) =
+        Hashtbl.find comparisons_table p.prim_name in
+      gencomp
+    with Not_found ->
+    try
+      find_primitive loc p.prim_name
+    with Not_found ->
+      Pccall p in
+  match prim with
+  | Plazyforce ->
+      let parm = Ident.create "prim" in
+      Lfunction(Curried, [parm],
+                Matching.inline_lazy_force (Lvar parm) Location.none)
+  | Ploc kind ->
+    let lam = lam_of_loc kind loc in
+    begin match p.prim_arity with
+      | 0 -> lam
+      | 1 -> (* TODO: we should issue a warning ? *)
+        let param = Ident.create "prim" in
+        Lfunction(Curried, [param],
+          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), [lam; Lvar param], loc))
+      | _ -> assert false
+    end
+  | _ ->
+      let rec make_params n =
+        if n <= 0 then [] else Ident.create "prim" :: make_params (n-1) in
+      let params = make_params p.prim_arity in
+      if params = [] then  Lprim(prim,[], loc) (* arity = 0 in Buckle? TODO: unneeded *)
+      else Lfunction(Curried, params,
+                Lprim(prim, List.map (fun id -> Lvar id) params, loc))
 
+(* To check the well-formedness of r.h.s. of "let rec" definitions *)
 
-val simple_beta_reduce : 
-  Ident.t list -> Lam.t -> Lam.t list -> Lam.t option
+let check_recursive_lambda idlist lam =
+  let rec check_top idlist = function
+    | Lvar v -> not (List.mem v idlist)
+    | Llet (_, _, _, _) as lam when check_recursive_recordwith idlist lam ->
+        true
+    | Llet(str, id, arg, body) ->
+        check idlist arg && check_top (add_let id arg idlist) body
+    | Lletrec(bindings, body) ->
+        let idlist' = add_letrec bindings idlist in
+        List.for_all (fun (id, arg) -> check idlist' arg) bindings &&
+        check_top idlist' body
+    | Lprim (Pmakearray (Pgenarray), args, _) -> false
+    | Lsequence (lam1, lam2) -> check idlist lam1 && check_top idlist lam2
+    | Levent (lam, _) -> check_top idlist lam
+    | lam -> check idlist lam
 
-end = struct
-#1 "lam_beta_reduce_util.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+  and check idlist = function
+    | Lvar _ -> true
+    | Lfunction(kind, params, body) -> true
+    | Llet (_, _, _, _) as lam when check_recursive_recordwith idlist lam ->
+        true
+    | Llet(str, id, arg, body) ->
+        check idlist arg && check (add_let id arg idlist) body
+    | Lletrec(bindings, body) ->
+        let idlist' = add_letrec bindings idlist in
+        List.for_all (fun (id, arg) -> check idlist' arg) bindings &&
+        check idlist' body
+    | Lprim(Pmakeblock(tag, _,  mut), args, _) ->
+        List.for_all (check idlist) args
+    | Lprim(Pmakearray(_), args, _) ->
+        List.for_all (check idlist) args
+    | Lsequence (lam1, lam2) -> check idlist lam1 && check idlist lam2
+    | Levent (lam, _) -> check idlist lam
+    | lam ->
+        let fv = free_variables lam in
+        not (List.exists (fun id -> IdentSet.mem id fv) idlist)
 
+  and add_let id arg idlist =
+    let fv = free_variables arg in
+    if List.exists (fun id -> IdentSet.mem id fv) idlist
+    then id :: idlist
+    else idlist
 
+  and add_letrec bindings idlist =
+    List.fold_right (fun (id, arg) idl -> add_let id arg idl)
+                    bindings idlist
 
+  (* reverse-engineering the code generated by transl_record case 2 *)
+  (* If you change this, you probably need to change Bytegen.size_of_lambda. *)
+  and check_recursive_recordwith idlist = function
+    | Llet (Strict, id1, Lprim (Pduprecord _, [e1], _), body) ->
+       check_top idlist e1
+       && check_recordwith_updates idlist id1 body
+    | _ -> false
 
+  and check_recordwith_updates idlist id1 = function
+    | Lsequence (Lprim ((Psetfield _ | Psetfloatfield _), [Lvar id2; e1], _), cont)
+        -> id2 = id1 && check idlist e1
+           && check_recordwith_updates idlist id1 cont
+    | Lvar id2 -> id2 = id1
+    | _ -> false
 
+  in check_top idlist lam
 
-(* 
-   Principle: since in ocaml, the apply order is not specified 
-   rules:
-   1. each argument it is only used once, (avoid eval duplication)
-   2. it's actually used, if not (Lsequence)
-   3. no nested  compuation, 
-      other wise the evaluation order is tricky (make sure eval order is correct)
-*)
+(* To propagate structured constants *)
 
-type value = 
-  { mutable used : bool ; 
-    lambda  : Lam.t
-  }
-let param_hash :  _ Ident_hashtbl.t = Ident_hashtbl.create 20
-let simple_beta_reduce params body args = 
-  let module E = struct exception Not_simple_apply end in
-  let rec find_param v  opt = 
-    match Ident_hashtbl.find_opt param_hash v with 
-    | Some exp ->  
-      if exp.used then raise E.Not_simple_apply
-      else exp.used <- true; exp.lambda
-    | None -> opt
-  in  
-  let rec aux acc (us : Lam.t list) = 
-    match us with 
-    | [] -> List.rev acc
-    | (Lvar x as a ) :: rest 
-      -> 
-      aux  (find_param x a  :: acc) rest 
-    | (Lconst  _  as u) :: rest 
-      -> aux (u :: acc) rest 
-    | _ :: _ -> raise E.Not_simple_apply 
-  in 
-  match (body : Lam.t) with 
-  | Lprim { primitive ; args =  args' ; loc}  (* There is no lambda in primitive *)
-    -> (* catch a special case of primitives *)
-    (* Note in a very special case we can avoid any allocation
-       {[
-         when Ext_list.for_all2_no_exn
-             (fun p a ->
-                match (a : Lam.t) with
-                | Lvar a -> Ident.same p a
-                | _ -> false ) params args'
-       ]}*)
-    let () = 
-      List.iter2 (fun p a -> Ident_hashtbl.add param_hash p {lambda = a; used = false }) params args  
-    in 
-    begin match aux [] args' with 
-    | args -> 
-      let result = 
-        Ident_hashtbl.fold (fun _param {lambda; used} code -> 
-            if not used then
-              Lam.seq lambda code
-            else code) param_hash (Lam.prim ~primitive ~args loc) in 
-      Ident_hashtbl.clear param_hash;
-      Some result 
-    | exception _ -> 
-      Ident_hashtbl.clear param_hash ;
-      None
-    end
-  | Lapply { fn = Lvar fn_name as f ; args =  args';  loc; status}
-    ->  
-    let () = 
-      List.iter2 (fun p a -> Ident_hashtbl.add param_hash p {lambda = a; used = false }) params args  
-    in 
-    (*since we adde each param only once, 
-      iff it is removed once, no exception, 
-      if it is removed twice there will be exception.
-      if it is never removed, we have it as rest keys 
-    *)
-    begin match aux [] args' with 
-      | us -> 
-        let f = find_param fn_name  f in
-        let result = 
-          Ident_hashtbl.fold 
-            (fun _param {lambda; used} code -> 
-               if not used then 
-                 Lam.seq lambda code
-               else code )
-            param_hash (Lam.apply  f us  loc status) in
-        Ident_hashtbl.clear param_hash;
-        Some result 
-      | exception _ -> 
-        Ident_hashtbl.clear param_hash; 
-        None
-    end
-  | _ -> None
+exception Not_constant
 
-end
-module Lam_closure : sig 
-#1 "lam_closure.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let extract_constant = function
+    Lconst sc -> sc
+  | _ -> raise Not_constant
 
-(** [is_closed_by map lam]
-    return [true] if all unbound variables
-    belongs to the given [map] *)
-val is_closed_by : Ident_set.t -> Lam.t -> bool
+let extract_float = function
+    Const_base(Const_float f) -> f
+  | _ -> fatal_error "Translcore.extract_float"
 
-val is_closed : Lam.t -> bool
+(* To find reasonable names for let-bound and lambda-bound idents *)
 
+let rec name_pattern default = function
+    [] -> Ident.create default
+  | {c_lhs=p; _} :: rem ->
+      match p.pat_desc with
+        Tpat_var (id, _) -> id
+      | Tpat_alias(p, id, _) -> id
+      | _ -> name_pattern default rem
 
+(* Push the default values under the functional abstractions *)
 
+let rec push_defaults loc bindings cases partial =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function(l, pl,partial)} as exp}] ->
+      let pl = push_defaults exp.exp_loc bindings pl partial in
+      [{c_lhs=pat; c_guard=None;
+        c_rhs={exp with exp_desc = Texp_function(l, pl, partial)}}]
+  | [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_attributes=[{txt="#default"},_];
+             exp_desc = Texp_let
+               (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}] ->
+      push_defaults loc (binds :: bindings) [{c_lhs=pat;c_guard=None;c_rhs=e2}]
+                    partial
+  | [case] ->
+      let exp =
+        List.fold_left
+          (fun exp binds ->
+            {exp with exp_desc = Texp_let(Nonrecursive, binds, exp)})
+          case.c_rhs bindings
+      in
+      [{case with c_rhs=exp}]
+  | {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
+      let param = name_pattern "param" cases in
+      let name = Ident.name param in
+      let exp =
+        { exp with exp_loc = loc; exp_desc =
+          Texp_match
+            ({exp with exp_type = pat.pat_type; exp_desc =
+              Texp_ident (Path.Pident param, mknoloc (Longident.Lident name),
+                          {val_type = pat.pat_type; val_kind = Val_reg;
+                           val_attributes = [];
+                           Types.val_loc = Location.none;
+                          })},
+             cases, [], partial) }
+      in
+      push_defaults loc bindings
+        [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)};
+          c_guard=None; c_rhs=exp}]
+        Total
+  | _ ->
+      cases
 
+(* Insertion of debugging events *)
 
-type stats = 
-  { 
-    top : bool ; 
-    (* all appearances are in the top,  substitution is fine 
-       whether it is pure or not
-       {[
-         (fun x y          
-           ->  x + y + (f x )) (32) (console.log('hi'), 33)
-       ]}       
-       since in ocaml, the application order is intentionally undefined, 
-       note if [times] is not one, this field does not make sense       
-    *)    
-    times : int ; 
-  }
+let event_before exp lam = match lam with
+| Lstaticraise (_,_) -> lam
+| _ ->
+  if !Clflags.debug
+  then Levent(lam, {lev_loc = exp.exp_loc;
+                    lev_kind = Lev_before;
+                    lev_repr = None;
+                    lev_env = Env.summary exp.exp_env})
+  else lam
 
-val is_closed_with_map : 
-  Ident_set.t ->
-  Ident.t list -> Lam.t -> bool * stats Ident_map.t
+let event_after exp lam =
+  if !Clflags.debug
+  then Levent(lam, {lev_loc = exp.exp_loc;
+                    lev_kind = Lev_after exp.exp_type;
+                    lev_repr = None;
+                    lev_env = Env.summary exp.exp_env})
+  else lam
 
-(* val param_map_of_list : Ident.t list -> stats Ident_map.t *)
+let event_function exp lam =
+  if !Clflags.debug then
+    let repr = Some (ref 0) in
+    let (info, body) = lam repr in
+    (info,
+     Levent(body, {lev_loc = exp.exp_loc;
+                   lev_kind = Lev_function;
+                   lev_repr = repr;
+                   lev_env = Env.summary exp.exp_env}))
+  else
+    lam None
 
-val free_variables : Ident_set.t -> stats Ident_map.t -> Lam.t -> stats Ident_map.t
+let primitive_is_ccall = function
+  (* Determine if a primitive is a Pccall or will be turned later into
+     a C function call that may raise an exception *)
+  | Pccall _ | Pstringrefs | Pstringsets | Parrayrefs _ | Parraysets _ |
+    Pbigarrayref _ | Pbigarrayset _ | Pduprecord _ -> true
+  | _ -> false
 
+(* Assertions *)
 
-end = struct
-#1 "lam_closure.ml"
+let assert_failed exp =
+  let (fname, line, char) =
+    Location.get_pos_info exp.exp_loc.Location.loc_start in
+  Lprim(Praise Raise_regular, [event_after exp
+    (Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+          [transl_normal_path Predef.path_assert_failure;
+           Lconst(Const_block(0, Lambda.default_tag_info,
+              [Const_base(Const_string (fname, None));
+               Const_base(Const_int line);
+               Const_base(Const_int char)]))], exp.exp_loc))], exp.exp_loc)
+;;
+
+let rec cut n l =
+  if n = 0 then ([],l) else
+  match l with [] -> failwith "Translcore.cut"
+  | a::l -> let (l1,l2) = cut (n-1) l in (a::l1,l2)
+
+(* Translation of expressions *)
 
+let try_ids = Hashtbl.create 8
+
+let rec transl_exp e =
+  let eval_once =
+    (* Whether classes for immediate objects must be cached *)
+    match e.exp_desc with
+      Texp_function _ | Texp_for _ | Texp_while _ -> false
+    | _ -> true
+  in
+  if eval_once then transl_exp0 e else
+  Translobj.oo_wrap e.exp_env true transl_exp0 e
+
+and transl_exp0 e =
+  match e.exp_desc with
+    Texp_ident(path, _, {val_kind = Val_prim p}) ->
+      let public_send = p.prim_name = "%send" in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public None else Self in
+        let obj = Ident.create "obj" and meth = Ident.create "meth" in
+        Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [],
+                                              e.exp_loc))
+      else if p.prim_name = "%sendcache" then
+        let obj = Ident.create "obj" and meth = Ident.create "meth" in
+        let cache = Ident.create "cache" and pos = Ident.create "pos" in
+        Lfunction(Curried, [obj; meth; cache; pos],
+                  Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos],
+                        e.exp_loc))
+      else
+        transl_primitive e.exp_loc p
+  | Texp_ident(path, _, {val_kind = Val_anc _}) ->
+      raise(Error(e.exp_loc, Free_super_var))
+  | Texp_ident(path, _, {val_kind = Val_reg | Val_self _}) ->
+      transl_path ~loc:e.exp_loc e.exp_env path
+  | Texp_ident _ -> fatal_error "Translcore.transl_exp: bad Texp_ident"
+  | Texp_constant cst ->
+      Lconst(Const_base cst)
+  | Texp_let(rec_flag, pat_expr_list, body) ->
+      transl_let rec_flag pat_expr_list (event_before body (transl_exp body))
+  | Texp_function (_, pat_expr_list, partial) ->
+      let ((kind, params), body) =
+        event_function e
+          (function repr ->
+            let pl = push_defaults e.exp_loc [] pat_expr_list partial in
+            transl_function e.exp_loc !Clflags.native_code repr partial pl)
+      in
+      Lfunction(kind, params, body)
+  | Texp_apply({exp_desc = Texp_ident(path, _, {val_kind = Val_prim p})},
+               oargs)
+    when List.length oargs >= p.prim_arity
+    && List.for_all (fun (_, arg,_) -> arg <> None) oargs ->
+      let args, args' = cut p.prim_arity oargs in
+      let wrap f =
+        if args' = []
+        then event_after e f
+        else event_after e (transl_apply f args' e.exp_loc)
+      in
+      let wrap0 f =
+        if args' = [] then f else wrap f in
+      let args =
+         List.map (function _, Some x, _ -> x | _ -> assert false) args in
+      let argl = transl_list args in
+      let public_send = p.prim_name = "%send"
+        || not !Clflags.native_code && p.prim_name = "%sendcache"in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public None else Self in
+        let obj = List.hd argl in
+        wrap (Lsend (kind, List.nth argl 1, obj, [], e.exp_loc))
+      else if p.prim_name = "%sendcache" then
+        match argl with [obj; meth; cache; pos] ->
+          wrap (Lsend(Cached, meth, obj, [cache; pos], e.exp_loc))
+        | _ -> assert false
+      else begin
+        let prim = transl_prim e.exp_loc p args in
+        match (prim, args) with
+          (Praise k, [arg1]) ->
+            let targ = List.hd argl in
+            let k =
+              match k, targ with
+              | Raise_regular, Lvar id
+                when Hashtbl.mem try_ids id ->
+                  Raise_reraise
+              | _ ->
+                  k
+            in
+            wrap0 (Lprim(Praise k, [event_after arg1 targ], e.exp_loc))
+        | (Ploc kind, []) ->
+          lam_of_loc kind e.exp_loc
+        | (Ploc kind, [arg1]) ->
+          let lam = lam_of_loc kind arg1.exp_loc in
+          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), lam :: argl, e.exp_loc)
+        | (Ploc _, _) -> assert false
+        | (_, _) ->
+            begin match (prim, argl) with
+            | (Plazyforce, [a]) ->
+                wrap (Matching.inline_lazy_force a e.exp_loc)
+            | (Plazyforce, _) -> assert false
+            |_ -> let p = Lprim(prim, argl, e.exp_loc) in
+               if primitive_is_ccall prim then wrap p else wrap0 p
+            end
+      end
+  | Texp_apply(funct, oargs) ->
+      event_after e (transl_apply (transl_exp funct) oargs e.exp_loc)
+  | Texp_match(arg, pat_expr_list, exn_pat_expr_list, partial) ->
+    transl_match e arg pat_expr_list exn_pat_expr_list partial
+  | Texp_try(body, pat_expr_list) ->
+      let id = name_pattern "exn" pat_expr_list in
+      Ltrywith(transl_exp body, id,
+               Matching.for_trywith (Lvar id) (transl_cases_try pat_expr_list))
+  | Texp_tuple el ->
+      let ll = transl_list el in
+      let tag_info = Lambda.Blk_tuple in 
+      begin try
+        Lconst(Const_block(0, tag_info, List.map extract_constant ll))
+      with Not_constant ->
+        Lprim(Pmakeblock(0,  tag_info, Immutable), ll, e.exp_loc)
+      end
+  | Texp_construct(_, cstr, args) ->
+      let ll = transl_list args in
+      begin match cstr.cstr_tag with
+        Cstr_constant n ->
+          Lconst(Const_pointer (n, Lambda.Pt_constructor cstr.cstr_name))
+      | Cstr_block n ->
+          let tag_info = (Lambda.Blk_constructor (cstr.cstr_name, cstr.cstr_nonconsts)) in
+          begin try
+            Lconst(Const_block(n,tag_info, List.map extract_constant ll))
+          with Not_constant ->
+            Lprim(Pmakeblock(n, tag_info, Immutable), ll, e.exp_loc)
+          end
+      | Cstr_extension(path, is_const) ->
+          if is_const then
+            transl_path e.exp_env path
+          else
+            Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+                  transl_path e.exp_env path :: ll, e.exp_loc)
+      end
+  | Texp_variant(l, arg) ->
+      let tag = Btype.hash_variant l in
+      begin match arg with
+        None -> Lconst(Const_pointer (tag, Lambda.Pt_variant l))
+      | Some arg ->
+          let lam = transl_exp arg in
+          let tag_info = Lambda.Blk_variant l in
+          try
+            Lconst(Const_block(0, tag_info, [Const_base(Const_int tag);
+                                   extract_constant lam]))
+          with Not_constant ->
+            Lprim(Pmakeblock(0, tag_info, Immutable),
+                  [Lconst(Const_base(Const_int tag)); lam], e.exp_loc)
+      end
+  | Texp_record ((_, lbl1, _) :: _ as lbl_expr_list, opt_init_expr) ->
+      transl_record e.exp_loc lbl1.lbl_all lbl1.lbl_repres lbl_expr_list opt_init_expr
+  | Texp_record ([], _) ->
+      fatal_error "Translcore.transl_exp: bad Texp_record"
+  | Texp_field(arg, _, lbl) ->
+      let access =
+        match lbl.lbl_repres with
+          Record_regular -> Pfield (lbl.lbl_pos, Fld_record lbl.lbl_name)
+        | Record_float -> Pfloatfield (lbl.lbl_pos, Fld_record lbl.lbl_name) in
+      Lprim(access, [transl_exp arg], e.exp_loc)
+  | Texp_setfield(arg, _, lbl, newval) ->
+      let access =
+        match lbl.lbl_repres with
+          Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer newval, Fld_record_set lbl.lbl_name)
+        | Record_float -> Psetfloatfield (lbl.lbl_pos, Fld_record_set lbl.lbl_name) in
+      Lprim(access, [transl_exp arg; transl_exp newval], e.exp_loc)
+  | Texp_array expr_list ->
+      let kind = array_kind e in
+      let ll = transl_list expr_list in
+      begin try
+        (* Deactivate constant optimization if array is small enough *)
+        if List.length ll <= 4 then raise Not_constant;
+        let cl = List.map extract_constant ll in
+        let master =
+          match kind with
+          | Paddrarray | Pintarray ->
+              Lconst(Const_block(0, Lambda.Blk_array, cl)) (* ATTENTION: ? [|1;2;3;4|]*)
+          | Pfloatarray ->
+              Lconst(Const_float_array(List.map extract_float cl))
+          | Pgenarray ->
+              raise Not_constant in             (* can this really happen? *)
+        Lprim(Pccall prim_obj_dup, [master], e.exp_loc)
+      with Not_constant ->
+        Lprim(Pmakearray kind, ll, e.exp_loc)
+      end
+  | Texp_ifthenelse(cond, ifso, Some ifnot) ->
+      Lifthenelse(transl_exp cond,
+                  event_before ifso (transl_exp ifso),
+                  event_before ifnot (transl_exp ifnot))
+  | Texp_ifthenelse(cond, ifso, None) ->
+      Lifthenelse(transl_exp cond,
+                  event_before ifso (transl_exp ifso),
+                  lambda_unit)
+  | Texp_sequence(expr1, expr2) ->
+      Lsequence(transl_exp expr1, event_before expr2 (transl_exp expr2))
+  | Texp_while(cond, body) ->
+      Lwhile(transl_exp cond, event_before body (transl_exp body))
+  | Texp_for(param, _, low, high, dir, body) ->
+      Lfor(param, transl_exp low, transl_exp high, dir,
+           event_before body (transl_exp body))
+  | Texp_send(_, _, Some exp) -> transl_exp exp
+  | Texp_send(expr, met, None) ->
+      let obj = transl_exp expr in
+      let lam =
+        match met with
+          Tmeth_val id -> Lsend (Self, Lvar id, obj, [], e.exp_loc)
+        | Tmeth_name nm ->
+            let (tag, cache) = Translobj.meth obj nm in
+            let kind = if cache = [] then Public (Some nm) else Cached in
+            Lsend (kind, tag, obj, cache, e.exp_loc)
+      in
+      event_after e lam
+  | Texp_new (cl, {Location.loc=loc}, _) ->
+      Lapply(Lprim(Pfield (0, Fld_na), [transl_path ~loc e.exp_env cl], loc),
+             [lambda_unit], Location.none)
+  | Texp_instvar(path_self, path, _) ->
+      Lprim(Parrayrefu Paddrarray,
+            [transl_normal_path path_self; transl_normal_path path], e.exp_loc)
+  | Texp_setinstvar(path_self, path, _, expr) ->
+      transl_setinstvar e.exp_loc (transl_normal_path path_self) path expr
+  | Texp_override(path_self, modifs) ->
+      let cpy = Ident.create "copy" in
+      Llet(Strict, cpy,
+           Lapply(Translobj.oo_prim "copy", [transl_normal_path path_self],
+                  Location.none),
+           List.fold_right
+             (fun (path, _, expr) rem ->
+                Lsequence(transl_setinstvar Location.none (Lvar cpy) path expr, rem))
+             modifs
+             (Lvar cpy))
+  | Texp_letmodule(id, _, modl, body) ->
+      Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body)
+  | Texp_pack modl ->
+      !transl_module Tcoerce_none None modl
+  | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} ->
+      assert_failed e
+  | Texp_assert (cond) ->
+      if !Clflags.noassert
+      then lambda_unit
+      else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e)
+  | Texp_lazy e ->
+      (* when e needs no computation (constants, identifiers, ...), we
+         optimize the translation just as Lazy.lazy_from_val would
+         do *)
+      begin match e.exp_desc with
+        (* a constant expr of type <> float gets compiled as itself *)
+      | Texp_constant
+          ( Const_int _ | Const_char _ | Const_string _
+          | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
+      | Texp_function(_, _, _)
+      | Texp_construct (_, {cstr_arity = 0}, _)
+        -> transl_exp e
+      | Texp_constant(Const_float _) ->
+          Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
+      | Texp_ident(_, _, _) -> (* according to the type *)
+          begin match e.exp_type.desc with
+          (* the following may represent a float/forward/lazy: need a
+             forward_tag *)
+          | Tvar _ | Tlink _ | Tsubst _ | Tunivar _
+          | Tpoly(_,_) | Tfield(_,_,_,_) ->
+              Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
+          (* the following cannot be represented as float/forward/lazy:
+             optimize *)
+          | Tarrow(_,_,_,_) | Ttuple _ | Tpackage _ | Tobject(_,_) | Tnil
+          | Tvariant _
+              -> transl_exp e
+          (* optimize predefined types (excepted float) *)
+          | Tconstr(_,_,_) ->
+              if has_base_type e Predef.path_int
+                || has_base_type e Predef.path_char
+                || has_base_type e Predef.path_string
+                || has_base_type e Predef.path_bool
+                || has_base_type e Predef.path_unit
+                || has_base_type e Predef.path_exn
+                || has_base_type e Predef.path_array
+                || has_base_type e Predef.path_list
+                || has_base_type e Predef.path_option
+                || has_base_type e Predef.path_nativeint
+                || has_base_type e Predef.path_int32
+                || has_base_type e Predef.path_int64
+              then transl_exp e
+              else
+                Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
+          end
+      (* other cases compile to a lazy block holding a function *)
+      | _ ->
+          let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in
+          Lprim(Pmakeblock(Config.lazy_tag, Lambda.default_tag_info, Mutable), [fn], e.exp_loc)
+      end
+  | Texp_object (cs, meths) ->
+      let cty = cs.cstr_type in
+      let cl = Ident.create "class" in
+      !transl_object cl meths
+        { cl_desc = Tcl_structure cs;
+          cl_loc = e.exp_loc;
+          cl_type = Cty_signature cty;
+          cl_env = e.exp_env;
+          cl_attributes = [];
+         }
 
+and transl_list expr_list =
+  List.map transl_exp expr_list
 
-type stats = 
-  { 
-    top : bool ; 
-    (* all appearances are in the top,  substitution is fine 
-       whether it is pure or not
-       {[
-         (fun x y          
-           ->  x + y + (f x )) (32) (console.log('hi'), 33)
-       ]}       
-       since in ocaml, the application order is intentionally undefined, 
-       note if [times] is not one, this field does not make sense       
-    *)    
-    times : int ; 
-  }
-type env = 
-  { top  : bool ; 
-    loop : bool 
-  }
+and transl_guard guard rhs =
+  let expr = event_before rhs (transl_exp rhs) in
+  match guard with
+  | None -> expr
+  | Some cond ->
+      event_before cond (Lifthenelse(transl_exp cond, expr, staticfail))
 
-let no_substitute = { top = false; loop = true }
-let fresh_env = {top = true; loop = false }
-let fresh_stats  : stats = { top = true; times = 0 }
+and transl_case {c_lhs; c_guard; c_rhs} =
+  c_lhs, transl_guard c_guard c_rhs
 
-let param_map_of_list lst : stats Ident_map.t = 
-  List.fold_left  (fun acc l -> Ident_map.add l fresh_stats acc) Ident_map.empty  lst 
+and transl_cases cases =
+  List.map transl_case cases
 
-(** Sanity check, remove all varaibles in [local_set] in the last pass *)  
+and transl_case_try {c_lhs; c_guard; c_rhs} =
+  match c_lhs.pat_desc with
+  | Tpat_var (id, _)
+  | Tpat_alias (_, id, _) ->
+      Hashtbl.replace try_ids id ();
+      Misc.try_finally
+        (fun () -> c_lhs, transl_guard c_guard c_rhs)
+        (fun () -> Hashtbl.remove try_ids id)
+  | _ ->
+      c_lhs, transl_guard c_guard c_rhs
 
-let loop_use = 100 (** Used in loop, huge punishment *)
+and transl_cases_try cases =
+  List.map transl_case_try cases
 
-(**
-   [param_stats = free_variables exports param_stats lam] 
-   This function tries to do more than detect free variable of [lam],  
-   given [param_stats] it tries to return a new stats with updated usage of 
-   recorded params and unbound parameters
-*)
-let free_variables (export_idents : Ident_set.t ) (params : stats Ident_map.t ) lam = 
-  let fv = ref params in
-  let local_set = ref export_idents in
+and transl_tupled_cases patl_expr_list =
+  List.map (fun (patl, guard, expr) -> (patl, transl_guard guard expr))
+    patl_expr_list
 
-  let local_add k =
-    local_set := Ident_set.add k !local_set in
-  let local_add_list ks = 
-    local_set :=  
-      List.fold_left (fun acc k -> Ident_set.add k acc) !local_set ks 
-  in    
-  (* base don the envrionmet, recoring the use cases of arguments *)
-  let map_use {top; loop} v = 
-    (* relies on [identifier] uniquely bound *)    
-    if not (Ident_set.mem v !local_set) then 
-      fv := Ident_map.adjust 
-        v
-        (fun _ -> {top; times = if loop then loop_use else 1})
-        (fun v -> {times = if loop then loop_use else v.times + 1 ; top = v.top && top})
-        !fv 
+and transl_apply lam sargs loc =
+  let lapply funct args =
+    match funct with
+      Lsend(k, lmet, lobj, largs, loc) ->
+        Lsend(k, lmet, lobj, largs @ args, loc)
+    | Levent(Lsend(k, lmet, lobj, largs, loc), _) ->
+        Lsend(k, lmet, lobj, largs @ args, loc)
+    | Lapply(lexp, largs, _) ->
+        Lapply(lexp, largs @ args, loc)
+    | lexp ->
+        Lapply(lexp, args, loc)
   in
-  let new_env lam (env : env) : env = 
-    if env.top then 
-      if Lam_analysis.no_side_effects lam 
-      then env 
-      (* no side effect, if argument has no side effect and used only once we can simply do the replacement *)
-      else { env with top = false}
-    else env      
-  in    
-  let rec iter (top : env) (lam : Lam.t) =
-    match lam with 
-    | Lvar v -> map_use top v 
-    | Lconst _ -> ()
-    | Lapply {fn; args; _} ->
-      iter top  fn; 
-      let top = new_env fn top in
-      List.iter (fun lam -> iter top lam ) args  
-    | Lprim {args ; _} -> 
-      (* Check: can top be propoaged for all primitives *)
-      List.iter (iter top) args
-    | Lfunction{ params; body} ->
-      local_add_list params;
-      iter no_substitute body 
-    | Llet(_let_kind, id, arg, body) ->
-      local_add id ;  
-      iter top  arg; iter no_substitute body
-    | Lletrec(decl, body) ->
-      local_set := List.fold_left (fun acc (id, _) -> 
-          Ident_set.add id acc) !local_set decl;        
-      List.iter (fun (_, exp) -> iter no_substitute exp) decl;
-      iter no_substitute body
-    | Lswitch(arg, sw) ->
-      iter top arg; 
-      let top = new_env arg top  in       
-      List.iter (fun (key, case) -> iter top case) sw.sw_consts;
-      List.iter (fun (key, case) -> iter top  case) sw.sw_blocks;
-  
-      begin match sw.sw_failaction with 
-        | None -> ()
-        | Some x ->
-          let nconsts = List.length sw.sw_consts in
-          let nblocks = List.length sw.sw_blocks in
-
-          if nconsts < sw.sw_numconsts  && nblocks < sw.sw_numblocks then
-            iter no_substitute x
-          else
-            iter top x
-      end
+  let rec build_apply lam args = function
+      (None, optional) :: l ->
+        let defs = ref [] in
+        let protect name lam =
+          match lam with
+            Lvar _ | Lconst _ -> lam
+          | _ ->
+              let id = Ident.create name in
+              defs := (id, lam) :: !defs;
+              Lvar id
+        in
+        let args, args' =
+          if List.for_all (fun (_,opt) -> opt = Optional) args then [], args
+          else args, [] in
+        let lam =
+          if args = [] then lam else lapply lam (List.rev_map fst args) in
+        let handle = protect "func" lam
+        and l = List.map (fun (arg, opt) -> may_map (protect "arg") arg, opt) l
+        and id_arg = Ident.create "param" in
+        let body =
+          match build_apply handle ((Lvar id_arg, optional)::args') l with
+            Lfunction(Curried, ids, lam) ->
+              Lfunction(Curried, id_arg::ids, lam)
+          | Levent(Lfunction(Curried, ids, lam), _) ->
+              Lfunction(Curried, id_arg::ids, lam)
+          | lam ->
+              Lfunction(Curried, [id_arg], lam)
+        in
+        List.fold_left
+          (fun body (id, lam) -> Llet(Strict, id, lam, body))
+          body !defs
+    | (Some arg, optional) :: l ->
+        build_apply lam ((arg, optional) :: args) l
+    | [] ->
+        lapply lam (List.rev_map fst args)
+  in
+  build_apply lam [] (List.map (fun (l, x,o) -> may_map transl_exp x, o) sargs)
 
-    | Lstringswitch (arg,cases,default) ->
-      iter top arg ;
-      let top = new_env arg top  in       
-      List.iter (fun (_,act) -> iter top  act) cases ;
-      begin match default with 
-      | None -> ()
-      | Some x -> iter top x 
+and transl_function loc untuplify_fn repr partial cases =
+  match cases with
+    [{c_lhs=pat; c_guard=None;
+      c_rhs={exp_desc = Texp_function(_, pl,partial')} as exp}]
+    when Parmatch.fluid pat ->
+      let param = name_pattern "param" cases in
+      let ((_, params), body) =
+        transl_function exp.exp_loc false repr partial' pl in
+      ((Curried, param :: params),
+       Matching.for_function loc None (Lvar param) [pat, body] partial)
+  | {c_lhs={pat_desc = Tpat_tuple pl}} :: _ when untuplify_fn ->
+      begin try
+        let size = List.length pl in
+        let pats_expr_list =
+          List.map
+            (fun {c_lhs; c_guard; c_rhs} ->
+              (Matching.flatten_pattern size c_lhs, c_guard, c_rhs))
+            cases in
+        let params = List.map (fun p -> Ident.create "param") pl in
+        ((Tupled, params),
+         Matching.for_tupled_function loc params
+           (transl_tupled_cases pats_expr_list) partial)
+      with Matching.Cannot_flatten ->
+        let param = name_pattern "param" cases in
+        ((Curried, [param]),
+         Matching.for_function loc repr (Lvar param)
+           (transl_cases cases) partial)
       end
-    | Lstaticraise (_,args) ->
-      List.iter (iter no_substitute ) args
-    | Lstaticcatch(e1, (_,vars), e2) ->
-      iter no_substitute  e1; 
-      local_add_list vars;       
-      iter no_substitute e2
-    | Ltrywith(e1, exn, e2) ->
-      iter top  e1; iter no_substitute  e2
-    | Lifthenelse(e1, e2, e3) ->
-      iter top e1; 
-      let top = new_env e1 top  in
-      iter top e2; iter top e3
-    | Lsequence(e1, e2) ->
-      iter top e1; iter no_substitute e2
-    | Lwhile(e1, e2) ->
-      iter no_substitute e1; iter no_substitute e2 (* in the loop, no substitution any way *)
-    | Lfor(v, e1, e2, dir, e3) ->
-      local_add v ; 
-      iter no_substitute e1; iter no_substitute e2; iter no_substitute e3
-    | Lassign(id, e) ->
-      map_use top  id ; 
-      iter top e
-    | Lsend (_k, met, obj, args, _) ->
-      iter no_substitute met ; 
-      iter no_substitute obj;
-      List.iter (iter no_substitute) args
-    | Lifused (v, e) ->
-      iter no_substitute e in
-  iter fresh_env  lam ; !fv 
-
-
-let is_closed_by set lam = 
-  Ident_map.is_empty (free_variables set (Ident_map.empty ) lam   )
-
-
-(** A bit consverative , it should be empty *)
-let is_closed  lam = 
-  Ident_map.for_all (fun k _ -> Ident.global k)
-    (free_variables Ident_set.empty Ident_map.empty lam)  
-
-
-let is_closed_with_map exports params body = 
-  let param_map = free_variables exports (param_map_of_list params) body in
-  let old_count = List.length params in
-  let new_count = Ident_map.cardinal param_map in
-  (old_count  = new_count, param_map)
-
+  | _ ->
+      let param = name_pattern "param" cases in
+      ((Curried, [param]),
+       Matching.for_function loc repr (Lvar param)
+         (transl_cases cases) partial)
 
-  
+and transl_let rec_flag pat_expr_list body =
+  match rec_flag with
+    Nonrecursive ->
+      let rec transl = function
+        [] ->
+          body
+      | {vb_pat=pat; vb_expr=expr} :: rem ->
+          Matching.for_let pat.pat_loc (transl_exp expr) pat (transl rem)
+      in transl pat_expr_list
+  | Recursive ->
+      let idlist =
+        List.map
+          (fun {vb_pat=pat} -> match pat.pat_desc with
+              Tpat_var (id,_) -> id
+            | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id
+            | _ -> raise(Error(pat.pat_loc, Illegal_letrec_pat)))
+        pat_expr_list in
+      let transl_case {vb_pat=pat; vb_expr=expr} id =
+        let lam = transl_exp expr in
+        if not (check_recursive_lambda idlist lam) then
+          raise(Error(expr.exp_loc, Illegal_letrec_expr));
+        (id, lam) in
+      Lletrec(List.map2 transl_case pat_expr_list idlist, body)
 
-end
-module Js_of_lam_module : sig 
-#1 "js_of_lam_module.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+and transl_setinstvar loc self var expr =
+  Lprim(Parraysetu (if maybe_pointer expr then Paddrarray else Pintarray),
+                    [self; transl_normal_path var; transl_exp expr], loc)
 
+and transl_record loc all_labels repres lbl_expr_list opt_init_expr =
+  let size = Array.length all_labels in
+  (* Determine if there are "enough" new fields *)
+  if 3 + 2 * List.length lbl_expr_list >= size
+  then begin
+    (* Allocate new record with given fields (and remaining fields
+       taken from init_expr if any *)
+    let lv = Array.make (Array.length all_labels) staticfail in
+    let init_id = Ident.create "init" in
+    begin match opt_init_expr with
+      None -> ()
+    | Some init_expr ->
+        for i = 0 to Array.length all_labels - 1 do
+          let access =
+            let lbl = all_labels.(i) in
+            match lbl.lbl_repres with
+              Record_regular -> Pfield (i, Fld_record lbl.lbl_name)
+            | Record_float -> Pfloatfield (i, Fld_record lbl.lbl_name)  in
+          lv.(i) <- Lprim(access, [Lvar init_id], loc)
+        done
+    end;
+    List.iter
+      (fun (_, lbl, expr) -> lv.(lbl.lbl_pos) <- transl_exp expr)
+      lbl_expr_list;
+    let ll = Array.to_list lv in
+    let mut =
+      if List.exists (fun (_, lbl, expr) -> lbl.lbl_mut = Mutable) lbl_expr_list
+      then Mutable
+      else Immutable in
+    let all_labels_info = all_labels |> Array.map (fun x -> x.Types.lbl_name) in
+    let lam =
+      try
+        if mut = Mutable then raise Not_constant;
+        let cl = List.map extract_constant ll in
+        match repres with
+          Record_regular -> Lconst(Const_block(0, Lambda.Blk_record all_labels_info, cl))
+        | Record_float ->
+            Lconst(Const_float_array(List.map extract_float cl))
+      with Not_constant ->
+        match repres with
+          Record_regular -> Lprim(Pmakeblock(0, Lambda.Blk_record all_labels_info, mut), ll,loc)
+        | Record_float -> Lprim(Pmakearray Pfloatarray, ll, loc) in
+    begin match opt_init_expr with
+      None -> lam
+    | Some init_expr -> Llet(Strict, init_id, transl_exp init_expr, lam)
+    end
+  end else begin
+    (* Take a shallow copy of the init record, then mutate the fields
+       of the copy *)
+    (* If you change anything here, you will likely have to change
+       [check_recursive_recordwith] in this file. *)
+    let copy_id = Ident.create "newrecord" in
+    let update_field (_, lbl, expr) cont =
+      let upd =
+        match lbl.lbl_repres with
+          Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer expr, Fld_record_set lbl.lbl_name)
+        | Record_float -> Psetfloatfield (lbl.lbl_pos, Fld_record_set lbl.lbl_name) in
+      Lsequence(Lprim(upd, [Lvar copy_id; transl_exp expr], loc), cont) in
+    begin match opt_init_expr with
+      None -> assert false
+    | Some init_expr ->
+        Llet(Strict, copy_id,
+             Lprim(Pduprecord (repres, size), [transl_exp init_expr], loc),
+             List.fold_right update_field lbl_expr_list (Lvar copy_id))
+    end
+  end
 
+and transl_match e arg pat_expr_list exn_pat_expr_list partial =
+  let id = name_pattern "exn" exn_pat_expr_list
+  and cases = transl_cases pat_expr_list
+  and exn_cases = transl_cases exn_pat_expr_list in
+  let static_catch body val_ids handler =
+    let static_exception_id = next_negative_raise_count () in
+    Lstaticcatch
+      (Ltrywith (Lstaticraise (static_exception_id, body), id,
+                 Matching.for_trywith (Lvar id) exn_cases),
+       (static_exception_id, val_ids),
+       handler)
+  in
+  match arg, exn_cases with
+  | {exp_desc = Texp_tuple argl}, [] ->
+    Matching.for_multiple_match e.exp_loc (transl_list argl) cases partial
+  | {exp_desc = Texp_tuple argl}, _ :: _ ->
+    let val_ids = List.map (fun _ -> name_pattern "val" []) argl in
+    let lvars = List.map (fun id -> Lvar id) val_ids in
+    static_catch (transl_list argl) val_ids
+      (Matching.for_multiple_match e.exp_loc lvars cases partial)
+  | arg, [] ->
+    Matching.for_function e.exp_loc None (transl_exp arg) cases partial
+  | arg, _ :: _ ->
+    let val_id = name_pattern "val" pat_expr_list in
+    static_catch [transl_exp arg] [val_id]
+      (Matching.for_function e.exp_loc None (Lvar val_id) cases partial)
 
 
+(* Wrapper for class compilation *)
 
+(*
+let transl_exp = transl_exp_wrap
 
-val make :
-  ?comment:string ->
-  J.expression list -> J.expression
+let transl_let rec_flag pat_expr_list body =
+  match pat_expr_list with
+    [] -> body
+  | (_, expr) :: _ ->
+      Translobj.oo_wrap expr.exp_env false
+        (transl_let rec_flag pat_expr_list) body
+*)
 
+(* Error report *)
 
-end = struct
-#1 "js_of_lam_module.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+open Format
 
+let report_error ppf = function
+  | Illegal_letrec_pat ->
+      fprintf ppf
+        "Only variables are allowed as left-hand side of `let rec'"
+  | Illegal_letrec_expr ->
+      fprintf ppf
+        "This kind of expression is not allowed as right-hand side of `let rec'"
+  | Free_super_var ->
+      fprintf ppf
+        "Ancestor names can only be used to select inherited methods"
+  | Unknown_builtin_primitive prim_name ->
+    fprintf ppf  "Unknown builtin primitive \"%s\"" prim_name
 
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+          Some (Location.error_of_printer loc report_error err)
+      | _ ->
+        None
+    )
 
+end
+module Translclass : sig 
+#1 "translclass.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+open Typedtree
+open Lambda
 
+val transl_class :
+  Ident.t list -> Ident.t ->
+  string list -> class_expr -> Asttypes.virtual_flag -> lambda;;
 
-module E = Js_exp_make 
+type error = Illegal_class_expr | Tags of string * string
 
-let make ?comment (args : J.expression list) =
-  E.make_block
-    ?comment E.zero_int_literal
-    (Blk_module None) args Immutable
+exception Error of Location.t * error
 
+open Format
 
-end
-module Lam_compile_global : sig 
-#1 "lam_compile_global.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+val report_error: formatter -> error -> unit
 
+end = struct
+#1 "translclass.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
+open Asttypes
+open Types
+open Typedtree
+open Lambda
+open Translobj
+open Translcore
 
+(* XXX Rajouter des evenements... *)
 
+type error = Illegal_class_expr | Tags of label * label
 
+exception Error of Location.t * error
 
+let lfunction params body =
+  if params = [] then body else
+  match body with
+    Lfunction (Curried, params', body') ->
+      Lfunction (Curried, params @ params', body')
+  |  _ ->
+      Lfunction (Curried, params, body)
 
+let lapply func args loc =
+  match func with
+    Lapply(func', args', _) ->
+      Lapply(func', args' @ args, loc)
+  | _ ->
+      Lapply(func, args, loc)
 
-(** Compile ocaml external module call , e.g [List.length] to  JS IR *)
+let mkappl (func, args) = Lapply (func, args, Location.none);;
 
-val get_exp : Lam_compile_env.key  -> J.expression
+let lsequence l1 l2 =
+  if l2 = lambda_unit then l1 else Lsequence(l1, l2)
 
+let lfield v i = Lprim(Pfield (i, Fld_na), [Lvar v], Location.none)
 
+let transl_label l = share (Const_immstring l)
 
-val query_lambda : Ident.t -> Env.t -> Lam.t
+let transl_meth_list lst =
+  if lst = [] then Lconst (Const_pointer (0, Lambda.Pt_na)) else
+  share (Const_block
+            (0, Lambda.Blk_na, List.map (fun lab -> Const_immstring lab) lst))
 
-end = struct
-#1 "lam_compile_global.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let set_inst_var obj id expr =
+  let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
+  Lprim(Parraysetu kind, [Lvar obj; Lvar id; transl_exp expr],Location.none)
 
+let copy_inst_var obj id expr templ offset =
+  let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
+  let id' = Ident.create (Ident.name id) in
+  Llet(Strict, id', Lprim (Pidentity, [Lvar id], Location.none),
+  Lprim(Parraysetu kind,
+        [Lvar obj; Lvar id';
+         Lprim(Parrayrefu kind, [Lvar templ; Lprim(Paddint,
+                                                   [Lvar id';
+                                                    Lvar offset], Location.none)], Location.none)], Location.none))
 
+let transl_val tbl create name =
+  mkappl (oo_prim (if create then "new_variable" else "get_variable"),
+          [Lvar tbl; transl_label name])
 
+let transl_vals tbl create strict vals rem =
+  List.fold_right
+    (fun (name, id) rem ->
+      Llet(strict, id, transl_val tbl create name, rem))
+    vals rem
 
+let meths_super tbl meths inh_meths =
+  List.fold_right
+    (fun (nm, id) rem ->
+       try
+         (nm, id,
+          mkappl(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
+         :: rem
+       with Not_found -> rem)
+    inh_meths []
 
+let bind_super tbl (vals, meths) cl_init =
+  transl_vals tbl false StrictOpt vals
+    (List.fold_right (fun (nm, id, def) rem -> Llet(StrictOpt, id, def, rem))
+       meths cl_init)
 
+let create_object cl obj init =
+  let obj' = Ident.create "self" in
+  let (inh_init, obj_init, has_init) = init obj' in
+  if obj_init = lambda_unit then
+    (inh_init,
+     mkappl (oo_prim (if has_init then "create_object_and_run_initializers"
+                      else"create_object_opt"),
+             [obj; Lvar cl]))
+  else begin
+   (inh_init,
+    Llet(Strict, obj',
+            mkappl (oo_prim "create_object_opt", [obj; Lvar cl]),
+         Lsequence(obj_init,
+                   if not has_init then Lvar obj' else
+                   mkappl (oo_prim "run_initializers_opt",
+                           [obj; Lvar obj'; Lvar cl]))))
+  end
 
+let name_pattern default p =
+  match p.pat_desc with
+  | Tpat_var (id, _) -> id
+  | Tpat_alias(p, id, _) -> id
+  | _ -> Ident.create default
 
-module E = Js_exp_make  
-module S = Js_stmt_make
+let normalize_cl_path cl path =
+  Env.normalize_path (Some cl.cl_loc) cl.cl_env path
 
-open Js_output.Ops
+let rec build_object_init cl_table obj params inh_init obj_init cl =
+  match cl.cl_desc with
+    Tcl_ident ( path, _, _) ->
+      let obj_init = Ident.create "obj_init" in
+      let envs, inh_init = inh_init in
+      let env =
+        match envs with None -> []
+        | Some envs -> [Lprim(Pfield (List.length inh_init + 1, Fld_na), [Lvar envs], Location.none)]
+      in
+      ((envs, (obj_init, normalize_cl_path cl path)
+        ::inh_init),
+       mkappl(Lvar obj_init, env @ [obj]))
+  | Tcl_structure str ->
+      create_object cl_table obj (fun obj ->
+        let (inh_init, obj_init, has_init) =
+          List.fold_right
+            (fun field (inh_init, obj_init, has_init) ->
+               match field.cf_desc with
+                 Tcf_inherit (_, cl, _, _, _) ->
+                   let (inh_init, obj_init') =
+                     build_object_init cl_table (Lvar obj) [] inh_init
+                       (fun _ -> lambda_unit) cl
+                   in
+                   (inh_init, lsequence obj_init' obj_init, true)
+               | Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
+                   (inh_init, lsequence (set_inst_var obj id exp) obj_init,
+                    has_init)
+               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _->
+                   (inh_init, obj_init, has_init)
+               | Tcf_initializer _ ->
+                   (inh_init, obj_init, true)
+            )
+            str.cstr_fields
+            (inh_init, obj_init obj, false)
+        in
+        (inh_init,
+         List.fold_right
+           (fun (id, expr) rem ->
+              lsequence (Lifused (id, set_inst_var obj id expr)) rem)
+           params obj_init,
+         has_init))
+  | Tcl_fun (_, pat, vals, cl, partial) ->
+      let vals = List.map (fun (id, _, e) -> id,e) vals in
+      let (inh_init, obj_init) =
+        build_object_init cl_table obj (vals @ params) inh_init obj_init cl
+      in
+      (inh_init,
+       let build params rem =
+         let param = name_pattern "param" pat in
+         Lfunction (Curried, param::params,
+                    Matching.for_function
+                      pat.pat_loc None (Lvar param) [pat, rem] partial)
+       in
+       begin match obj_init with
+         Lfunction (Curried, params, rem) -> build params rem
+       | rem                              -> build [] rem
+       end)
+  | Tcl_apply (cl, oexprs) ->
+      let (inh_init, obj_init) =
+        build_object_init cl_table obj params inh_init obj_init cl
+      in
+      (inh_init, transl_apply obj_init oexprs Location.none)
+  | Tcl_let (rec_flag, defs, vals, cl) ->
+      let vals = List.map (fun (id, _, e) -> id,e) vals in
+      let (inh_init, obj_init) =
+        build_object_init cl_table obj (vals @ params) inh_init obj_init cl
+      in
+      (inh_init, Translcore.transl_let rec_flag defs obj_init)
+  | Tcl_constraint (cl, _, vals, pub_meths, concr_meths) ->
+      build_object_init cl_table obj params inh_init obj_init cl
 
-(* TODO: used in functor inlining, so that it can not be an exception
-   Make(S), S can not be an exception
- *)
+let rec build_object_init_0 cl_table params cl copy_env subst_env top ids =
+  match cl.cl_desc with
+    Tcl_let (rec_flag, defs, vals, cl) ->
+      let vals = List.map (fun (id, _, e) -> id,e) vals in
+      build_object_init_0 cl_table (vals@params) cl copy_env subst_env top ids
+  | _ ->
+      let self = Ident.create "self" in
+      let env = Ident.create "env" in
+      let obj = if ids = [] then lambda_unit else Lvar self in
+      let envs = if top then None else Some env in
+      let ((_,inh_init), obj_init) =
+        build_object_init cl_table obj params (envs,[]) (copy_env env) cl in
+      let obj_init =
+        if ids = [] then obj_init else lfunction [self] obj_init in
+      (inh_init, lfunction [env] (subst_env env inh_init obj_init))
 
 
+let bind_method tbl lab id cl_init =
+  Llet(Strict, id, mkappl (oo_prim "get_method_label",
+                           [Lvar tbl; transl_label lab]),
+       cl_init)
 
-let query_lambda id env = 
-  Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) 
-    (Has_env env)
-    ~not_found:(fun id -> assert false)
-    ~found:(fun {signature = sigs; _} 
-             -> 
-               Lam.prim
-                 ~primitive:(Pmakeblock(0, Blk_module None, Immutable))  
-                 ~args:(
-                   List.mapi (fun i _ -> 
-                       Lam.prim
-                         ~primitive:(Pfield (i, Lambda.Fld_na)) 
-                         ~args:[
-                           Lam.prim 
-                             ~primitive:(Pgetglobal id)
-                             ~args:[] Location.none (* FIXME*)] Location.none)
-                     sigs) Location.none (* FIXME*))
+let bind_methods tbl meths vals cl_init =
+  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
+  let len = List.length methl and nvals = List.length vals in
+  if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
+  if len = 0 && nvals < 2 then transl_vals tbl true Strict vals cl_init else
+  let ids = Ident.create "ids" in
+  let i = ref (len + nvals) in
+  let getter, names =
+    if nvals = 0 then "get_method_labels", [] else
+    "new_methods_variables", [transl_meth_list (List.map fst vals)]
+  in
+  Llet(Strict, ids,
+       mkappl (oo_prim getter,
+               [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
+       List.fold_right
+         (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
+         (methl @ vals) cl_init)
 
+let output_methods tbl methods lam =
+  match methods with
+    [] -> lam
+  | [lab; code] ->
+      lsequence (mkappl(oo_prim "set_method", [Lvar tbl; lab; code])) lam
+  | _ ->
+      lsequence (mkappl(oo_prim "set_methods",
+                        [Lvar tbl; Lprim(Pmakeblock(0, Lambda.Blk_array, Immutable), methods, Location.none)]))
+        lam
 
-(* Given an module name and position, find its corresponding name  *)  
-let get_exp (key : Lam_compile_env.key) : J.expression = 
-  match key with 
-   (id, env, expand) -> 
-    Lam_compile_env.query_and_add_if_not_exist 
-        (Lam_module_ident.of_ml id) 
-        (Has_env env)
-        ~not_found:(fun id -> assert false)
-        ~found:(fun   {signature = sigs; _} -> 
-            if expand 
-            then 
-              (** TODO: add module into taginfo*)
-              let len = List.length sigs in (** TODO: could be optimized *) 
-              Js_of_lam_module.make ~comment:id.name 
-                (Ext_list.init len (fun i -> 
-                     E.ml_var_dot id
-                       (Type_util.get_name sigs i )))
-                               
+let rec ignore_cstrs cl =
+  match cl.cl_desc with
+    Tcl_constraint (cl, _, _, _, _) -> ignore_cstrs cl
+  | Tcl_apply (cl, _) -> ignore_cstrs cl
+  | _ -> cl
 
-            else 
-              E.ml_var id)
+let rec index a = function
+    [] -> raise Not_found
+  | b :: l ->
+      if b = a then 0 else 1 + index a l
 
-  
+let bind_id_as_val (id, _, _) = ("", id)
 
+let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
+  match cl.cl_desc with
+    Tcl_ident ( path, _, _) ->
+      begin match inh_init with
+        (obj_init, path')::inh_init ->
+          let lpath = transl_path ~loc:cl.cl_loc cl.cl_env path in
+          (inh_init,
+           Llet (Strict, obj_init,
+                 mkappl(Lprim(Pfield (1, Fld_na), [lpath], Location.none), Lvar cla ::
+                        if top then [Lprim(Pfield (3, Fld_na), [lpath], Location.none)] else []),
+                 bind_super cla super cl_init))
+      | _ ->
+          assert false
+      end
+  | Tcl_structure str ->
+      let cl_init = bind_super cla super cl_init in
+      let (inh_init, cl_init, methods, values) =
+        List.fold_right
+          (fun field (inh_init, cl_init, methods, values) ->
+            match field.cf_desc with
+              Tcf_inherit (_, cl, _, vals, meths) ->
+                let cl_init = output_methods cla methods cl_init in
+                let inh_init, cl_init =
+                  build_class_init cla false
+                    (vals, meths_super cla str.cstr_meths meths)
+                    inh_init cl_init msubst top cl in
+                (inh_init, cl_init, [], values)
+            | Tcf_val (name, _, id, _, over) ->
+                let values =
+                  if over then values else (name.txt, id) :: values
+                in
+                (inh_init, cl_init, methods, values)
+            | Tcf_method (_, _, Tcfk_virtual _)
+            | Tcf_constraint _
+              ->
+                (inh_init, cl_init, methods, values)
+            | Tcf_method (name, _, Tcfk_concrete (_, exp)) ->
+                let met_code = msubst true (transl_exp exp) in
+                let met_code =
+                  if !Clflags.native_code && List.length met_code = 1 then
+                    (* Force correct naming of method for profiles *)
+                    let met = Ident.create ("method_" ^ name.txt) in
+                    [Llet(Strict, met, List.hd met_code, Lvar met)]
+                  else met_code
+                in
+                (inh_init, cl_init,
+                 Lvar(Meths.find name.txt str.cstr_meths) :: met_code @ methods,
+                 values)
+            | Tcf_initializer exp ->
+                (inh_init,
+                 Lsequence(mkappl (oo_prim "add_initializer",
+                                   Lvar cla :: msubst false (transl_exp exp)),
+                           cl_init),
+                 methods, values)
+            | Tcf_attribute _ ->
+                (inh_init, cl_init, methods, values))
+          str.cstr_fields
+          (inh_init, cl_init, [], [])
+      in
+      let cl_init = output_methods cla methods cl_init in
+      (inh_init, bind_methods cla str.cstr_meths values cl_init)
+  | Tcl_fun (_, pat, vals, cl, _) ->
+      let (inh_init, cl_init) =
+        build_class_init cla cstr super inh_init cl_init msubst top cl
+      in
+      let vals = List.map bind_id_as_val vals in
+      (inh_init, transl_vals cla true StrictOpt vals cl_init)
+  | Tcl_apply (cl, exprs) ->
+      build_class_init cla cstr super inh_init cl_init msubst top cl
+  | Tcl_let (rec_flag, defs, vals, cl) ->
+      let (inh_init, cl_init) =
+        build_class_init cla cstr super inh_init cl_init msubst top cl
+      in
+      let vals = List.map bind_id_as_val vals in
+      (inh_init, transl_vals cla true StrictOpt vals cl_init)
+  | Tcl_constraint (cl, _, vals, meths, concr_meths) ->
+      let virt_meths =
+        List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
+      let concr_meths = Concr.elements concr_meths in
+      let narrow_args =
+        [Lvar cla;
+         transl_meth_list vals;
+         transl_meth_list virt_meths;
+         transl_meth_list concr_meths] in
+      let cl = ignore_cstrs cl in
+      begin match cl.cl_desc, inh_init with
+        Tcl_ident (path, _, _), (obj_init, path')::inh_init ->
+          assert (Path.same (normalize_cl_path cl path) path');
+          let lpath = transl_normal_path path' in
+          let inh = Ident.create "inh"
+          and ofs = List.length vals + 1
+          and valids, methids = super in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id, _) ->
+                Llet(StrictOpt, id, lfield inh (index nm concr_meths + ofs),
+                     init))
+              cl_init methids in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id) ->
+                Llet(StrictOpt, id, lfield inh (index nm vals + 1), init))
+              cl_init valids in
+          (inh_init,
+           Llet (Strict, inh,
+                 mkappl(oo_prim "inherits", narrow_args @
+                        [lpath; Lconst(Const_pointer ((if top then 1 else 0), Lambda.Pt_na))]),
+                 Llet(StrictOpt, obj_init, lfield inh 0, cl_init)))
+      | _ ->
+          let core cl_init =
+            build_class_init cla true super inh_init cl_init msubst top cl
+          in
+          if cstr then core cl_init else
+          let (inh_init, cl_init) =
+            core (Lsequence (mkappl (oo_prim "widen", [Lvar cla]), cl_init))
+          in
+          (inh_init,
+           Lsequence(mkappl (oo_prim "narrow", narrow_args),
+                     cl_init))
+      end
 
-end
-module Lam_beta_reduce : sig 
-#1 "lam_beta_reduce.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let rec build_class_lets cl ids =
+  match cl.cl_desc with
+    Tcl_let (rec_flag, defs, vals, cl') ->
+      let env, wrap = build_class_lets cl' [] in
+      (env, fun x ->
+        let lam = Translcore.transl_let rec_flag defs (wrap x) in
+        (* Check recursion in toplevel let-definitions *)
+        if ids = [] || Translcore.check_recursive_lambda ids lam then lam
+        else raise(Error(cl.cl_loc, Illegal_class_expr)))
+  | _ ->
+      (cl.cl_env, fun x -> x)
+
+let rec get_class_meths cl =
+  match cl.cl_desc with
+    Tcl_structure cl ->
+      Meths.fold (fun _ -> IdentSet.add) cl.cstr_meths IdentSet.empty
+  | Tcl_ident _ -> IdentSet.empty
+  | Tcl_fun (_, _, _, cl, _)
+  | Tcl_let (_, _, _, cl)
+  | Tcl_apply (cl, _)
+  | Tcl_constraint (cl, _, _, _, _) -> get_class_meths cl
 
+(*
+   XXX Il devrait etre peu couteux d'ecrire des classes :
+     class c x y = d e f
+*)
+let rec transl_class_rebind obj_init cl vf =
+  match cl.cl_desc with
+    Tcl_ident (path, _, _) ->
+      if vf = Concrete then begin
+        try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit
+        with Not_found -> raise Exit
+      end;
+      (normalize_cl_path cl path, obj_init)
+  | Tcl_fun (_, pat, _, cl, partial) ->
+      let path, obj_init = transl_class_rebind obj_init cl vf in
+      let build params rem =
+        let param = name_pattern "param" pat in
+        Lfunction (Curried, param::params,
+                   Matching.for_function
+                     pat.pat_loc None (Lvar param) [pat, rem] partial)
+      in
+      (path,
+       match obj_init with
+         Lfunction (Curried, params, rem) -> build params rem
+       | rem                              -> build [] rem)
+  | Tcl_apply (cl, oexprs) ->
+      let path, obj_init = transl_class_rebind obj_init cl vf in
+      (path, transl_apply obj_init oexprs Location.none)
+  | Tcl_let (rec_flag, defs, vals, cl) ->
+      let path, obj_init = transl_class_rebind obj_init cl vf in
+      (path, Translcore.transl_let rec_flag defs obj_init)
+  | Tcl_structure _ -> raise Exit
+  | Tcl_constraint (cl', _, _, _, _) ->
+      let path, obj_init = transl_class_rebind obj_init cl' vf in
+      let rec check_constraint = function
+          Cty_constr(path', _, _) when Path.same path path' -> ()
+        | Cty_arrow (_, _, cty) -> check_constraint cty
+        | _ -> raise Exit
+      in
+      check_constraint cl.cl_type;
+      (path, obj_init)
 
+let rec transl_class_rebind_0 self obj_init cl vf =
+  match cl.cl_desc with
+    Tcl_let (rec_flag, defs, vals, cl) ->
+      let path, obj_init = transl_class_rebind_0 self obj_init cl vf in
+      (path, Translcore.transl_let rec_flag defs obj_init)
+  | _ ->
+      let path, obj_init = transl_class_rebind obj_init cl vf in
+      (path, lfunction [self] obj_init)
 
+let transl_class_rebind ids cl vf =
+  try
+    let obj_init = Ident.create "obj_init"
+    and self = Ident.create "self" in
+    let obj_init0 = lapply (Lvar obj_init) [Lvar self] Location.none in
+    let path, obj_init' = transl_class_rebind_0 self obj_init0 cl vf in
+    if not (Translcore.check_recursive_lambda ids obj_init') then
+      raise(Error(cl.cl_loc, Illegal_class_expr));
+    let id = (obj_init' = lfunction [self] obj_init0) in
+    if id then transl_normal_path path else
 
+    let cla = Ident.create "class"
+    and new_init = Ident.create "new_init"
+    and env_init = Ident.create "env_init"
+    and table = Ident.create "table"
+    and envs = Ident.create "envs" in
+    Llet(
+    Strict, new_init, lfunction [obj_init] obj_init',
+    Llet(
+    Alias, cla, transl_normal_path path,
+    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+          [mkappl(Lvar new_init, [lfield cla 0]);
+           lfunction [table]
+             (Llet(Strict, env_init,
+                   mkappl(lfield cla 1, [Lvar table]),
+                   lfunction [envs]
+                     (mkappl(Lvar new_init,
+                             [mkappl(Lvar env_init, [Lvar envs])]))));
+           lfield cla 2;
+           lfield cla 3], Location.none)))
+  with Exit ->
+    lambda_unit
 
+(* Rewrite a closure using builtins. Improves native code size. *)
 
+let rec module_path = function
+    Lvar id ->
+      let s = Ident.name id in s <> "" && s.[0] >= 'A' && s.[0] <= 'Z'
+  | Lprim(Pfield _, [p], _)    -> module_path p
+  | Lprim(Pgetglobal _, [], _) -> true
+  | _                       -> false
 
+let const_path local = function
+    Lvar id -> not (List.mem id local)
+  | Lconst _ -> true
+  | Lfunction (Curried, _, body) ->
+      let fv = free_variables body in
+      List.for_all (fun x -> not (IdentSet.mem x fv)) local
+  | p -> module_path p
 
-(** Beta reduction of lambda IR *)
+let rec builtin_meths self env env2 body =
+  let const_path = const_path (env::self) in
+  let conv = function
+    (* Lvar s when List.mem s self ->  "_self", [] *)
+    | p when const_path p -> "const", [p]
+    | Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self ->
+        "var", [Lvar n]
+    | Lprim(Pfield (n,_), [Lvar e], _) when Ident.same e env ->
+        "env", [Lvar env2; Lconst(Const_pointer (n, Lambda.Pt_na))]
+    | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
+        "meth", [met]
+    | _ -> raise Not_found
+  in
+  match body with
+  | Llet(_, s', Lvar s, body) when List.mem s self ->
+      builtin_meths (s'::self) env env2 body
+  | Lapply(f, [arg], _) when const_path f ->
+      let s, args = conv arg in ("app_"^s, f :: args)
+  | Lapply(f, [arg; p], _) when const_path f && const_path p ->
+      let s, args = conv arg in
+      ("app_"^s^"_const", f :: args @ [p])
+  | Lapply(f, [p; arg], _) when const_path f && const_path p ->
+      let s, args = conv arg in
+      ("app_const_"^s, f :: p :: args)
+  | Lsend(Self, Lvar n, Lvar s, [arg], _) when List.mem s self ->
+      let s, args = conv arg in
+      ("meth_app_"^s, Lvar n :: args)
+  | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
+      ("get_meth", [met])
+  | Lsend(Public _, met, arg, [], _) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lsend(Cached, met, arg, [_;_], _) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lfunction (Curried, [x], body) ->
+      let rec enter self = function
+        | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'], _)
+          when Ident.same x x' && List.mem s self ->
+            ("set_var", [Lvar n])
+        | Llet(_, s', Lvar s, body) when List.mem s self ->
+            enter (s'::self) body
+        | _ -> raise Not_found
+      in enter self body
+  | Lfunction _ -> raise Not_found
+  | _ ->
+      let s, args = conv body in ("get_"^s, args)
 
+module M = struct
+  open CamlinternalOO
+  let builtin_meths self env env2 body =
+    let builtin, args = builtin_meths self env env2 body in
+    (* if not arr then [mkappl(oo_prim builtin, args)] else *)
+    let tag = match builtin with
+      "get_const" -> GetConst
+    | "get_var"   -> GetVar
+    | "get_env"   -> GetEnv
+    | "get_meth"  -> GetMeth
+    | "set_var"   -> SetVar
+    | "app_const" -> AppConst
+    | "app_var"   -> AppVar
+    | "app_env"   -> AppEnv
+    | "app_meth"  -> AppMeth
+    | "app_const_const" -> AppConstConst
+    | "app_const_var"   -> AppConstVar
+    | "app_const_env"   -> AppConstEnv
+    | "app_const_meth"  -> AppConstMeth
+    | "app_var_const"   -> AppVarConst
+    | "app_env_const"   -> AppEnvConst
+    | "app_meth_const"  -> AppMethConst
+    | "meth_app_const"  -> MethAppConst
+    | "meth_app_var"    -> MethAppVar
+    | "meth_app_env"    -> MethAppEnv
+    | "meth_app_meth"   -> MethAppMeth
+    | "send_const" -> SendConst
+    | "send_var"   -> SendVar
+    | "send_env"   -> SendEnv
+    | "send_meth"  -> SendMeth
+    | _ -> assert false
+    in Lconst(Const_pointer(Obj.magic tag, Lambda.Pt_na)) :: args
+end
+open M
 
-val beta_reduce : Ident.t list -> Lam.t -> Lam.t list -> Lam.t
-(* Compile-time beta-reduction of functions immediately applied:
-      Lapply(Lfunction(Curried, params, body), args, loc) ->
-        let paramN = argN in ... let param1 = arg1 in body
-      Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) ->
-        let paramN = argN in ... let param1 = arg1 in body
-   Assumes |args| = |params|.
-*)
 
 (*
-   Refresh all the identifiers, 
-   otherwise the identifier property can not be preserved, 
-   the obvious example is parameter
- *)
+   Traduction d'une classe.
+   Plusieurs cas:
+    * reapplication d'une classe connue -> transl_class_rebind
+    * classe sans dependances locales -> traduction directe
+    * avec dependances locale -> creation d'un arbre de stubs,
+      avec un noeud pour chaque classe locale heritee
+   Une classe est un 4-uplet:
+    (obj_init, class_init, env_init, env)
+    obj_init: fonction de creation d'objet (unit -> obj)
+    class_init: fonction d'heritage (table -> env_init)
+      (une seule par code source)
+    env_init: parametrage par l'environnement local (env -> params -> obj_init)
+      (une par combinaison de class_init herites)
+    env: environnement local
+   Si ids=0 (objet immediat), alors on ne conserve que env_init.
+*)
 
-val propogate_beta_reduce : 
-  Lam_stats.meta -> 
-  Ident.t list -> 
-  Lam.t -> 
-  Lam.t list -> 
-  Lam.t
+let prerr_ids msg ids =
+  let names = List.map Ident.unique_toplevel_name ids in
+  prerr_endline (String.concat " " (msg :: names))
 
+let transl_class ids cl_id pub_meths cl vflag =
+  (* First check if it is not only a rebind *)
+  let rebind = transl_class_rebind ids cl vflag in
+  if rebind <> lambda_unit then rebind else
 
-val refresh : 
-  Lam.t -> 
-  Lam.t 
+  (* Prepare for heavy environment handling *)
+  let tables = Ident.create (Ident.name cl_id ^ "_tables") in
+  let (top_env, req) = oo_add_class tables in
+  let top = not req in
+  let cl_env, llets = build_class_lets cl ids in
+  let new_ids = if top then [] else Env.diff top_env cl_env in
+  let env2 = Ident.create "env" in
+  let meth_ids = get_class_meths cl in
+  let subst env lam i0 new_ids' =
+    let fv = free_variables lam in
+    (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (IdentSet.elements fv); *)
+    let fv = List.fold_right IdentSet.remove !new_ids' fv in
+    (* We need to handle method ids specially, as they do not appear
+       in the typing environment (PR#3576, PR#4560) *)
+    (* very hacky: we add and remove free method ids on the fly,
+       depending on the visit order... *)
+    method_ids :=
+      IdentSet.diff (IdentSet.union (free_methods lam) !method_ids) meth_ids;
+    (* prerr_ids "meth_ids =" (IdentSet.elements meth_ids);
+       prerr_ids "method_ids =" (IdentSet.elements !method_ids); *)
+    let new_ids = List.fold_right IdentSet.add new_ids !method_ids in
+    let fv = IdentSet.inter fv new_ids in
+    new_ids' := !new_ids' @ IdentSet.elements fv;
+    (* prerr_ids "new_ids' =" !new_ids'; *)
+    let i = ref (i0-1) in
+    List.fold_left
+      (fun subst id ->
+        incr i; Ident.add id (lfield env !i)  subst)
+      Ident.empty !new_ids'
+  in
+  let new_ids_meths = ref [] in
+  let msubst arr = function
+      Lfunction (Curried, self :: args, body) ->
+        let env = Ident.create "env" in
+        let body' =
+          if new_ids = [] then body else
+          subst_lambda (subst env body 0 new_ids_meths) body in
+        begin try
+          (* Doesn't seem to improve size for bytecode *)
+          (* if not !Clflags.native_code then raise Not_found; *)
+          if not arr || !Clflags.debug then raise Not_found;
+          builtin_meths [self] env env2 (lfunction args body')
+        with Not_found ->
+          [lfunction (self :: args)
+             (if not (IdentSet.mem env (free_variables body')) then body' else
+              Llet(Alias, env,
+                   Lprim(Parrayrefu Paddrarray,
+                         [Lvar self; Lvar env2], Location.none), body'))]
+        end
+      | _ -> assert false
+  in
+  let new_ids_init = ref [] in
+  let env1 = Ident.create "env" and env1' = Ident.create "env'" in
+  let copy_env envs self =
+    if top then lambda_unit else
+    Lifused(env2, Lprim(Parraysetu Paddrarray,
+                        [Lvar self; Lvar env2; Lvar env1'], Location.none))
+  and subst_env envs l lam =
+    if top then lam else
+    (* must be called only once! *)
+    let lam = subst_lambda (subst env1 lam 1 new_ids_init) lam in
+    Llet(Alias, env1, (if l = [] then Lvar envs else lfield envs 0),
+    Llet(Alias, env1',
+         (if !new_ids_init = [] then Lvar env1 else lfield env1 0),
+         lam))
+  in
 
-(** 
-   {[ Lam_beta_reduce.propogate_beta_reduce_with_map 
-       meta param_map
-       params body args]}
+  (* Now we start compiling the class *)
+  let cla = Ident.create "class" in
+  let (inh_init, obj_init) =
+    build_object_init_0 cla [] cl copy_env subst_env top ids in
+  let inh_init' = List.rev inh_init in
+  let (inh_init', cl_init) =
+    build_class_init cla true ([],[]) inh_init' obj_init msubst top cl
+  in
+  assert (inh_init' = []);
+  let table = Ident.create "table"
+  and class_init = Ident.create (Ident.name cl_id ^ "_init")
+  and env_init = Ident.create "env_init"
+  and obj_init = Ident.create "obj_init" in
+  let pub_meths =
+    List.sort
+      (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
+      pub_meths in
+  let tags = List.map Btype.hash_variant pub_meths in
+  let rev_map = List.combine tags pub_meths in
+  List.iter2
+    (fun tag name ->
+      let name' = List.assoc tag rev_map in
+      if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
+    tags pub_meths;
+  let ltable table lam =
+    Llet(Strict, table,
+         mkappl (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
+  and ldirect obj_init =
+    Llet(Strict, obj_init, cl_init,
+         Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
+                   mkappl (Lvar obj_init, [lambda_unit])))
+  in
+  (* Simplest case: an object defined at toplevel (ids=[]) *)
+  if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
 
-   [param_map] collect the usage of parameters, it's readonly
-   it can be  produced by 
+  let concrete = (vflag = Concrete)
+  and lclass lam =
+    let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in
+    Llet(Strict, class_init, cl_init, lam (free_variables cl_init))
+  and lbody fv =
+    if List.for_all (fun id -> not (IdentSet.mem id fv)) ids then
+      mkappl (oo_prim "make_class",[transl_meth_list pub_meths;
+                                    Lvar class_init])
+    else
+      ltable table (
+      Llet(
+      Strict, env_init, mkappl (Lvar class_init, [Lvar table]),
+      Lsequence(
+      mkappl (oo_prim "init_class", [Lvar table]),
+      Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+            [mkappl (Lvar env_init, [lambda_unit]);
+             Lvar class_init; Lvar env_init; lambda_unit], Location.none))))
+  and lbody_virt lenvs =
+    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+          [lambda_unit; Lfunction(Curried,[cla], cl_init); lambda_unit; lenvs], Location.none)
+  in
+  (* Still easy: a class defined at toplevel *)
+  if top && concrete then lclass lbody else
+  if top then llets (lbody_virt lambda_unit) else
 
-   {[!Lam_analysis.free_variables meta.export_idents 
-       (Lam_analysis.param_map_of_list params) body]}
+  (* Now for the hard stuff: prepare for table cacheing *)
+  let envs = Ident.create "envs"
+  and cached = Ident.create "cached" in
+  let lenvs =
+    if !new_ids_meths = [] && !new_ids_init = [] && inh_init = []
+    then lambda_unit
+    else Lvar envs in
+  let lenv =
+    let menv =
+      if !new_ids_meths = [] then lambda_unit else
+      Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+            List.map (fun id -> Lvar id) !new_ids_meths, Location.none) in
+    if !new_ids_init = [] then menv else
+    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+          menv :: List.map (fun id -> Lvar id) !new_ids_init, Location.none)
+  and linh_envs =
+    List.map (fun (_, p) -> Lprim(Pfield (3, Fld_na), [transl_normal_path p], Location.none))
+      (List.rev inh_init)
+  in
+  let make_envs lam =
+    Llet(StrictOpt, envs,
+         (if linh_envs = [] then lenv else
+         Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), lenv :: linh_envs, Location.none)),
+         lam)
+  and def_ids cla lam =
+    Llet(StrictOpt, env2,
+         mkappl (oo_prim "new_variable", [Lvar cla; transl_label ""]),
+         lam)
+  in
+  let inh_paths =
+    List.filter
+      (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in
+  let inh_keys =
+    List.map (fun (_,p) -> Lprim(Pfield (1, Fld_na), [transl_normal_path p], Location.none)) inh_paths in
+  let lclass lam =
+    Llet(Strict, class_init,
+         Lfunction(Curried, [cla], def_ids cla cl_init), lam)
+  and lcache lam =
+    if inh_keys = [] then Llet(Alias, cached, Lvar tables, lam) else
+    Llet(Strict, cached,
+         mkappl (oo_prim "lookup_tables",
+                [Lvar tables; Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), inh_keys, Location.none)]),
+         lam)
+  and lset cached i lam =
+    Lprim(Psetfield(i, true, Fld_set_na), [Lvar cached; lam], Location.none)
+  in
+  let ldirect () =
+    ltable cla
+      (Llet(Strict, env_init, def_ids cla cl_init,
+            Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
+                      lset cached 0 (Lvar env_init))))
+  and lclass_virt () =
+    lset cached 0 (Lfunction(Curried, [cla], def_ids cla cl_init))
+  in
+  llets (
+  lcache (
+  Lsequence(
+  Lifthenelse(lfield cached 0, lambda_unit,
+              if ids = [] then ldirect () else
+              if not concrete then lclass_virt () else
+              lclass (
+              mkappl (oo_prim "make_class_store",
+                      [transl_meth_list pub_meths;
+                       Lvar class_init; Lvar cached]))),
+  make_envs (
+  if ids = [] then mkappl (lfield cached 0, [lenvs]) else
+  Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+        (if concrete then
+          [mkappl (lfield cached 0, [lenvs]);
+           lfield cached 1;
+           lfield cached 0;
+           lenvs]
+        else [lambda_unit; lfield cached 0; lambda_unit; lenvs])
+       , Location.none)))))
 
-   TODO:
-   replace [propogate_beta_reduce] with such implementation 
-   {[
-     let propogate_beta_reduce meta params body args = 
-       let (_, param_map) = 
-         Lam_analysis.is_closed_with_map Ident_set.empty params body in 
-       propogate_beta_reduce_with_map meta param_map params body args  
-   ]}
+(* Wrapper for class compilation *)
+(*
+    let cl_id = ci.ci_id_class in
+(* TODO: cl_id is used somewhere else as typesharp ? *)
+  let _arity = List.length ci.ci_params in
+  let pub_meths = m in
+  let cl = ci.ci_expr in
+  let vflag = vf in
 *)
-val propogate_beta_reduce_with_map : 
-  Lam_stats.meta ->
-  Lam_closure.stats Ident_map.t ->
-  Ident.t list ->
-  Lam.t -> Lam.t list -> Lam.t
-
-end = struct
-#1 "lam_beta_reduce.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-
 
+let transl_class ids id pub_meths cl vf =
+  oo_wrap cl.cl_env false (transl_class ids id pub_meths cl) vf
 
+let () =
+  transl_object := (fun id meths cl -> transl_class [] id meths cl Concrete)
 
+(* Error report *)
 
+open Format
 
-(*
-   Given an [map], rewrite all let bound variables into new variables, 
-   note that the [map] is changed
-   example    
-   {[
-     let a/112 = 3 in a/112      
-   ]}
-   would be converted into 
-   {[
-     let a/113 = 3 in a/113     
-   ]}   
+let report_error ppf = function
+  | Illegal_class_expr ->
+      fprintf ppf "This kind of recursive class expression is not allowed"
+  | Tags (lab1, lab2) ->
+      fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s"
+        lab1 lab2 "Change one of them."
 
-   ATTENTION: [let] bound idents have to be renamed, 
-   Note we rely on an invariant that parameter could not be rebound 
- *)
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer loc report_error err)
+      | _ ->
+        None
+    )
 
-(* 
-  Small function inline heuristics:
-  Even if a function is small, it does not mean it is good for inlining,
-  for example, in list.ml
-   {[
-     let rec length_aux len = function
-         [] -> len
-       | a::l -> length_aux (len + 1) l
+end
+module Translmod : sig 
+#1 "translmod.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-     let length l = length_aux 0 l
-   ]}   
-   if we inline [length], it will expose [length_aux] to the user, first, it make 
-   the code not very friendly, also since [length_aux] is used everywhere now, it 
-   may affect that we will not do the inlining of [length_aux] in [length]
+(* Translation from typed abstract syntax to lambda terms,
+   for the module language *)
 
-   Criteior for sure to inline   
-   1. small size, does not introduce extra symbols, non-exported and non-recursive   
-      non-recursive is required if we re-apply the strategy
+open Typedtree
+open Lambda
 
-   Other Factors:   
-   2. number of invoked times
-   3. arguments are const or not   
-*)
-let rewrite (map :   _ Ident_hashtbl.t) 
-    (lam : Lam.t) : Lam.t = 
+val transl_implementation: string -> structure * module_coercion -> lambda
+val transl_store_phrases: string -> structure -> int * lambda
+val transl_store_implementation:
+      string -> structure * module_coercion -> int * lambda
+val transl_toplevel_definition: structure -> lambda
+val transl_package:
+      Ident.t option list -> Ident.t -> module_coercion -> lambda
+val transl_store_package:
+      Ident.t option list -> Ident.t -> module_coercion -> int * lambda
 
-  let rebind i = 
-    let i' = Ident.rename i in 
-    Ident_hashtbl.add map i (Lam.var i');
-    i' in
-  (* order matters, especially for let bindings *)
-  let rec 
-    option_map op = 
-    match op with 
-    | None -> None 
-    | Some x -> Some (aux x)
-  and aux (lam : Lam.t) : Lam.t = 
-    match lam with 
-    | Lvar v ->
-      Ident_hashtbl.find_default map v lam 
-    | Llet(str, v, l1, l2) ->
-      let v = rebind v in
-      let l1 = aux l1 in      
-      let l2 = aux l2 in
-      Lam.let_ str v  l1  l2 
-    | Lletrec(bindings, body) ->
-      (*order matters see GPR #405*)
-      let vars = List.map (fun (k, _) -> rebind k) bindings in 
-      let bindings = List.map2 (fun var (_,l) -> var, aux l) vars bindings in 
-      let body = aux body in       
-      Lam.letrec bindings body
-    | Lfunction{arity; kind; params; body} -> 
-      let params =  List.map rebind params in
-      let body = aux body in      
-      Lam.function_ ~arity ~kind ~params ~body
-    | Lstaticcatch(l1, (i,xs), l2) -> 
-      let l1 = aux l1 in
-      let xs = List.map rebind xs in
-      let l2 = aux l2 in
-      Lam.staticcatch l1 (i,xs) l2
-    | Lfor(ident, l1, l2, dir, l3) ->
-      let ident = rebind ident in 
-      let l1 = aux l1 in
-      let l2 = aux l2 in
-      let l3 = aux l3 in
-      Lam.for_ ident (aux  l1)  l2 dir  l3
-    | Lconst _ -> lam
-    | Lprim {primitive; args ; loc} ->
-      (* here it makes sure that global vars are not rebound *)      
-      Lam.prim ~primitive ~args:(List.map aux  args) loc
-    | Lapply {fn;  args; loc;  status } ->
-      let fn = aux fn in       
-      let args = List.map aux  args in 
-      Lam.apply fn  args loc status
-    | Lswitch(l, {sw_failaction; 
-                  sw_consts; 
-                  sw_blocks;
-                  sw_numblocks;
-                  sw_numconsts;
-                 }) ->
-      let l = aux l in
-      Lam.switch l
-              {sw_consts = 
-                 List.map (fun (v, l) -> v, aux  l) sw_consts;
-               sw_blocks = List.map (fun (v, l) -> v, aux  l) sw_blocks;
-               sw_numconsts = sw_numconsts;
-               sw_numblocks = sw_numblocks;
-               sw_failaction =  option_map sw_failaction
-              }
-    | Lstringswitch(l, sw, d) ->
-      let l = aux  l in
-      Lam.stringswitch l 
-                     (List.map (fun (i, l) -> i,aux  l) sw)
-                     (option_map d)
-    | Lstaticraise (i,ls) 
-      -> Lam.staticraise i (List.map aux  ls)
-    | Ltrywith(l1, v, l2) -> 
-      let l1 = aux l1 in
-      let v = rebind v in
-      let l2 = aux l2 in
-      Lam.try_ l1 v l2
-    | Lifthenelse(l1, l2, l3) -> 
-      let l1 = aux l1 in
-      let l2 = aux l2 in
-      let l3 = aux l3 in
-      Lam.if_ l1  l2   l3
-    | Lsequence(l1, l2) -> 
-      let l1 = aux l1 in
-      let l2 = aux l2 in
-      Lam.seq l1 l2
-    | Lwhile(l1, l2) -> 
-      let l1 = aux l1 in
-      let l2 = aux l2 in
-      Lam.while_  l1  l2
-    | Lassign(v, l) 
-      -> Lam.assign v (aux  l)
-    | Lsend(u, m, o, ll, v) ->
-      let m = aux m in 
-      let o = aux o in 
-      let ll = List.map aux ll in
-      Lam.send u  m  o  ll v
-    | Lifused(v, l) -> 
-      let l = aux l in 
-      Lam.ifused v  l
-  in 
-  aux lam
+val toplevel_name: Ident.t -> string
+val nat_toplevel_name: Ident.t -> Ident.t * int
 
+val primitive_declarations: Primitive.description list ref
 
-let refresh lam = rewrite (Ident_hashtbl.create 17 : Lam.t Ident_hashtbl.t ) lam
+type error =
+  Circular_dependency of Ident.t
 
+exception Error of Location.t * error
 
+val report_error: Format.formatter -> error -> unit
 
+val reset: unit -> unit
 
-(* 
-    A naive beta reduce would break the invariants of the optmization.
 
+(** make it an array for better performance*)
+val get_export_identifiers : unit -> Ident.t list 
 
-    The sane but slowest  way:
-      when we do a beta reduction, we need rename all variables inlcuding 
-      let-bound ones
+end = struct
+#1 "translmod.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
 
-    A conservative one:
-      - for internal one 
-        rename params and let bound variables
-      - for external one (seriaized)
-        if it's enclosed environment should be good enough
-        so far, we only inline enclosed lambdas
-    TODO: rename 
+(* Translation from typed abstract syntax to lambda terms,
+   for the module language *)
 
-   Optimizations:   
-   {[
-     (fun x y -> ...     ) 100 3 
-   ]}   
-   we can bound [x] to [100] in a single step     
- *)
-let propogate_beta_reduce 
-    (meta : Lam_stats.meta) params body args =
-  match Lam_beta_reduce_util.simple_beta_reduce params body  args with 
-  | Some x -> x 
-  | None -> 
-  let rest_bindings, rev_new_params  = 
-    List.fold_left2 
-      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
-         match arg with          
-         | Lconst _
-         | Lvar _  -> rest_bindings , arg :: acc 
-         | _ -> 
-           let p = Ident.rename old_param in 
-           (p,arg) :: rest_bindings , (Lam.var p) :: acc 
-      )  ([],[]) params args in
-  let new_body = rewrite (Ident_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
-  List.fold_right
-    (fun (param, (arg : Lam.t)) l -> 
-       let arg = 
-         match arg with 
-         | Lvar v -> 
-           begin 
-             match Ident_hashtbl.find_opt meta.ident_tbl v with 
-             | None -> ()
-             | Some ident_info -> 
-               Ident_hashtbl.add meta.ident_tbl param ident_info 
-           end;
-           arg 
-         | Lprim {primitive = Pgetglobal ident;  args = [];  _} -> 
-           (* It's not completeness, its to make it sound.. 
-              Pass global module as an argument
-           *)
-           Lam_compile_global.query_lambda ident meta.env 
-         (* alias meta param ident (Module (Global ident)) Strict *)
-         | Lprim {primitive = Pmakeblock (_, _, Immutable) ;args ; _} -> 
-           Ident_hashtbl.replace meta.ident_tbl param 
-             (Lam_util.kind_of_lambda_block Normal args ); (** *)
-           arg
-         | _ -> arg in
-       Lam_util.refine_let param arg l) 
-     rest_bindings new_body
+open Misc
+open Asttypes
+open Longident
+open Path
+open Types
+open Typedtree
+open Lambda
+open Translobj
+open Translcore
+open Translclass
 
-let propogate_beta_reduce_with_map  
-    (meta : Lam_stats.meta) (map : Lam_closure.stats Ident_map.t ) params body args =
-  match Lam_beta_reduce_util.simple_beta_reduce params body args with
-  | Some x -> x
-  | None ->
-  let rest_bindings, rev_new_params  = 
-    List.fold_left2 
-      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
-         match arg with          
-         | Lconst _
-         | Lvar _  -> rest_bindings , arg :: acc 
-         | Lprim {primitive = Pgetglobal ident; args = []}
-           (* TODO: we can pass Global, but you also need keep track of it*)
-           ->
-           let p = Ident.rename old_param in 
-           (p,arg) :: rest_bindings , (Lam.var p) :: acc 
+type error =
+  Circular_dependency of Ident.t
 
-         | _ -> 
-           if  Lam_analysis.no_side_effects arg then
-             begin match Ident_map.find_exn old_param map with 
-               | exception Not_found -> assert false 
-               | {top = true ; times = 0 }
-               | {top = true ; times = 1 } 
-                 -> 
-                 rest_bindings, arg :: acc                
-               | _  ->  
-                 let p = Ident.rename old_param in 
-                 (p,arg) :: rest_bindings , (Lam.var p) :: acc 
-             end
-           else
-             let p = Ident.rename old_param in 
-             (p,arg) :: rest_bindings , (Lam.var p) :: acc 
-      )  ([],[]) params args in
-  let new_body = rewrite (Ident_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
-  List.fold_right
-    (fun (param, (arg : Lam.t)) l -> 
-       let arg = 
-         match arg with 
-         | Lvar v -> 
-           begin 
-             match Ident_hashtbl.find_opt meta.ident_tbl v with 
-             | None -> ()
-             | Some ident_info -> 
-               Ident_hashtbl.add meta.ident_tbl param ident_info 
-           end;
-           arg 
-         | Lprim {primitive = Pgetglobal ident; args =  []} -> 
-           (* It's not completeness, its to make it sound.. *)
-           Lam_compile_global.query_lambda ident meta.env 
-         (* alias meta param ident (Module (Global ident)) Strict *)
-         | Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args} -> 
-           Ident_hashtbl.replace meta.ident_tbl param 
-             (Lam_util.kind_of_lambda_block Normal args ); (** *)
-           arg
-         | _ -> arg in
-       Lam_util.refine_let param arg l) 
-     rest_bindings new_body
 
+exception Error of Location.t * error
 
+(* Keep track of the root path (from the root of the namespace to the
+   currently compiled module expression).  Useful for naming extensions. *)
 
-let beta_reduce params body args =
-  match Lam_beta_reduce_util.simple_beta_reduce params body args with 
-  | Some x -> x 
-  | None -> 
-    List.fold_left2 
-      (fun l param arg ->
-         Lam_util.refine_let param arg l)
-      body params args
+let global_path glob = Some(Pident glob)
+let is_top rootpath = 
+  match rootpath with 
+  | Some (Pident _ ) -> true
+  | _ -> false 
 
-end
-module Js_long : sig 
-#1 "js_long.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let functor_path path param =
+  match path with
+    None -> None
+  | Some p -> Some(Papply(p, Pident param))
+let field_path path field =
+  match path with
+    None -> None
+  | Some p -> Some(Pdot(p, Ident.name field, Path.nopos))
 
+(* Compile type extensions *)
 
+let prim_set_oo_id =
+  Pccall {Primitive.prim_name = "caml_set_oo_id"; prim_arity = 1;
+          prim_alloc = false; prim_native_name = "";
+          prim_native_float = false}
 
+let transl_extension_constructor env path ext =
+  let name =
+    match path with
+      None -> Ident.name ext.ext_id
+    | Some p -> Path.name p
+  in
+  let loc = ext.ext_loc in
+  match ext.ext_kind with
+    Text_decl(args, ret) ->
+      Lprim(prim_set_oo_id,
+            [Lprim(Pmakeblock(Obj.object_tag, Lambda.default_tag_info, Mutable),
+                   [Lconst(Const_base(Const_string (name,None)));
+                    Lconst(Const_base(Const_int 0))], loc)], loc)
+  | Text_rebind(path, lid) ->
+      transl_path ~loc env path
 
+let transl_type_extension env rootpath tyext body =
+  List.fold_right
+    (fun ext body ->
+      let lam =
+        transl_extension_constructor env (field_path rootpath ext.ext_id) ext
+      in
+      Llet(Strict, ext.ext_id, lam, body))
+    tyext.tyext_constructors
+    body
 
+(* Compile a coercion *)
 
-type int64_call = J.expression list -> J.expression  
+let rec apply_coercion loc strict restr arg =
+  match restr with
+    Tcoerce_none ->
+      arg
+  | Tcoerce_structure(pos_cc_list, id_pos_list) ->
+      name_lambda strict arg (fun id ->
+        let get_field pos = Lprim(Pfield (pos, Fld_na (*TODO*)),[Lvar id], loc) in
+        let lam =
+          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+                List.map (apply_coercion_field loc get_field) pos_cc_list, loc)
+        in
+        wrap_id_pos_list loc id_pos_list get_field lam)
+  | Tcoerce_functor(cc_arg, cc_res) ->
+      let param = Ident.create "funarg" in
+      name_lambda strict arg (fun id ->
+        Lfunction(Curried, [param],
+          apply_coercion loc Strict cc_res
+            (Lapply(Lvar id, [apply_coercion loc Alias cc_arg (Lvar param)],
+                   Location.none))))
+  | Tcoerce_primitive (_,p) ->
+      transl_primitive Location.none p
+  | Tcoerce_alias (path, cc) ->
+      name_lambda strict arg
+        (fun id -> apply_coercion loc Alias cc (transl_normal_path path))
 
-val make_const : lo:Int32.t -> hi:Int32.t -> J.expression
+and apply_coercion_field loc get_field (pos, cc) =
+  apply_coercion loc Alias cc (get_field pos)
 
-val of_const : int64 -> J.expression
+and wrap_id_pos_list loc id_pos_list get_field lam =
+  let fv = free_variables lam in
+  (*Format.eprintf "%a@." Printlambda.lambda lam;
+  IdentSet.iter (fun id -> Format.eprintf "%a " Ident.print id) fv;
+  Format.eprintf "@.";*)
+  let (lam,s) =
+    List.fold_left (fun (lam,s) (id',pos,c) ->
+      if IdentSet.mem id' fv then
+        let id'' = Ident.create (Ident.name id') in
+        (Llet(Alias,id'',
+              apply_coercion loc Alias c (get_field pos),lam),
+         Ident.add id' (Lvar id'') s)
+      else (lam,s))
+      (lam, Ident.empty) id_pos_list
+  in
+  if s == Ident.empty then lam else subst_lambda s lam
 
-val to_int32 : int64_call
 
-val of_int32 : int64_call
-val comp : Lambda.comparison -> int64_call
-val neg : int64_call
-val add : int64_call
-val sub : int64_call
-val mul : int64_call
-val div : int64_call
-val xor : int64_call
-val mod_ : int64_call
-val lsl_ : int64_call
-val lsr_ : int64_call
-val asr_ : int64_call
-val and_ : int64_call
-val or_ : int64_call
-val swap : int64_call
-val discard_sign : int64_call
-val div_mod : int64_call
-val to_hex : int64_call  
-val to_float : int64_call
-val of_float : int64_call
-val compare : int64_call
-val of_string : int64_call
-val float_of_bits : int64_call
-val bits_of_float : int64_call  
-val get64 : int64_call
+(* Compose two coercions
+   apply_coercion c1 (apply_coercion c2 e) behaves like
+   apply_coercion (compose_coercions c1 c2) e. *)
 
-end = struct
-#1 "js_long.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let rec compose_coercions c1 c2 =
+  match (c1, c2) with
+    (Tcoerce_none, c2) -> c2
+  | (c1, Tcoerce_none) -> c1
+  | (Tcoerce_structure (pc1, ids1), Tcoerce_structure (pc2, ids2)) ->
+      let v2 = Array.of_list pc2 in
+      let ids1 =
+        List.map (fun (id,pos1,c1) ->
+          let (pos2,c2) = v2.(pos1) in (id, pos2, compose_coercions c1 c2))
+          ids1
+      in
+      Tcoerce_structure
+        (List.map
+          (function (p1, Tcoerce_primitive _) as x ->
+                      x (* (p1, Tcoerce_primitive p) *)
+                  | (p1, c1) ->
+                      let (p2, c2) = v2.(p1) in (p2, compose_coercions c1 c2))
+             pc1,
+         ids1 @ ids2)
+  | (Tcoerce_functor(arg1, res1), Tcoerce_functor(arg2, res2)) ->
+      Tcoerce_functor(compose_coercions arg2 arg1,
+                      compose_coercions res1 res2)
+  | (c1, Tcoerce_alias (path, c2)) ->
+      Tcoerce_alias (path, compose_coercions c1 c2)
+  | (_, _) ->
+      fatal_error "Translmod.compose_coercions"
 
+(*
+let apply_coercion a b c =
+  Format.eprintf "@[<2>apply_coercion@ %a@]@." Includemod.print_coercion b;
+  apply_coercion a b c
 
+let compose_coercions c1 c2 =
+  let c3 = compose_coercions c1 c2 in
+  let open Includemod in
+  Format.eprintf "@[<2>compose_coercions@ (%a)@ (%a) =@ %a@]@."
+    print_coercion c1 print_coercion c2 print_coercion c3;
+  c3
+*)
 
+(* Record the primitive declarations occuring in the module compiled *)
 
+let primitive_declarations = ref ([] :  Primitive.description list)
+let record_primitive = function
+  | {val_kind=Val_prim p} ->
+      primitive_declarations := p :: !primitive_declarations
+  | _ -> ()
 
+(* Utilities for compiling "module rec" definitions *)
 
-module E = Js_exp_make
-type int64_call = J.expression list -> J.expression  
+let mod_prim name =
+  try
+    transl_normal_path
+      (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
+                             Env.empty))
+  with Not_found ->
+    fatal_error ("Primitive " ^ name ^ " not found.")
 
-let int64_call (fn : string) args  = 
-  E.runtime_call Js_config.int64 fn args 
+let undefined_location loc =
+  let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
+  Lconst(Const_block(0, Lambda.default_tag_info,
+                     [Const_base(Const_string (fname, None));
+                      Const_base(Const_int line);
+                      Const_base(Const_int char)]))
 
+let init_shape modl =
+  let rec init_shape_mod env mty =
+    match Mtype.scrape env mty with
+      Mty_ident _ ->
+        raise Not_found
+    | Mty_alias _ ->
+        Const_block (1, Lambda.default_tag_info, [Const_pointer (0, Lambda.Pt_module_alias)])
+    | Mty_signature sg ->
+        Const_block(0,  Lambda.default_tag_info, [Const_block(0, Lambda.default_tag_info, init_shape_struct env sg)])
+    | Mty_functor(id, arg, res) ->
+        raise Not_found (* can we do better? *)
+  and init_shape_struct env sg =
+    match sg with
+      [] -> []
+    | Sig_value(id, vdesc) :: rem ->
+        let init_v =
+          match Ctype.expand_head env vdesc.val_type with
+            {desc = Tarrow(_,_,_,_)} ->
+              Const_pointer (0,Lambda.default_pointer_info) (* camlinternalMod.Function *)
+          | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
+              Const_pointer (1, Lambda.default_pointer_info) (* camlinternalMod.Lazy *)
+          | _ -> raise Not_found in
+        init_v :: init_shape_struct env rem
+    | Sig_type(id, tdecl, _) :: rem ->
+        init_shape_struct (Env.add_type ~check:false id tdecl env) rem
+    | Sig_typext(id, ext, _) :: rem ->
+        raise Not_found
+    | Sig_module(id, md, _) :: rem ->
+        init_shape_mod env md.md_type ::
+        init_shape_struct (Env.add_module_declaration id md env) rem
+    | Sig_modtype(id, minfo) :: rem ->
+        init_shape_struct (Env.add_modtype id minfo env) rem
+    | Sig_class(id, cdecl, _) :: rem ->
+        Const_pointer (2, Lambda.default_pointer_info) (* camlinternalMod.Class *)
+        :: init_shape_struct env rem
+    | Sig_class_type(id, ctyp, _) :: rem ->
+        init_shape_struct env rem
+  in
+  try
+    Some(undefined_location modl.mod_loc,
+         Lconst(init_shape_mod modl.mod_env modl.mod_type))
+  with Not_found ->
+    None
 
-(* TODO: make layout easier to change later *)
-let record_info = Lambda.Blk_record [| "hi"; "lo"|]
-let make_const ~lo ~hi = 
-   E.make_block 
-     ~comment:"int64" (E.zero_int_literal) 
-     record_info
-     [E.int hi; E.to_uint32 @@ E.int lo ; ]
-     (* If we use unsigned int for lo field, 
-        then we can not use [E.int] which is 
-        assumed to to be signed int.
-        Or we can use [Int64] to encode 
-        in the ast node?
-     *)
-     Immutable
-let make ~lo ~hi = 
-   E.make_block 
-     ~comment:"int64" (E.zero_int_literal) 
-     record_info [   hi; E.to_uint32 lo ]
-     Immutable
-let get_lo x = E.index x 1l
-let get_hi x = E.index x 0l
+(* Reorder bindings to honor dependencies.  *)
 
+type binding_status = Undefined | Inprogress | Defined
 
-(* below should  not depend on layout *)
+let reorder_rec_bindings bindings =
+  let id = Array.of_list (List.map (fun (id,_,_,_) -> id) bindings)
+  and loc = Array.of_list (List.map (fun (_,loc,_,_) -> loc) bindings)
+  and init = Array.of_list (List.map (fun (_,_,init,_) -> init) bindings)
+  and rhs = Array.of_list (List.map (fun (_,_,_,rhs) -> rhs) bindings) in
+  let fv = Array.map Lambda.free_variables rhs in
+  let num_bindings = Array.length id in
+  let status = Array.make num_bindings Undefined in
+  let res = ref [] in
+  let rec emit_binding i =
+    match status.(i) with
+      Defined -> ()
+    | Inprogress -> raise(Error(loc.(i), Circular_dependency id.(i)))
+    | Undefined ->
+        if init.(i) = None then begin
+          status.(i) <- Inprogress;
+          for j = 0 to num_bindings - 1 do
+            if IdentSet.mem id.(j) fv.(i) then emit_binding j
+          done
+        end;
+        res := (id.(i), init.(i), rhs.(i)) :: !res;
+        status.(i) <- Defined in
+  for i = 0 to num_bindings - 1 do
+    match status.(i) with
+      Undefined -> emit_binding i
+    | Inprogress -> assert false
+    | Defined -> ()
+  done;
+  List.rev !res
 
+(* Generate lambda-code for a reordered list of bindings *)
 
-let of_const (v : Int64.t) = 
-  make_const
-    ~lo:(Int64.to_int32 v )
-    ~hi:(Int64.to_int32 (Int64.shift_right v 32))
+let eval_rec_bindings bindings cont =
+  let rec bind_inits = function
+    [] ->
+      bind_strict bindings
+  | (id, None, rhs) :: rem ->
+      bind_inits rem
+  | (id, Some(loc, shape), rhs) :: rem ->
+      Llet(Strict, id, Lapply(mod_prim "init_mod", [loc; shape], Location.none),
+           bind_inits rem)
+  and bind_strict = function
+    [] ->
+      patch_forwards bindings
+  | (id, None, rhs) :: rem ->
+      Llet(Strict, id, rhs, bind_strict rem)
+  | (id, Some(loc, shape), rhs) :: rem ->
+      bind_strict rem
+  and patch_forwards = function
+    [] ->
+      cont
+  | (id, None, rhs) :: rem ->
+      patch_forwards rem
+  | (id, Some(loc, shape), rhs) :: rem ->
+      Lsequence(Lapply(mod_prim "update_mod", [shape; Lvar id; rhs],
+                       Location.none),
+                patch_forwards rem)
+  in
+    bind_inits bindings
 
-let to_int32 args = 
-  begin match args with
-  | [v] ->  E.to_int32 @@ get_lo v
-  | _ -> assert false
-  end
+let compile_recmodule compile_rhs bindings cont =
+  eval_rec_bindings
+    (reorder_rec_bindings
+       (List.map
+          (fun {mb_id=id; mb_expr=modl; _} ->
+            (id, modl.mod_loc, init_shape modl, compile_rhs id modl))
+          bindings))
+    cont
 
-let of_int32 (args : J.expression list) = 
-  match args with 
-  | [{expression_desc = Number (Int {i}) ; _}] 
-    -> 
-    if i < 0l then make_const ~lo:i ~hi:(-1l)
-    else make_const ~lo:i ~hi:0l
-  | _ -> int64_call  "of_int32" args
+(* Extract the list of "value" identifiers bound by a signature.
+   "Value" identifiers are identifiers for signature components that
+   correspond to a run-time value: values, extensions, modules, classes.
+   Note: manifest primitives do not correspond to a run-time value! *)
 
-let comp (cmp : Lambda.comparison) args = 
-  E.runtime_call  Js_config.int64
-    (match cmp with 
-     | Ceq -> "eq"
-     | Cneq -> "neq"
-     | Clt -> "lt"
-     | Cgt -> "gt"
-     | Cle -> "le"
-     | Cge -> "ge") args 
+let rec bound_value_identifiers = function
+    [] -> []
+  | Sig_value(id, {val_kind = Val_reg}) :: rem ->
+      id :: bound_value_identifiers rem
+  | Sig_typext(id, ext, _) :: rem -> id :: bound_value_identifiers rem
+  | Sig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem
+  | Sig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem
+  | _ :: rem -> bound_value_identifiers rem
 
-let neg args = 
-  int64_call "neg" args
+(* Compile a module expression *)
+ 
+let export_identifiers  : Ident.t list ref = ref []
+let get_export_identifiers () = 
+  !export_identifiers
 
-let add args = 
-  int64_call "add" args 
+let rec transl_module cc rootpath mexp =
+  let loc = mexp.mod_loc in
+  match mexp.mod_type with
+    Mty_alias _ -> apply_coercion loc Alias cc lambda_unit
+  | _ ->
+  match mexp.mod_desc with
+    Tmod_ident (path,_) ->
+      apply_coercion loc Strict cc
+        (transl_path ~loc mexp.mod_env path)
+  | Tmod_structure str ->
+      transl_struct loc [] cc rootpath str
+  | Tmod_functor( param, _, mty, body) ->
+      let bodypath = functor_path rootpath param in
+      oo_wrap mexp.mod_env true
+        (function
+        | Tcoerce_none ->
+            Lfunction(Curried, [param],
+                      transl_module Tcoerce_none bodypath body)
+        | Tcoerce_functor(ccarg, ccres) ->
+            let param' = Ident.create "funarg" in
+            Lfunction(Curried, [param'],
+                      Llet(Alias, param,
+                           apply_coercion loc Alias ccarg (Lvar param'),
+                           transl_module ccres bodypath body))
+        | _ ->
+            fatal_error "Translmod.transl_module")
+        cc
+  | Tmod_apply(funct, arg, ccarg) ->
+      oo_wrap mexp.mod_env true
+        (apply_coercion loc Strict cc)
+        (Lapply(transl_module Tcoerce_none None funct,
+                [transl_module ccarg None arg], loc))
+  | Tmod_constraint(arg, mty, _, ccarg) ->
+      transl_module (compose_coercions cc ccarg) rootpath arg
+  | Tmod_unpack(arg, _) ->
+      apply_coercion loc  Strict cc (Translcore.transl_exp arg)
 
-let sub args = 
-  int64_call "sub" args
+and transl_struct loc fields cc rootpath str =
+  transl_structure loc fields cc rootpath str.str_items
 
-let mul args =  
-  int64_call "mul" args
+and transl_structure loc fields cc rootpath = function
+    [] ->
+      begin match cc with
+        Tcoerce_none ->
+          let fields =  List.rev fields in
+          let field_names = List.map (fun id -> id.Ident.name) fields in
+          Lprim(Pmakeblock(0, Lambda.Blk_module (Some field_names) , Immutable),
+                List.fold_right (fun id acc -> begin
+                      (if is_top rootpath then 
+                         export_identifiers :=  id :: !export_identifiers);
+                      (Lvar id :: acc) end) fields [] , loc
+                 )
+      | Tcoerce_structure(pos_cc_list, id_pos_list) ->
+              (* Do not ignore id_pos_list ! *)
+          (*Format.eprintf "%a@.@[" Includemod.print_coercion cc;
+          List.iter (fun l -> Format.eprintf "%a@ " Ident.print l)
+            fields;
+          Format.eprintf "@]@.";*)
+          let v = Array.of_list (List.rev fields) in
+          let get_field pos = Lvar v.(pos)
+          and ids = List.fold_right IdentSet.add fields IdentSet.empty in
+          let (result, names) = List.fold_right
+              (fun  (pos, cc) (code, name) ->
+                 begin match cc with
+                 | Tcoerce_primitive (id,p) -> 
+                     (if is_top rootpath then 
+                        export_identifiers := id:: !export_identifiers);
+                     (transl_primitive Location.none p :: code, p.Primitive.prim_name ::name)
+                 | _ -> 
+                     (if is_top rootpath then 
+                        export_identifiers :=  v.(pos) :: !export_identifiers);
+                     (apply_coercion loc Strict cc (get_field pos) :: code, v.(pos).Ident.name :: name)
+                 end)
+              pos_cc_list ([], [])in 
+          let lam =
+            (Lprim(Pmakeblock(0, Blk_module (Some names), Immutable),
+                   result, loc))
+          and id_pos_list =
+            List.filter (fun (id,_,_) -> not (IdentSet.mem id ids)) id_pos_list
+          in
+          wrap_id_pos_list loc id_pos_list get_field lam
+      | _ ->
+          fatal_error "Translmod.transl_structure"
+      end
+  | item :: rem ->
+      match item.str_desc with
+      | Tstr_eval (expr, _) ->
+      Lsequence(transl_exp expr, transl_structure loc fields cc rootpath rem)
+  | Tstr_value(rec_flag, pat_expr_list) ->
+      let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
+      transl_let rec_flag pat_expr_list
+                 (transl_structure loc ext_fields cc rootpath rem)
+  | Tstr_primitive descr ->
+      record_primitive descr.val_val;
+      transl_structure loc fields cc rootpath rem
+  | Tstr_type decls ->
+      transl_structure loc  fields cc rootpath rem
+  | Tstr_typext(tyext) ->
+      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
+      transl_type_extension item.str_env rootpath tyext
+        (transl_structure loc (List.rev_append ids fields) cc rootpath rem)
+  | Tstr_exception ext ->
+      let id = ext.ext_id in
+      let path = field_path rootpath id in
+      Llet(Strict, id, transl_extension_constructor item.str_env path ext,
+           transl_structure loc (id :: fields) cc rootpath rem)
+  | Tstr_module mb ->
+      let id = mb.mb_id in
+      Llet(pure_module mb.mb_expr, id,
+           transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr,
+           transl_structure loc (id :: fields) cc rootpath rem)
+  | Tstr_recmodule bindings ->
+      let ext_fields =
+        List.rev_append (List.map (fun mb -> mb.mb_id) bindings) fields
+      in
+      compile_recmodule
+        (fun id modl ->
+          transl_module Tcoerce_none (field_path rootpath id) modl)
+        bindings
+        (transl_structure loc ext_fields cc rootpath rem)
+  | Tstr_class cl_list ->
+      let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in
+      Lletrec(List.map
+              (fun (ci, meths, vf) ->
+                let id = ci.ci_id_class in
+                let cl = ci.ci_expr in
+                  (id, transl_class ids id meths cl vf ))
+                cl_list,
+              transl_structure loc (List.rev_append ids fields) cc rootpath rem)
+  | Tstr_include incl ->
+      let ids = bound_value_identifiers incl.incl_type in
+      let modl = incl.incl_mod in
+      let mid = Ident.create "include" in
+      let rec rebind_idents pos newfields = function
+        [] ->
+          transl_structure loc newfields cc rootpath rem
+      | id :: ids ->
+          Llet(Alias, id, Lprim(Pfield (pos, Fld_na), [Lvar mid], incl.incl_loc),
+               rebind_idents (pos + 1) (id :: newfields) ids) in
+      Llet(pure_module modl, mid, transl_module Tcoerce_none None modl,
+           rebind_idents 0 fields ids)
 
-let div args =
-  int64_call "div" args
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_structure loc fields cc rootpath rem
 
-let bit_op  op args = 
-  match args  with 
-  | [l;r] -> 
-    make ~lo:(op (get_lo l) (get_lo r))
-      ~hi:(op (get_hi l) (get_hi r))
-  | _ -> assert false
+and pure_module m =
+  match m.mod_desc with
+    Tmod_ident _ -> Alias
+  | Tmod_constraint (m,_,_,_) -> pure_module m
+  | _ -> Strict
 
-let xor  = bit_op E.int32_bxor 
-let or_ = bit_op E.int32_bor
-let and_ = bit_op E.int32_band
+(* Update forward declaration in Translcore *)
+let _ =
+  Translcore.transl_module := transl_module
 
+(* Compile an implementation *)
 
-let lsl_ args = 
-  int64_call "lsl_" args
+let transl_implementation module_name (str, cc) =
+  reset_labels ();
+  primitive_declarations := [];
+  let module_id = Ident.create_persistent module_name in
+  Lprim(Psetglobal module_id,
+        [transl_label_init
+            (transl_struct Location.none [] cc (global_path module_id) str)], Location.none)
 
-let lsr_ args = 
-  int64_call "lsr_" args
 
-let asr_ args = 
-  int64_call "asr_" args
+(* Build the list of value identifiers defined by a toplevel structure
+   (excluding primitive declarations). *)
 
-let mod_ args = 
-  int64_call "mod_" args
+let rec defined_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval (expr, _) -> defined_idents rem
+    | Tstr_value(rec_flag, pat_expr_list) ->
+      let_bound_idents pat_expr_list @ defined_idents rem
+    | Tstr_primitive desc -> defined_idents rem
+    | Tstr_type decls -> defined_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ defined_idents rem
+    | Tstr_exception ext -> ext.ext_id :: defined_idents rem
+    | Tstr_module mb -> mb.mb_id :: defined_idents rem
+    | Tstr_recmodule decls ->
+      List.map (fun mb -> mb.mb_id) decls @ defined_idents rem
+    | Tstr_modtype _ -> defined_idents rem
+    | Tstr_open _ -> defined_idents rem
+    | Tstr_class cl_list ->
+      List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem
+    | Tstr_class_type cl_list -> defined_idents rem
+    | Tstr_include incl ->
+      bound_value_identifiers incl.incl_type @ defined_idents rem
+    | Tstr_attribute _ -> defined_idents rem
+
+(* second level idents (module M = struct ... let id = ... end),
+   and all sub-levels idents *)
+let rec more_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval (expr, _attrs) -> more_idents rem
+    | Tstr_value(rec_flag, pat_expr_list) -> more_idents rem
+    | Tstr_primitive _ -> more_idents rem
+    | Tstr_type decls -> more_idents rem
+    | Tstr_typext tyext -> more_idents rem
+    | Tstr_exception _ -> more_idents rem
+    | Tstr_recmodule decls -> more_idents rem
+    | Tstr_modtype _ -> more_idents rem
+    | Tstr_open _ -> more_idents rem
+    | Tstr_class cl_list -> more_idents rem
+    | Tstr_class_type cl_list -> more_idents rem
+    | Tstr_include _ -> more_idents rem
+    | Tstr_module {mb_expr={mod_desc = Tmod_structure str}} ->
+        all_idents str.str_items @ more_idents rem
+    | Tstr_module _ -> more_idents rem
+    | Tstr_attribute _ -> more_idents rem
 
+and all_idents = function
+    [] -> []
+  | item :: rem ->
+    match item.str_desc with
+    | Tstr_eval (expr, _attrs) -> all_idents rem
+    | Tstr_value(rec_flag, pat_expr_list) ->
+      let_bound_idents pat_expr_list @ all_idents rem
+    | Tstr_primitive _ -> all_idents rem
+    | Tstr_type decls -> all_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ all_idents rem
+    | Tstr_exception ext -> ext.ext_id :: all_idents rem
+    | Tstr_recmodule decls ->
+      List.map (fun mb -> mb.mb_id) decls @ all_idents rem
+    | Tstr_modtype _ -> all_idents rem
+    | Tstr_open _ -> all_idents rem
+    | Tstr_class cl_list ->
+      List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem
+    | Tstr_class_type cl_list -> all_idents rem
+    | Tstr_include incl ->
+      bound_value_identifiers incl.incl_type @ all_idents rem
+    | Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}} ->
+        mb_id :: all_idents str.str_items @ all_idents rem
+    | Tstr_module mb -> mb.mb_id :: all_idents rem
+    | Tstr_attribute _ -> all_idents rem
 
-let swap args = 
-  int64_call "swap" args
 
-(* Safe constant propgation 
-   {[
-     Number.MAX_SAFE_INTEGER:
-       Math.pow(2,53) - 1
-   ]}
-   {[
-     Number.MIN_SAFE_INTEGER:
-       - (Math.pow(2,53) -1)
-   ]}
-   Note that [Number._SAFE_INTEGER] is in ES6, 
-   we can hard code this number without bringing browser issue.
-*)
-let of_float (args : J.expression list ) = 
-  int64_call "of_float" args
+(* A variant of transl_structure used to compile toplevel structure definitions
+   for the native-code compiler. Store the defined values in the fields
+   of the global as soon as they are defined, in order to reduce register
+   pressure.  Also rewrites the defining expressions so that they
+   refer to earlier fields of the structure through the fields of
+   the global, not by their names.
+   "map" is a table from defined idents to (pos in global block, coercion).
+   "prim" is a list of (pos in global block, primitive declaration). *)
 
-let compare (args : J.expression list) = 
-  int64_call "compare" args 
+let transl_store_subst = ref Ident.empty
+  (** In the native toplevel, this reference is threaded through successive
+      calls of transl_store_structure *)
+
+let nat_toplevel_name id =
+  try match Ident.find_same id !transl_store_subst with
+    | Lprim(Pfield (pos, _), [Lprim(Pgetglobal glob, [], _)] ,_) -> (glob,pos)
+    | _ -> raise Not_found
+  with Not_found ->
+    fatal_error("Translmod.nat_toplevel_name: " ^ Ident.unique_name id)
 
-let of_string (args : J.expression list) = 
-  int64_call "of_string" args 
-let discard_sign (args : J.expression list) =
-  int64_call "discard_sign" args
-let div_mod (args : J.expression list) =
-  int64_call "div_mod" args
-let to_hex (args : J.expression list) =
-  int64_call "to_hex"  args
-let get64 = int64_call "get64"
-let float_of_bits  =  int64_call "float_of_bits" 
-let bits_of_float = int64_call "bits_of_float"
-let to_float (args : J.expression list ) = 
-  match args with
-  (* | [ {expression_desc  *)
-  (*      = Caml_block (  *)
-  (*          [lo =  *)
-  (*           {expression_desc = Number (Int {i = lo; _}) }; *)
-  (*           hi =  *)
-  (*           {expression_desc = Number (Int {i = hi; _}) }; *)
-  (*          ], _, _, _); _ }]  *)
-  (*   ->  *)
-    
-  | [ _ ] -> 
-      int64_call "to_float" args
-  | _ -> 
-    assert false    
+let transl_store_structure glob map prims str =
+  let rec transl_store rootpath subst = function
+    [] ->
+      transl_store_subst := subst;
+        lambda_unit
+    | item :: rem ->
+        match item.str_desc with
+  | Tstr_eval (expr, _attrs) ->
+      Lsequence(subst_lambda subst (transl_exp expr),
+                transl_store rootpath subst rem)
+  | Tstr_value(rec_flag, pat_expr_list) ->
+      let ids = let_bound_idents pat_expr_list in
+      let lam = transl_let rec_flag pat_expr_list (store_idents Location.none ids) in
+      Lsequence(subst_lambda subst lam,
+                transl_store rootpath (add_idents false ids subst) rem)
+  | Tstr_primitive descr ->
+      record_primitive descr.val_val;
+      transl_store rootpath subst rem
+  | Tstr_type decls ->
+      transl_store rootpath subst rem
+  | Tstr_typext(tyext) ->
+      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
+      let lam =
+        transl_type_extension item.str_env rootpath tyext (store_idents Location.none ids)
+      in
+        Lsequence(subst_lambda subst lam,
+                  transl_store rootpath (add_idents false ids subst) rem)
+  | Tstr_exception ext ->
+      let id = ext.ext_id in
+      let path = field_path rootpath id in
+      let lam = transl_extension_constructor item.str_env path ext in
+      Lsequence(Llet(Strict, id, subst_lambda subst lam, store_ident ext.ext_loc id),
+                transl_store rootpath (add_ident false id subst) rem)
+  | Tstr_module{mb_id=id; mb_expr={mod_desc = Tmod_structure str}; mb_loc = loc} ->
+    let lam = transl_store (field_path rootpath id) subst str.str_items in
+      (* Careful: see next case *)
+    let subst = !transl_store_subst in
+    Lsequence(lam,
+              Llet(Strict, id,
+                   subst_lambda subst
+                   (Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
+                          List.map (fun id -> Lvar id)
+                                   (defined_idents str.str_items),loc)),
+                   Lsequence(store_ident loc id,
+                             transl_store rootpath (add_ident true id subst)
+                                          rem)))
+  | Tstr_module{mb_id=id; mb_expr=modl; mb_loc = loc} ->
+      let lam = transl_module Tcoerce_none (field_path rootpath id) modl in
+      (* Careful: the module value stored in the global may be different
+         from the local module value, in case a coercion is applied.
+         If so, keep using the local module value (id) in the remainder of
+         the compilation unit (add_ident true returns subst unchanged).
+         If not, we can use the value from the global
+         (add_ident true adds id -> Pgetglobal... to subst). *)
+      Llet(Strict, id, subst_lambda subst lam,
+        Lsequence(store_ident loc id,
+                  transl_store rootpath (add_ident true id subst) rem))
+  | Tstr_recmodule bindings ->
+      let ids = List.map (fun mb -> mb.mb_id) bindings in
+      compile_recmodule
+        (fun id modl ->
+          subst_lambda subst
+            (transl_module Tcoerce_none
+                           (field_path rootpath id) modl))
+        bindings
+        (Lsequence(store_idents Location.none ids,
+                   transl_store rootpath (add_idents true ids subst) rem))
+  | Tstr_class cl_list ->
+      let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
+      let lam =
+        Lletrec(List.map
+              (fun (ci, meths, vf) ->
+                let id = ci.ci_id_class in
+                let cl = ci.ci_expr in
+                     (id, transl_class ids id meths cl vf))
+                  cl_list,
+                store_idents Location.none ids) in
+      Lsequence(subst_lambda subst lam,
+                transl_store rootpath (add_idents false ids subst) rem)
+  | Tstr_include incl ->
+      let ids = bound_value_identifiers incl.incl_type in
+      let modl = incl.incl_mod in
+      let mid = Ident.create "include" in
+      let loc = incl.incl_loc in
+      let rec store_idents pos = function
+        [] -> transl_store rootpath (add_idents true ids subst) rem
+      | id :: idl ->
+          Llet(Alias, id, Lprim(Pfield (pos, Fld_na), [Lvar mid],loc),
+               Lsequence(store_ident loc id, store_idents (pos + 1) idl)) in
+      Llet(Strict, mid,
+           subst_lambda subst (transl_module Tcoerce_none None modl),
+           store_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_store rootpath subst rem
 
-end
-module Js_of_lam_block : sig 
-#1 "js_of_lam_block.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+  and store_ident loc id =
+    try
+      let (pos, cc) = Ident.find_same id map in
+      let init_val = apply_coercion loc Alias cc (Lvar id) in
+      Lprim(Psetfield(pos, false, Fld_set_na), [Lprim(Pgetglobal glob, [], loc); init_val], loc)
+    with Not_found ->
+      fatal_error("Translmod.store_ident: " ^ Ident.unique_name id)
 
+  and store_idents loc idlist =
+    make_sequence (store_ident loc) idlist
 
+  and add_ident may_coerce id subst =
+    try
+      let (pos, cc) = Ident.find_same id map in
+      match cc with
+        Tcoerce_none ->
+          Ident.add id (Lprim(Pfield (pos, Fld_na), [Lprim(Pgetglobal glob, [], Location.none)], Location.none)) subst
+      | _ ->
+          if may_coerce then subst else assert false
+    with Not_found ->
+      assert false
 
+  and add_idents may_coerce idlist subst =
+    List.fold_right (add_ident may_coerce) idlist subst
 
+  and store_primitive (pos, prim) cont =
+    Lsequence(Lprim(Psetfield(pos, false, Fld_set_na),
+                    [Lprim(Pgetglobal glob, [], Location.none);
+                     transl_primitive Location.none prim], Location.none),
+              cont)
 
+  in List.fold_right store_primitive prims
+                     (transl_store (global_path glob) !transl_store_subst str)
 
+(* Transform a coercion and the list of value identifiers defined by
+   a toplevel structure into a table [id -> (pos, coercion)],
+   with [pos] being the position in the global block where the value of
+   [id] must be stored, and [coercion] the coercion to be applied to it.
+   A given identifier may appear several times
+   in the coercion (if it occurs several times in the signature); remember
+   to assign it the position of its last occurrence.
+   Identifiers that are not exported are assigned positions at the
+   end of the block (beyond the positions of all exported idents).
+   Also compute the total size of the global block,
+   and the list of all primitives exported as values. *)
 
+let build_ident_map restr idlist more_ids =
+  let rec natural_map pos map prims = function
+    [] ->
+      (map, prims, pos)
+  | id :: rem ->
+      natural_map (pos+1) (Ident.add id (pos, Tcoerce_none) map) prims rem in
+  let (map, prims, pos) =
+    match restr with
+        Tcoerce_none ->
+          natural_map 0 Ident.empty [] idlist
+      | Tcoerce_structure (pos_cc_list, _id_pos_list) ->
+              (* ignore _id_pos_list as the ids are already bound *)
+        let idarray = Array.of_list idlist in
+        let rec export_map pos map prims undef = function
+        [] ->
+          natural_map pos map prims undef
+          | (source_pos, Tcoerce_primitive (_,p)) :: rem ->
+            export_map (pos + 1) map ((pos, p) :: prims) undef rem
+          | (source_pos, cc) :: rem ->
+            let id = idarray.(source_pos) in
+            export_map (pos + 1) (Ident.add id (pos, cc) map)
+              prims (list_remove id undef) rem
+        in export_map 0 Ident.empty [] idlist pos_cc_list
+      | _ ->
+        fatal_error "Translmod.build_ident_map"
+  in
+  natural_map pos map prims more_ids
 
-(** Utilities for creating block of lambda expression in JS IR *)
+(* Compile an implementation using transl_store_structure
+   (for the native-code compiler). *)
 
-val make_block : 
-  Js_op.mutable_flag -> Lambda.tag_info ->
-  J.expression -> J.expression list -> J.expression
+let transl_store_gen module_name ({ str_items = str }, restr) topl =
+  reset_labels ();
+  primitive_declarations := [];
+  let module_id = Ident.create_persistent module_name in
+  let (map, prims, size) =
+    build_ident_map restr (defined_idents str) (more_idents str) in
+  let f = function
+    | [ { str_desc = Tstr_eval (expr, _attrs) } ] when topl ->
+        assert (size = 0);
+        subst_lambda !transl_store_subst (transl_exp expr)
+    | str -> transl_store_structure module_id map prims str in
+  transl_store_label_init module_id size f str
+  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
 
-val field : Lambda.field_dbg_info -> J.expression -> J.jsint -> J.expression
+let transl_store_phrases module_name str =
+  transl_store_gen module_name (str,Tcoerce_none) true
 
-val set_field : 
-  Lambda.set_field_dbg_info -> 
-  J.expression -> J.jsint -> J.expression -> J.expression
+let transl_store_implementation module_name (str, restr) =
+  let s = !transl_store_subst in
+  transl_store_subst := Ident.empty;
+  let r = transl_store_gen module_name (str, restr) false in
+  transl_store_subst := s;
+  r
 
+(* Compile a toplevel phrase *)
 
-end = struct
-#1 "js_of_lam_block.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let toploop_ident = Ident.create_persistent "Toploop"
+let toploop_getvalue_pos = 0 (* position of getvalue in module Toploop *)
+let toploop_setvalue_pos = 1 (* position of setvalue in module Toploop *)
 
+let aliased_idents = ref Ident.empty
 
+let set_toplevel_unique_name id =
+  aliased_idents :=
+    Ident.add id (Ident.unique_toplevel_name id) !aliased_idents
 
+let toplevel_name id =
+  try Ident.find_same id !aliased_idents
+  with Not_found -> Ident.name id
 
+let toploop_getvalue id =
+  Lapply(Lprim(Pfield (toploop_getvalue_pos, Fld_na),
+                 [Lprim(Pgetglobal toploop_ident, [], Location.none)], Location.none),
+         [Lconst(Const_base(Const_string (toplevel_name id, None)))],
+         Location.none)
 
+let toploop_setvalue id lam =
+  Lapply(Lprim(Pfield (toploop_setvalue_pos, Fld_na),
+                 [Lprim(Pgetglobal toploop_ident, [], Location.none)], Location.none),
+         [Lconst(Const_base(Const_string (toplevel_name id, None))); lam],
+         Location.none)
 
+let toploop_setvalue_id id = toploop_setvalue id (Lvar id)
 
+let close_toplevel_term lam =
+  IdentSet.fold (fun id l -> Llet(Strict, id, toploop_getvalue id, l))
+                (free_variables lam) lam
 
-module E = Js_exp_make
+let transl_toplevel_item item =
+  match item.str_desc with
+    Tstr_eval (expr, _attrs) ->
+      transl_exp expr
+  | Tstr_value(rec_flag, pat_expr_list) ->
+      let idents = let_bound_idents pat_expr_list in
+      transl_let rec_flag pat_expr_list
+                 (make_sequence toploop_setvalue_id idents)
+  | Tstr_typext(tyext) ->
+      let idents =
+        List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      in
+        transl_type_extension item.str_env None tyext
+          (make_sequence toploop_setvalue_id idents)
+  | Tstr_exception ext ->
+      toploop_setvalue ext.ext_id
+        (transl_extension_constructor item.str_env None ext)
+  | Tstr_module {mb_id=id; mb_expr=modl} ->
+      (* we need to use the unique name for the module because of issues
+         with "open" (PR#1672) *)
+      set_toplevel_unique_name id;
+      let lam = transl_module Tcoerce_none (Some(Pident id)) modl in
+      toploop_setvalue id lam
+  | Tstr_recmodule bindings ->
+      let idents = List.map (fun mb -> mb.mb_id) bindings in
+      compile_recmodule
+        (fun id modl -> transl_module Tcoerce_none (Some(Pident id)) modl)
+        bindings
+        (make_sequence toploop_setvalue_id idents)
+  | Tstr_class cl_list ->
+      (* we need to use unique names for the classes because there might
+         be a value named identically *)
+      let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
+      List.iter set_toplevel_unique_name ids;
+      Lletrec(List.map
+          (fun (ci, meths, vf) ->
+            let id = ci.ci_id_class in
+            let cl = ci.ci_expr in
+                   (id, transl_class ids id meths cl vf))
+                cl_list,
+              make_sequence
+                (fun (ci, _, _) -> toploop_setvalue_id ci.ci_id_class)
+                cl_list)
+  | Tstr_include incl ->
+      let ids = bound_value_identifiers incl.incl_type in
+      let modl = incl.incl_mod in
+      let mid = Ident.create "include" in
+      let rec set_idents pos = function
+        [] ->
+          lambda_unit
+      | id :: ids ->
+          Lsequence(toploop_setvalue id (Lprim(Pfield (pos, Fld_na), [Lvar mid], Location.none)),
+                    set_idents (pos + 1) ids) in
+      Llet(Strict, mid, transl_module Tcoerce_none None modl, set_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      lambda_unit
 
-(* TODO: it would be even better, if the [tag_info] contains more information
-   about immutablility
- *)
-let make_block mutable_flag (tag_info : Lambda.tag_info) tag args  = 
+let transl_toplevel_item_and_close itm =
+  close_toplevel_term (transl_label_init (transl_toplevel_item itm))
 
-  match mutable_flag, tag_info with
-  | _, Blk_array -> Js_of_lam_array.make_array mutable_flag  Pgenarray args
-  | _ , _ -> E.make_block tag tag_info args mutable_flag
-  (* | _, (  Tuple | Variant _ ) -> (\** TODO: check with inline record *\) *)
-  (*     E.arr Immutable *)
-  (*       (E.small_int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
-  (*        :: args) *)
-  (* | _, _  ->  *)
-  (*     E.arr mutable_flag *)
-  (*       (E.int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
-  (*        :: args) *)
+let transl_toplevel_definition str =
+  reset_labels ();
+  make_sequence transl_toplevel_item_and_close str.str_items
 
-let field field_info e i =
-  match field_info with 
-  | Lambda.Fld_na -> 
-    E.index e i 
-  | Lambda.Fld_record s 
-  | Lambda.Fld_module s 
-    -> E.index ~comment:s e i
+(* Compile the initialization code for a packed library *)
 
+let get_component = function
+    None -> Lconst const_unit
+  | Some id -> Lprim(Pgetglobal id, [], Location.none)
 
+let transl_package component_names target_name coercion =
+  let components =
+    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), List.map get_component component_names, Location.none) in
+  Lprim(Psetglobal target_name, [apply_coercion Location.none Strict coercion components], Location.none)
+  (*
+  let components =
+    match coercion with
+      Tcoerce_none ->
+        List.map get_component component_names
+    | Tcoerce_structure (pos_cc_list, id_pos_list) ->
+              (* ignore id_pos_list as the ids are already bound *)
+        let g = Array.of_list component_names in
+        List.map
+          (fun (pos, cc) -> apply_coercion Strict cc (get_component g.(pos)))
+          pos_cc_list
+    | _ ->
+        assert false in
+  Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
+   *)
 
-let set_field field_info e i e0 =
-  let comment = 
-    match field_info with 
-    | Lambda.Fld_set_na 
-      -> None
-    | Fld_record_set s -> Some (s)
-  in (* see GPR#631*)
-  E.index_addr ?comment e i  ~no:e0 ~yes:(fun v -> E.assign v e0)
+let transl_store_package component_names target_name coercion =
+  let rec make_sequence fn pos arg =
+    match arg with
+      [] -> lambda_unit
+    | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in
+  match coercion with
+    Tcoerce_none ->
+      (List.length component_names,
+       make_sequence
+         (fun pos id ->
+           Lprim(Psetfield(pos, false, Fld_set_na),
+                 [Lprim(Pgetglobal target_name, [], Location.none);
+                  get_component id], Location.none))
+         0 component_names)
+  | Tcoerce_structure (pos_cc_list, id_pos_list) ->
+      let components =
+        Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), List.map get_component component_names, Location.none)
+      in
+      let blk = Ident.create "block" in
+      (List.length pos_cc_list,
+       Llet (Strict, blk, apply_coercion Location.none Strict coercion components,
+             make_sequence
+               (fun pos id ->
+                 Lprim(Psetfield(pos, false, Fld_set_na),
+                       [Lprim(Pgetglobal target_name, [], Location.none);
+                        Lprim(Pfield (pos, Fld_na), [Lvar blk], Location.none)], Location.none))
+               0 pos_cc_list))
+  (*
+              (* ignore id_pos_list as the ids are already bound *)
+      let id = Array.of_list component_names in
+      (List.length pos_cc_list,
+       make_sequence
+         (fun dst (src, cc) ->
+           Lprim(Psetfield(dst, false),
+                 [Lprim(Pgetglobal target_name, []);
+                  apply_coercion Strict cc (get_component id.(src))]))
+         0 pos_cc_list)
+  *)
+  | _ -> assert false
 
+(* Error report *)
 
+open Format
 
+let report_error ppf = function
+    Circular_dependency id ->
+      fprintf ppf
+        "@[Cannot safely evaluate the definition@ \
+         of the recursively-defined module %a@]"
+        Printtyp.ident id
 
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (loc, err) ->
+        Some (Location.error_of_printer loc report_error err)
+      | _ ->
+        None
+    )
 
+let reset () =
+  export_identifiers := [];
+  primitive_declarations := [];
+  transl_store_subst := Ident.empty;
+  toploop_ident.Ident.flags <- 0;
+  aliased_idents := Ident.empty
 
 end
-module Js_of_lam_string : sig 
-#1 "js_of_lam_string.mli"
+module Type_int_to_string
+= struct
+#1 "type_int_to_string.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -77589,37 +78247,36 @@ module Js_of_lam_string : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+let name_of_signature_item (x : Types.signature_item )=
+  match x with 
+  | Sig_value (i,_) 
+  | Sig_module (i,_,_) -> i 
+  | Sig_typext (i,_,_) -> i 
+  | Sig_modtype(i,_) -> i 
+  | Sig_class (i,_,_) -> i 
+  | Sig_class_type(i,_,_) -> i 
+  | Sig_type(i,_,_) -> i  
 
 
+(** It should be safe to replace Pervasives[], 
+    we should test cases  like module Pervasives = List *)
+let serializable_signature =
+  (fun x ->
+     match (x : Types.signature_item) with 
+     | Sig_value(_, {val_kind = Val_prim _}) -> false
+     | Sig_typext _ 
+     | Sig_module _
+     | Sig_class _ 
+     | Sig_value _ -> true
+     | _ -> false)
+  
+let filter_serializable_signatures (signature : Types.signature)
+  : Types.signature = 
+  List.filter serializable_signature signature
 
-
-
-
-
-(** Utilities to wrap [string] and [bytes] compilation, 
-
-   this is isolated, so that we can swap different representation in the future.
-   [string] is Immutable, so there is not [set_string] method
-*)
-
-val ref_string : J.expression -> J.expression -> J.expression
-
-val ref_byte : J.expression -> J.expression -> J.expression
-
-val set_byte : J.expression -> J.expression -> J.expression -> J.expression 
-
-val caml_char_of_int : ?comment:string -> J.expression -> J.expression
-
-val caml_char_to_int : ?comment:string -> J.expression -> J.expression
-
-val const_char : char -> J.expression
-
-val bytes_to_string : J.expression -> J.expression
-
-val bytes_of_string : J.expression -> J.expression
-
-end = struct
-#1 "js_of_lam_string.ml"
+end
+module Type_util : sig 
+#1 "type_util.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -77651,118 +78308,28 @@ end = struct
 
 
 
+(** Utilities for quering typing inforaation from {!Env.t}, this part relies
+    on compiler API
+*)
 
-module E = Js_exp_make
-
-module A = struct 
-
-  let const_char (i : char) = 
-    E.str (String.make 1 i)
-
-  let caml_char_of_int ?comment (v : J.expression)  =  
-    E.char_of_int ?comment v
-
-  let caml_char_to_int ?comment v =  
-    E.char_to_int ?comment v
-
-  (* string [s[i]] expects to return a [ocaml_char] *)
-  let ref_string e e1 = 
-    E.string_access e e1
-
-  (* [s[i]] excepts to return a [ocaml_char]
-     We use normal array for [bytes]
-     TODO: we can use [Buffer] in the future 
-   *)
-  let ref_byte e e0  =
-    E.char_of_int (E.access  e  e0)
-
-  (* {Bytes.set : bytes -> int -> char -> unit }*)
-  let set_byte  e e0 e1 = 
-    E.assign (E.access e e0)  (E.char_to_int e1)
-
-(*
-   Note that [String.fromCharCode] also works, but it only 
-   work for small arrays, however, for {bytes_to_string} it is likely the bytes 
-   will become big
-   {[
-   String.fromCharCode.apply(null,[87,97])
-   "Wa"
-   String.fromCharCode(87,97)
-   "Wa" 
-   ]}
-   This does not work for large arrays
-   {[
-   String.fromCharCode.apply(null, prim = Array[1048576]) 
-   Maxiume call stack size exceeded
-   ]}
- *)
-
-  let bytes_to_string e = 
-    E.runtime_call Js_config.string "bytes_to_string" [e]
-
-  let bytes_of_string s =
-    E.runtime_call Js_config.string "bytes_of_string" [s]
-end
-
-(* We use module B for string compilation, once the upstream can make changes to the 
-    patten match of range patterns, we can use module [A] which means [char] is [string] in js, 
-    currently, it follows the same patten of ocaml, [char] is [int]
- *)
-
-module B = struct 
-
-  let const_char (i : char) = 
-    E.int  ~comment:("\"" ^ Ext_string.escaped (String.make 1 i) ^ "\"") 
-      ~c:i (Int32.of_int @@ Char.code i)
-
-  let caml_char_of_int ?comment (v : J.expression)  =  v
 
-  let caml_char_to_int ?comment v =  v
+val get_name : Types.signature -> int -> string
 
-  (* string [s[i]] expects to return a [ocaml_char] *)
-  let ref_string e e1 = 
-    E.char_to_int (E.string_access e e1)
 
-  (* [s[i]] excepts to return a [ocaml_char]
-     We use normal array for [bytes]
-     TODO: we can use [Buffer] in the future 
-   *)
-  let ref_byte e e0  = E.access  e  e0
+(* Input path is a global module 
+    TODO: it should be fine for local module*)
+val find_serializable_signatures_by_path :
+  Ident.t -> Env.t -> Types.signature option
 
-  (* {Bytes.set : bytes -> int -> char -> unit }*)
-  let set_byte  e e0 e1 = 
-    E.assign (E.access e e0)  e1
 
-(**
-   Note that [String.fromCharCode] also works, but it only 
-   work for small arrays, however, for {bytes_to_string} it is likely the bytes 
-   will become big
-   {[
-   String.fromCharCode.apply(null,[87,97])
-   "Wa"
-   String.fromCharCode(87,97)
-   "Wa" 
-   ]}
-   This does not work for large arrays
-   {[
-   String.fromCharCode.apply(null, prim = Array[1048576]) 
-   Maxiume call stack size exceeded
-   ]}
- *)
+(* val find_name : *)
+(*   Ident.t -> int -> Env.t -> string option *)
 
-  let bytes_to_string e = 
-    E.runtime_call Js_config.string "bytes_to_string" [e]
 
-  let bytes_of_string s =
-    E.runtime_call Js_config.string "bytes_of_string" [s]
-end
 
-(* include A *)
-include B
 
-end
-module Lam_compile_const : sig 
-#1 "lam_compile_const.mli"
+end = struct
+#1 "type_util.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -77789,17 +78356,45 @@ module Lam_compile_const : sig
 
 
 
+(* Input path is a global module 
+    TODO: it should be fine for local module
+*)
+let find_serializable_signatures_by_path v (env : Env.t) 
+  : Types.signature option = 
+  match Env.find_module (Pident v) env with 
+  | exception Not_found -> None 
+  | {md_type = Mty_signature signature; _} -> 
+    Some (Type_int_to_string.filter_serializable_signatures signature)
+  (** TODO: refine *)
+  | _ -> Ext_log.err __LOC__  "@[impossible path %s@]@."
+           (Ident.name v) ; assert false 
+
+let rec dump_summary fmt (x : Env.summary) = 
+  match x with 
+  | Env_empty -> ()
+  | Env_value(s,id,value_description) -> 
+    dump_summary fmt s ;
+    Printtyp.value_description id fmt value_description
+  | _ -> ()
 
+(** Used in [Pgetglobal] *)
+let get_name  (serializable_sigs : Types.signature) (pos : int) = 
+  Ident.name @@ Type_int_to_string.name_of_signature_item @@ List.nth  serializable_sigs  pos
 
+(* let find_name id pos env = *)
+(*   match find_serializable_signatures_by_path id env with *)
+(*   | Some signatures -> *)
+(*     Some (get_name signatures pos) *)
+(*   | None -> None       *)
 
 
 
-(** Compile lambda constant to JS *)
+    
 
-val translate : Lambda.structured_constant -> J.expression
 
-end = struct
-#1 "lam_compile_const.ml"
+end
+module Lam_compile_env : sig 
+#1 "lam_compile_env.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -77831,110 +78426,85 @@ end = struct
 
 
 
-module E = Js_exp_make
+(** Helper for global Ocaml module index into meaningful names  *) 
 
-let rec translate (x : Lambda.structured_constant ) : J.expression = 
-  match x with 
-  | Const_base c -> 
-    begin match c with 
-      | Const_int i -> E.int (Int32.of_int i)
-      | Const_char i ->
-        Js_of_lam_string.const_char i
-      | Const_int32 i -> E.int i 
-          (* E.float (Int32.to_string i) *)
-      | Const_int64 i -> 
-          (*
-            TODO:
-            {[
-            Int64.to_string 0x7FFFFFFFFFFFFFFFL;;
-            - : string = "9223372036854775807"
-            ]}
-            {[
-            Int64.(to_float max_int);;
-            - : float = 9.22337203685477581e+18
-            ]}
-            Note we should compile it to Int64 as JS's 
-            speical representation -- 
-            it is not representatble in JS number
-           *)
-          (* E.float (Int64.to_string i) *)
-        Js_long.of_const i
-        (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
-      | Const_nativeint i -> E.nint i 
-      | Const_float f -> E.float f (* TODO: preserve float *)
-      | Const_string (i,_) (*TODO: here inline js*) -> 
-        E.str i
-    end
+type primitive_description =  Primitive.description
 
-  | Const_pointer (c,pointer_info) -> 
-    E.int ?comment:(Lam_compile_util.comment_of_pointer_info pointer_info)
-      (Int32.of_int c )
+type key = 
+  Ident.t * Env.t * bool 
+  (** the boolean is expand or not
+      when it's passed as module, it should be expanded, 
+      otherwise for alias, [include Array], it's okay to return an identifier
+      TODO: be more clear about its concept
+  *)
+  (** we need register which global variable is an dependency *)
 
-  | Const_block(tag, tag_info, xs ) -> 
-    Js_of_lam_block.make_block NA tag_info 
-      (E.small_int  tag) (List.map translate xs)
 
-  | Const_float_array ars -> 
-    (* according to the compiler 
-        const_float_array is immutable 
-       {[ Lprim(Pccall prim_obj_dup, [master]) ]},
-        however, we can not translate 
-       {[ prim_obj_dup(x) =>  x' ]}
-        since x' is now mutable, prim_obj_dup does a copy,
+type ident_info = {
+  id : Ident.t;
+  name : string;
+  signatures : Types.signature;
+  arity : Lam.function_arities; 
+  closed_lambda : Lam.t option 
+}
 
-        the compiler does this  is mainly to extract common data into data section, 
-        we  deoptimized this in js backend? so it is actually mutable 
-    *)
-    (* TODO-- *)
-    Js_of_lam_array.make_array Mutable Pfloatarray 
-      (List.map (fun x ->  E.float  x ) ars)
-    (* E.arr Mutable ~comment:"float array" *)
-    (*   (List.map (fun x ->  E.float  x ) ars) *)
+type module_info = {
+  signature :  Types.signature ;
+  pure : bool 
+}
 
-  | Const_immstring s ->  (*TODO *)
-    E.str s  (* TODO: check *)
+type _ t = 
+  | No_env :  Js_cmj_format.t t 
+  | Has_env : Env.t  -> module_info t 
 
-end
-module Js_of_lam_exception : sig 
-#1 "js_of_lam_exception.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+val find_and_add_if_not_exist : 
+  Ident.t * int -> 
+  Env.t -> 
+  not_found:(Ident.t -> 'a) -> 
+  found:(ident_info -> 'a) -> 'a
 
+val query_and_add_if_not_exist : 
+  Lam_module_ident.t ->
+  'a t -> not_found:(unit -> 'b) ->
+  found:('a -> 'b) -> 'b
 
+val add_js_module : ?id:Ident.t -> string  -> Ident.t 
+(** add third party dependency *)
+
+(* The other dependencies are captured by querying 
+   either when [access] or when expansion, 
+   however such dependency can be removed after inlining etc.
 
+   When we register such compile time dependency we classified 
+   it as 
+   Visit (ml), Builtin(built in js), External()
 
+   For external, we never remove, we only consider 
+   remove dependency for Runtime and Visit, so 
+   when compile OCaml to Javascript, we only need 
+   pay attention to for those modules are actually used or not
+*)
 
+val reset : unit -> unit 
 
-  
-val get_builtin_by_name : string -> J.expression
+val is_pure : Lam_module_ident.t -> bool
 
+val get_package_path_from_cmj : 
+  Lam_module_ident.system -> Lam_module_ident.t -> 
+  Js_config.info_query
 
 
-val caml_set_oo_id : J.expression list -> J.expression
+(* The second argument is mostly from [runtime] modules 
+    will change the input [hard_dependencies]
+*)
+val get_requried_modules : 
+  Env.t ->
+  Lam_module_ident.t list ->
+  Lam_module_ident.t Hash_set_poly.t -> 
+  Lam_module_ident.t list
 
 end = struct
-#1 "js_of_lam_exception.ml"
+#1 "lam_compile_env.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -77964,59 +78534,236 @@ end = struct
 
 
 
-(** An pattern match on {!caml_set_oo_id args}
-    Note that in the trunk, it is immutable by default now 
- *)
-module E = Js_exp_make 
 
-let match_exception_def (args : J.expression list) = 
-  match args with   
-  | [{ expression_desc  = 
-               Caml_block (
-                 [ exception_str; 
-                   {expression_desc = J.Number (Int { i = 0l; _}); _}
-                 ],
-                 mutable_flag, 
-                 {expression_desc = J.Number (Int {i = object_tag; _}); _}, _ );
-              _} ] -> 
-    if object_tag = 248l (* Obj.object_tag *) then
-      Some ( exception_str, mutable_flag)    
-    else
-      None
-  | _ -> None
 
-(* Sync up with [caml_set_oo_id] 
-   Note if we inline {!Caml_exceptions.create}, 
-   it seems can be useful for optimizations in theory, 
-   in practice, it never happen, since the pattern match 
-   never dig into it internally, so maybe {!Obj.set_tag} 
-   is not necessary at all
-*)
-let make_exception exception_str mutable_flag : J.expression = 
-  E.runtime_call Js_config.exceptions Literals.create [exception_str]
+module E = Js_exp_make  
+module S = Js_stmt_make
+
+type module_id = Lam_module_ident.t
+
+type ml_module_info = { 
+  signatures : Types.signature ;
+  cmj_table : Js_cmj_format.t
+}
+
+type env_value = 
+  | Visit of ml_module_info
+  | Runtime  of bool * Js_cmj_format.t
+  (** A built in module probably from our runtime primitives, 
+      so it does not have any [signature]
+  *)
+  | External  
+  (** Also a js file, but this belong to third party 
+  *)
+
+type module_info = {
+  signature :  Types.signature ;
+  pure : bool 
+}
+
+type primitive_description =  Primitive.description
+
+type key = 
+  Ident.t * Env.t  * bool (** we need register which global variable is an dependency *)
+
+
+type ident_info = {
+  id : Ident.t;
+  name : string;
+  signatures : Types.signature;
+  arity : Lam.function_arities; 
+  closed_lambda : Lam.t option 
+}
+
+(*
+   refer: [Env.find_pers_struct]
+   [ find_in_path_uncap !load_path (name ^ ".cmi")]
+*)
+
+
+
+let cached_tbl  = Lam_module_ident.Hash.create 31
+
+(* For each compilation we need reset to make it re-entrant *)
+let reset () = 
+  Translmod.reset ();
+  Lam_module_ident.Hash.clear cached_tbl 
+
+(* FIXME: JS external instead *)
+let add_js_module ?id module_name = 
+  let id = 
+    match id with
+    | None -> Ext_ident.create_js_module module_name 
+    | Some id -> id in
+  Lam_module_ident.Hash.replace cached_tbl (Lam_module_ident.of_external id module_name) External;
+  id  
+
+
+
+let add_cached_tbl = Lam_module_ident.Hash.add cached_tbl
+
+let find_and_add_if_not_exist (id, pos) env ~not_found ~found =
+  let oid  = Lam_module_ident.of_ml id in
+  begin match Lam_module_ident.Hash.find_opt cached_tbl oid with 
+    | None -> 
+      let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in
+      begin match
+          Type_util.find_serializable_signatures_by_path
+            ( id) env with 
+      | None -> not_found id 
+      | Some signature -> 
+        add_cached_tbl oid (Visit {signatures = signature; 
+                                   cmj_table ;  } ) ;
+        let name =  (Type_util.get_name signature pos ) in
+        let arity, closed_lambda =        
+          begin match String_map.find_opt name cmj_table.values with
+            | Some {arity; closed_lambda} -> arity, closed_lambda
+            | None -> NA, None 
+          end in
+        found {id; 
+               name ;
+               signatures = signature ;
+               arity ;
+               closed_lambda = 
+                 if Js_config.get_cross_module_inline () then
+                   closed_lambda
+                 else None
+              }
+      end
+    | Some (Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } ) -> 
+      let name = (Type_util.get_name serializable_sigs pos ) in
+      let arity , closed_lambda =  (
+        match  String_map.find_opt name values with
+        | Some {arity; closed_lambda;_} -> 
+          arity, closed_lambda 
+        | None -> (NA, None)
+      ) in
+      found { id;
+              name; 
+              signatures = serializable_sigs;
+              arity;
+              closed_lambda = 
+                if Js_config.get_cross_module_inline () then
+                  closed_lambda
+                else None
+              (* TODO shall we cache the arity ?*) 
+            } 
+    | Some (Runtime _) -> assert false
+    | Some External  -> assert false
+  end
+
+
+(* TODO: it does not make sense to cache
+   [Runtime] 
+   and [externals]*)
+type _ t = 
+  | No_env :  Js_cmj_format.t t 
+  | Has_env : Env.t  -> module_info t 
+
+
+let query_and_add_if_not_exist (type u)
+    (oid : Lam_module_ident.t) 
+    (env : u t) ~not_found ~found:(found : u -> _) =
+  match Lam_module_ident.Hash.find_opt cached_tbl oid with 
+  | None -> 
+    begin match oid.kind with
+      | Runtime  -> 
+        let cmj_table = 
+          Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in           
+        add_cached_tbl oid (Runtime (true,cmj_table)) ; 
+        begin match env with 
+        | Has_env _ -> 
+          found {signature = []; pure = true}
+        | No_env -> 
+          found cmj_table
+        end
+      | Ml 
+        -> 
+        let cmj_table = 
+          Config_util.find_cmj (Lam_module_ident.name oid ^ Js_config.cmj_ext) in           
+        begin match env with 
+          | Has_env env -> 
+            begin match 
+                Type_util.find_serializable_signatures_by_path ( oid.id) env with 
+            | None -> not_found () (* actually when [not_found] in the call site, we throw... *)
+            | Some signature -> 
+              add_cached_tbl oid (Visit {signatures = signature; cmj_table }) ;
+              found  { signature ; pure = cmj_table.effect = None} 
+            end
+          | No_env -> 
+            found cmj_table
+        end
+
+      | External _  -> 
+        add_cached_tbl oid External;
+        (** This might be wrong, if we happen to expand  an js module
+            we should assert false (but this in general should not happen)
+        *)
+        begin match env with 
+        | Has_env _ 
+          -> 
+          found {signature = []; pure = false}
+        | No_env -> 
+          found (Js_cmj_format.no_pure_dummy)
+        end
+
+    end
+  | Some (Visit {signatures  ; cmj_table =  cmj_table; _}) -> 
+    begin match env with 
+      | Has_env _ -> 
+        found   { signature =  signatures  ; pure = (cmj_table.effect = None)} 
+      | No_env  -> found cmj_table
+    end
+
+  | Some (Runtime (pure, cmj_table)) -> 
+    begin match env with 
+      | Has_env _ -> 
+        found {signature = []  ; pure }
+      | No_env -> 
+        found cmj_table
+    end
+  | Some External -> 
+    begin match env with 
+    | Has_env _ -> 
+      found {signature = []  ; pure  = false}
+    | No_env -> found Js_cmj_format.no_pure_dummy
+    end
+
+(* Conservative interface *)
+let is_pure id  = 
+  query_and_add_if_not_exist id No_env
+    ~not_found:(fun _ -> false) 
+    ~found:(fun x -> x.effect = None)
+
+
+    
 
+let get_package_path_from_cmj module_system ( id : Lam_module_ident.t) = 
+  query_and_add_if_not_exist id No_env
+    ~not_found:(fun _ -> `NotFound) 
+    ~found:(fun x -> Js_config.query_package_infos x.npm_package_path module_system)
 
 
+(* TODO: [env] is not hard dependency *)
 
-let get_builtin_by_name name = 
-  E.runtime_ref Js_config.builtin_exceptions (String.lowercase name)
+let get_requried_modules env (extras : module_id list ) (hard_dependencies 
+  : _ Hash_set_poly.t) : module_id list =  
 
-let caml_set_oo_id args = 
-    begin match match_exception_def args with 
-    | Some ( exception_str, mutable_flag)
-      -> 
-      make_exception exception_str mutable_flag      
-    | _ ->
-      (**
-         If we can guarantee this code path is never hit, we can do 
-         a better job for encoding of exception and extension?
-      *)
-      E.runtime_call Js_config.exceptions "caml_set_oo_id" args 
-    end
+  let mem (x : Lam_module_ident.t) = 
+    not (is_pure x ) || Hash_set_poly.mem hard_dependencies  x 
+  in
+  Lam_module_ident.Hash.iter (fun (id : module_id)  _  ->
+      if mem id 
+      then Hash_set_poly.add hard_dependencies id) cached_tbl ;
+  List.iter (fun id -> 
+      if mem id 
+      then Hash_set_poly.add hard_dependencies id
+    ) extras;
+  Hash_set_poly.elements hard_dependencies
 
 end
-module Js_of_lam_float_record : sig 
-#1 "js_of_lam_float_record.mli"
+module Ext_pp : sig 
+#1 "ext_pp.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78046,134 +78793,65 @@ module Js_of_lam_float_record : sig
 
 
 
-(** Compile a special representation in OCaml when all fields are of type [float] 
-    check the invariant in {!Js_of_lam_array.make_array}
-*)
-
-val set_double_field : 
-  Lambda.set_field_dbg_info -> 
-  J.expression -> J.jsint -> 
-  J.expression -> J.expression
 
-val get_double_feild : 
-  Lambda.field_dbg_info -> 
-  J.expression -> J.jsint -> J.expression
 
-end = struct
-#1 "js_of_lam_float_record.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+(** A simple pretty printer
+    
+    Advantage compared with [Format], 
+    [P.newline] does not screw the layout, have better control when do a newline (sicne JS has ASI)
+    Easy to tweak
 
+    {ul 
+    {- be a little smarter}
+    {- buffer the last line, so that  we can do a smart newline, when it's really safe to do so}
+    }
+*)
+type t
 
+val indent_length : int 
 
+val string : t -> string -> unit
 
+val space :  t -> unit
 
+val nspace : t -> int ->  unit
 
-module E = Js_exp_make 
+val group : t -> int -> (unit -> 'a) -> 'a
+(** [group] will record current indentation 
+    and indent futher
+ *)
 
-let get_double_feild field_info e i = 
-  match field_info with 
-  | Lambda.Fld_na -> 
-    E.index e i 
-  | Lambda.Fld_record s 
-  | Lambda.Fld_module s 
-    -> E.index ~comment:s e i
+val vgroup : t -> int -> (unit -> 'a) -> 'a
 
+val paren : t -> (unit -> 'a) -> 'a
 
-let set_double_field field_info e  i e0 = 
-  let v = 
-    match field_info with 
-    | Lambda.Fld_set_na 
-      -> 
-      E.index e i 
-    | Fld_record_set s -> 
-      E.index ~comment:s e i in 
-  E.assign v  e0
+val brace : t -> (unit -> 'a) -> 'a
 
+val paren_group : t -> int -> (unit -> 'a) -> 'a
 
-end
-module Ast_literal : sig 
-#1 "ast_literal.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+val paren_vgroup : t -> int -> (unit -> 'a) -> 'a
 
+val brace_group : t -> int -> (unit -> 'a) -> 'a
 
-type 'a  lit = ?loc: Location.t -> unit -> 'a
-module Lid : sig
-  type t = Longident.t 
-  val val_unit : t 
-  val type_unit : t 
-  val js_fn : t 
-  val js_meth : t 
-  val js_meth_callback : t 
-  val js_obj : t 
+val brace_vgroup : t -> int -> (unit -> 'a) -> 'a
 
-  val ignore_id : t 
-  val js_null : t 
-  val js_undefined : t
-  val js_null_undefined : t 
-  val js_re_id : t 
-  val js_unsafe : t 
-end
+val bracket_group : t -> int -> (unit -> 'a) -> 'a
 
-type expression_lit = Parsetree.expression lit 
-type core_type_lit = Parsetree.core_type lit 
-type pattern_lit = Parsetree.pattern lit 
+val bracket_vgroup : t -> int -> (unit -> 'a) -> 'a
 
-val val_unit : expression_lit
+val newline : t -> unit
 
-val type_unit : core_type_lit
+val force_newline : t -> unit
+(** [force_newline] Always print a newline *)
 
-val type_string : core_type_lit
+val from_channel : out_channel -> t
 
-val type_any : core_type_lit
+val from_buffer : Buffer.t -> t
 
-val pat_unit : pattern_lit
+val flush : t -> unit -> unit
 
 end = struct
-#1 "ast_literal.ml"
+#1 "ext_pp.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78198,236 +78876,152 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-open Ast_helper
-
-
-module Lid = struct 
-  type t = Longident.t 
-  let val_unit : t = Lident "()"
-  let type_unit : t = Lident "unit"
-  let type_string : t = Lident "string"
-  (* TODO should be renamed in to {!Js.fn} *)
-  (* TODO should be moved into {!Js.t} Later *)
-  let js_fn = Longident.Ldot (Lident "Js", "fn")
-  let js_meth = Longident.Ldot (Lident "Js", "meth")
-  let js_meth_callback = Longident.Ldot (Lident "Js", "meth_callback")
-  let js_obj = Longident.Ldot (Lident "Js", "t") 
-  let ignore_id = Longident.Ldot (Lident "Pervasives", "ignore")
-  let js_null  = Longident.Ldot (Lident "Js", "null")
-  let js_undefined = Longident.Ldot (Lident "Js", "undefined")
-  let js_null_undefined = Longident.Ldot (Lident "Js", "null_undefined")
-  let js_re_id = Longident.Ldot (Lident "Js_re", "t")
-  let js_unsafe = Longident.Lident "Js_unsafe"
-end
-
-module No_loc = struct 
-  let loc = Location.none
-  let val_unit = 
-    Ast_helper.Exp.construct {txt = Lid.val_unit; loc }  None
-  let type_unit =   
-    Ast_helper.Typ.mk  (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
-
-  let type_string =   
-    Ast_helper.Typ.mk  (Ptyp_constr ({ txt = Lid.type_string; loc}, []))
-
-  let type_any = Ast_helper.Typ.any ()
-  let pat_unit = Pat.construct {txt = Lid.val_unit; loc} None
-end 
-
-type 'a  lit = ?loc: Location.t -> unit -> 'a
-type expression_lit = Parsetree.expression lit 
-type core_type_lit = Parsetree.core_type lit 
-type pattern_lit = Parsetree.pattern lit 
-
-let val_unit ?loc () = 
-  match loc with 
-  | None -> No_loc.val_unit
-  | Some loc -> Ast_helper.Exp.construct {txt = Lid.val_unit; loc}  None
 
 
-let type_unit ?loc () = 
-  match loc with
-  | None ->     
-    No_loc.type_unit
-  | Some loc -> 
-    Ast_helper.Typ.mk ~loc  (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
 
 
-let type_string ?loc () = 
-  match loc with 
-  | None -> No_loc.type_string 
-  | Some loc ->     
-    Ast_helper.Typ.mk ~loc  (Ptyp_constr ({ txt = Lid.type_string; loc}, []))
 
-let type_any ?loc () = 
-  match loc with 
-  | None -> No_loc.type_any
-  | Some loc -> Ast_helper.Typ.any ~loc ()
 
-let pat_unit ?loc () = 
-  match loc with 
-  | None -> No_loc.pat_unit
-  | Some loc -> 
-    Pat.construct ~loc {txt = Lid.val_unit; loc} None
 
+module L = struct 
+  let space = " "
+  let indent_str = "  "
 end
-module Ast_comb : sig 
-#1 "ast_comb.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
-
-
-val exp_apply_no_label : 
-  ?loc:Location.t ->
-  ?attrs:Parsetree.attributes ->
-  Parsetree.expression -> Parsetree.expression list -> Parsetree.expression
-
-val fun_no_label : 
-  ?loc:Location.t ->
-  ?attrs:Parsetree.attributes ->
-  Parsetree.pattern -> Parsetree.expression -> Parsetree.expression
-
-val arrow_no_label : 
-  ?loc:Location.t ->
-  ?attrs:Parsetree.attributes ->
-  Parsetree.core_type -> Parsetree.core_type -> Parsetree.core_type
 
-(* note we first declare its type is [unit], 
-   then [ignore] it, [ignore] is necessary since 
-   the js value  maybe not be of type [unit] and 
-   we can use [unit] value (though very little chance) 
-   sometimes
-*)
-val discard_exp_as_unit : 
-  Location.t -> Parsetree.expression -> Parsetree.expression
+let indent_length = String.length L.indent_str 
 
+type t = {
+  output_string : string -> unit;
+  output_char : char -> unit; 
+  flush : unit -> unit;
+  mutable indent_level : int;
+  mutable last_new_line : bool; 
+  (* only when we print newline, we print the indent *)
+}
 
-val tuple_type_pair : 
-  ?loc:Ast_helper.loc ->
-  [< `Make | `Run ] ->
-  int -> Parsetree.core_type * Parsetree.core_type list * Parsetree.core_type
+let from_channel chan = { 
+  output_string = (fun  s -> output_string chan s); 
+  output_char = (fun c -> output_char chan c);
+  flush = (fun _ -> flush chan);
+  indent_level = 0 ;
+  last_new_line = false;
+}
 
-val to_js_type :
-  Location.t -> Parsetree.core_type -> Parsetree.core_type
 
+let from_buffer buf = {
+  output_string = (fun s -> Buffer.add_string buf s);
+  output_char = (fun  c -> Buffer.add_char buf c);
+  flush = (fun _ -> ());
+  indent_level = 0;
+  last_new_line = false;
+}
 
-(** TODO: make it work for browser too *)
-val to_undefined_type :
-  Location.t -> Parsetree.core_type -> Parsetree.core_type  
+(* If we have [newline] in [s], 
+   all indentations will be broken 
+   in the future, we can detect this in [s]
+ *)
+let string t s = 
+  t.output_string  s ;
+  t.last_new_line <- false
 
-val to_js_re_type : Location.t -> Parsetree.core_type
+let newline t = 
+  if not t.last_new_line then 
+    begin
+      t.output_char  '\n';
+      for i = 0 to t.indent_level - 1 do 
+        t.output_string  L.indent_str;
+      done;
+      t.last_new_line <- true
+    end
 
-end = struct
-#1 "ast_comb.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let force_newline t = 
+  t.output_char  '\n';
+  for i = 0 to t.indent_level - 1 do 
+    t.output_string  L.indent_str;
+  done
 
+let space t  = 
+  string t L.space
 
-open Ast_helper 
+let nspace  t n  = 
+  string  t (String.make n ' ')
 
-let exp_apply_no_label ?loc ?attrs a b = 
-  Exp.apply ?loc ?attrs a (List.map (fun x -> "", x) b)
+let group t i action = 
+  if i = 0 then action ()
+  else 
+    let old = t.indent_level in
+    t.indent_level <- t.indent_level + i;
+    Ext_pervasives.finally () (fun _ -> t.indent_level <- old) action 
 
-let fun_no_label ?loc ?attrs  pat body = 
-  Exp.fun_ ?loc ?attrs "" None pat body
+let vgroup = group
 
-let arrow_no_label ?loc ?attrs b c = 
-  Typ.arrow ?loc ?attrs "" b c 
+let paren t action = 
+  string t "(";
+  let v = action () in
+  string t ")";
+  v 
 
-let discard_exp_as_unit loc e = 
-  exp_apply_no_label ~loc     
-    (Exp.ident ~loc {txt = Ast_literal.Lid.ignore_id; loc})
-    [Exp.constraint_ ~loc e 
-       (Ast_literal.type_unit ~loc ())]
+let brace fmt u = 
+  string fmt "{";
+  (* break1 fmt ; *)
+  let v = u () in
+  string fmt "}";
+  v 
 
+let bracket fmt u = 
+  string fmt "[";
+  let v = u () in
+  string fmt "]";
+  v 
 
-let tuple_type_pair ?loc kind arity = 
-  let prefix  = "a" in
-  if arity = 0 then 
-    let ty = Typ.var ?loc ( prefix ^ "0") in 
-    match kind with 
-    | `Run -> ty,  [], ty 
-    | `Make -> 
-      (Typ.arrow "" ?loc
-         (Ast_literal.type_unit ?loc ())
-         ty ,
-       [], ty)
-  else
-    let number = arity + 1 in
-    let tys = Ext_list.init number (fun i -> 
-        Typ.var ?loc (prefix ^ string_of_int (number - i - 1))
-      )  in
-    match tys with 
-    | result :: rest -> 
-      Ext_list.reduce_from_left (fun r arg -> Typ.arrow "" ?loc arg r) tys, 
-      List.rev rest , result
-    | [] -> assert false
-    
-    
+let brace_vgroup st n action = 
+  string st "{";
+  let v = vgroup st n (fun _ -> 
+    newline st; 
+    let v =  action () in
+    v
+              ) in
+  force_newline st;
+  string st "}";
+  v
 
-let js_obj_type_id  = 
-  Ast_literal.Lid.js_obj 
+let bracket_vgroup st n action = 
+  string st "[";
+  let v = vgroup st n (fun _ -> 
+    newline st; 
+    let v =  action () in
+    v
+              ) in
+  force_newline st;
+  string st "]";
+  v
 
-let re_id  = 
-  Ast_literal.Lid.js_re_id 
+let bracket_group st n action = 
+  group st n (fun _ -> bracket st action)
 
-let to_js_type loc  x  = 
-  Typ.constr ~loc {txt = js_obj_type_id; loc} [x]
+let paren_vgroup st n action = 
+  string st "(";
+  let v = group st n (fun _ -> 
+    newline st; 
+    let v = action () in
+    v
+                     ) in
+  newline st;
+  string st ")";
+  v 
+let paren_group st n action = group st n (fun _ -> paren st action)
 
-let to_js_re_type loc  =
-  Typ.constr ~loc { txt = re_id ; loc} []
-    
-let to_undefined_type loc x =
-  Typ.constr ~loc
-    {txt = Ast_literal.Lid.js_undefined ; loc}
-    [x]  
+let brace_group st n action = 
+  group st n (fun _ -> brace st action )
+
+let indent t n = 
+  t.indent_level <- t.indent_level + n 
 
+let flush t () = t.flush ()
 
 end
-module Ast_core_type : sig 
-#1 "ast_core_type.mli"
+module Int_map : sig 
+#1 "int_map.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78452,153 +79046,181 @@ module Ast_core_type : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type t = Parsetree.core_type 
 
 
 
-val replace_result : t -> t -> t
 
-val is_unit : t -> bool 
-val is_array : t -> bool 
-type arg_label =
-  | Label of string 
-  | Optional of string 
-  | Empty
-type arg_type = 
-  | NullString of (int * string) list 
-  | NonNullString of (int * string) list 
-  | Int of (int * int ) list 
-  | Array 
-  | Unit
-  | Nothing
-  | Ignore
 
-(** for 
-       [x:t] -> "x"
-       [?x:t] -> "?x"
-*)
-val label_name : string -> arg_label
 
 
+include Map_gen.S with type key = int
 
+end = struct
+#1 "int_map.ml"
 
+# 2 "ext/map.cppo.ml"
+(* we don't create [map_poly], since some operations require raise an exception which carries [key] *)
 
-(** return a function type 
-    [from_labels ~loc tyvars labels]
-    example output:
-    {[x:'a0 -> y:'a1 -> < x :'a0 ;y :'a1  > Js.t]}
-*)
-val from_labels :
-  loc:Location.t -> int ->  string Asttypes.loc list -> t
 
-val make_obj :
-  loc:Location.t ->
-  (string * Parsetree.attributes * t) list ->
-  t
+  
+# 13
+  type key = int
+  let compare_key = Ext_int.compare
 
-end = struct
-#1 "ast_core_type.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+# 22
+type 'a t = (key,'a) Map_gen.t
+exception Duplicate_key of key 
 
-type t = Parsetree.core_type 
-type arg_label =
-  | Label of string 
-  | Optional of string 
-  | Empty (* it will be ignored , side effect will be recorded *)
+let empty = Map_gen.empty 
+let is_empty = Map_gen.is_empty
+let iter = Map_gen.iter
+let fold = Map_gen.fold
+let for_all = Map_gen.for_all 
+let exists = Map_gen.exists 
+let singleton = Map_gen.singleton 
+let cardinal = Map_gen.cardinal
+let bindings = Map_gen.bindings
+let keys = Map_gen.keys
+let choose = Map_gen.choose 
+let partition = Map_gen.partition 
+let filter = Map_gen.filter 
+let map = Map_gen.map 
+let mapi = Map_gen.mapi
+let bal = Map_gen.bal 
+let height = Map_gen.height 
+let max_binding_exn = Map_gen.max_binding_exn
+let min_binding_exn = Map_gen.min_binding_exn
 
-type arg_type = 
-  | NullString of (int * string) list 
-  | NonNullString of (int * string) list 
-  | Int of (int * int ) list 
-  | Array 
-  | Unit
-  | Nothing
-  | Ignore
 
-open Ast_helper
+let rec add x data (tree : _ Map_gen.t as 'a) : 'a = match tree with 
+  | Empty ->
+    Node(Empty, x, data, Empty, 1)
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Node(l, x, data, r, h)
+    else if c < 0 then
+      bal (add x data l) v d r
+    else
+      bal l v d (add x data r)
 
-let replace_result ty result = 
-  let rec aux (ty : Parsetree.core_type) = 
-    match ty with 
-    | { ptyp_desc = 
-          Ptyp_arrow (label,t1,t2)
-      } -> { ty with ptyp_desc = Ptyp_arrow(label,t1, aux t2)}
-    | {ptyp_desc = Ptyp_poly(fs,ty)} 
-      ->  {ty with ptyp_desc = Ptyp_poly(fs, aux ty)}
-    | _ -> result in 
-  aux ty 
 
-let is_unit (ty : t ) = 
-  match ty.ptyp_desc with 
-  | Ptyp_constr({txt =Lident "unit"}, []) -> true
-  | _ -> false 
+let rec adjust x data replace (tree : _ Map_gen.t as 'a) : 'a = 
+  match tree with 
+  | Empty ->
+    Node(Empty, x, data (), Empty, 1)
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Node(l, x, replace  d , r, h)
+    else if c < 0 then
+      bal (adjust x data replace l) v d r
+    else
+      bal l v d (adjust x data replace r)
 
-let is_array (ty : t) = 
-  match ty.ptyp_desc with 
-  | Ptyp_constr({txt =Lident "array"}, [_]) -> true
-  | _ -> false 
 
-let is_optional l =
-  String.length l > 0 && l.[0] = '?'
+let rec find_exn x (tree : _ Map_gen.t )  = match tree with 
+  | Empty ->
+    raise Not_found
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then d
+    else find_exn x (if c < 0 then l else r)
 
-let label_name l : arg_label =
-  if l = "" then Empty else 
-  if is_optional l 
-  then Optional (String.sub l 1 (String.length l - 1))
-  else Label l
+let rec find_opt x (tree : _ Map_gen.t )  = match tree with 
+  | Empty -> None 
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then Some d
+    else find_opt x (if c < 0 then l else r)
 
+let rec find_default x (tree : _ Map_gen.t ) default     = match tree with 
+  | Empty -> default  
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then  d
+    else find_default x   (if c < 0 then l else r) default
 
-(* Note that OCaml type checker will not allow arbitrary 
-   name as type variables, for example:
-   {[
-     '_x'_
-   ]}
-   will be recognized as a invalid program
-*)
-let from_labels ~loc arity labels 
-  : t =
-  let tyvars = 
-    ((Ext_list.init arity (fun i ->      
-           Typ.var ~loc ("a" ^ string_of_int i)))) in
-  let result_type =
-    Ast_comb.to_js_type loc  
-      (Typ.object_ ~loc
-         (List.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
-  in 
-  List.fold_right2 
-    (fun {Asttypes.loc ; txt = label }
-      tyvar acc -> Typ.arrow ~loc label tyvar acc) labels tyvars  result_type
+let rec mem x (tree : _ Map_gen.t )   = match tree with 
+  | Empty ->
+    false
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    c = 0 || mem x (if c < 0 then l else r)
 
+let rec remove x (tree : _ Map_gen.t as 'a) : 'a = match tree with 
+  | Empty ->
+    Empty
+  | Node(l, v, d, r, h) ->
+    let c = compare_key x v in
+    if c = 0 then
+      Map_gen.merge l r
+    else if c < 0 then
+      bal (remove x l) v d r
+    else
+      bal l v d (remove x r)
 
-let make_obj ~loc xs =
-  Ast_comb.to_js_type loc @@
-  Ast_helper.Typ.object_  ~loc xs   Closed
+
+let rec split x (tree : _ Map_gen.t as 'a) : 'a * _ option * 'a  = match tree with 
+  | Empty ->
+    (Empty, None, Empty)
+  | Node(l, v, d, r, _) ->
+    let c = compare_key x v in
+    if c = 0 then (l, Some d, r)
+    else if c < 0 then
+      let (ll, pres, rl) = split x l in (ll, pres, Map_gen.join rl v d r)
+    else
+      let (lr, pres, rr) = split x r in (Map_gen.join l v d lr, pres, rr)
+
+let rec merge f (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
+  match (s1, s2) with
+  | (Empty, Empty) -> Empty
+  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+    let (l2, d2, r2) = split v1 s2 in
+    Map_gen.concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+  | (_, Node (l2, v2, d2, r2, h2)) ->
+    let (l1, d1, r1) = split v2 s1 in
+    Map_gen.concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+  | _ ->
+    assert false
+
+let rec disjoint_merge  (s1 : _ Map_gen.t) (s2  : _ Map_gen.t) : _ Map_gen.t =
+  match (s1, s2) with
+  | (Empty, Empty) -> Empty
+  | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+    begin match split v1 s2 with 
+    | l2, None, r2 -> 
+      Map_gen.join (disjoint_merge  l1 l2) v1 d1 (disjoint_merge r1 r2)
+    | _, Some _, _ ->
+      raise (Duplicate_key  v1)
+    end        
+  | (_, Node (l2, v2, d2, r2, h2)) ->
+    begin match  split v2 s1 with 
+    | (l1, None, r1) -> 
+      Map_gen.join (disjoint_merge  l1 l2) v2 d2 (disjoint_merge  r1 r2)
+    | (_, Some _, _) -> 
+      raise (Duplicate_key v2)
+    end
+  | _ ->
+    assert false
+
+
+
+let compare cmp m1 m2 = Map_gen.compare compare_key cmp m1 m2
+
+let equal cmp m1 m2 = Map_gen.equal compare_key cmp m1 m2 
+
+let add_list (xs : _ list ) init = 
+  List.fold_left (fun acc (k,v) -> add k v acc) init xs 
+
+let of_list xs = add_list xs empty
+
+let of_array xs = 
+  Array.fold_left (fun acc (k,v) -> add k v acc) empty xs
 
 end
-module Ast_payload : sig 
-#1 "ast_payload.mli"
+module Ext_pp_scope : sig 
+#1 "ext_pp_scope.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78625,53 +79247,33 @@ module Ast_payload : sig
 
 
 
-(** A utility module used when destructuring parsetree attributes, used for 
-    compiling FFI attributes and built-in ppx  *)
 
-type t = Parsetree.payload
-type lid = string Asttypes.loc
-type label_expr = lid  * Parsetree.expression
-type action = 
-   lid * Parsetree.expression option 
 
-val is_single_string : t -> string option
-val is_single_int : t -> int option 
 
-val as_string_exp : t -> Parsetree.expression option
-val as_core_type : Location.t -> t -> Parsetree.core_type    
-val as_empty_structure :  t -> bool 
-val as_ident : t -> Longident.t Asttypes.loc option
-val raw_string_payload : Location.t -> string -> t 
-val assert_strings :
-  Location.t -> t -> string list  
 
-(** as a record or empty 
-    it will accept 
-    {[ [@@@bs.config ]]}
-    or 
-    {[ [@@@bs.config { property  .. } ]]}    
-    Note that we only 
-    {[
-      { flat_property}
-    ]}
-    below  is not allowed 
-    {[
-      {M.flat_property}
-    ]}
-*)
-val as_config_record_and_process : 
-  Location.t ->
-  t -> action list 
 
-val assert_bool_lit : Parsetree.expression -> bool
+(** Scope type to improve identifier name printing
+ *) 
+
+(** Defines scope type [t], so that the pretty printer would print more beautiful code: 
+    
+    print [identifer] instead of [identifier$1234] when it can
+ *)
+
+type t 
 
 val empty : t 
 
-val table_dispatch : 
-  (Parsetree.expression option  -> 'a) String_map.t -> action -> 'a
+val add_ident : Ident.t -> t -> int * t
+
+val sub_scope : t -> Ident_set.t -> t
+
+val merge : Ident_set.t -> t -> t
+
+val print : Format.formatter -> t -> unit
 
 end = struct
-#1 "ast_payload.ml"
+#1 "ext_pp_scope.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78696,177 +79298,71 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type t = Parsetree.payload
 
-let is_single_string (x : t ) = 
-  match x with  (** TODO also need detect empty phrase case *)
-  | PStr [ {
-      pstr_desc =  
-        Pstr_eval (
-          {pexp_desc = 
-             Pexp_constant 
-               (Const_string (name,_));
-           _},_);
-      _}] -> Some name
-  | _  -> None
 
-let is_single_int (x : t ) = 
-  match x with  (** TODO also need detect empty phrase case *)
-  | PStr [ {
-      pstr_desc =  
-        Pstr_eval (
-          {pexp_desc = 
-             Pexp_constant 
-               (Const_int name);
-           _},_);
-      _}] -> Some name
-  | _  -> None
 
-let as_string_exp (x : t ) = 
-  match x with  (** TODO also need detect empty phrase case *)
-  | PStr [ {
-      pstr_desc =  
-        Pstr_eval (
-          {pexp_desc = 
-             Pexp_constant 
-               (Const_string (_,_));
-           _} as e ,_);
-      _}] -> Some e
-  | _  -> None
 
-let as_core_type loc x =
-  match  x with
-  | Parsetree.PTyp x -> x
-  | _ -> Location.raise_errorf ~loc "except a core type"
-           
-let as_ident (x : t ) =
-  match x with
-  | PStr [
-      {pstr_desc =
-         Pstr_eval (
-           {
-             pexp_desc =
-               Pexp_ident ident 
-                 
-           } , _)
-      }
-    ] -> Some ident
-  | _ -> None
-open Ast_helper
 
-let raw_string_payload loc (s : string) : t =
-  PStr [ Str.eval ~loc (Exp.constant ~loc (Const_string (s,None)  ))]
-    
-let as_empty_structure (x : t ) = 
-  match x with 
-  | PStr ([]) -> true
-  | PTyp _ | PPat _ | PStr (_ :: _ ) -> false 
 
-type lid = string Asttypes.loc
-type label_expr = lid  * Parsetree.expression
 
-type action = 
-   lid * Parsetree.expression option 
-(** None means punning is hit 
-    {[ { x } ]}
-    otherwise it comes with a payload 
-    {[ { x = exp }]}
-*)
+type t =  
+    int  Int_map.t String_map.t
 
-let as_config_record_and_process 
-    loc
-    (x : Parsetree.payload) 
-  = 
-  match  x with 
-  | PStr 
-      [ {pstr_desc = Pstr_eval
-             ({pexp_desc = Pexp_record (label_exprs, with_obj) ; pexp_loc = loc}, _); 
-         _
-        }]
-    -> 
-    begin match with_obj with
-    | None ->
-      List.map
-        (fun (x,y) -> 
-           match (x,y) with 
-           | ({Asttypes.txt = Longident.Lident name; loc} ) , 
-             ({Parsetree.pexp_desc = Pexp_ident{txt = Lident name2}} )
-             when name2 = name -> 
-              ({Asttypes.txt = name ; loc}, None)
-           | ({Asttypes.txt = Longident.Lident name; loc} ), y 
-             -> 
-             ({Asttypes.txt = name ; loc}, Some y)
-           | _ -> 
-             Location.raise_errorf ~loc "Qualified label is not allood"
-        )
-        label_exprs
-    | Some _ -> 
-      Location.raise_errorf ~loc "with is not supported"
-    end
-  | Parsetree.PStr [] -> []
-  | _ -> 
-    Location.raise_errorf ~loc "this is not a valid record config"
+let empty = 
+  String_map.empty 
+
+let rec print fmt v = 
+  Format.fprintf fmt "@[<v>{"  ;
+  String_map.iter (fun k m -> 
+      Format.fprintf fmt "%s: @[%a@],@ " k print_int_map m       
+    )  v;
+  Format.fprintf fmt "}@]"  
+and print_int_map fmt m = 
+  Int_map.iter (fun k v -> 
+      Format.fprintf fmt "%d - %d" k v       
+    ) m    
 
+let add_ident (id : Ident.t) (cxt : t) : int * t = 
+  match String_map.find_exn id.name cxt with 
+  | exception Not_found -> (0, String_map.add id.name Int_map.(add id.stamp 0  empty) cxt )
+  | imap -> (
+    match Int_map.find_exn id.stamp imap with
+    | exception Not_found ->
+      let v = Int_map.cardinal imap in
+      v, String_map.add id.name (Int_map.add id.stamp v imap) cxt
+    | i -> i, cxt
+  )
 
+let of_list lst cxt = 
+  List.fold_left (fun scope i -> snd (add_ident i scope)) cxt lst 
 
-let assert_strings loc (x : t) : string list
-   = 
-  let module M = struct exception Not_str end  in 
-  match x with 
-  | PStr [ {pstr_desc =  
-              Pstr_eval (
-                {pexp_desc = 
-                   Pexp_tuple strs;
-                 _},_);
-            pstr_loc = loc ;            
-            _}] ->
-    (try 
-        strs |> List.map (fun e ->
-           match (e : Parsetree.expression) with
-           | {pexp_desc = Pexp_constant (Const_string (name,_)); _} -> 
-             name
-           | _ -> raise M.Not_str)
-     with M.Not_str ->
-       Location.raise_errorf ~loc "expect string tuple list"
-    )
-  | PStr [ {
-      pstr_desc =  
-        Pstr_eval (
-          {pexp_desc = 
-             Pexp_constant 
-               (Const_string (name,_));
-           _},_);
-      _}] ->  [name] 
-  | PStr [] ->  []
-  | PStr _                
-  | PTyp _ | PPat _ ->
-    Location.raise_errorf ~loc "expect string tuple list"
-let assert_bool_lit  (e : Parsetree.expression) = 
-  match e.pexp_desc with
-  | Pexp_construct ({txt = Lident "true" }, None)
-    -> true
-  | Pexp_construct ({txt = Lident "false" }, None)
-    -> false 
-  | _ ->
-    Location.raise_errorf ~loc:e.pexp_loc "expect `true` or `false` in this field"
+let merge set cxt  = 
+  Ident_set.fold (fun ident acc -> snd (add_ident ident acc)) set  cxt 
 
+(* Assume that all idents are already in the scope
+   so both [param/0] and [param/1] are in idents, we don't need 
+   update twice,  once is enough
+ *)
+let sub_scope (scope : t) ident_collection : t =
+  let cxt = empty in
+  Ident_set.fold (fun (i : Ident.t) acc -> 
+    match String_map.find_exn i.name scope with 
+    | exception Not_found -> assert false 
+    | imap -> ( 
+      (* They are the same if already there*)
+      match String_map.find_exn i.name acc with 
+      | exception Not_found -> String_map.add i.name imap acc
+      | _ -> acc  (* TODO: optimization *) 
+    )
+  ) ident_collection cxt 
 
-let empty : t = Parsetree.PStr []
 
 
 
-let table_dispatch table (action : action)
-     = 
-  match action with 
-  | {txt =  name; loc  }, y -> 
-    begin match String_map.find_exn name table with 
-      | fn -> fn y
-      | exception _ -> Location.raise_errorf ~loc "%s is not supported" name
-    end
 
 end
-module Ast_attributes : sig 
-#1 "ast_attributes.mli"
+module Js_number : sig 
+#1 "js_number.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78890,51 +79386,23 @@ module Ast_attributes : sig
  * 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. *)
-type attr =  Parsetree.attribute
-type t =  attr list 
-
-type ('a,'b) st = 
-  { get : 'a option ; 
-    set : 'b option }
-
-val process_method_attributes_rev : 
-  t ->
-  (bool * bool , [`Get | `No_get ]) st * t 
-
-val process_attributes_rev : 
-  t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t 
 
-val process_bs : 
-  t -> [ `Nothing | `Has] * t 
 
-val process_external : t -> bool 
 
-type derive_attr = {
-  explict_nonrec : bool;
-  bs_deriving : [`Has_deriving of Ast_payload.action list | `Nothing ]
-}
-val process_bs_string_int : 
-  t -> [`Nothing | `String | `Int | `Ignore]  * t 
 
-val process_bs_string_as :
-  t -> string option * t 
-val process_bs_int_as : 
-  t -> int option * t 
 
 
-val process_derive_type : 
-  t -> derive_attr * t 
 
+type t  = float 
 
 
-val bs : attr 
-val bs_this : attr
-val bs_method : attr
+val to_string : t -> string
 
 
+val caml_float_literal_to_js_string : string -> string
 
 end = struct
-#1 "ast_attributes.ml"
+#1 "js_number.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -78959,199 +79427,88 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type attr =  Parsetree.attribute
-type t =  attr list 
-
-type ('a,'b) st = 
-  { get : 'a option ; 
-    set : 'b option }
-
-
-let process_method_attributes_rev (attrs : t) = 
-  List.fold_left (fun (st,acc) (({txt ; loc}, payload) as attr : attr) -> 
-
-      match txt  with 
-      | "bs.get" (* [@@bs.get{null; undefined}]*)
-        -> 
-        let result = 
-          List.fold_left 
-          (fun 
-            (null, undefined)
-            (({txt ; loc}, opt_expr) : Ast_payload.action) -> 
-            if txt =  "null" then 
-              (match opt_expr with 
-              | None -> true
-              | Some e -> 
-                Ast_payload.assert_bool_lit e), undefined
-
-            else if txt = "undefined" then 
-              null, 
-              (match opt_expr with
-               | None ->  true
-               | Some e -> 
-                 Ast_payload.assert_bool_lit e)
-
-            else Location.raise_errorf ~loc "unsupported predicates"
-          ) (false, false) (Ast_payload.as_config_record_and_process loc payload)  in 
-
-        ({st with get = Some result}, acc  )
-
-      | "bs.set"
-        -> 
-        let result = 
-          List.fold_left 
-          (fun st (({txt ; loc}, opt_expr) : Ast_payload.action) -> 
-            if txt =  "no_get" then 
-              match opt_expr with 
-              | None -> `No_get 
-              | Some e -> 
-                if Ast_payload.assert_bool_lit e then 
-                  `No_get
-                else `Get
-            else Location.raise_errorf ~loc "unsupported predicates"
-          ) `Get (Ast_payload.as_config_record_and_process loc payload)  in 
-        (* properties -- void 
-              [@@bs.set{only}]
-           *)
-        {st with set = Some result }, acc
-      | _ -> 
-        (st, attr::acc  )
-    ) ( {get = None ; set = None}, []) attrs
 
 
-let process_attributes_rev (attrs : t) = 
-  List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) -> 
-      match txt, st  with 
-      | "bs", (`Nothing | `Uncurry) 
-        -> 
-        `Uncurry, acc
-      | "bs.this", (`Nothing | `Meth_callback)
-        ->  `Meth_callback, acc
-      | "bs.meth",  (`Nothing | `Method)
-        -> `Method, acc
-      | "bs", _
-      | "bs.this", _
-        -> Location.raise_errorf 
-             ~loc
-             "[@bs.this], [@bs], [@bs.meth] can not be applied at the same time"
-      | _ , _ -> 
-        st, attr::acc 
-    ) ( `Nothing, []) attrs
 
-let process_bs attrs = 
-  List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) -> 
-      match txt, st  with 
-      | "bs", _
-        -> 
-        `Has, acc
-      | _ , _ -> 
-        st, attr::acc 
-    ) ( `Nothing, []) attrs
 
-let process_external attrs = 
-  List.exists (fun (({txt; }, _)  : attr) -> 
-      if Ext_string.starts_with txt "bs." then true 
-      else false
-    ) attrs
 
+type t = float 
 
-type derive_attr = {
-  explict_nonrec : bool;
-  bs_deriving : [`Has_deriving of Ast_payload.action list | `Nothing ]
-}
 
-let process_derive_type attrs =
-  List.fold_left 
-    (fun (st, acc) 
-      (({txt ; loc}, payload  as attr): attr)  ->
-      match  st, txt  with
-      |  {bs_deriving = `Nothing}, "bs.deriving"
-        ->
-        {st with
-         bs_deriving = `Has_deriving 
-             (Ast_payload.as_config_record_and_process loc payload)}, acc 
-      | {bs_deriving = `Has_deriving _}, "bs.deriving"
-        -> 
-        Location.raise_errorf ~loc "duplicated bs.deriving attribute"
-      | _ , _ ->
-        let st = 
-          if txt = "nonrec" then 
-            { st with explict_nonrec = true }
-          else st in 
-        st, attr::acc
-    ) ( {explict_nonrec = false; bs_deriving = `Nothing }, []) attrs
+(* http://www.ecma-international.org/ecma-262/5.1/#sec-7.8.3 
+   http://caml.inria.fr/pub/docs/manual-ocaml/lex.html
+   {[
+     float-literal ::= [-](0...9){0...9|_}[.{0...9|_}][(e|E)][(e|E)[+|-](0...9){0...9|_}]     
+   ]}   
+   In ocaml, the interpretation of floating-point literals that
+   fall outside the range of representable floating-point values is undefined.
+   Also, (_) are accepted   
 
+   see https://github.com/ocaml/ocaml/pull/268 that ocaml will have HEXADECIMAL notation 
+   support in 4.3
 
+   The Hex part is quite different   
+ *)
 
-let process_bs_string_int attrs = 
-  List.fold_left 
-    (fun (st,attrs)
-      (({txt ; loc}, payload ) as attr : attr)  ->
-      match  txt, st  with
-      | "bs.string", (`Nothing | `String)
-        -> `String, attrs
-      | "bs.int", (`Nothing | `Int)
-        ->  `Int, attrs
-      | "bs.ignore", (`Nothing | `Ignore)
-        -> `Ignore, attrs
-      | "bs.int", _
-      | "bs.string", _
-      | "bs.ignore", _
-        -> 
-        Location.raise_errorf ~loc "conflict attributes "
-      | _ , _ -> st, (attr :: attrs )
-    ) (`Nothing, []) attrs
 
-let process_bs_string_as  attrs = 
-  List.fold_left 
-    (fun (st, attrs)
-      (({txt ; loc}, payload ) as attr : attr)  ->
-      match  txt, st  with
-      | "bs.as", None
-        ->
-        begin match Ast_payload.is_single_string payload with 
-          | None -> 
-            Location.raise_errorf ~loc "expect string literal "
-          | Some  _ as v->  (v, attrs)  
-        end
-      | "bs.as",  _ 
-        -> 
-          Location.raise_errorf ~loc "duplicated bs.as "
-      | _ , _ -> (st, attr::attrs) 
-    ) (None, []) attrs
 
-let process_bs_int_as  attrs = 
-  List.fold_left 
-    (fun (st, attrs)
-      (({txt ; loc}, payload ) as attr : attr)  ->
-      match  txt, st  with
-      | "bs.as", None
-        ->
-        begin match Ast_payload.is_single_int payload with 
-          | None -> 
-            Location.raise_errorf ~loc "expect int literal "
-          | Some  _ as v->  (v, attrs)  
-        end
-      | "bs.as",  _ 
-        -> 
-          Location.raise_errorf ~loc "duplicated bs.as "
-      | _ , _ -> (st, attr::attrs) 
-    ) (None, []) attrs
+let to_string v =
+  if v = infinity
+  then "Infinity"
+  else if v = neg_infinity
+  then "-Infinity"
+  else if v <> v
+  then "NaN"
+  else
+    let vint = (int_of_float v)
+    (* TODO: check if 32-bits will loose some precision *)               
+    in
+    if float_of_int  vint = v
+    then
+      string_of_int vint
+    else
+      let s1 = Printf.sprintf "%.12g" v in
+      if v = float_of_string s1
+      then s1
+      else
+        let s2 = Printf.sprintf "%.15g" v in
+        if v = float_of_string s2
+        then s2
+        else  Printf.sprintf "%.18g" v
 
 
-let bs : attr
-  =  {txt = "bs" ; loc = Location.none}, Ast_payload.empty
-let bs_this : attr
-  =  {txt = "bs.this" ; loc = Location.none}, Ast_payload.empty
 
-let bs_method : attr 
-  =  {txt = "bs.meth"; loc = Location.none}, Ast_payload.empty
+let caml_float_literal_to_js_string v = 
+  let len = String.length v in
+  if len >= 2 && 
+    v.[0] = '0' &&
+    (v.[1] = 'x' || v.[1] = 'X') then  
+    assert false 
+   (* TODO: catchup when upgraded to 4.3 
+      it does not make sense too much since js dos not 
+      support it natively
+    *)    
+  else    
 
+    let rec aux buf i = 
+      if i >= len then buf
+      else 
+        let x = v.[i] in
+        if x = '_' then
+          aux buf (i + 1)
+        else if   x  = '.' && i = len - 1  then
+          buf
+        else 
+          begin
+            Buffer.add_char buf x ;
+            aux buf ( i + 1) 
+          end in
+    Buffer.contents (aux  (Buffer.create len) 0)
 
 
 end
-module Bs_loc : sig 
-#1 "bs_loc.mli"
+module Js_program_loader : sig 
+#1 "js_program_loader.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -79176,19 +79533,36 @@ module Bs_loc : sig
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type t = Location.t = {
-  loc_start : Lexing.position;
-  loc_end : Lexing.position ; 
-  loc_ghost : bool
-} 
 
-val is_ghost : t -> bool
-val merge : t -> t -> t 
-val none : t 
 
 
+
+
+
+
+(** A module to create the whole JS program IR with [requires] and [exports] *)
+
+(* TODO: 
+   1. support es6 modle
+   2. make sure exported have its origin name, 
+      this makes it easier to read code 
+ *)
+
+val make_program : 
+    string -> 
+    Ident.t list -> J.block -> J.program
+
+val decorate_deps : 
+  J.required_modules ->
+  string option ->
+  J.program -> J.deps_program
+
+val string_of_module_id :
+  output_prefix:string ->
+  Lam_module_ident.system -> Lam_module_ident.t -> string
+
 end = struct
-#1 "bs_loc.ml"
+#1 "js_program_loader.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -79208,77 +79582,221 @@ end = struct
  * 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
+
+
+
+(** Design guides:
+    1. We don't want to force user to have 
+       [-bs-package-name] and [-bs-package-output] set
+
+       [bsc.exe -c hello.ml] should just work 
+       by producing a [hello.js] file in the same directory
+
+    Some designs due to legacy reasons that we don't have all runtime
+    written in OCaml, so it might only have js files (no cmjs) for Runtime kind
+    {[
+      begin match Config_util.find file with   
+        (* maybe from third party library*)
+        (* Check: be consistent when generating js files
+           A.ml -> a.js
+           a.ml -> a.js
+           check generated [js] file if it's capital or not
+           Actually, we can not tell its original name just from [id], 
+           so we just always general litte_case.js
+        *)
+        | file ->
+          rebase (`File file)
+        (* for some primitive files, no cmj support *)
+        | exception Not_found ->
+          Ext_pervasives.failwithf ~loc:__LOC__ 
+            "@[%s not found in search path - while compiling %s @] "
+            file !Location.input_name 
+      end
+
+    ]}
+
+*)
+
+let (//) = Filename.concat 
+
+let string_of_module_id ~output_prefix
+    (module_system : Lam_module_ident.system)
+    (x : Lam_module_ident.t) : string =
+
+
+    let result = 
+      match x.kind  with 
+      | Runtime  
+      | Ml  -> 
+        let id = x.id in
+        let modulename = String.uncapitalize id.name in
+        let js_file = Printf.sprintf "%s.js" modulename in
+        let rebase package_dir dep =
+          let current_unit_dir =
+            `Dir (Js_config.get_output_dir ~pkg_dir:package_dir module_system output_prefix) in
+          Ext_filename.node_relative_path  current_unit_dir dep 
+        in 
+        let dependency_pkg_info = 
+          Lam_compile_env.get_package_path_from_cmj module_system x 
+        in
+        let current_pkg_info = 
+          Js_config.get_current_package_name_and_path module_system  
+        in
+        begin match module_system,  dependency_pkg_info, current_pkg_info with
+          | _, `NotFound , _ -> 
+            Ext_pervasives.failwithf ~loc:__LOC__ 
+              " @[%s not found in search path - while compiling %s @] "
+              js_file !Location.input_name 
+          | `Goog , `Found (package_name, x), _  -> 
+            package_name  ^ "." ^  String.uncapitalize id.name
+          | `Goog, (`Empty | `Package_script _), _ 
+            -> 
+            Ext_pervasives.failwithf ~loc:__LOC__ 
+              " @[%s was not compiled with goog support  in search path - while compiling %s @] "
+              js_file !Location.input_name 
+          | (`AmdJS | `NodeJS),
+            ( `Empty | `Package_script _) ,
+            `Found _  -> 
+            Ext_pervasives.failwithf ~loc:__LOC__
+              "@[dependency %s was compiled in script mode - while compiling %s in package mode @]"
+              js_file !Location.input_name
+          | _ , _, `NotFound -> assert false 
+          | (`AmdJS | `NodeJS), 
+            `Found(package_name, x),
+            `Found(current_package, path) -> 
+            if  current_package = package_name then 
+              let package_dir = Lazy.force Ext_filename.package_dir in
+              rebase package_dir (`File (package_dir // x // modulename)) 
+            else 
+              package_name // x // modulename
+          | (`AmdJS | `NodeJS), `Found(package_name, x), 
+            `Package_script(current_package)
+            ->    
+            if current_package = package_name then 
+              let package_dir = Lazy.force Ext_filename.package_dir in
+              rebase package_dir (`File (
+                  package_dir // x // modulename)) 
+            else 
+              package_name // x // modulename
+          | (`AmdJS | `NodeJS), `Found(package_name, x), `Empty 
+            ->    package_name // x // modulename
+          |  (`AmdJS | `NodeJS), 
+             (`Empty | `Package_script _) , 
+             (`Empty  | `Package_script _)
+            -> 
+            begin match Config_util.find_opt js_file with 
+              | Some file -> 
+                let package_dir = Lazy.force Ext_filename.package_dir in
+                rebase package_dir (`File file) 
+              | None -> 
+                Bs_exception.error (Js_not_found js_file)
+            end
+        end
+      | External name -> name in 
+    if Js_config.is_windows then Ext_filename.replace_backward_slash result 
+    else result 
+
+
+
+(* support es6 modules instead
+   TODO: enrich ast to support import export 
+   http://www.ecma-international.org/ecma-262/6.0/#sec-imports
+   For every module, we need [Ident.t] for accessing and [filename] for import, 
+   they are not necessarily the same.
+
+   Es6 modules is not the same with commonjs, we use commonjs currently
+   (play better with node)
+
+   FIXME: the module order matters?
+*)
+
+let make_program name  export_idents block : J.program = 
+
+  {
+    name;
+
+    exports = export_idents ; 
+    export_set = Ident_set.of_list export_idents;
+    block = block;
+
+  }
+let decorate_deps modules side_effect program : J.deps_program = 
+
+  { program ; modules ; side_effect }
+
+
+end
+module Js_dump : sig 
+#1 "js_dump.mli"
+(* BuckleScript compiler
+ * Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+(* Authors: Jérôme Vouillon, Hongbo Zhang  *)
 
 
-type t = Location.t = {
-  loc_start : Lexing.position;
-  loc_end : Lexing.position ; 
-  loc_ghost : bool
-} 
 
-let is_ghost x = x.loc_ghost
+(** Print JS IR to vanilla Javascript code *)
 
-let merge (l: t) (r : t) = 
-  if is_ghost l then r 
-  else if is_ghost r then l 
-  else match l,r with 
-  | {loc_start ; }, {loc_end; _} (* TODO: improve*)
-    -> 
-    {loc_start ;loc_end; loc_ghost = false}
 
-let none = Location.none
 
-end
-module Lam_methname : sig 
-#1 "lam_methname.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+val pp_deps_program :
+  output_prefix:string ->
+  Lam_module_ident.system -> J.deps_program -> Ext_pp.t -> unit
 
+val dump_deps_program :
+  output_prefix:string ->
+  Lam_module_ident.system  -> J.deps_program -> out_channel -> unit
 
+(** 2 functions Only used for debugging *)
+val string_of_block : J.block -> string
 
-val translate : ?loc:Location.t -> string -> string
+val dump_program : J.program -> out_channel -> unit
+
+val string_of_expression : J.expression -> string
 
 end = struct
-#1 "lam_methname.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+#1 "js_dump.ml"
+(* BuckleScript compiler
+ * Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
  *
- * This program is free software: you can redistribute it and/or modify
+ * 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
  *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -79287,1004 +79805,1808 @@ end = struct
  *
  * 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. *)
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+(* Authors: Jérôme Vouillon, Hongbo Zhang  *)
 
 
-let translate ?loc name =
-  let i = Ext_string.rfind ~sub:"_" name  in
-  if name.[0] = '_' then
-    if i <= 0 then
-      let len = (String.length name - 1) in
-      if len = 0 then
-        Location.raise_errorf ?loc "invalid label %s" name
-      else String.sub name 1 len
-    else
-      let len = (i - 1) in
-      if len = 0 then
-        Location.raise_errorf ?loc "invalid label %s" name 
-      else
-        String.sub name 1 len
-  else if i > 0 then
-    String.sub name 0 i
-  else name
 
+(*
+  http://stackoverflow.com/questions/2846283/what-are-the-rules-for-javascripts-automatic-semicolon-insertion-asi
+  ASI catch up
+  {[
+  a=b
+  ++c
+  ---
+  a=b ++c
+  ====================
+  a ++
+  ---
+  a 
+  ++
+  ====================
+  a --
+  ---
+  a 
+  --
+  ====================
+  (continue/break/return/throw) a
+  ---
+  (continue/break/return/throw)
+  a
+  ====================
+  ]}
+
+*)
+
+(* module P = Ext_format *)
+module P = Ext_pp
+module E = Js_exp_make 
+module S = Js_stmt_make 
+
+module L = struct
+  let function_ = "function"
+  let var = "var" (* should be able to switch to [let] easily*)
+  let return = "return"
+  let eq = "="
+  let require = "require"
+  let goog_require = "goog.require" 
+  let goog_module = "goog.module"
+  let lparen = "("
+  let rparen = ")"
+  let exports = "exports"
+  let dot = "."
+  let comma = ","
+  let colon = ":"
+  let throw = "throw"
+  let default = "default"
+  let length = "length"
+  let char_code_at = "charCodeAt"
+  let new_ = "new"
+  let array = "Array"
+  let question = "?"      
+  let plusplus = "++"
+  let minusminus = "--"
+  let semi = ";"
+  let else_ = "else"
+  let if_ = "if"
+  let this = "this"
+  let while_ = "while"
+  let empty_block = "empty_block"
+  let start_block = "start_block"
+  let end_block = "end_block"
+  let json = "JSON"
+  let stringify = "stringify"
+  let console = "console"
+  let define = "define"
+  let break = "break"
+  let continue = "continue"
+  let switch = "switch"
+  let strict_directive = "'use strict';"
+  let true_ = "true"
+  let false_ = "false"
+  let app = Literals.app (* curry arbitrary args *)
+  let app_array = Literals.app_array
+  let debugger = "debugger"
+  let tag = "tag"
+  let bind = "bind"
+  let math = "Math"
+  let apply = "apply"
+  let null = "null"
+  let string_cap = "String"
+  let fromCharcode = "fromCharCode"
+  let eq = "="
+  let le = "<="
+  let ge = ">="
+  let plus_plus = "++" (* FIXME: use (i = i + 1 | 0) instead *)
+  let minus_minus = "--"
+  let caml_block = "Block"
+  let caml_block_create = "__"
 end
-module Ast_external_attributes : sig 
-#1 "ast_external_attributes.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let return_indent = (String.length L.return / Ext_pp.indent_length) 
 
+let throw_indent = (String.length L.throw / Ext_pp.indent_length) 
 
-type external_module_name = 
-  { bundle : string ; 
-    bind_name : string option
-  }
 
-type js_call = { 
-  name : string;
-  external_module_name : external_module_name option;
-  splice : bool 
-}
-type pipe = bool 
-type js_send = { 
-  name : string ;
-  splice : bool ; 
-  pipe : pipe   
-} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
+let semi f = P.string f L.semi
 
-type js_global_val = {
-  name : string ; 
-  external_module_name : external_module_name option
-  }
+let op_prec, op_str  =
+  Js_op_util.(op_prec, op_str)
 
-type js_new_val = {
-  name : string ; 
-  external_module_name : external_module_name option;
-  splice : bool ;
-}
+let best_string_quote s =
+  let simple = ref 0 in
+  let double = ref 0 in
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | '\'' -> incr simple
+    | '"' -> incr double
+    | _ -> ()
+  done;
+  if !simple < !double
+  then '\''
+  else '"'
 
-type arg_type = Ast_core_type.arg_type
-  
-type arg_label = Ast_core_type.arg_label 
 
-type arg_kind = 
-  {
-    arg_type : arg_type;
-    arg_label : arg_label
-  }
-type js_module_as_fn = 
-  { external_module_name : external_module_name;
-    splice : bool 
-  }
-type ffi = 
-  | Obj_create of arg_label list
-  | Js_global of js_global_val 
-  | Js_module_as_var of  external_module_name
-  | Js_module_as_fn of js_module_as_fn
-  | Js_module_as_class of external_module_name       
-  | Js_call of js_call
-  | Js_send of js_send
-  | Js_new of js_new_val
-  | Js_set of string
-  | Js_get of string
-  | Js_get_index
-  | Js_set_index
+(**
+   same as {!Js_dump.ident} except it generates a string instead of doing the printing
+*)
+let str_of_ident (cxt : Ext_pp_scope.t) (id : Ident.t)   =
+  if Ext_ident.is_js id then (* reserved by compiler *)
+     ( id.name , cxt) 
+  else 
+    (* For fast/debug mode, we can generate the name as 
+       [Printf.sprintf "%s$%d" name id.stamp] which is 
+       not relevant to the context       
+    *)    
+    let name = Ext_ident.convert true id.name in
+    let i,new_cxt = Ext_pp_scope.add_ident  id cxt in
+    (* Attention: 
+       $$Array.length, due to the fact that global module is 
+       always printed in the begining(via imports), so you get a gurantee, 
+       (global modules will not be printed as [List$1]) 
 
-  (* When it's normal, it is handled as normal c functional ffi call *)
+       However, this means we loose the ability of dynamic loading, is it a big 
+       deal? we can fix this by a scanning first, since we already know which 
+       modules are global
 
-type t  = 
-  | Bs of arg_kind list  * arg_type *   ffi
-  | Normal 
+       check [test/test_global_print.ml] for regression
 
+    *)
+    (if i == 0 then 
+       name 
+     else
+       Printf.sprintf"%s$%d" name i), new_cxt 
 
 
+let ident (cxt : Ext_pp_scope.t) f (id : Ident.t) : Ext_pp_scope.t  =
+  let str, cxt = str_of_ident cxt id in
+  P.string f str; 
+  cxt   
 
+(** Avoid to allocate single char string too many times*)
+let array_str1 =
+  Array.init 256 (fun i -> String.make 1 (Char.chr i)) 
 
-(**
-   return value is of [pval_type, pval_prim]
-*)    
-val handle_attributes_as_string : 
-  Bs_loc.t ->
-  string  ->
-  Ast_core_type.t ->
-  Ast_attributes.t -> 
-  string   ->
-  Ast_core_type.t * string list * Ast_attributes.t
+(** For conveting 
+ 
+*)
+let array_conv =
+  [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "a"; "b"; "c"; "d";
+    "e"; "f"|]
 
 
-val bs_external : string 
-val to_string : t -> string 
-val from_string : string -> t 
-val unsafe_from_string : string -> t 
-val is_bs_external_prefix : string -> bool
 
+(* https://mathiasbynens.be/notes/javascript-escapes *)
+let pp_string f ?(quote='"') ?(utf=false) s =
+  let pp_raw_string f ?(utf=false) s = 
+    let l = String.length s in
+    for i = 0 to l - 1 do
+      let c = String.unsafe_get s i in
+      match c with
+      | '\b' -> P.string f "\\b"
+      | '\012' -> P.string f "\\f"
+      | '\n' -> P.string f "\\n"
+      | '\r' -> P.string f "\\r"
+      | '\t' -> P.string f "\\t"
+      (* This escape sequence is not supported by IE < 9
+               | '\011' -> "\\v"
+         IE < 9 treats '\v' as 'v' instead of a vertical tab ('\x0B'). 
+         If cross-browser compatibility is a concern, use \x0B instead of \v.
 
+         Another thing to note is that the \v and \0 escapes are not allowed in JSON strings.
+      *)
+      | '\000' when i = l - 1 || (let next = String.unsafe_get s (i + 1) in (next < '0' || next > '9'))
+        -> P.string f "\\0"
 
-val pval_prim_of_labels : string Asttypes.loc list -> string list
+      | '\\' when not utf -> P.string f "\\\\"
 
-val name_of_ffi : ffi -> string
 
-end = struct
-#1 "ast_external_attributes.ml"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+      | '\000' .. '\031'  | '\127'->
+        let c = Char.code c in
+        P.string f "\\x";
+        P.string f (Array.unsafe_get array_conv (c lsr 4));
+        P.string f (Array.unsafe_get array_conv (c land 0xf))
+      | '\128' .. '\255' when not utf ->
+        let c = Char.code c in
+        P.string f "\\x";
+        P.string f (Array.unsafe_get array_conv (c lsr 4));
+        P.string f (Array.unsafe_get array_conv (c land 0xf))
+      (* | '\'' -> P.string f "\\'" *)
+      (* | '\"' -> P.string f "\\\"" *)
+      | _ ->
+        begin 
+          (if c = quote  then
+             P.string f "\\");           
+          P.string f (Array.unsafe_get array_str1 (Char.code c))
+        end
+    done
+  in
+  let quote_s = String.make 1 quote in
+  P.string f quote_s;
+  pp_raw_string f ~utf s ;
+  P.string f quote_s
+;;
 
+let property_string f s = 
+  if Ext_ident.property_no_need_convert s  then 
+    P.string f s
+  else 
+    pp_string f ~utf:true ~quote:(best_string_quote s) s
 
+(* TODO: check utf's correct semantics *)
+let pp_quote_string f s = 
+  pp_string f ~utf:false ~quote:(best_string_quote s ) s 
 
-type external_module_name = 
-  { bundle : string ; 
-    bind_name : string option
-  }
+let rec comma_idents  cxt f (ls : Ident.t list)  =
+  match ls with
+  | [] -> cxt
+  | [x] -> ident cxt f x
+  | y :: ys ->
+    let cxt = ident cxt f y in
+    P.string f L.comma;
+    comma_idents cxt f ys  
+let ipp_ident cxt f id un_used = 
+  if un_used then 
+    ident cxt f (Ext_ident.make_unused ())
+  else 
+    ident cxt f id  
+let rec formal_parameter_list cxt (f : P.t) method_ l env =
+  let offset = if method_ then 1 else 0 in   
+  let rec aux i cxt l = 
+    match l with
+    | []     -> cxt
+    | [id]    -> ipp_ident cxt f id (Js_fun_env.get_unused env i)
+    | id :: r -> 
+      let cxt = ipp_ident cxt f id (Js_fun_env.get_unused env i) in
+      P.string f L.comma; P.space f;
+      aux (i + 1) cxt  r
+  in
+  match l with 
+  | [] -> cxt 
+  | [i] -> 
+    (** necessary, since some js libraries like [mocha]...*)
+    if Js_fun_env.get_unused env offset then cxt else ident cxt f i 
+  | _ -> 
+    aux offset cxt l  
 
-type pipe = bool 
-type js_call = { 
-  name : string;
-  external_module_name : external_module_name option;
-  splice : bool 
-}
 
-type js_send = { 
-  name : string ;
-  splice : bool ; 
-  pipe : pipe   
-} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
+(* IdentMap *)
+(*
+f/122 --> 
+  f/122 is in the map 
+  if in, use the old mapping
+  else 
+    check  f,
+     if in last bumped id
+     else 
+        use "f", register it 
+
+  check "f"       
+         if not , use "f", register stamp -> 0 
+         else 
+           check stamp 
+             if in  use it 
+             else check last bumped id, increase it and register
+*)
+type name =
+  | No_name
+  | Name_top  of Ident.t
+  | Name_non_top of Ident.t
+
+
+(* TODO: refactoring 
+   Note that {!pp_function} could print both statement and expression when [No_name] is given 
+*)
+let rec pp_function method_
+    cxt (f : P.t) ?(name=No_name)  return 
+    (l : Ident.t list) (b : J.block) (env : Js_fun_env.t ) =  
+  match b, (name,  return)  with 
+  | [ {statement_desc =
+         Return {return_value = 
+                   {expression_desc = 
+                      Call(({expression_desc = Var v ; _} as function_), 
+                           ls , 
+                           {arity = ( Full | NA as arity(* see #234*)); 
+                            (* TODO: need a case to justify it*)
+                            call_info = 
+                              (Call_builtin_runtime | Call_ml )})}}}],
+    ((_, false) | (No_name, true))  
+    when
+      not method_ && 
+      Ext_list.for_all2_no_exn (fun a b -> 
+          match b.J.expression_desc with 
+          | Var (Id i) -> Ident.same a i 
+          | _ -> false) l ls ->
+    let optimize  len p cxt f v =
+      if p then
+        begin           
+          P.string f Js_config.curry;
+          P.string f L.dot;
+          P.string f "__";
+          P.string f (Printf.sprintf "%d" len);
+          P.paren_group f 1 (fun _ -> arguments cxt f [function_])            
+        end              
+      else
+        vident cxt f v
+    in
+    let len = List.length l in (* length *)           
+    begin match name with 
+      | Name_top i | Name_non_top i  -> 
+        P.string f L.var; 
+        P.space f ; 
+        let cxt = ident cxt f i in
+        P.space f ;
+        P.string f L.eq;
+        P.space f ;
+        let cxt = optimize len (arity = NA && len <= 8) cxt f v in 
+        semi f ;
+        cxt
+      | No_name ->
+        if return then 
+          begin 
+            P.string f L.return ;
+            P.space f;
+          end;
+        optimize len (arity = NA && len <=8) cxt f v 
+    end
+  | _, _  -> 
 
-type js_global_val = {
-  name : string ; 
-  external_module_name : external_module_name option
-  }
+    let set_env : Ident_set.t = (** identifiers will be printed following*)
+      match name with 
+      | No_name ->
+        Js_fun_env.get_unbounded env 
+      | Name_top id | Name_non_top id -> Ident_set.add id (Js_fun_env.get_unbounded env )
+    in
+    (* the context will be continued after this function *)
+    let outer_cxt = Ext_pp_scope.merge set_env cxt in  
 
-type js_new_val = {
-  name : string ; 
-  external_module_name : external_module_name option;
-  splice : bool ;
-}
+    (* the context used to be printed inside this function
 
-type js_module_as_fn = 
-  { external_module_name : external_module_name;
-    splice : bool 
-  }
+       when printing a function, 
+       only the enclosed variables and function name matters, 
+       if the function does not capture any variable, then the context is empty     
+    *)
+    let inner_cxt = Ext_pp_scope.sub_scope outer_cxt set_env in
 
-type arg_type = Ast_core_type.arg_type
-type arg_label = Ast_core_type.arg_label
 
-type arg_kind = 
-  {
-    arg_type : arg_type;
-    arg_label : arg_label
-  }
+    (* (if not @@ Js_fun_env.is_empty env then *)
+    (* pp_comment  f (Some (Js_fun_env.to_string env))) ; *)
+    let param_body () = 
+      if method_ then begin
+        let cxt = P.paren_group f 1 (fun _ -> 
+            formal_parameter_list inner_cxt  f method_ (List.tl l) env )
+        in
+        P.space f ;
+        ignore @@ P.brace_vgroup f 1 (fun _ ->
+            let cxt =
+              if not (Js_fun_env.get_unused env 0) then
+                begin               
+                  P.string f L.var ; 
+                  P.space f; 
+                  let cxt = ident cxt f (List.hd l) in 
+                  P.space f ; 
+                  P.string f L.eq ; 
+                  P.space f ;
+                  P.string f L.this;
+                  P.space f ; 
+                  semi f ;
+                  P.newline f ;
+                  cxt ;                
+                end
+              else
+                cxt
+            in
+            statement_list false cxt f b 
+          );
 
+      end
+      else begin  
+        let cxt = P.paren_group f 1 (fun _ -> 
+            formal_parameter_list inner_cxt  f method_ l env )
+        in
+        P.space f ;
+        ignore @@ P.brace_vgroup f 1 (fun _ -> statement_list false cxt f b );
+      end
+    in
+    let lexical = Js_fun_env.get_lexical_scope env in
+    let enclose  lexical  return = 
+        let handle lexical = 
+          if  Ident_set.is_empty lexical  
+          then
+            begin 
+              if return then 
+                begin 
+                  P.string f L.return ;
+                  P.space f
+                end ;
 
-type ffi = 
-  | Obj_create of arg_label list
-  | Js_global of js_global_val 
-  | Js_module_as_var of  external_module_name
-  | Js_module_as_fn of js_module_as_fn
-  | Js_module_as_class of external_module_name             
-  | Js_call of js_call 
-  | Js_send of js_send
-  | Js_new of js_new_val
-  | Js_set of string
-  | Js_get of string
-  | Js_get_index
-  | Js_set_index
+              begin match name with 
+              | No_name -> 
+                P.string f L.function_;
+                P.space f ;
+                param_body ();
+                (* semi f ; *)
+              | Name_non_top x  -> 
+                P.string f L.var ;
+                P.space f ; 
+                ignore @@ ident inner_cxt f x ; 
+                P.space f ;
+                P.string f L.eq ;
+                P.space f ; 
+                P.string f L.function_;
+                P.space f ;
+                param_body ();
+                semi f ;
+              | Name_top x  -> 
+                P.string f L.function_;
+                P.space f ;
+                ignore (ident inner_cxt f x);
+                param_body ();
+              end;
+          end
+          else
+            (* print as 
+               {[(function(x,y){...} (x,y))]}           
+            *)
+            let lexical = Ident_set.elements lexical in
+            (if return then
+               begin 
+                 P.string f L.return ; 
+                 P.space f
+               end
+             else 
+               begin match name with
+                 | No_name -> ()
+                 | Name_non_top name | Name_top name->
+                   P.string f L.var;
+                   P.space f;
+                   ignore @@ ident inner_cxt f name ;
+                   P.space f ;
+                   P.string f L.eq;
+                   P.space f ;
+               end
+            )   
+            ;
+            P.string f L.lparen;
+            P.string f L.function_; 
+            P.string f L.lparen;
+            ignore @@ comma_idents inner_cxt f lexical;
+            P.string f L.rparen;
+            P.brace_vgroup f 0  (fun _ -> 
+                begin 
+                  P.string f L.return ;
+                  P.space f;
+                  P.string f L.function_;
+                  P.space f ;
+                  (match name with 
+                   | No_name  -> () 
+                   | Name_non_top x | Name_top x -> ignore (ident inner_cxt f x));
+                  param_body ()
+                end);
+            P.string f L.lparen;
+            ignore @@ comma_idents inner_cxt f lexical;
+            P.string f L.rparen;
+            P.string f L.rparen;
+            begin match name with 
+              | No_name -> () (* expression *)
+              | _ -> semi f (* has binding, a statement *)
+            end
+        in 
+        begin match name with 
+          | Name_top name | Name_non_top name  when Ident_set.mem name lexical ->
+            (*TODO: when calculating lexical we should not include itself *)
+            let lexical =  (Ident_set.remove name lexical) in
+            handle lexical
+          | _ -> handle lexical 
+        end
+    in
+    enclose lexical return 
+    ;
+    outer_cxt
 
-let name_of_ffi ffi =
-  match ffi with 
-  | Js_get_index -> "[@@bs.get_index]"
-  | Js_set_index -> "[@@bs.set_index]"
-  | Js_get s -> Printf.sprintf "[@@bs.get %S]" s 
-  | Js_set s -> Printf.sprintf "[@@bs.set %S]" s 
-  | Js_call v  -> Printf.sprintf "[@@bs.val %S]" v.name
-  | Js_send v  -> Printf.sprintf "[@@bs.send %S]" v.name
-  | Js_module_as_fn v  -> Printf.sprintf "[@@bs.val %S]" v.external_module_name.bundle
-  | Js_new v  -> Printf.sprintf "[@@bs.new %S]" v.name                    
-  | Js_module_as_class v
-    -> Printf.sprintf "[@@bs.module] %S " v.bundle
-  | Js_module_as_var v
-    -> 
-      Printf.sprintf "[@@bs.module] %S " v.bundle
-  | Js_global v 
-    -> 
-      Printf.sprintf "[@@bs.val] %S " v.name                    
-  | Obj_create _ -> 
-    Printf.sprintf "[@@bs.obj]"
-type t  = 
-  | Bs of arg_kind list  * Ast_core_type.arg_type * ffi
-  | Normal 
-  (* When it's normal, it is handled as normal c functional ffi call *)
 
+(* Assume the cond would not change the context, 
+    since it can be either [int] or [string]
+ *)
+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) -> 
+  let cxt = 
+    P.group f 1 @@ fun _ -> 
+      P.group f 1 @@ (fun _ -> 
+        P.string f "case ";
+        pp_cond  f e;
+        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
+  in
+  P.newline f;
+  cxt 
 
+and loop  :  'a . Ext_pp_scope.t ->
+  P.t -> (P.t -> 'a -> unit) -> 'a J.case_clause list -> Ext_pp_scope.t
+      = fun  cxt  f pp_cond cases ->
+  match cases with 
+  | [] -> cxt 
+  | [x] -> output_one cxt f pp_cond x
+  | x::xs ->
+      let cxt = output_one cxt f pp_cond x 
+      in loop  cxt f pp_cond  xs 
 
-let get_arg_type ({ptyp_desc; ptyp_attributes; ptyp_loc = loc} as ptyp : Ast_core_type.t) : 
-  arg_type * Ast_core_type.t  = 
-    match Ast_attributes.process_bs_string_int ptyp_attributes, ptyp_desc with 
-    | (`String, ptyp_attributes),  Ptyp_variant ( row_fields, Closed, None)
-      -> 
-      let case, result, row_fields  = 
-        (List.fold_right (fun tag (nullary, acc, row_fields) -> 
-             match nullary, tag with 
-             | (`Nothing | `Null), 
-               Parsetree.Rtag (label, attrs, true,  [])
-               -> 
-               begin match Ast_attributes.process_bs_string_as attrs with 
-                 | Some name, new_attrs  -> 
-                   `Null, ((Ext_pervasives.hash_variant label, name) :: acc ), 
-                   Parsetree.Rtag(label, new_attrs, true, []) :: row_fields
+and vident cxt f  (v : J.vident) =
+  begin match v with 
+  | Id v | Qualified(v, _, None) ->  
+      ident cxt f v
+  | Qualified (id,_, Some name) ->
+      let cxt = ident cxt f id in
+      P.string f L.dot;
+      P.string f (Ext_ident.convert true name);
+      cxt
+  end
 
-                 | None, _ -> 
-                   `Null, ((Ext_pervasives.hash_variant label, label) :: acc ), 
-                   tag :: row_fields
-               end
-             | (`Nothing | `NonNull), Parsetree.Rtag(label, attrs, false, ([ _ ] as vs)) 
-               -> 
-               begin match Ast_attributes.process_bs_string_as attrs with 
-                 | Some name, new_attrs -> 
-                   `NonNull, ((Ext_pervasives.hash_variant label, name) :: acc),
-                   Parsetree.Rtag (label, new_attrs, false, vs) :: row_fields
-                 | None, _ -> 
-                   `NonNull, ((Ext_pervasives.hash_variant label, label) :: acc),
-                   (tag :: row_fields)
-               end
-             | _ -> Location.raise_errorf ~loc "Not a valid string type"
-           ) row_fields (`Nothing, [], [])) in 
-       (match case with 
-        | `Nothing -> Location.raise_errorf ~loc "Not a valid string type"
-        | `Null -> NullString result 
-        | `NonNull -> NonNullString result) , 
-       {ptyp with ptyp_desc = Ptyp_variant(row_fields, Closed, None);
-        ptyp_attributes ;
-       }
-    | (`String, _),  _ -> Location.raise_errorf ~loc "Not a valid string type"
+and expression l cxt  f (exp : J.expression) : Ext_pp_scope.t = 
+  pp_comment_option f exp.comment ;
+  expression_desc cxt l f exp.expression_desc
 
-    | (`Ignore, ptyp_attributes), _  -> 
-      (Ignore, {ptyp with ptyp_attributes})
-    | (`Int , ptyp_attributes),  Ptyp_variant ( row_fields, Closed, None) -> 
-      let _, acc, rev_row_fields = 
-        (List.fold_left 
-           (fun (i,acc, row_fields) rtag -> 
-              match rtag with 
-              | Parsetree.Rtag (label, attrs, true,  [])
-                -> 
-                  begin match Ast_attributes.process_bs_int_as attrs with 
-                  | Some i, new_attrs -> 
-                    i + 1, ((Ext_pervasives.hash_variant label , i):: acc ), 
-                    Parsetree.Rtag (label, new_attrs, true, []) :: row_fields
-                  | None, _ -> 
-                    i + 1 , ((Ext_pervasives.hash_variant label , i):: acc ), rtag::row_fields
-                  end
+and
+  expression_desc cxt (l:int) f x : Ext_pp_scope.t  =
+  match x with
+  | Var v ->
+    vident cxt f v 
+  | Bool b -> 
+    (if  b then P.string f L.true_ else P.string f L.false_ ) ; cxt 
+  | Seq (e1, e2) ->
+    let action () = 
+      let cxt = expression 0 cxt f e1 in
+      P.string f L.comma ;
+      P.space f ;
+      expression 0 cxt f e2  in
+    if l > 0 then 
+      P.paren_group f 1 action
+    else action ()
 
-              | _ -> Location.raise_errorf ~loc "Not a valid string type"
-           ) (0, [],[]) row_fields) in 
-      Int (List.rev acc),
-      {ptyp with 
-       ptyp_desc = Ptyp_variant(List.rev rev_row_fields, Closed, None );
-       ptyp_attributes
-      }
-      
-    | (`Int, _), _ -> Location.raise_errorf ~loc "Not a valid string type"
-    | (`Nothing, ptyp_attributes),  ptyp_desc ->
-      begin match ptyp_desc with
-        | Ptyp_constr ({txt = Lident "bool"}, [])
-          -> 
-          Bs_warnings.prerr_warning loc Unsafe_ffi_bool_type;
-          Nothing
-        | Ptyp_constr ({txt = Lident "unit"}, [])
-          -> Unit 
-        | Ptyp_constr ({txt = Lident "array"}, [_])
-          -> Array
-        | Ptyp_variant _ ->
-          Bs_warnings.prerr_warning loc Unsafe_poly_variant_type;
-          Nothing           
-        | _ ->
-          Nothing           
-      end, ptyp
+  | Fun (method_, l, b, env) ->  (* TODO: dump for comments *)
+      pp_function method_ cxt f false  l b env
+  (* TODO: 
+     when [e] is [Js_raw_code] with arity
+     print it in a more precise way
+     It seems the optimizer already did work to make sure
+     {[
+       Call (Raw_js_code (s, Exp i), el, {Full})
+         when List.length el = i
+     ]}
+  *)
 
+  | Call (e, el, info) ->
+    let action () = 
+      P.group f 1 (fun _ -> 
+          match info, el  with
+          | {arity  = Full }, _ 
+          | _, [] -> 
+            let cxt = expression 15 cxt f e in 
+            P.paren_group f 1 (fun _ -> arguments cxt  f el )  
 
-let valid_js_char =
-  let a = Array.init 256 (fun i ->
-    let c = Char.chr i in
-    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' || c = '$'
-  ) in
-  (fun c -> Array.unsafe_get a (Char.code c))
+          | _ , _ -> 
+            (* ipp_comment f (Some "!") *)
+            P.string f  Js_config.curry; 
+            P.string f L.dot;
+            let len = List.length el in
+            if 1 <= len && len <= 8 then  
+              begin
+                P.string f L.app;
+                P.string f (Printf.sprintf "%d" len);
+                P.paren_group f 1 (fun _ -> arguments cxt f (e::el))
+              end
+            else 
+              begin 
+                P.string f  L.app_array;                
+                P.paren_group f 1 (fun _ -> arguments cxt f [ e ; E.arr Mutable el])
+              end)
+    in
+    if l > 15 then P.paren_group f 1 action   
+    else action ()
+  | Bind (a,b) -> 
+    (* a.bind(b)
+       {[ fun b -> a.bind(b) ==? a.bind ]}
+    *)
+    begin
+      expression_desc cxt l f  
+        (Call ({expression_desc = Dot(a,L.bind, true); comment = None }, [b], 
+               {arity = Full; call_info = Call_na}))
+    end    
 
-let valid_first_js_char = 
-  let a = Array.init 256 (fun i ->
-    let c = Char.chr i in
-    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$'
-  ) in
-  (fun c -> Array.unsafe_get a (Char.code c))
+  | FlatCall(e,el) -> 
+    P.group f 1 (fun _ -> 
+        let cxt = expression 15 cxt f e in
+        P.string f L.dot; 
+        P.string f L.apply;
+        P.paren_group f 1 (fun _ ->
+            P.string f L.null;
+            P.string f L.comma;
+            P.space f ; 
+            expression 1 cxt f el
+          )
+      )
+  | String_of_small_int_array ({expression_desc = desc } as e) -> 
+    let action () = 
+      P.group f 1 (fun _ -> 
+          P.string f L.string_cap; 
+          P.string f L.dot ;
+          P.string f L.fromCharcode;
+          begin match desc with 
+            | Array (el, _mutable)
+              ->
+              P.paren_group f 1 (fun _ -> arguments cxt f el)
+            | _ -> 
+              P.string f L.dot ;
+              P.string f L.apply; 
+              P.paren_group f 1 (fun _ -> 
+                  P.string f L.null;
+                  P.string f L.comma;
+                  expression 1 cxt  f e  )
+          end ) 
+    in
+      if l > 15 then P.paren_group f 1 action   
+      else action ()
 
-(** Approximation could be improved *)
-let valid_ident (s : string) =
-  let len = String.length s in
-  len > 0 && valid_js_char s.[0] && valid_first_js_char s.[0] &&
-  (let module E = struct exception E end in
-   try
-     for i = 1 to len - 1 do
-       if not (valid_js_char (String.unsafe_get s i)) then
-         raise E.E         
-     done ;
-     true     
-   with E.E -> false )  
-  
-let valid_global_name ?loc txt =
-  if not (valid_ident txt) then
-    let v = Ext_string.split_by ~keep_empty:true (fun x -> x = '.') txt in
-    List.iter
-      (fun s ->
-         if not (valid_ident s) then
-           Location.raise_errorf ?loc "Not a valid  name %s"  txt
-      ) v      
 
-let valid_method_name ?loc txt =         
-  if not (valid_ident txt) then
-    Location.raise_errorf ?loc "Not a valid  name %s"  txt
+  | Array_append (e, el) -> 
+    P.group f 1 (fun _ -> 
+        let cxt = expression 15 cxt f e in
+        P.string f ".concat";
+        P.paren_group f 1 (fun _ -> arguments cxt f [el]))
 
+  | Array_copy e -> 
+    P.group f 1 (fun _ -> 
+        let cxt = expression 15 cxt f e in
+        P.string f ".slice";
+        P.string f "()" ;
+        cxt 
+      )
 
+  | Dump (level, el) -> 
+    let obj = 
+      match level with 
+      | Log -> "log"
+      | Info -> "info"
+      | Warn -> "warn"
+      | Error -> "error" in
+    P.group f 1 (fun _ -> 
+        P.string f L.console;
+        P.string f L.dot;
+        P.string f obj ;
+        P.paren_group f 1 (fun _ -> arguments cxt f el))
+  | Json_stringify e 
+    -> 
+    P.group f 1 (fun _ -> 
+        P.string f L.json ;
+        P.string f L.dot;
+        P.string f L.stringify; 
+        P.paren_group f 1 (fun _ -> expression 0 cxt f e )        
+      )    
+  | Char_to_int e -> 
+    begin match e.expression_desc with 
+      | String_access (a,b) -> 
+        P.group f 1 (fun _ -> 
+            let cxt = expression 15 cxt f a in
+            P.string f L.dot;
+            P.string f L.char_code_at;
+            P.paren_group f 1 (fun _ -> expression 0 cxt f b);
+          )
+      | _ -> 
+        P.group f 1 (fun _ -> 
+            let cxt = expression 15 cxt f e in
+            P.string f L.dot;
+            P.string f L.char_code_at;
+            P.string f "(0)";
+            cxt)
+    end
 
-let check_external_module_name ?loc x = 
-  match x with 
-  | {bundle = ""; _ } | {bind_name = Some ""} -> 
-    Location.raise_errorf ?loc "empty name encountered"
-  | _ -> ()
-let check_external_module_name_opt ?loc x = 
-  match x with 
-  | None -> ()
-  | Some v -> check_external_module_name ?loc v 
+  | Char_of_int e -> 
+    P.group f 1 (fun _ -> 
+        P.string f L.string_cap;
+        P.string f L.dot;
+        P.string f L.fromCharcode;
+        P.paren_group f 1 (fun _ -> arguments cxt f [e])
+      )
 
 
-let check_ffi ?loc ffi = 
-  match ffi with 
-  | Js_global {name} -> valid_global_name ?loc  name
-  | Js_send {name } 
-  | Js_set  name
-  | Js_get name
-    ->  valid_method_name ?loc name
-  | Obj_create _ -> ()
-  | Js_get_index | Js_set_index 
-    -> ()
+  | Math (name, el) -> 
+    P.group f 1 (fun _ ->
+        P.string f L.math;
+        P.string f L.dot;
+        P.string f name;
+        P.paren_group f 1 (fun _ -> arguments cxt f el)
+      )
 
-  | Js_module_as_var external_module_name
-  | Js_module_as_fn {external_module_name; _}
-  | Js_module_as_class external_module_name             
-    -> check_external_module_name external_module_name
-  | Js_new {external_module_name ;  name}
-  | Js_call {external_module_name ;  name ; _}
+  | Str (_, s) ->
+    (*TODO --
+       when utf8-> it will not escape '\\' which is definitely not we want
+     *)
+    let quote = best_string_quote s in 
+    pp_string f (* ~utf:(kind = `Utf8) *) ~quote s; cxt 
+  | Raw_js_code (s,info) -> 
+    begin match info with 
+    | Exp -> 
+      P.string f "("; 
+      P.string f s ; 
+      P.string f ")";
+      cxt 
+    | Stmt -> 
+      P.newline f  ;
+      P.string f s ;
+      P.newline f ;
+      cxt 
+    end
+  | Number v ->
+    let s = 
+      match v with 
+      | Float {f = v} -> 
+        Js_number.caml_float_literal_to_js_string v 
+       (* attach string here for float constant folding?*)
+      | Int { i = v; _} 
+        -> Int32.to_string v (* check , js convention with ocaml lexical convention *)
+      | Uint i
+        -> Format.asprintf "%lu" i              
+      | Nint i -> Nativeint.to_string i 
+    in
+    let need_paren =
+      if s.[0] = '-'
+      then l > 13  (* Negative numbers may need to be parenthesized. *)
+      else l = 15  (* Parenthesize as well when followed by a dot. *)
+           && s.[0] <> 'I' (* Infinity *)
+           && s.[0] <> 'N' (* NaN *)
+    in
+    let action = fun _ -> P.string f s  in
+    (
+      if need_paren 
+      then P.paren f  action
+      else action ()
+    ); 
+    cxt 
+  | J.Anything_to_number e 
+  | Int_of_boolean e -> 
+    let action () = 
+      P.group f 0 @@ fun _ -> 
+        P.string f "+" ;
+        expression 13 cxt f e 
+    in
+    (* need to tweak precedence carefully 
+       here [++x --> +(+x)]
+    *)
+    if l > 12 
+    then P.paren_group f 1 action 
+    else action ()
+  | Caml_not e ->
+    expression_desc cxt l f (Bin (Minus, E.one_int_literal, e))
+
+  | Js_not e ->
+    let action () = 
+      P.string f "!" ;
+      expression 13 cxt f e 
+    in
+    if l > 13 
+    then P.paren_group f 1 action 
+    else action ()
+  | Typeof e 
     -> 
-    check_external_module_name_opt ?loc external_module_name ;
-    valid_global_name ?loc name     
+    P.string f "typeof"; 
+    P.space f;
+    expression 13 cxt f e     
+  | Caml_block_set_tag(a,b) -> 
+    expression_desc cxt l f 
+      (Bin(Eq, 
+           {expression_desc = Caml_block_tag a; comment = None},
+           b
+          ))
+  | Caml_block_set_length(a,b) -> 
+    expression_desc cxt l f 
+      (Bin(Eq, 
+           {expression_desc = Length (a,Caml_block); comment = None},
+           b
+          ))
+  | Bin (Eq, {expression_desc = Var i },
+         {expression_desc = 
+            (
+              Bin(
+                (Plus as op), {expression_desc = Var j}, delta)
+            | Bin(
+                (Plus as op), delta, {expression_desc = Var j})
+            | Bin(
+                (Minus as op), {expression_desc = Var j}, delta)
+            )
+         })
+    when Js_op_util.same_vident i j -> 
+    (* TODO: parenthesize when necessary *)
+    begin match delta, op with 
+      | {expression_desc = Number (Int { i =  1l; _})}, Plus
+        (* TODO: float 1. instead, 
+             since in JS, ++ is a float operation           
+        *)        
+      | {expression_desc = Number (Int { i =  -1l; _})}, Minus
+        ->
+        P.string f L.plusplus;
+        P.space f ; 
+        vident cxt f i
 
+      | {expression_desc = Number (Int { i =  -1l; _})}, Plus
+      | {expression_desc = Number (Int { i =  1l; _})}, Minus
+        -> 
+        P.string f L.minusminus; 
+        P.space f ; 
+        vident cxt f i;
+      | _, _ -> 
+        let cxt = vident cxt f i in
+        P.space f ;
+        if op = Plus then P.string f "+=" 
+        else P.string f "-=";
+        P.space f ; 
+        expression 13 cxt  f delta
+    end
+  | Bin (Eq, {expression_desc = Access({expression_desc = Var i; _},
+                                       {expression_desc = Number (Int {i = k0 })}
+                                      ) },
+         {expression_desc = 
+            (Bin((Plus as op), 
+                 {expression_desc = Access(
+                      {expression_desc = Var j; _},
+                      {expression_desc = Number (Int {i = k1; })}
+                    ); _}, delta)
+            | Bin((Plus as op), delta,
+                  {expression_desc = Access(
+                       {expression_desc = Var j; _},
+                       {expression_desc = Number (Int {i = k1; })}
+                     ); _})
+            | Bin((Minus as op), 
+                  {expression_desc = Access(
+                       {expression_desc = Var j; _},
+                       {expression_desc = Number (Int {i = k1; })}
+                     ); _}, delta)
 
-(** 
-   [@@bs.module "react"]
-   [@@bs.module "react"]
-   ---
-   [@@bs.module "@" "react"]
-   [@@bs.module "@" "react"]
+            )})
+    when  k0 = k1 && Js_op_util.same_vident i j 
+    (* Note that 
+       {[x = x + 1]}
+       is exactly the same  (side effect, and return value)
+       as {[ ++ x]}
+       same to 
+       {[ x = x + a]}
+       {[ x += a ]}
+       they both return the modified value too
+    *)
+    (* TODO:
+       handle parens..
+    *)
+    ->
+    let aux cxt f vid i = 
+      let cxt = vident cxt f vid in
+      P.string f "[";
+      P.string f (Int32.to_string  i);
+      P.string f"]"; 
+      cxt in
+    (** TODO: parenthesize when necessary *)
 
-   They should have the same module name 
+    begin match delta, op with 
+      | {expression_desc = Number (Int { i =  1l; _})}, Plus
+      | {expression_desc = Number (Int { i =  -1l; _})}, Minus
+        ->
+        P.string f L.plusplus;
+        P.space f ; 
+        aux cxt f i k0
+      | {expression_desc = Number (Int { i =  -1l; _})}, Plus
+      | {expression_desc = Number (Int { i =  1l; _})}, Minus
+        -> 
+        P.string f L.minusminus; 
+        P.space f ; 
+        aux cxt f  i k0
+      | _, _ -> 
+        let cxt = aux cxt f i k0 in
+        P.space f ;
+        if op = Plus then P.string f "+=" 
+        else P.string f "-=";
+        P.space f ; 
+        expression 13 cxt  f delta
+    end
+  | Anything_to_string e -> 
+    (* Note that we should not apply any smart construtor here, 
+       it's purely  a convenice for pretty-printing
+    *)    
+    expression_desc cxt l f (Bin (Plus, {expression_desc = Str (true,""); comment = None}, e))    
 
-   TODO: we should emit an warning if we bind 
-   two external files to the same module name
-*)
-type bundle_source =
-  [`Nm_payload of string
-  |`Nm_external of string
-  | `Nm_val of string      
-  ]  
+  | Bin (Minus, {expression_desc = Number (Int {i=0l;_} | Float {f = "0."})}, e) 
+      (* TODO:
+         Handle multiple cases like
+         {[ 0. - x ]}
+         {[ 0.00 - x ]}
+         {[ 0.000 - x ]}
+       *)
+    ->
+    let action () = 
+      P.string f "-" ;
+      expression 13 cxt f e 
+    in
+    if l > 13 then P.paren_group f 1 action 
+    else action ()
 
-let string_of_bundle_source (x : bundle_source) =
-  match x with
-  | `Nm_payload x
-  | `Nm_external x
-  | `Nm_val x -> x   
-type name_source =
-  [ bundle_source  
-  | `Nm_na
+  | Bin (op, e1, e2) ->
+    let (out, lft, rght) = op_prec op in
+    let need_paren =
+      l > out || (match op with Lsl | Lsr | Asr -> true | _ -> false) in
 
-  ]
-type st = 
-  { val_name : name_source;
-    external_module_name : external_module_name option;
-    module_as_val : external_module_name option;
-    val_send : name_source ;
-    val_send_pipe : Ast_core_type.t option;    
-    splice : bool ; (* mutable *)
-    set_index : bool; (* mutable *)
-    get_index : bool;
-    new_name : name_source ;
-    call_name : name_source ;
-    set_name : name_source ;
-    get_name : name_source ;
-    mk_obj : bool ;
+    let action () = 
+      (* We are more conservative here, to make the generated code more readable
+          to the user
+       *)
 
-  }
+      let cxt = expression lft cxt  f e1 in
+      P.space f; 
+      P.string f (op_str op);
+      P.space f;
+      expression rght cxt   f e2 
+    in
+    if need_paren 
+    then P.paren_group f 1 action 
+    else action ()
 
-let init_st = 
-  {
-    val_name = `Nm_na; 
-    external_module_name = None ;
-    module_as_val = None;
-    val_send = `Nm_na;
-    val_send_pipe = None;    
-    splice = false;
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    call_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na ;
-    mk_obj = false ; 
+  | String_append (e1, e2) -> 
+    let op : Js_op.binop = Plus in
+    let (out, lft, rght) = op_prec op in
+    let need_paren =
+      l > out || (match op with Lsl | Lsr | Asr -> true | _ -> false) in
 
-  }
+    let action () = 
+      let cxt = expression  lft cxt f e1 in
+      P.space f ;
+      P.string f "+";
+      P.space f;
+      expression rght  cxt   f e2 
+    in
+    if need_paren then P.paren_group f 1 action else action ()
+
+  | Array (el,_) ->
+    (** TODO: simplify for singleton list *)
+    begin match el with 
+      | []| [ _ ] -> P.bracket_group f 1 @@ fun _ -> array_element_list  cxt f el 
+      | _ -> P.bracket_vgroup f 1 @@ fun _ -> array_element_list  cxt f el 
+    end
+  | Caml_uninitialized_obj (tag, size) 
+    ->  (* FIXME *)
+    expression_desc cxt l f (Object [Length, size ; Tag, tag])    
+  | Caml_block( el, mutable_flag, tag, tag_info) 
+    -> 
+    (* 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
+    *)
 
-let bs_external = "BS:" ^ Bs_version.version
-let bs_external_length = String.length bs_external
+    | _, _
+      -> 
+      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.arr mutable_flag el])
+    end
+  | Caml_block_tag e ->
+    P.group f 1 (fun _ ->  
+        let cxt = expression 15 cxt f  e in
+        P.string f L.dot ;
+        P.string f L.tag ;
+        cxt)
+  | Access (e, e') 
 
-let is_bs_external_prefix s = 
-  Ext_string.starts_with s bs_external
+  | String_access (e,e')
+    ->
+    let action () = 
+      P.group f 1 @@ fun _ -> 
+        let cxt = expression 15 cxt f e in
+        P.bracket_group f 1 @@ fun _ -> 
+          expression 0 cxt f e' 
+    in
+    if l > 15 then P.paren_group f 1 action else action ()
 
-let to_string  t = 
-  bs_external ^ Marshal.to_string t []
-let unsafe_from_string s = 
-    Marshal.from_string  s bs_external_length 
-let from_string s : t  = 
-  if is_bs_external_prefix s then 
-    Marshal.from_string  s (String.length bs_external)
-  else Ext_pervasives.failwithf ~loc:__LOC__
-      "compiler version mismatch, please do a clean build" 
+  | Length (e, _) -> 
+    let action () =  (** Todo: check parens *)
+      let cxt = expression 15 cxt f e in
+      P.string f L.dot;
+      P.string f L.length;
+      cxt  in
+    if l > 15 then P.paren_group f 1 action else action ()
 
-let process_external_attributes 
-    no_arguments 
-    (prim_name_or_pval_prim: [< bundle_source ] as 'a)
-    pval_prim
-    prim_attributes =
-  let name_from_payload_or_prim payload : name_source =
-    match Ast_payload.is_single_string payload with
-    | Some  val_name ->  `Nm_payload val_name
-    | None ->  (prim_name_or_pval_prim :> name_source)
-  in
-  List.fold_left 
-    (fun (st, attrs)
-      (({txt ; loc}, payload) as attr : Ast_attributes.attr) 
-      ->
-        if Ext_string.starts_with txt "bs." then
-          begin match txt with 
-            | "bs.val" ->  
-              if no_arguments then
-                {st with val_name = name_from_payload_or_prim payload}
-              else 
-                {st with call_name = name_from_payload_or_prim payload}
+  | Dot (e, s,normal) ->
+    let action () = 
+      let cxt = expression 15 cxt f e in
+      if Ext_ident.property_no_need_convert s  then
+        begin 
+          P.string f L.dot;
+          P.string f s; 
+        end
+      else
+        begin 
+          P.bracket_group f 1 @@ fun _ ->
+          pp_string f (* ~utf:(kind = `Utf8) *) ~quote:( best_string_quote s) s
+        end;
+      (* See [Js_program_loader.obj_of_exports] 
+         maybe in the ast level we should have 
+         refer and export
+      *)
+      cxt in
+    if l > 15 then P.paren_group f 1 action else action ()
 
-            | "bs.module" -> 
-              begin match Ast_payload.assert_strings loc payload with 
-                | [name] ->
-                  {st with external_module_name =
-                             Some {bundle=name; bind_name = None}}
-                | [bundle;bind_name] -> 
-                  {st with external_module_name =
-                             Some {bundle; bind_name = Some bind_name}}
-                | [] ->
-                  { st with
-                    module_as_val = 
-                      Some
-                        { bundle =
-                            string_of_bundle_source
-                              (prim_name_or_pval_prim :> bundle_source) ;
-                          bind_name = Some pval_prim}
-                  }
-                | _  -> Location.raise_errorf ~loc "Illegal attributes"
-              end
-            | "bs.splice" -> {st with splice = true}
-            | "bs.send" -> 
-              { st with val_send = name_from_payload_or_prim payload}
-            | "bs.send.pipe"
-              ->
-              { st with val_send_pipe = Some (Ast_payload.as_core_type loc payload)}                
-            | "bs.set" -> 
-              {st with set_name = name_from_payload_or_prim payload}
-            | "bs.get" -> {st with get_name = name_from_payload_or_prim payload}
+  | New (e,  el) ->
+    let action () = 
+      P.group f 1 @@ fun _ -> 
+        P.string f L.new_;
+        P.space f;
+        let cxt = expression 16 cxt f e in
+        P.paren_group f 1 @@ fun _ -> 
+          match el with 
+          | Some el  -> arguments cxt f el  
+          | None -> cxt
+    in
+    if l > 15 then P.paren_group f 1 action else action ()
 
-            | "bs.new" -> {st with new_name = name_from_payload_or_prim payload}
-            | "bs.set_index" -> {st with set_index = true}
-            | "bs.get_index"-> {st with get_index = true}
-            | "bs.obj" -> {st with mk_obj = true}
-            | _ -> (Bs_warnings.warn_unused_attribute loc txt; st)
-          end, attrs
-        else (st , attr :: attrs)
-    )
-    (init_st, []) prim_attributes 
+  | Array_of_size e ->
+    let action () = 
+      P.group f 1 @@ fun _ -> 
+        P.string f L.new_;
+        P.space f;
+        P.string f L.array;
+        P.paren_group f 1 @@ fun _ -> expression 0 cxt f e
+    in
+    if l > 15 then P.paren_group f 1 action else action ()
 
+  | Cond (e, e1, e2) ->
+    let action () = 
+      (* P.group f 1 @@ fun _ ->  *)
+      let cxt =  expression 3 cxt f e in
+      P.space f;
+      P.string f L.question; 
+      P.space f;
+      (* 
+            [level 1] is correct, however
+            to make nice indentation , force nested conditional to be parenthesized
+          *)
+      let cxt = (P.group f 1 @@ fun _ -> expression 3 cxt f e1) in
+      (* let cxt = (P.group f 1 @@ fun _ -> expression 1 cxt f e1) in *)
+      P.space f;
+      P.string f L.colon;
+      P.space f ; 
 
-let list_of_arrow (ty : Parsetree.core_type) = 
-  let rec aux (ty : Parsetree.core_type) acc = 
-    match ty.ptyp_desc with 
-    | Ptyp_arrow(label,t1,t2) -> 
-      aux t2 ((label,t1,ty.ptyp_attributes,ty.ptyp_loc) ::acc)
-    | Ptyp_poly(_, ty) -> (* should not happen? *)
-      Location.raise_errorf ~loc:ty.ptyp_loc "Unhandled poly type"
-    | return_type -> ty, List.rev acc
-  in aux ty []
+      (* idem *)
+      P.group f 1 @@ fun _ -> expression 3 cxt f e2
+      (* P.group f 1 @@ fun _ -> expression 1 cxt f e2 *)
+    in
+    if l > 2 then P.paren_vgroup f 1 action else action ()
 
-(** Note that the passed [type_annotation] is already processed by visitor pattern before 
-*)
-let handle_attributes 
-    (loc : Bs_loc.t)
-    (pval_prim : string ) 
-    (type_annotation : Parsetree.core_type)
-    (prim_attributes : Ast_attributes.t) (prim_name : string)
-  : Ast_core_type.t * string * t * Ast_attributes.t =
-  let prim_name_or_pval_prim =
-    if String.length prim_name = 0 then  `Nm_val pval_prim
-    else  `Nm_external prim_name  (* need check name *)
-  in    
-  let result_type, arg_types_ty =
-    list_of_arrow type_annotation in
-  let result_type_spec, new_result_type  = get_arg_type result_type in
-  let (st, left_attrs) = 
-    process_external_attributes 
-      (arg_types_ty = [])
-      prim_name_or_pval_prim pval_prim prim_attributes in 
+  | Object lst ->
+    begin
+      match lst with 
+      | [] -> P.string f "{ }" ; cxt 
+      | _ -> 
+        P.brace_vgroup f 1 @@ fun _ -> 
+        property_name_and_value_list cxt f lst
+    end
 
-  let splice = st.splice in 
-  let arg_type_specs, new_arg_types_ty, arg_type_specs_length   = 
-    List.fold_right 
-      (fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) -> 
-         let spec, new_ty = get_arg_type ty in
-         (if i = 0 && splice  then
-           match spec with 
-           | Array  -> ()
-           | _ ->  Location.raise_errorf ~loc "[@@bs.splice] expect last type to array");
-         ({ arg_label = Ast_core_type.label_name label ; 
-            arg_type = spec 
-          } :: arg_type_specs,
-          (label, new_ty,attr,loc) :: arg_types,
-          i + 1)
-      ) arg_types_ty 
-      (match st with
-       | {val_send_pipe = Some obj} ->      
-         let spec, new_ty = get_arg_type obj in 
-         [{ arg_label = Empty ; 
-           arg_type = spec
-          }],
-         ["", new_ty, [], obj.ptyp_loc]
-         ,0
-       | {val_send_pipe = None } -> [],[], 0) in 
+and property_name cxt f (s : J.property_name) : unit =
+  match s with
+  | Tag -> P.string f L.tag
+  | Length -> P.string f L.length
+  | Key s -> 
+    property_string  f s 
+  | Int_key i -> P.string f (string_of_int i)
 
+and property_name_and_value_list cxt f l : Ext_pp_scope.t =
+  match l with
+  | [] -> cxt
+  | [(pn, e)] ->
+    property_name cxt  f pn ;
+    P.string f L.colon;
+    P.space f;
+    expression 1 cxt f e 
+  | (pn, e) :: r ->
+    property_name cxt f pn ; 
+    P.string f L.colon;
+    P.space f;
+    let cxt = expression 1 cxt f e in
+    P.string f L.comma;
+    P.newline f;
+    property_name_and_value_list cxt f r
 
-  let ffi = 
-    match st with 
-    | { mk_obj = true;
-        val_name = `Nm_na; 
-        external_module_name = None ;
-        module_as_val = None;
-        val_send = `Nm_na;
-        val_send_pipe = None;    
-        splice = false;
-        new_name = `Nm_na;
-        call_name = `Nm_na;
-        set_name = `Nm_na ;
-        get_name = `Nm_na ;
-        get_index = false ;
-      } ->
-      if String.length prim_name <> 0 then 
-        Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string";
-      Obj_create (List.map (function
-          | {arg_label = (Empty as l) ; arg_type = Unit  }
-            -> l 
-          | {arg_label = Empty ; arg_type = _ }
-            -> Location.raise_errorf ~loc "expect label, optional, or unit here"
-          | {arg_label = (Label _) ; arg_type = (Ignore | Unit) ; }
-            -> Empty
-          | {arg_label = Label name ; arg_type = (Nothing | Array)} -> 
-            Label (Lam_methname.translate ~loc name)            
-          | {arg_label = Label l ; arg_type = (NullString _ | NonNullString _ | Int _ ) }
-            -> Location.raise_errorf ~loc 
-                 "bs.obj label %s does not support such arg type" l
-          | {arg_label = Optional name ; arg_type = (Nothing | Array | Unit | Ignore)} 
-            -> Optional (Lam_methname.translate ~loc name)
-          | {arg_label = Optional l ; arg_type = (NullString _ | NonNullString _ | Int _)} 
-            -> Location.raise_errorf ~loc 
-                 "bs.obj optional %s does not support such arg type" l )
-          arg_type_specs)(* Need fetch label here, for better error message *)
-    | {mk_obj = true; _}
-      ->
-      Location.raise_errorf ~loc "conflict attributes found"                
-    | {set_index = true;
+and array_element_list cxt f el : Ext_pp_scope.t =
+  match el with
+  | []     -> cxt 
+  | [e]    ->  expression 1 cxt f e
+  | e :: r ->
+    let cxt =  expression 1 cxt f e 
+    in
+    P.string f L.comma; P.newline f; array_element_list cxt f r
 
-       val_name = `Nm_na; 
-       external_module_name = None ;
-       module_as_val = None;
-       val_send = `Nm_na;
-       val_send_pipe = None;    
-       splice = false;
-       get_index = false;
-       new_name = `Nm_na;
-       call_name = `Nm_na;
-       set_name = `Nm_na ;
-       get_name = `Nm_na ;
-       mk_obj = false ; 
+and arguments cxt f l : Ext_pp_scope.t =
+  match l with
+  | []     -> cxt 
+  | [e]    ->   expression 1 cxt f e
+  | e :: r -> 
+    let cxt =   expression 1 cxt f e in
+    P.string f L.comma; P.space f; arguments cxt f r
 
-      } 
-      ->
-      if String.length prim_name <> 0 then 
-        Location.raise_errorf ~loc "[@@bs.set_index] expect external names to be empty string";
-      if arg_type_specs_length = 3 then 
-          Js_set_index
-      else 
-        Location.raise_errorf ~loc "Ill defined attribute [@@bs.set_index](arity of 3)"
+and variable_declaration top cxt f 
+    (variable : J.variable_declaration) : Ext_pp_scope.t = 
+  (* TODO: print [const/var] for different backends  *)
+  match variable with
+  | {ident = i; value =  None; ident_info ; _} -> 
+    if ident_info.used_stats = Dead_pure 
+    then cxt
+    else 
+      begin
+        P.string f L.var;
+        P.space f;
+        let cxt = ident cxt  f i in
+        semi f ; 
+        cxt
+      end 
+  | { ident = name; value =  Some e; ident_info = {used_stats; _}} ->
+    begin match used_stats with
+      | Dead_pure -> 
+        cxt 
+      | Dead_non_pure -> 
+        (* Make sure parens are added correctly *)
+        statement_desc top cxt f (J.Exp e)
+      | _ -> 
+        begin match e, top  with 
+          | {expression_desc = Fun (method_, params, b, env ); comment = _}, _ -> 
+            pp_function method_ cxt f 
+              ~name:(if top then Name_top name else Name_non_top name) 
+              false params b env 
+          | _, _ -> 
+              P.string f L.var;
+              P.space f;
+              let cxt = ident cxt f name in
+              P.space f ;
+              P.string f L.eq;
+              P.space f ;
+              let cxt = expression 1 cxt f e in
+              semi f;
+              cxt 
+        end
+    end
+and ipp_comment : 'a . P.t -> 'a  -> unit = fun   f comment -> 
+  ()
 
-    | {set_index = true; _}
-      ->
-      Location.raise_errorf ~loc "conflict attributes found"        
 
-    | {get_index = true;
+(** don't print a new line -- ASI 
+    FIXME: this still does not work in some cases...
+    {[
+    return /* ... */
+    [... ]
+    ]}
+*)
 
-       val_name = `Nm_na; 
-       external_module_name = None ;
-       module_as_val = None;
-       val_send = `Nm_na;
-       val_send_pipe = None;    
+and pp_comment f comment = 
+  if String.length comment > 0 then 
+    P.string f "/* "; P.string f comment ; P.string f " */" 
 
-       splice = false;
-       new_name = `Nm_na;
-       call_name = `Nm_na;
-       set_name = `Nm_na ;
-       get_name = `Nm_na ;
-       mk_obj = false ; 
-      } ->
-      if String.length prim_name <> 0 then 
-        Location.raise_errorf ~loc "[@@bs.get_index] expect external names to be empty string";
-      if arg_type_specs_length = 2 then 
-          Js_get_index
-      else Location.raise_errorf ~loc "Ill defined attribute [@@bs.get_index] (arity of 2)"
+and pp_comment_option f comment  = 
+    match comment with 
+    | None -> ()
+    | Some x -> pp_comment f x
+and statement top cxt f 
+    ({statement_desc = s;  comment ; _} : J.statement)  : Ext_pp_scope.t =
 
-    | {get_index = true; _}
-      -> Location.raise_errorf ~loc "conflict attributes found"        
-    | {module_as_val = Some external_module_name ;
+  pp_comment_option f comment ;
+  statement_desc top cxt f s 
 
-       get_index = false;
-       val_name ;
-       new_name ;
-       (*TODO: a better way to avoid breaking existing code,
-         we need tell the difference from 
-         {[
-           1. [@@bs.val "x"]
-           2. external x : .. "x" [@@bs.val ]
-           3. external x : .. ""  [@@bs.val]    ]}
-                                                *)         
-      external_module_name = None ;
-      val_send = `Nm_na;
-      val_send_pipe = None;    
-      splice ;
-      call_name = `Nm_na;
-      set_name = `Nm_na ;
-      get_name = `Nm_na ;
-      mk_obj = false ;} ->
-   begin match arg_types_ty, new_name, val_name  with         
-    | [], `Nm_na,  _ -> Js_module_as_var external_module_name
-    | _, `Nm_na, _ -> Js_module_as_fn {splice; external_module_name }
-    | _, #bundle_source, #bundle_source ->
-      Location.raise_errorf ~loc "conflict attributes found"
-    | _, (`Nm_val _ | `Nm_external _) , `Nm_na
-      -> Js_module_as_class external_module_name
-    | _, `Nm_payload _ , `Nm_na
-      ->
-      Location.raise_errorf ~loc
-        "conflict attributes found: (bs.new should not carry payload here)"
+and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t = 
+  match s with
+  | Block [] -> 
+      ipp_comment f  L.empty_block; (* debugging*)
+      cxt
+  | Exp {expression_desc = Var _;}
+    -> (* Does it make sense to optimize here? *)
+      semi f; cxt 
 
-  end
- | {module_as_val = Some _}
-   -> Location.raise_errorf ~loc "conflict attributes found" 
- | {call_name = (`Nm_val name | `Nm_external name | `Nm_payload name) ;
-    splice; 
-    external_module_name;
+  | Block b -> (* No braces needed here *)
+      ipp_comment f L.start_block;
+      let cxt = statement_list top cxt  f b in
+      ipp_comment f  L.end_block;
+      cxt
+  | Variable l ->
+      variable_declaration top cxt  f l
+  | Exp e ->
+    (* Parentheses are required when the expression
+       starts syntactically with "{" or "function" 
+       TODO:  be more conservative, since Google Closure will handle
+       the precedence correctly, we also need people read the code..
+       Here we force parens for some alien operators
 
-    val_name = `Nm_na ;
-    module_as_val = None;
-    val_send = `Nm_na ;
-    val_send_pipe = None;    
+       If we move assign into a statement, will be less?
+       TODO: construct a test case that do need parenthesisze for expression
+       IIE does not apply (will be inlined?)
+    *)
 
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na 
-   } -> 
-   Js_call {splice; name; external_module_name}
- | {call_name = #bundle_source } 
-   -> Location.raise_errorf ~loc "conflict attributes found"
+    let rec need_paren  (e : J.expression) =
+      match e.expression_desc with
+      | Call ({expression_desc = Fun _; },_,_) -> true
+      | Caml_uninitialized_obj _ 
+      | Raw_js_code (_, Exp) 
+      | Fun _ | Object _ -> true
+      | Raw_js_code (_,Stmt)
+      | Caml_block_set_tag _ 
+      | Length _ 
+      | Caml_block_set_length _ 
+      | Anything_to_string _ 
+      | String_of_small_int_array _
+      | Call _ 
+      | Array_append _ 
+      | Array_copy _ 
+      | Caml_block_tag _ 
+      | Seq _
+      | Dot _
+      | Cond _
+      | Bin _ 
+      | String_access _ 
+      | Access _
+      | Array_of_size _ 
+      | String_append _ 
+      | Char_of_int _ 
+      | Char_to_int _
+      | Dump _
+      | Json_stringify _ 
+      | Math _
+      | Var _ 
+      | Str _ 
+      | Array _ 
+      | Caml_block  _ 
+      | FlatCall _ 
+      | Typeof _
+      | Bind _ 
+      | Number _
+      | Caml_not _ (* FIXME*)
+      | Js_not _ 
+      | Bool _
+      | New _ 
+      | J.Anything_to_number _ 
+      | Int_of_boolean _ -> false
+      (* e = function(x){...}(x);  is good
+       *)
+    in
+    let cxt = 
+      (
+        if need_paren  e 
+        then (P.paren_group f 1)
+        else (P.group f 0)
+      ) (fun _ -> expression 0 cxt f e ) in
+    semi f;
+    cxt 
+
+  | If (e, s1,  s2) -> (* TODO: always brace those statements *)
+    P.string f L.if_;
+    P.space f;
+    let cxt = P.paren_group f 1 @@ fun _ -> expression 0 cxt f e in
+    P.space f;
+    let cxt =
+      block cxt f s1
+    in
+    begin match s2 with 
+     | None | (Some []) 
+     | Some [{statement_desc = (Block [] | Exp {expression_desc = Var _;} ); }]
+       -> P.newline f; cxt
+     | Some [{statement_desc = If _} as nest]
+     | Some [{statement_desc = Block [ {statement_desc = If _ ; _} as nest] ; _}]
+       ->
+       P.newline f;
+       P.string f L.else_;
+       P.space f;
+       statement false cxt f nest 
+     | Some s2 -> 
+       P.newline f;
+       P.string f L.else_;
+       P.space f ;
+       block  cxt f s2 
+    end
+
+  | While (label, e, s, _env) ->  (*  FIXME: print scope as well *)
+      begin 
+        (match label with 
+        | Some i ->
+            P.string f i ; 
+            P.string f L.colon;
+            P.newline f ;
+        | None -> ());
+        let cxt = 
+          match e.expression_desc with
+          | Number (Int {i = 1l}) ->
+              P.string f L.while_;
+              P.string f "(";
+              P.string f L.true_;
+              P.string f ")"; 
+              P.space f ;
+              cxt 
+          | _ -> 
+              P.string f L.while_;
+              let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e in
+              P.space f ; 
+              cxt 
+        in
+        let cxt = block cxt f s in
+        semi f;
+        cxt
+      end
+  | ForRange (for_ident_expression, finish, id, direction, s, env) -> 
+    let action cxt  = 
+      P.vgroup f 0 @@ fun _ -> 
+        let cxt = P.group f 0 @@ fun _ -> 
+            (* The only place that [semi] may have semantics here *)
+            P.string f "for";
+            P.paren_group f 1 @@ fun _ -> 
+              let cxt, new_id = 
+                (match for_ident_expression, finish.expression_desc with 
+                 | Some ident_expression , (Number _ | Var _ ) -> 
+                   P.string f L.var;
+                   P.space f;
+                   let cxt  =  ident cxt f id in
+                   P.space f; 
+                   P.string f L.eq;
+                   P.space f;
+                   expression 0 cxt f ident_expression, None
+                 | Some ident_expression, _ -> 
+                   P.string f L.var;
+                   P.space f;
+                   let cxt  =  ident cxt f id in
+                   P.space f;
+                   P.string f L.eq;
+                   P.space f; 
+                   let cxt = expression 1 cxt f ident_expression in
+                   P.space f ; 
+                   P.string f L.comma;
+                   let id = Ext_ident.create (Ident.name id ^ "_finish") in
+                   let cxt = ident cxt f id in
+                   P.space f ; 
+                   P.string f L.eq;
+                   P.space f;
+                   expression 1 cxt f finish, Some id
+                 | None, (Number _ | Var _) -> 
+                   cxt, None 
+                 | None , _ -> 
+                   P.string f L.var;
+                   P.space f ;
+                   let id = Ext_ident.create (Ident.name id ^ "_finish") in
+                   let cxt = ident cxt f id in
+                   P.space f ; 
+                   P.string f L.eq ; 
+                   P.space f ; 
+                   expression 15 cxt f finish, Some id
+                ) in
 
- | {val_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
-    external_module_name;
+              semi f ; 
+              P.space f;
+              let cxt = ident cxt f id in
+              P.space f;
+              let right_prec  = 
 
-    call_name = `Nm_na ;
-    module_as_val = None;
-    val_send = `Nm_na ;
-    val_send_pipe = None;    
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na 
+                match direction with 
+                | Upto -> 
+                  let (_,_,right) = op_prec Le  in
+                  P.string f L.le;
+                  right
+                | Downto -> 
+                  let (_,_,right) = op_prec Ge in
+                  P.string f L.ge ;
+                  right
+              in
+              P.space f ; 
+              let cxt  = 
+                match new_id with 
+                | Some i -> expression   right_prec cxt  f (E.var i)
+                | None -> expression  right_prec cxt  f finish
+              in
+              semi f; 
+              P.space f;
+              let ()  = 
+                match direction with 
+                | Upto -> P.string f L.plus_plus
+                | Downto -> P.string f L.minus_minus in
+              ident cxt f id
+        in
+        block  cxt f s  in
+    let lexical = Js_closure.get_lexical_scope env in
+    if Ident_set.is_empty lexical 
+    then action cxt
+    else 
+      (* unlike function, 
+         [print for loop] has side effect, 
+         we should take it out
+      *)
+      let inner_cxt = Ext_pp_scope.merge lexical cxt in
+      let lexical = Ident_set.elements lexical in
+      let _enclose action inner_cxt lexical   = 
+        let rec aux  cxt f ls  =
+          match ls with
+          | [] -> cxt
+          | [x] -> ident cxt f x
+          | y :: ys ->
+            let cxt = ident cxt f y in
+            P.string f L.comma;
+            aux cxt f ys  in
+        P.vgroup f 0
+          (fun _ ->
+             (
+               P.string f "(function(";
+               ignore @@ aux inner_cxt f lexical;
+               P.string f ")";
+               let cxt = P.brace_vgroup f 0  (fun _ -> action inner_cxt) in
+               P.string f "(";
+               ignore @@ aux inner_cxt f lexical;
+               P.string f ")";
+               P.string f ")";
+               semi f;
+               cxt
+             )) 
+      in
+      _enclose action inner_cxt lexical
 
-   } 
-   -> 
-   Js_global { name; external_module_name}
- | {val_name = #bundle_source }
-   -> Location.raise_errorf ~loc "conflict attributes found"
- | {splice ;
-    external_module_name = (Some _ as external_module_name);
+  | Continue s ->
+    P.string f L.continue;
+    P.space f ;
+    P.string f s;
+    semi f;
+    P.newline f;
+    cxt
+  | Debugger
+    -> 
+    P.newline f ;
+    P.string f L.debugger;
+    semi f ;
+    P.newline f;
+    cxt 
+  | Break
+    ->
+    P.string f L.break;
+    P.space f ;
+    semi f;
+    P.newline f; 
+    cxt
 
-    val_name = `Nm_na ;         
-    call_name = `Nm_na ;
-    module_as_val = None;
-    val_send = `Nm_na ;
-    val_send_pipe = None;             
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na ;
+  | Return {return_value = e} ->
+    begin match e with
+      | {expression_desc = Fun (method_,  l, b, env); _} ->
+        let cxt =
+          pp_function method_ cxt f true l b env in
+        semi f ; cxt 
+      | e ->
+        P.string f L.return ;
+        P.space f ;
 
-   }
-   ->
-   let name = string_of_bundle_source prim_name_or_pval_prim in
-   if arg_type_specs_length  = 0 then
-     Js_global { name; external_module_name}
-   else  Js_call {splice; name; external_module_name}                     
- | {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name); 
-    splice;
-    val_send_pipe = None;
-    val_name = `Nm_na  ;
-    call_name = `Nm_na ;
-    module_as_val = None;
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na ;
-    external_module_name = None ;
-   } -> 
-   if arg_type_specs_length > 0 then 
-       Js_send {splice ; name; pipe = false}
-   else 
-       Location.raise_errorf ~loc "Ill defined attribute [@@bs.send] (at least one argument)"
- | {val_send = #bundle_source} 
-   -> Location.raise_errorf ~loc "conflict attributes found"
+        (* P.string f "return ";(\* ASI -- when there is a comment*\) *)
+        P.group f return_indent @@ fun _ -> 
+          let cxt =  expression 0 cxt f e in
+          semi f;
+          cxt 
+          (* There MUST be a space between the return and its
+             argument. A line return will not work *)
+    end
+  | Int_switch (e, cc, def) ->
+    P.string f L.switch;  
+    P.space f;
+    let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e 
+    in
+    P.space f;
+    P.brace_vgroup f 1 @@ fun _ -> 
+      let cxt = loop cxt f (fun f i -> P.string f (string_of_int i) ) cc in
+      (match def with
+       | None -> cxt
+       | Some def ->
+         P.group f 1 @@ fun _ -> 
+           P.string f L.default;
+           P.string f L.colon;
+           P.newline f;
+           statement_list  false cxt  f def 
+      )
 
- | {val_send_pipe = Some typ; 
-    (* splice = (false as splice); *)
-    val_send = `Nm_na;
-    val_name = `Nm_na  ;
-    call_name = `Nm_na ;
-    module_as_val = None;
-    set_index = false;
-    get_index = false;
-    new_name = `Nm_na;
-    set_name = `Nm_na ;
-    get_name = `Nm_na ;
-    external_module_name = None ;
-   } -> 
-   (** can be one argument *)
-   Js_send {splice  ;
-            name = string_of_bundle_source prim_name_or_pval_prim;
-            pipe = true}
+  | String_switch (e, cc, def) ->
+    P.string f L.switch;
+    P.space f;
+    let cxt = P.paren_group f 1 @@ fun _ ->  expression 0 cxt f e 
+    in
+    P.space f;
+    P.brace_vgroup f 1 @@ fun _ -> 
+      let cxt = loop cxt f (fun f i -> pp_quote_string f i ) cc in
+      (match def with
+       | None -> cxt
+       | Some def ->
+         P.group f 1 @@ fun _ -> 
+           P.string f L.default;
+           P.string f L.colon;
+           P.newline f;
+           statement_list  false cxt  f def )
 
- | {val_send_pipe = Some _ } 
-   -> Location.raise_errorf ~loc "conflict attributes found"
+  | Throw e ->
+    P.string f L.throw;
+    P.space f ;
+    P.group f throw_indent @@ fun _ -> 
 
- | {new_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
-    external_module_name;
+      let cxt = expression 0 cxt f e in
+      semi f ; cxt 
 
-    val_name = `Nm_na  ;
-    call_name = `Nm_na ;
-    module_as_val = None;
-    set_index = false;
-    get_index = false;
-    val_send = `Nm_na ;
-    val_send_pipe = None;             
-    set_name = `Nm_na ;
-    get_name = `Nm_na ;
-    splice 
-   } 
-   -> Js_new {name; external_module_name; splice}
- | {new_name = #bundle_source }
-   -> Location.raise_errorf ~loc "conflict attributes found"
+  (* There must be a space between the return and its
+     argument. A line return would not work *)
+  | Try (b, ctch, fin) ->
+    P.vgroup f 0 @@ fun _-> 
+      P.string f "try";
+      P.space f ; 
+      let cxt = block cxt f b in
+      let cxt = 
+        match ctch with
+        | None ->
+          cxt
+        | Some (i, b) ->
+          P.newline f;
+          P.string f "catch (";
+          let cxt = ident cxt f i in
+          P.string f ")";
+          block cxt f b
+      in 
+      begin match fin with
+        | None -> cxt
+        | Some b ->
+          P.group f 1 @@ fun _ -> 
+            P.string f "finally";
+            P.space f;
+            block cxt f b 
+      end
+(* similar to [block] but no braces *)
+and statement_list top cxt f  b =
+  match b with
+  | []     -> cxt
+  | [s]    -> statement top  cxt f  s
+  | s :: r -> 
+    let cxt = statement top cxt f s in
+    P.newline f;
+    (if top then P.force_newline f);
+    statement_list top cxt f  r
 
- | {set_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
+and block cxt f b =
+  (* This one is for '{' *)
+  P.brace_vgroup f 1 (fun _ -> statement_list false cxt   f b )
 
-    val_name = `Nm_na  ;
-    call_name = `Nm_na ;
-    module_as_val = None;
-    set_index = false;
-    get_index = false;
-    val_send = `Nm_na ;
-    val_send_pipe = None;             
-    new_name = `Nm_na ;
-    get_name = `Nm_na ;
-    external_module_name = None
-   } 
-   -> 
-   if arg_type_specs_length = 2 then 
-       Js_set name 
-   else  Location.raise_errorf ~loc "Ill defined attribute [@@bs.set] (two args required)"
 
- | {set_name = #bundle_source}
-   -> Location.raise_errorf ~loc "conflict attributes found"
+let exports cxt f (idents : Ident.t list) = 
+  let outer_cxt, reversed_list, margin = 
+    List.fold_left (fun (cxt, acc, len ) (id : Ident.t) -> 
+        let s = Ext_ident.convert true id.name in        
+        let str,cxt  = str_of_ident cxt id in         
+        cxt, ( (s,str) :: acc ) , max len (String.length s)   )
+      (cxt, [], 0)  idents in    
+  P.newline f ;
+  Ext_list.rev_iter (fun (s,export) -> 
+      P.group f 0 @@ (fun _ ->  
+          P.string f L.exports;
+          P.string f L.dot;
+          P.string f s; 
+          P.nspace f (margin - String.length s +  1) ;
+          P.string f L.eq;
+          P.space f;
+          P.string f export;          
+          semi f;);
+      P.newline f;
+    ) reversed_list;
+  outer_cxt  
 
- | {get_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
 
-    val_name = `Nm_na  ;
-    call_name = `Nm_na ;
-    module_as_val = None;
-    set_index = false;
-    get_index = false;
-    val_send = `Nm_na ;
-    val_send_pipe = None;             
-    new_name = `Nm_na ;
-    set_name = `Nm_na ;
-    external_module_name = None
-   }
-   ->
-   if arg_type_specs_length = 1 then  
-     Js_get name
-   else 
-       Location.raise_errorf ~loc "Ill defined attribute [@@bs.get] (only one argument)"
- | {get_name = #bundle_source}
-   -> Location.raise_errorf ~loc "conflict attributes found"
- | _ ->  Location.raise_errorf ~loc "Illegal attribute found"  in
-  begin 
-    check_ffi ~loc ffi;
-    (match ffi, new_result_type with
-     | Obj_create arg_labels ,  {ptyp_desc = Ptyp_any; _}
-       ->
-       (* special case: 
-          {[ external f : int -> string -> _ = "" ]}
-       *)
-       let result =
-         Ast_core_type.make_obj ~loc (
-           List.fold_right2  (fun arg label acc ->
-               match arg, label with
-               | (_, ty, _,_), Ast_core_type.Label s
-                 -> (s , [], ty) :: acc                 
-               | (_, ty, _,_), Optional s
-                 ->
-                 begin match (ty : Ast_core_type.t) with
-                   | {ptyp_desc =
-                        Ptyp_constr({txt =
-                                       Ldot (Lident "*predef*", "option") },
-                                    [ty])}
-                     ->                
-                     (s, [], Ast_comb.to_undefined_type loc ty) :: acc
-                   | _ -> assert false                 
-                 end                 
-               | (_, _, _,_), Ast_core_type.Empty -> acc                
-             ) arg_types_ty arg_labels [])  in
+(* Node style *)
+let requires require_lit cxt f (modules : (Ident.t * string) list ) =
+  P.newline f ; 
+  (* the context used to print the following program *)  
+  let outer_cxt, reversed_list, margin  =
+    List.fold_left
+      (fun (cxt, acc, len) (id,s) ->
+         let str, cxt = str_of_ident cxt id  in
+         cxt, ((str,s) :: acc), (max len (String.length str))
+      )
+      (cxt, [], 0)  modules in
+  P.force_newline f ;    
+  Ext_list.rev_iter (fun (s,file) ->
+      P.string f L.var;
+      P.space f ;
+      P.string f s ;
+      P.nspace f (margin - String.length s + 1) ;
+      P.string f L.eq;
+      P.space f;
+      P.string f require_lit;
+      P.paren_group f 0 @@ (fun _ ->
+          pp_string f ~utf:true ~quote:(best_string_quote s) file  );
+      semi f ;
+      P.newline f ;
+    ) reversed_list;
+  outer_cxt
 
-       List.fold_right (fun (label,ty,attrs,loc) acc -> 
-           Ast_helper.Typ.arrow ~loc  ~attrs label ty acc 
-           ) new_arg_types_ty result 
+let program f cxt   ( x : J.program ) = 
+  let () = P.force_newline f in
+  let cxt =  statement_list true cxt f x.block  in
+  let () = P.force_newline f in
+  exports cxt f x.exports
 
-       (* Ast_core_type.replace_result type_annotation result *)
-     | _  ->
-       List.fold_right (fun (label,ty,attrs,loc) acc -> 
-           Ast_helper.Typ.arrow ~loc  ~attrs label ty acc 
-           ) new_arg_types_ty new_result_type
-    ) ,
-    prim_name,
-    (Bs(arg_type_specs, result_type_spec,  ffi)), left_attrs
-  end
+let goog_program ~output_prefix f goog_package (x : J.deps_program)  = 
+  P.newline f ;
+  P.string f L.goog_module;
+  P.string f "(";
+  P.string f (Printf.sprintf "%S" goog_package);
+  P.string f ")";
+  semi f ;
+  let cxt = 
+    requires
+      L.goog_require
+      Ext_pp_scope.empty
+      f 
+      (List.map 
+         (fun x -> 
+            Lam_module_ident.id x,
+            Js_program_loader.string_of_module_id
+              ~output_prefix `Goog x)
+         x.modules) 
+  in
+  program f cxt x.program  
 
-let handle_attributes_as_string 
-    pval_loc
-    pval_prim 
-    (typ : Ast_core_type.t) attrs v = 
-  let pval_type, prim_name, ffi, processed_attrs  = 
-    handle_attributes pval_loc pval_prim typ attrs v  in
-  pval_type, [prim_name; to_string ffi], processed_attrs
-    
-let pval_prim_of_labels labels = 
-  let encoding = 
-    let (arg_kinds, vs) = 
-      List.fold_right 
-        (fun {Asttypes.loc ; txt } (arg_kinds,v)
-          ->
-            let arg_label =  Ast_core_type.Label (Lam_methname.translate ~loc txt) in
-            {arg_type = Nothing ; 
-             arg_label  } :: arg_kinds, arg_label :: v
-        )
-        labels ([],[]) in 
-    to_string @@
-    Bs (arg_kinds , Nothing, Obj_create vs) in 
-  [""; encoding]
+let node_program ~output_prefix f ( x : J.deps_program) = 
+  let cxt = 
+    requires 
+      L.require
+      Ext_pp_scope.empty
+      f
+      (List.map 
+         (fun x -> 
+            Lam_module_ident.id x,
+            Js_program_loader.string_of_module_id
+              ~output_prefix
+              `NodeJS x)
+         x.modules)
+  in
+  program f cxt x.program  
 
 
-end
-module Js_of_lam_option : sig 
-#1 "js_of_lam_option.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+let amd_program ~output_prefix f (  x : J.deps_program) = 
+  P.newline f ; 
+  let cxt = Ext_pp_scope.empty in
+  P.vgroup f 1 @@ fun _ -> 
+  P.string f L.define;
+  P.string f "([";
+  P.string f (Printf.sprintf "%S" L.exports);
+
+  List.iter (fun x ->
+      let s = Js_program_loader.string_of_module_id ~output_prefix `AmdJS x in
+      P.string f L.comma ;
+      P.space f; 
+      pp_string f ~utf:true ~quote:(best_string_quote s) s;
+    ) x.modules ;
+  P.string f "]";
+  P.string f L.comma;
+  P.newline f;
+  P.string f L.function_;
+  P.string f "(";
+  P.string f L.exports;
 
+  let cxt = 
+    List.fold_left (fun cxt x ->         
+        let id = Lam_module_ident.id x in
+        P.string f L.comma;
+        P.space f ; 
+        ident cxt f id
+      ) cxt x.modules     
+  in
+  P.string f ")";
+  let v = P.brace_vgroup f 1 @@ (fun _ -> 
+      let () = P.string f L.strict_directive in 
+      program f cxt x.program
+    ) in
+  P.string f ")";
+  v
 
+(** Make sure github linguist happy
+    {[
+      require('Linguist')
+      Linguist::FileBlob.new('jscomp/test/test_u.js').generated?
+    ]}
+*)
+let bs_header = 
+  "// Generated by BUCKLESCRIPT VERSION " ^
+  Bs_version.version ^
+  " , PLEASE EDIT WITH CARE"
 
+let pp_deps_program
+    ~output_prefix
+    (kind : Lam_module_ident.system )
+    (program  : J.deps_program) (f : Ext_pp.t) = 
+  begin
+    if not !Js_config.no_version_header then 
+      begin 
+        P.string f bs_header;
+        P.newline f
+      end ; 
+    P.string f L.strict_directive; 
+    P.newline f ;    
+    ignore (match kind with 
+     | `AmdJS -> 
+       amd_program ~output_prefix f program
+     | `NodeJS -> 
+       node_program ~output_prefix f program
+     | `Goog  -> 
+       let goog_package = 
+         let v = Js_config.get_module_name () in
+         match Js_config.get_package_name () with 
+         | None 
+           -> v 
+         | Some x -> x ^ "." ^ v 
+       in 
+       goog_program ~output_prefix f goog_package  program
+      ) ;
+    P.newline f ;
+    P.string f (
+      match program.side_effect with
+      | None -> "/* No side effect */"
+      | Some v -> Printf.sprintf "/* %s Not a pure module */" v );
+    P.newline f;
+    P.flush f ()
+  end
 
+let dump_program (x : J.program) oc = 
+  ignore (program (P.from_channel oc)  Ext_pp_scope.empty  x )
 
+let dump_deps_program
+    ~output_prefix
+    kind
+    x 
+    (oc : out_channel) = 
+  pp_deps_program ~output_prefix  kind x (P.from_channel oc)
 
+let string_of_block  block  
+  = 
+  let buffer  = Buffer.create 50 in
+  begin
+    let f = P.from_buffer buffer in
+    let _scope =  statement_list true Ext_pp_scope.empty  f block in
+    P.flush  f ();
+    Buffer.contents buffer     
+  end
 
-val get_default_undefined : J.expression -> J.expression
 
-val none : J.expression 
+let string_of_expression e =
+  let buffer  = Buffer.create 50 in
+  begin
+    let f = P.from_buffer buffer in
+    let _scope =  expression 0  Ext_pp_scope.empty  f e in
+    P.flush  f ();
+    Buffer.contents buffer     
+  end
 
-val some : J.expression -> J.expression
+ 
 
-end = struct
-#1 "js_of_lam_option.ml"
+end
+module Js_fold_basic : sig 
+#1 "js_fold_basic.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -80314,88 +81636,16 @@ end = struct
 
 
 
-module E = Js_exp_make 
- 
-(**
-  Invrariant: 
-  - optional encoding
-  -  None encoding
-
-  when no argumet is supplied, [undefined] 
-  if we detect that all rest arguments are [null], 
-  we can remove them
-
-
-  - avoid duplicate evlauation of [arg] when it
-   is not a variable
-  {!Js_ast_util.named_expression} does not help 
-   since we need an expression here, it might be a statement
-*)
-let get_default_undefined (arg : J.expression) : J.expression = 
-  match arg.expression_desc with 
-  | Number _ -> E.undefined
-  | Array ([x],_) 
-  | Caml_block([x],_,_,_) -> x (* invariant: option encoding *)
-  | _ -> 
-    if Js_ast_util.is_simple_expression arg then 
-      E.econd arg (E.index arg 0l) E.undefined
-    else E.runtime_call Js_config.js_primitive "option_get" [arg]
-  
-(** Another way: 
-    {[
-      | Var _  ->
-        can only bd detected at runtime thing
-          (E.bin EqEqEq (E.typeof arg)
-             (E.str "number"))
-    ]}
-*)
-let none : J.expression = 
-  {expression_desc = Number (Int {i = 0l; c  = None}); comment = Some "None" }
-
-let some x : J.expression = 
-  {expression_desc = Caml_block ( [x], Immutable, E.zero_int_literal , Blk_constructor ("Some",1) );
-   comment = None}
-
-
-
-
-
 
 
+(** A module to calculate hard dependency based on JS IR in module [J] *)
 
-end
-module Js_of_lam_variant : sig 
-#1 "js_of_lam_variant.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
+val depends_j : J.expression -> Ident_set.t -> Ident_set.t
 
-val eval : J.expression -> (int * string) list -> J.expression
-val eval_as_event : J.expression -> (int * string) list -> J.expression list 
-val eval_as_int : J.expression -> (int * int) list -> J.expression
+val calculate_hard_dependencies : J.block -> Lam_module_ident.t Hash_set_poly.t
 
 end = struct
-#1 "js_of_lam_variant.ml"
+#1 "js_fold_basic.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -80420,115 +81670,96 @@ end = struct
  * 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
-
-let eval (arg : J.expression) (dispatches : (int * string) list ) = 
-  match arg.expression_desc with
-  | Number (Int {i} | Uint i) -> 
-    begin match List.assoc (Int32.to_int i) dispatches with 
-    | exception Not_found -> assert false 
-    | v ->  E.str v 
-    end
 
-  | _ ->  
-    E.of_block
-      [(S.int_switch arg
-      (List.map (fun (i,r) -> 
-              {J.case = i ; 
-               body = [S.return (E.str r)],
-                      false (* FIXME: if true, still print break*)
-              }) dispatches))]
 
-let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) = 
-  match arg.expression_desc with
-  | Array ([{expression_desc = Number (Int {i} | Uint i)}; cb], _)
-  | Caml_block([{expression_desc = Number (Int {i} | Uint i)}; cb], _, _, _)
-    -> 
-    begin match (List.assoc (Int32.to_int i) dispatches) with 
-    | v ->     [E.str v ; cb]
-    | exception Not_found -> assert false 
-    end
 
-  | _ ->  
-    let event = Ext_ident.create "action" in
-    [
-      E.ocaml_fun [event]
-      [(S.int_switch arg
-      (List.map (fun (i,r) -> 
-              {J.case = i ; 
-               body = [S.return (E.index (E.var event) 0l)],
-                      false (* FIXME: if true, still print break*)
-              }) dispatches))]
-      ; (* TODO: improve, one dispatch later, 
-           the problem is that we can not create bindings 
-           due to the 
-        *)
-      E.ocaml_fun [event]
-      [(S.int_switch arg
-      (List.map (fun (i,r) -> 
-              {J.case = i ; 
-               body = [S.return (E.index (E.var event) 1l)],
-                      false (* FIXME: if true, still print break*)
-              }) dispatches))]
-    ]
 
-let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) = 
-  match arg.expression_desc with
-  | Number (Int {i} | Uint i) ->
-    begin match  (List.assoc (Int32.to_int i) dispatches) with
-    | e -> E.int (Int32.of_int e)
-    | exception Not_found -> assert false 
-    end
-  | _ ->  
-    E.of_block
-      [(S.int_switch arg
-      (List.map (fun (i,r) -> 
-              {J.case = i ; 
-               body = [S.return (E.int (Int32.of_int  r))],
-                      false (* FIXME: if true, still print break*)
-              }) dispatches))]
 
-end
-module Js_of_lam_tuple : sig 
-#1 "js_of_lam_tuple.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
 
 
+class count_deps (add : Ident.t -> unit )  = 
+  object(self)
+    inherit  Js_fold.fold as super
+    method! expression lam = 
+      match lam.expression_desc with 
+      | Fun (_, _, block, _) -> self#block block
+      (** Call 
+          actually depends on parameter, 
+          since closure 
+          {[
+            n = n - 1
+                    acc = () => n 
+          ]}
+          should be 
 
+          {[
+            acc = (function (n) {() => n} (n))
+              n = n - 1
+          ]}
+      *)
+      | _ -> super#expression lam
+    method! ident x = add x ; self
+  end
 
+class count_hard_dependencies = 
+  object(self)
+    inherit  Js_fold.fold as super
+    val hard_dependencies = Hash_set_poly.create 17
+    method! vident vid = 
+      match vid with 
+      | Qualified (id,kind,_) ->
+          Hash_set_poly.add  hard_dependencies (Lam_module_ident.mk kind id); self
+      | Id id -> self
+    method! expression x = 
+      match  x with
+      | {expression_desc = Call (_,_, {arity = NA}); _}
+        (* see [Js_exp_make.runtime_var_dot] *)
+        -> 
+        Hash_set_poly.add hard_dependencies 
+          (Lam_module_ident.of_runtime (Ext_ident.create_js Js_config.curry));
+        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}*)
+            -> ()
+          | _, _
+            -> 
+            Hash_set_poly.add hard_dependencies 
+              (Lam_module_ident.of_runtime (Ext_ident.create_js Js_config.block));
+        end;
+        super#expression x 
+      | _ -> super#expression x
+    method get_hard_dependencies = hard_dependencies
+  end
 
+let calculate_hard_dependencies block = 
+  ((new count_hard_dependencies)#block block) # get_hard_dependencies
 
+(*
+   Given a set of [variables], count which variables  [lam] will depend on
+   Invariant:
+   [variables] are parameters which means immutable so that [Call] 
+   will not depend [variables]
 
-(** Utilities for compiling lambda tuple into JS IR *)
+*)
+let depends_j (lam : J.expression) (variables : Ident_set.t) = 
+  let v = ref Ident_set.empty in
+  let add id = 
+    if Ident_set.mem id variables then 
+      v := Ident_set.add id !v 
+  in
+  ignore @@ (new count_deps add ) # expression lam ;
+  !v
 
-val make : J.expression list -> J.expression
 
-end = struct
-#1 "js_of_lam_tuple.ml"
+end
+module Lam_compile_defs : sig 
+#1 "lam_compile_defs.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -80560,59 +81791,69 @@ end = struct
 
 
 
-module E = Js_exp_make
+(** Type defintion to keep track of compilation state 
+  *)
 
-let make (args : J.expression list) =
-  E.make_block E.zero_int_literal Blk_tuple args Immutable
+(** Some types are defined in this module to help avoiding generating unnecessary symbols 
+    (generating too many symbols will make the output code unreadable)
+*)
+
+type jbl_label = int 
 
 
-end
-module Lam_dispatch_primitive : sig 
-#1 "lam_dispatch_primitive.mli"
-(* 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
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * 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. *)
 
+type value = {
+    exit_id : Ident.t ; 
+    args : Ident.t list ;
+    order_id : int
+  }
 
+type let_kind = Lambda.let_kind
 
+type st = 
+  | EffectCall
+  | Declare of let_kind * J.ident (* bound value *)
+  | NeedValue 
+  | Assign of J.ident 
+  (** when use [Assign], var is not needed, since it's already declared 
+      make sure all [Assign] are declared first, otherwise you are creating global variables
+   *)
 
+type return_label = {
+  id : Ident.t;
+  label : J.label;
+  params : Ident.t list;
+  immutable_mask : bool array;
+  mutable new_params : Ident.t Ident_map.t ;
+  mutable triggered : bool
+}
 
+type return_type = 
+  | False 
+  | True of return_label option (* anonoymous function does not have identifier *)
 
+(* delegate to the callee to generate expression 
+      Invariant: [output] should return a trailing expression
+  *)
 
+module HandlerMap : Map.S with type key = jbl_label
 
+type cxt = {
+  st : st ;
+  should_return : return_type;
+  jmp_table : value  HandlerMap.t ;
+  meta : Lam_stats.meta ;
+}
 
-(** Compile lambda primitives (note this is different external c calls) *)
+val empty_handler_map : value HandlerMap.t 
 
+val add_jmps :
+    Ident.t * (HandlerMap.key * 'a * Ident.t list) list ->
+    value HandlerMap.t -> value HandlerMap.t * (int * 'a) list
 
-(** 
-    @return None when the primitives are not handled in  pre-processing
- *)
-val translate : 
-  string ->
-  J.expression list -> J.expression 
 
 end = struct
-#1 "lam_dispatch_primitive.ml"
+#1 "lam_compile_defs.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -80644,1040 +81885,349 @@ end = struct
 
 
 
+type jbl_label = int 
 
-module E = Js_exp_make  
-module S = Js_stmt_make
-
-
-(** 
-There are two things we need consider:
-1.  For some primitives we can replace caml-primitive with js primitives directly
-2.  For some standard library functions, we prefer to replace with javascript primitives
-    For example [Pervasives["^"] -> ^]
-    We can collect all mli files in OCaml and replace it with an efficient javascript runtime
+module HandlerMap = Map.Make(struct 
+  type t = jbl_label
+  let compare x y= compare (x:t) y 
+end )
 
-TODO: return type to be expression is ugly, 
-   we should allow return block    
-*)
-let translate (prim_name : string) 
-    (args : J.expression list) : J.expression  =
-  let call m = E.runtime_call m prim_name args in 
-  begin match prim_name with 
-  | "caml_gc_stat" 
-  | "caml_gc_quick_stat"  
-  | "caml_gc_counters"
-  | "caml_gc_get"
-  | "caml_gc_set"
-  | "caml_gc_minor"
-  | "caml_gc_major_slice"
-  | "caml_gc_major"
-  | "caml_gc_full_major"
-  | "caml_gc_compaction"
-  | "caml_final_register"
-  | "caml_final_release"
-    ->  call Js_config.gc
-  | "caml_abs_float" -> 
-    E.math "abs" args 
-  | "caml_acos_float" -> 
-    E.math "acos" args 
-  |  "caml_add_float" -> 
-    begin match args with 
-    | [e0;e1] -> E.float_add e0 e1 (** TODO float plus*)
-    | _ -> assert false
-    end
-  |"caml_div_float" -> 
-    begin match args with 
-    | [e0;e1] -> E.float_div e0 e1
-    | _ -> assert false 
-    end
-  |"caml_sub_float" -> 
-    begin match args with 
-    | [e0;e1] -> E.float_minus e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_eq_float" -> 
-    begin match args with 
-    | [e0;e1] -> E.float_equal e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_ge_float"  ->
-    begin match args with 
-    | [e0;e1] -> E.float_comp Cge e0 e1
-    | _ -> assert false 
-    end
-  |"caml_gt_float"  ->
-    begin match args with 
-    | [e0;e1] -> E.float_comp Cgt  e0 e1
-    | _ -> assert false 
-    end
-  | "caml_tan_float"  ->
-    E.math "tan" args 
-  | "caml_tanh_float"  ->
-    E.math "tanh" args 
-  | "caml_asin_float"  -> 
-    E.math "asin" args 
-  | "caml_atan2_float" -> 
-    E.math "atan2" args
-  | "caml_atan_float" -> 
-    E.math "atan" args 
-  | "caml_ceil_float" -> 
-    E.math "ceil" args 
-  | "caml_cos_float" -> 
-    E.math "cos" args 
-  | "caml_cosh_float" -> 
-    E.math "cosh" args
-  | "caml_exp_float" -> 
-    E.math "exp" args
-  | "caml_sin_float" -> 
-    E.math "sin" args
-  | "caml_sinh_float"-> 
-    E.math "sinh" args
-  | "caml_sqrt_float" -> 
-    E.math "sqrt" args
+type value = {
+    exit_id : Ident.t ;
+    args : Ident.t list ;
+    order_id : int
+  }
 
+(* delegate to the callee to generate expression 
+      Invariant: [output] should return a trailing expression
+ *)
+type return_label = {
+  id : Ident.t;
+  label : J.label;
+  params : Ident.t list;
+  immutable_mask : bool array; 
+  mutable new_params : Ident.t Ident_map.t;  
+  mutable triggered : bool
+}
 
-  | "caml_float_of_int" -> 
-    begin match args with 
-    | [e] -> e 
-    | _ -> assert false 
-    end
-  | "caml_floor_float" ->
-    E.math "floor" args 
-  | "caml_log_float" -> 
-    E.math "log" args 
-  | "caml_log10_float" -> 
-    E.math "log10" args 
-  | "caml_log1p_float" -> 
-    E.math "log1p" args 
-  | "caml_power_float"  -> 
-    E.math "pow" args
-  |  "caml_make_float_vect" -> 
-    E.new_ (E.js_global "Array") args 
+type return_type = 
+  | False 
+  | True of return_label option 
+   (* have a mutable field to notifiy it's actually triggered *)
+   (* anonoymous function does not have identifier *)
 
+type let_kind = Lambda.let_kind
 
-  | "caml_array_append" -> 
-    begin match args with 
-    | [e0;e1] -> E.array_append e0 e1
-    | _ ->  assert false 
-    end
+type st = 
+  | EffectCall
+  | Declare of let_kind * J.ident (* bound value *)
+  | NeedValue 
+  | Assign of J.ident (* when use [Assign], var is not needed, since it's already declared  *)
 
-  | "caml_array_get"
-  | "caml_array_get_addr"
-  | "caml_array_get_float"
-  | "caml_array_unsafe_get"
-  | "caml_array_unsafe_get_float" -> 
-    begin match args with 
-    | [e0;e1] -> Js_of_lam_array.ref_array e0 e1
-    | _ -> assert false
-    end
-  | "caml_array_set"
-  | "caml_array_set_addr"
-  | "caml_array_set_float"
-  | "caml_array_unsafe_set"
-  | "caml_array_unsafe_set_addr"
-  | "caml_array_unsafe_set_float" -> 
-    begin match args with 
-    | [e0;e1;e2] -> 
-      Js_of_lam_array.set_array e0 e1 e2
-    | _ -> assert false
-    end
+type cxt = {
+  st : st ;
+  should_return : return_type;
+  jmp_table : value  HandlerMap.t ;
+  meta : Lam_stats.meta ;
+  (* include_alias :  *)
+  (*   (\** It's correct to add more, we can do this in lambda optimization pass *)
+  (*    *\) *)
+  (*   (Ident.t , Ident.t) Hashtbl.t *)
+  (* Used when compiling [Lstaticraise]  *)
+}
 
-  | "caml_int32_add"
-    -> 
-    begin match args with 
-    | [e0;e1] -> E.int32_add e0 e1 
-    | _ -> assert false 
-    end
+let empty_handler_map = HandlerMap.empty
 
-  | "caml_nativeint_add" 
-    -> 
-    begin match args with 
-    | [e0;e1] -> E.unchecked_int32_add e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_int32_div" 
-    -> 
-    begin match args with 
-      | [e0;e1] -> 
-        E.int32_div  ~checked:(!Js_config.check_div_by_zero) e0 e1
-      | _ -> assert false 
-    end
 
-  | "caml_nativeint_div" 
-    -> (* nativeint behaves exactly the same as js numbers except division *)
-    begin match args with 
-    | [e0;e1] -> E.int32_div  ~checked:false e0 e1
-    | _ -> assert false 
-    end
+let add_jmps (exit_id, code_table)   
+    (m : value HandlerMap.t) = 
+  (* always keep key id positive, specifically no [0] generated
+   *)
+  let map, _, handlers = 
+    List.fold_left 
+           (fun (acc,prev_order_id, handlers) 
+               (l,lam, args)   -> 
+                 let order_id = prev_order_id + 1 in
+                 (HandlerMap.add l {exit_id ; args; order_id } acc, 
+                  order_id ,
+                  (order_id, lam) :: handlers))
+      (m,
+       HandlerMap.cardinal m,
+       []
+      )
+      code_table in
+  map, List.rev handlers
 
-  | "caml_int32_mul"
-    -> 
-    begin match args with 
-    | [e0;e1] -> E.int32_mul e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_nativeint_mul"  -> 
-    begin match args with 
-    | [e0;e1] -> E.unchecked_int32_mul e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_int32_of_int"
-  | "caml_nativeint_of_int" 
-  | "caml_nativeint_of_int32" -> 
-    begin match args with 
-    | [e] -> e 
-    | _ -> assert false 
-    end
-  | "caml_int32_of_float"
-  | "caml_int_of_float"
-  | "caml_nativeint_of_float" -> 
-    begin match args with 
-    | [e] -> E.to_int32 e 
-    | _ -> assert false 
-    end
-  | "caml_int32_to_float"
-  | "caml_int32_to_int"
-  | "caml_nativeint_to_int" 
-  | "caml_nativeint_to_float"
-  | "caml_nativeint_to_int32" -> 
-    begin match args with 
-    | [e] -> e (* TODO: do more checking when [to_int32]*)
-    | _ -> assert false 
-    end
-  | "caml_int32_sub" -> 
-    begin match args with 
-    | [e0;e1] -> E.int32_minus e0 e1 
-    | _ -> assert false 
-    end
+end
+module Js_output : sig 
+#1 "js_output.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  | "caml_nativeint_sub" ->
-    begin match args with 
-    | [e0;e1] -> E.unchecked_int32_minus e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_int32_xor" 
-  | "caml_nativeint_xor" -> 
-    begin match args with 
-    | [e0; e1] -> E.int32_bxor e0 e1 
-    | _ -> assert false 
-    end
 
-  | "caml_int32_and"
-  | "caml_nativeint_and" -> 
-    begin match args with 
-    | [e0;e1] -> E.int32_band e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_int32_or"
-  | "caml_nativeint_or" ->
-    begin match args with
-    | [e0;e1] -> E.int32_bor e0 e1 
-    | _ -> assert false  
-    end
-  | "caml_le_float" ->
-    begin match args with 
-    | [e0;e1] -> E.float_comp Cle e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_lt_float" ->
-    begin match args with 
-    | [e0;e1] -> E.float_comp Clt e0 e1 
-    | _ -> assert false 
-    end
-  |  "caml_neg_float" -> 
-    begin match args with 
-    | [e] -> 
-      (** TODO: use float.. *)
-      E.int32_minus E.zero_int_literal e 
-    | _ -> assert false
-    end
-  | "caml_neq_float" -> 
-    begin match args with 
-    | [e0;e1] -> E.float_notequal e0 e1
-    | _ -> assert false 
-    end
-  | "caml_mul_float" -> 
-    begin match args with 
-    | [e0; e1] -> E.float_mul e0 e1 
-    | _ -> assert false  
-    end
-  | "caml_int64_to_float"
-    -> Js_long.to_float args
-  | "caml_int64_of_float"
-    -> Js_long.of_float args
-  | "caml_int64_compare"
-    -> Js_long.compare args 
-  | "js_int64_discard_sign"
-    -> Js_long.discard_sign args
-  | "js_int64_div_mod"
-    -> Js_long.div_mod args
-  | "js_int64_to_hex"
-    -> Js_long.to_hex args    
-  | "caml_int64_bits_of_float"
-    -> Js_long.bits_of_float args     
-  | "caml_int64_float_of_bits"
-    -> Js_long.float_of_bits args 
-  | "caml_int64_bswap"
-    -> Js_long.swap args    
-  | "caml_int32_float_of_bits"
-  | "caml_int32_bits_of_float"
-  | "caml_classify_float"
-  | "caml_modf_float"
-  | "caml_ldexp_float"
-  | "caml_frexp_float"
-  | "caml_float_compare"
-  | "caml_copysign_float"
-  | "caml_expm1_float"
-  | "caml_hypot_float"
 
-    ->
-    call Js_config.float
-  | "caml_fmod_float" 
-    (* float module like js number module *)      
-    ->      
-    begin match args with 
-    | [e0;e1] -> E.float_mod e0 e1
-    | _ -> assert false 
-    end
 
-  | "caml_string_equal" 
-    -> 
-    begin match args with 
-    | [e0; e1] -> E.string_equal e0 e1 
-    | _ -> assert false 
-    end
-  | "caml_string_notequal"
-    -> 
-    begin match args with 
-    | [e0; e1] -> E.string_comp NotEqEq e0 e1
-    (** TODO: convert to ocaml ones*)
-    | _ -> assert false 
-    end
-  | "caml_string_lessequal"
-    -> 
-    begin 
-      match args with 
-      | [e0; e1] 
-        -> 
-        E.string_comp Le e0 e1
-      | _ -> assert false 
-    end
-  | "caml_string_lessthan"
-    -> 
-    begin match args with 
-    | [e0; e1] 
-      -> 
-      E.string_comp Lt e0 e1
-    | _ -> assert false 
-    end
-  | "caml_string_greaterequal"
-    -> 
-    begin match args with 
-    | [e0; e1] 
-      -> 
-      E.string_comp Ge  e0 e1
-    | _ -> assert false 
-    end
-  | "caml_string_greaterthan"
-    -> 
-    begin match args with 
-    | [e0; e1] 
-      -> 
-      E.string_comp Gt  e0 e1
-    | _ -> assert false 
-    end
-  | "caml_create_string" -> 
-    (* Note that for invalid range, JS raise an Exception RangeError, 
-       here in OCaml it's [Invalid_argument], we have to preserve this semantics.
-        Also, it's creating a [bytes] which is a js array actually.
-    *)
-    begin match args with
-    | [{expression_desc = Number (Int {i; _}); _} as v] 
-      when i >= 0l -> 
-      E.uninitialized_array v 
-    (* TODO: inline and spits out a warning when i is negative *)
-    | _ -> 
-      call Js_config.string 
-    end
 
-  | "caml_string_get"
-  | "caml_string_compare"
-  | "string_of_bytes"
-  | "bytes_of_string"
 
-  | "caml_is_printable"
-  | "caml_string_of_char_array"
-  | "caml_fill_string"
-  | "caml_blit_string" 
-  | "caml_blit_bytes"
-    -> 
-    call Js_config.string
 
-  | "caml_register_named_value" -> 
-    (**
-       callback.ml
-       {[ external register_named_value : string -> Obj.t -> unit
-         = "caml_register_named_value" ]}
 
-       See the manual chap19, Interfacing C with OCaml
+(** The intemediate output when compiling lambda into JS IR *)
 
-       {[
-         let f x = print_string "f is applied to "; print_int x; print_newline()
-         let _ = Callback.register "test function" f
-       ]}
+(* Hongbo Should we rename this module js_of_lambda since it looks like it's 
+   containing that step
+ *)
 
-       On the C side 
-       {[
-         let f x = print_string "f is applied to "; print_int x; print_newline()
-         let _ = Callback.register "test function" f
-       ]}
+type st = Lam_compile_defs.st 
 
-       [caml_named_value] is a c primitive but not belong to OCaml/runtimedef.ml,
-       so we don't needs
-       handle it 
-    *)
-    E.unit
+type finished = 
+  | True 
+  | False 
+  | Dummy (* Have no idea, so that when [++] is applied, always use the other *)
 
-  | "caml_backtrace_status"
+type t  =  { 
+  block : J.block ;
+  value : J.expression option;
+  finished : finished
+}
 
+val make : ?value: J.expression -> ?finished:finished -> J.block -> t
 
-  | "caml_get_exception_backtrace"
-  | "caml_get_exception_raw_backtrace"
-  | "caml_record_backtrace"
-  | "caml_convert_raw_backtrace" 
-  | "caml_get_current_callstack"
-    -> E.unit
-  (* unit -> unit 
-     _ -> unit  
-     major_slice : int -> int 
-  *)
-  | "caml_set_oo_id" 
-    ->
-    (** ATT: relevant to how exception is encoded in OCaml 
-        IDea: maybe we can delay compile primitive into js?
-        benefit: 
-        less code side when serialzation, and more knowledge in jsir
-    *)
-    Js_of_lam_exception.caml_set_oo_id args 
+val of_stmt : ?value: J.expression -> ?finished:finished -> J.statement -> t
 
-  | "caml_sys_const_big_endian" -> 
-    (** return false *)
-    E.bool Sys.big_endian
-  | "caml_sys_const_word_size" -> 
-    E.small_int  Sys.word_size
-  (** TODO: How it will affect program behavior *)
-  | "caml_sys_const_ostype_cygwin" -> E.caml_false 
-  | "caml_sys_const_ostype_win32" -> E.caml_false 
-  | "caml_sys_const_ostype_unix" -> E.caml_true
-  | "caml_is_js" -> E.caml_true
-  | "caml_sys_get_config" ->
-    (** No cross compilation *)
-    Js_of_lam_tuple.make [E.str Sys.os_type; E.small_int  Sys.word_size; 
-                          E.bool Sys.big_endian ]
-  | "caml_sys_get_argv" -> 
-    (** TODO: refine
-        Inlined here is helpful for DCE
-        {[ external get_argv: unit -> string * string array = "caml_sys_get_argv" ]}
-    *)
-    Js_of_lam_tuple.make [E.str "cmd"; 
-                          Js_of_lam_array.make_array NA Pgenarray []
-                         ]
-  | "caml_sys_time"
-  | "caml_sys_random_seed"
-  | "caml_sys_getenv"
-  | "caml_sys_system_command" 
-  | "caml_sys_getcwd" (* check browser or nodejs *)
-  | "caml_sys_is_directory"
-  | "caml_sys_file_exists"
-    -> 
-    call Js_config.sys
-  | "caml_lex_engine"
-  | "caml_new_lex_engine"
-    -> 
-    call Js_config.lexer 
-  | "caml_parse_engine"
-  | "caml_set_parser_trace" 
-    -> 
-    call Js_config.parser 
+val of_block : ?value:J.expression -> ?finished:finished -> J.block -> t
 
-  | "caml_array_sub"
-  | "caml_array_concat"
-  (*external concat: 'a array list -> 'a array 
-     Not good for inline *)
+val to_block : t -> J.block
 
-  | "caml_array_blit"
-  | "caml_make_vect" -> 
-    call Js_config.array
-  | "caml_ml_flush"
-  | "caml_ml_out_channels_list"
-  | "caml_ml_open_descriptor_in" 
-  | "caml_ml_open_descriptor_out"
-  | "caml_ml_output_char"
-  | "caml_ml_output" 
-  | "caml_ml_input_char"
-    -> 
-    call Js_config.io
-  | "caml_update_dummy"
-  | "caml_obj_dup" -> 
-    (** Note currently is an Array copy function, this is tightly coupled with 
-        how record, tuple encoded in JS.
-        Here we only inline constant cases, since this semantics should be preserved 
-        no matter how we represent objects, we don't inline it just for future
-    *)
-    begin 
-      match args with 
-      | [ a ] when Js_analyzer.is_constant a ->  a 
-      | _ -> 
-        call Js_config.obj_runtime 
-    end
-  | "caml_obj_block" -> 
-    (** TODO: Optimize  for [CamlinternalOO] input 
-        external new_block : tag:int -> size:int  -> t = "caml_obj_block"
-        Note that we don't need initialize its content anyway
-        TODO: more optimizations later
-        ATTENTION: This optmization is coupled with memory layout
-    *)
-    begin match args with 
-    | [ tag; 
-        {expression_desc = Number (Int { i ;_}); _} ] ->
-      E.make_block tag Blk_na 
-        (Ext_list.init (Int32.to_int i) 
-           (fun _ -> E.zero_int_literal)) NA
+val to_break_block : t -> J.block * bool 
 
-    | [ tag; size] -> 
-      E.uninitialized_object tag size
-    | _ -> assert false
+module Ops : sig 
+  val (++) : t -> t -> t 
+end
 
+val dummy : t 
 
-    end
-  | "caml_format_float"
 
-  | "caml_nativeint_format"
-  | "caml_int32_format"
-  | "caml_float_of_string"
-  | "caml_int_of_string" (* what is the semantics?*)
-  | "caml_int32_of_string"
-  | "caml_nativeint_of_string" 
-  | "caml_int64_format"
-  | "caml_int64_of_string"
-    -> 
-    call Js_config.format 
-  | "caml_format_int" -> 
-    begin match args with 
-    | [ {expression_desc = Str (_, "%d"); _}; v] 
-      ->
-      E.int_to_string v 
-    | _ -> 
-      call Js_config.format
-    end
-    (*   "caml_alloc_dummy"; *)
-    (* TODO:   "caml_alloc_dummy_float"; *)
+val handle_name_tail :
+    Lam_compile_defs.st ->
+    Lam_compile_defs.return_type ->
+    Lam.t ->  J.expression -> t
+
+val handle_block_return : 
+    Lam_compile_defs.st ->
+    Lam_compile_defs.return_type ->
+    Lam.t ->
+    J.block -> J.expression -> t
+
+val concat : t list -> t
+
+val to_string : t -> string
+
+end = struct
+#1 "js_output.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
 
 
-  | "caml_obj_is_block"
-    -> 
-    begin match args with 
-    | [e] -> E.is_caml_block e 
-    | _ -> assert false
-    end
-  | "caml_obj_truncate"
-  | "caml_lazy_make_forward"
-  | "caml_compare"
-  | "caml_int_compare"
-  | "caml_int32_compare"
-  | "caml_nativeint_compare"
-  | "caml_equal"
-  | "caml_notequal"
-  | "caml_greaterequal"
-  | "caml_greaterthan"
-  | "caml_lessequal"
-  | "caml_lessthan"
 
-    -> 
-    call Js_config.obj_runtime
-  | "caml_obj_set_tag" 
-    -> begin match args with 
-      | [a;b]  -> E.set_tag a b 
-      | _ -> assert false end
-  | "caml_obj_tag" -> 
-    (* Note that in ocaml, [int] has tag [1000] and [string] has tag [252]
-       also now we need do nullary check 
-    *)      
-    begin match args with 
-    | [e] -> E.tag e 
-    | _ -> assert false end
 
-  (* Unix support *)
-  | "unix_tcdrain"
-  | "unix_tcflush"
-  | "unix_setsid"
-  | "unix_tcflow"
-  | "unix_tcgetattr"
-  | "unix_tcsetattr"
-  | "unix_tcsendbreak"
-  | "unix_getprotobynumber"
-  | "unix_getprotobyname"
-  | "unix_getservbyport"
-  | "unix_getservbyname"
-  | "unix_getservbyaddr"
-  | "unix_gethostbyname"
-  | "unix_gethostname"
-  | "unix_getpeername"
-  | "unix_accept"
-  | "unix_bind"
-  | "unix_connect"
-  | "unix_listen"
-  | "unix_shutdown"
-  | "unix_getsockname"
-  | "unix_gethostbyaddr"
-  | "unix_getgrnam"
-  | "unix_getpwuid"
-  | "unix_getgrgid"
-  | "unix_inet_addr_of_string"
-  | "unix_string_of_inet_addr"
-  | "unix_socket"
-  | "unix_socketpair"
-  | "unix_error_message"
-  | "unix_read"
-  | "unix_write"
-  | "unix_single_write"
-  | "unix_set_close_on_exec"
-  | "unix_sigprocmask"
-  | "unix_sigsuspend"
-  | "unix_recv"
-  | "unix_recvfrom"
-  | "unix_send"
-  | "unix_sendto"
-  | "unix_getsockopt"
-  | "unix_setsockopt"
-  | "unix_getaddrinfo"
-  | "unix_getnameinfo"
-  | "unix_waitpid"
-  | "unix_wait"
-  | "unix_fork"
-  | "unix_execv"
-  | "unix_dup"
-  | "unix_close"
-  | "unix_dup2"
-  | "unix_execvp"
-  | "unix_execvpe"
-  | "unix_pipe"
-  | "unix_execve"
-  | "caml_channel_descriptor"
-  | "unix_putenv"
-  | "unix_environment"
-  | "unix_lseek"
-  | "unix_getppid"
-  | "unix_getpid"
-  | "unix_nice"
-  | "unix_open"
-  | "unix_truncate"
-  | "unix_ftruncate"
-  | "unix_stat"
-  | "unix_lstat"
-  | "unix_fstat"
-  | "unix_isatty"
-  | "unix_lseek_64"
-  | "unix_truncate_64"
-  | "unix_ftruncate_64"
-  | "unix_stat_64"
-  | "unix_lstat_64"
-  | "unix_fstat_64"
-  | "unix_unlink"
-  | "unix_rename"
-  | "unix_link"
-  | "unix_chmod"
-  | "unix_fchmod"
-  | "unix_chown"
-  | "unix_fchown"
-  | "unix_umask"
-  | "unix_access"
-  | "unix_set_nonblock"
-  | "unix_clear_nonblock"
-  | "unix_clear_close_on_exec"
-  | "unix_mkdir"
-  | "unix_rmdir"
-  | "unix_chdir"
-  | "unix_getcwd"
-  | "unix_chroot"
-  | "unix_opendir"
-  | "unix_readdir"
-  | "unix_rewinddir"
-  | "unix_closedir"
-  | "unix_mkfifo"
-  | "unix_symlink"
-  | "unix_readlink"
-  | "unix_select"
-  | "unix_lockf"
-  | "unix_kill"
-  | "unix_sigpending"
-  | "unix_time"
-  | "unix_gettimeofday"
-  | "unix_gmtime"
-  | "unix_localtime"
-  | "unix_mktime"
-  | "unix_alarm"
-  | "unix_sleep"
-  | "unix_times"
-  | "unix_utimes"
-  | "unix_getitimer"
-  | "unix_setitimer"
-  | "unix_getuid"
-  | "unix_geteuid"
-  | "unix_setuid"
-  | "unix_getgid"
-  | "unix_getegid"
-  | "unix_setgid"
-  | "unix_getgroups"
-  | "unix_setgroups"
-  | "unix_initgroups"
-  | "unix_getlogin"
-  | "unix_getpwnam"
-    ->  E.not_implemented prim_name
-  (* End of Unix support *)
-  (* bigarrary support *)
-  | "caml_ba_init"
-    -> 
-    begin match args with 
-      | [e] -> E.seq e E.unit 
-      | _ -> assert false
-    end
-  | "caml_ba_create"
-  | "caml_ba_get_generic"
-  | "caml_ba_set_generic"
-  | "caml_ba_num_dims"
-  | "caml_ba_dim"
-  | "caml_ba_kind"
-  | "caml_ba_layout"
-  | "caml_ba_sub"
-  | "caml_ba_slice"
-  | "caml_ba_blit"
-  | "caml_ba_fill"
-  | "caml_ba_reshape"
-  | "caml_ba_map_file_bytecode"
 
-    (* caml_ba_get_1,  (\* %caml_ba_ref_1 *\) *)
-    (* caml_ba_get_2, *)
-    (* caml_ba_get_3, *)
 
-    (* caml_ba_set_1,  // %caml_ba_set_1 *)
-    (* caml_ba_set_2, *)
-    (* caml_ba_set_3, *)
 
-    (* caml_ba_dim_1, // %caml_ba_dim_1 *)
-    (* caml_ba_dim_2,  *)
-    (* caml_ba_dim_3,  *)
+module E = Js_exp_make 
+module S = Js_stmt_make 
 
-    -> 
-    E.not_implemented prim_name
-    (* call  Js_config.bigarray *)
-  (* End of bigarray support *)
-  | "caml_convert_raw_backtrace_slot"
-    -> call  Js_config.backtrace
+type finished = 
+  | True 
+  | False 
+  | Dummy (* Have no idea, so that when [++] is applied, always use the other *)
 
-  | "caml_bswap16"
-  | "caml_int32_bswap"
-  | "caml_nativeint_bswap" 
-    -> call Js_config.int32
-  | "caml_get_public_method"
-    ->
-    call Js_config.oo
-  (** TODO: Primitives not implemented yet ...*)
-  | "caml_install_signal_handler"
-    -> 
-    begin match args with
-    | [num; behavior] 
-      -> E.seq num behavior (*TODO:*)
-    | _ -> assert false
-    end
-  | "caml_md5_string"
-    -> call Js_config.md5
-  | "caml_hash"
-    -> call Js_config.hash 
-  | "caml_weak_set"
-  | "caml_weak_create"
-  | "caml_weak_get"
-  | "caml_weak_check"
-  | "caml_weak_blit"
-  | "caml_weak_get_copy"
-    -> call Js_config.weak
+type t  =  { 
+  block : J.block ;
+  value : J.expression option;
+  finished : finished ; 
+    (** When [finished] is true the block is already terminated, value does not make sense
+        default is false, false is  an conservative approach 
+     *)
+}
 
-  | "caml_output_value_to_buffer"
-  | "caml_marshal_data_size"
-  | "caml_input_value_from_string"
-  | "caml_output_value"
-  | "caml_input_value"
-  | "caml_output_value_to_string"
-  | "caml_md5_chan"
-  | "caml_hash_univ_param"
-  | "caml_sys_close"
-  | "caml_sys_open"
-  | "caml_ml_input"
-  | "caml_ml_input_scan_line"
-  | "caml_ml_input_int"
-  | "caml_ml_close_channel"
-  | "caml_ml_output_int"
-  | "caml_sys_exit"
-  | "caml_ml_channel_size_64"
-  | "caml_ml_channel_size"
-  | "caml_ml_pos_in_64"
-  | "caml_ml_pos_in"
-  | "caml_ml_seek_in"
-  | "caml_ml_seek_in_64"
-  | "caml_ml_pos_out"
-  | "caml_ml_pos_out_64"
-  | "caml_ml_seek_out"
-  | "caml_ml_seek_out_64"
-  | "caml_ml_set_binary_mode"
-    ->  E.not_implemented prim_name
+type st = Lam_compile_defs.st 
 
-  | "js_function_length"
+let make ?value ?(finished=False) block = {block ; value ; finished }
 
-    -> begin
-        match args with 
-        | [f ] -> E.function_length f 
-        | _ -> assert false
-      end
-  | "js_create_array" 
-    -> 
-    begin match args with 
-    | [e] -> E.uninitialized_array e 
-    | _ -> assert false
-    end
-  | "js_array_append" 
-    -> 
-    begin match args with 
-    | [a;b] -> 
-      E.array_append a b 
-    | _ -> assert false 
-    end
-  | "js_string_append"
-    -> 
-    begin match args with 
-    | [a ; b] -> E.string_append a b 
-    | _ -> assert false
-    end
-  | "js_apply" 
-    -> 
-    begin match args with 
-    | [f ;  args] -> 
-      E.flat_call f args
-    | _ -> assert false 
-    end
-  | "js_string_of_small_int_array"
-    ->
-    begin match args with 
-    | [e] -> E.string_of_small_int_array e 
-    | _ -> assert false
-    end
-  | "js_string_of_char" 
-    ->
-      begin match args with 
-      | [{expression_desc = Number (Int {i; _})} ] 
-        -> E.str (String.make 1 (Char.chr (Int32.to_int i)))
-      | _ -> call Js_config.string
-      end
-  | "js_unsafe_lt" 
-    -> 
-    begin match args with 
-      | [l; r] -> E.bin Lt l r 
-      | _ -> assert false 
-    end
-  | "js_unsafe_le" 
-    -> begin match args with 
-    | [l; r] -> E.bin Le l r 
-    | _ -> assert false end 
-  | "js_unsafe_gt" 
-    -> begin match args with 
-    | [l;r] -> E.bin Gt l r 
-    | _ ->  assert false end 
-  | "js_unsafe_ge" -> 
-    begin match args with 
-    | [l ; r] -> E.bin Ge l r 
-    | _ -> assert false end
-  | "js_boolean_to_bool"
-    -> 
-    begin match args with 
-    | [e] -> E.to_ocaml_boolean e 
-    | _ -> assert false
-    end
-  | "js_is_instance_array" 
-    ->
-    begin match args with 
-    | [e] -> E.is_instance_array e 
-    | _ -> assert false end
-  | "js_typeof"
-    -> 
-    begin match args with 
-    | [e] -> E.typeof e         
-    | _ -> assert false
-    end
+let of_stmt ?value ?(finished = False) stmt = {block = [stmt] ; value ; finished }
 
-  | "js_dump"
-    -> 
-    (* This primitive can accept any number of arguments 
-       {[
-         console.log(1,2,3)
-           1 2 3
-       ]}         
-    *)      
-    E.seq (E.dump Log args) E.unit
+let of_block ?value ?(finished = False) block = 
+  {block  ; value ; finished }
 
-  | "caml_anything_to_string"
-  (* patched to compiler to support for convenience *)      
-  | "js_anything_to_string" 
-    ->
-    begin match args with 
-    | [e] -> E.anything_to_string e 
-    | _ -> assert false
-    end
-  | "js_anything_to_number" 
-    -> 
-    begin match args with 
-    | [e] -> E.to_number e 
-    | _ -> assert false
-    end
+let dummy = {value = None; block = []; finished = Dummy }
 
-  | "js_json_stringify"      
-    -> 
-    begin match args with 
-    | [e] ->        
-      E.to_json_string e
-    | _ -> 
-      assert false      
-    end
-    (* | "js_dump1" *)
-    (* | "js_dump2" *)
-    (* | "js_dump3" *)
-    (* | "js_dump4" *)
-    (* | "js_dump5" *)
-    (* | "js_dump6" *)
-    (* | "js_dump7" (\* TODO: refin api later *\) *)
-    (* | "js_dump8" -> E.dump Log args  *)
-    | "js_apply1"
-    | "js_apply2"
-    | "js_apply3"
-    | "js_apply4"
-    | "js_apply5"
-    | "js_apply6"
-    | "js_apply7"
-    | "js_apply8" -> 
-      begin match args with 
-        | fn :: rest -> 
-          E.call ~info:{arity=Full; call_info =  Call_na} fn rest 
-        | _ -> assert false
-      end
-    | "js_uninitialized_object"
-      ->
-      begin match args with 
-        | [ tag; size] -> E.uninitialized_object tag size 
-        | _ -> assert false  end
-    | "js_obj_length" 
-      -> 
-      begin match args with 
-        | [e] -> E.obj_length e 
-        | _ -> assert false 
-      end
-    | "js_pure_expr" (* TODO: conver it even earlier *)
-      -> 
-      begin match args with 
-      | [ { expression_desc = Str (_,s )}] -> 
-        E.raw_js_code Exp  s
-      | _ -> 
-        Ext_log.err __LOC__ 
-          "JS.unsafe_js_expr is applied to an non literal string in %s"
-          (Js_config.get_current_file ())
-        ;
-        assert false
-      end
-    | "js_pure_stmt" (* TODO: convert even ealier *)
-      -> 
-      begin match args with 
-      | [ { expression_desc = Str (_,s )}] -> E.raw_js_code Stmt s
-      | _ -> 
-        Ext_log.err __LOC__ 
-          "JS.unsafe_js_expr is applied to an non literal string in %s"
-          (Js_config.get_current_file ())
-        ;
-        assert false
-      end
-    | "js_is_nil" -> 
-      begin match args with
-      | [ e ] -> E.is_nil e 
-      | _ -> assert false 
-      end
-    | "js_is_undef" -> 
-      begin match args with 
-      | [e] -> E.is_undef e 
-      | _ -> assert false
-      end
-    | "js_is_nil_undef" 
-    | "js_from_nullable_def"
-      -> call Js_config.js_primitive
-    | "js_from_def" 
-      -> 
-      begin match args with 
-      | [e] -> 
-        begin match e.expression_desc with 
-        | Var _ -> 
-          E.econd (E.is_undef e) Js_of_lam_option.none (Js_of_lam_option.some e)
-        | _ -> 
-          call Js_config.js_primitive  
-        (* # GPR 974
-          let id = Ext_ident.create "v" in
-          let tmp = E.var id in
-          E.(seq (assign tmp e ) 
-               (econd (is_undef tmp) Js_of_lam_option.none (Js_of_lam_option.some tmp)) )
-        *)
-        end
+let handle_name_tail 
+    (name : st)
+    (should_return : Lam_compile_defs.return_type)
+    lam (exp : J.expression) : t =
+  begin match name, should_return with 
+  | EffectCall, False -> 
+      if Lam_analysis.no_side_effects lam 
+      then dummy
+      else {block = []; value  = Some exp ; finished = False}
+  | EffectCall, True _ ->
+      make [S.return  exp] ~finished:True
+  | Declare (kind, n), False -> 
+      make [ S.define ~kind n  exp]
+  | Assign n ,False -> 
+      make [S.assign n exp ]
+  | (Declare _ | Assign _ ), True _ -> 
+      make [S.unknown_lambda lam] ~finished:True
+  | NeedValue, _ -> {block = []; value = Some exp; finished = False }
+  end
 
-      | _ -> assert false 
-      end
-    | "js_from_nullable" 
-      -> 
-      begin match args with 
-      | [e] -> 
-        begin match e.expression_desc with 
-        | Var _ -> 
-          E.econd (E.is_nil e) Js_of_lam_option.none (Js_of_lam_option.some e)
-        | _ ->
-          call Js_config.js_primitive
-         (* GPR #974
-          let id = Ext_ident.create "v" in
-          let tmp = E.var id in
-          E.(seq (assign tmp e ) 
-               (econd (is_nil tmp) Js_of_lam_option.none (Js_of_lam_option.some tmp)) )
-          *)
+let handle_block_return 
+    (st : st) 
+    (should_return : Lam_compile_defs.return_type)
+    (lam : Lam.t) (block : J.block) exp : t = 
+  match st, should_return with 
+  | Declare (kind,n), False -> 
+    make (block @ [ S.define ~kind  n exp])
+  | Assign n, False -> make (block @ [S.assign n exp])
+  | (Declare _ | Assign _), True _ -> make [S.unknown_lambda lam] ~finished:True
+  | EffectCall, False -> make block ~value:exp
+  | EffectCall, True _ -> make (block @ [S.return exp]) ~finished:True
+  | NeedValue, _ ->  make block ~value:exp
+
+let statement_of_opt_expr (x : J.expression option) : J.statement =
+  match x with 
+  | None -> S.empty ()
+  | Some x when Js_analyzer.no_side_effect_expression x -> S.empty ()
+        (* TODO, pure analysis in lambda instead *)
+  | Some x -> S.exp x 
+
+let rec unroll_block (block : J.block) = 
+  match block with 
+  | [{statement_desc = Block block}] -> unroll_block block 
+  |  _ -> block 
+
+let to_block ( x : t)  : J.block = 
+  match x with 
+  | {block; value = opt; finished} ->
+      let block = unroll_block block in
+      if finished = True  then block
+      else 
+        begin match opt with 
+        | None -> block (* TODO, pure analysis in lambda instead *)
+        | Some x when Js_analyzer.no_side_effect_expression x -> block
+        | Some x -> block @ [S.exp x ]
         end
 
-      | _ -> assert false 
-      end
-    | "js_obj_set_length"
-      ->
-      begin match args with 
-        | [a; b] -> E.set_length a b 
-        | _ -> assert false 
-      end
+let to_break_block (x : t) : J.block * bool = 
+    match x with 
+    | {finished = True; block ; _ } -> 
+        unroll_block block, false 
+       (* value does not matter when [finished] is true
+           TODO: check if it has side efects
+        *)
+    | {block; value =  None; finished } -> 
+        let block = unroll_block block in 
+        block, (match finished with | True -> false | (False | Dummy)  -> true  )
 
-    | _ -> 
+    | {block; value = opt; _} -> 
+        let block = unroll_block block in
+        block @ [statement_of_opt_expr opt], true
 
-      let comment = "Missing primitive" in       
-      Ext_log.warn __LOC__  "%s: %s when compiling %s\n" comment prim_name 
-        (Js_config.get_current_file ()) ;
-      E.not_implemented prim_name
-      (*we dont use [throw] here, since [throw] is an statement 
-        so we wrap in IIFE
-      *)        
+let rec append  (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 
+          (* 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 
+        then z
+            (* It would optimize cases like [module aliases]
+                Bigarray, List 
+             *)
+        else
+          {block = []; value = Some (E.seq e1 e2); finished}
+          (* {block = [S.exp e1]; value =  Some e2(\* (E.seq e1 e2) *\); finished} *)
 
-  end 
+       (** TODO: make everything expression make inlining hard, and code not readable?
+
+           1. readability pends 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 
+        *)
+    (* | {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} *)
 
+    | {block = block1; value = opt_e1; _},  {block = block2; value = opt_e2; finished} -> 
+        let block1 = unroll_block block1 in
+        make (block1 @ (statement_of_opt_expr opt_e1  :: unroll_block block2))
+          ?value:opt_e2 ~finished
 
-;;
 
+module Ops = struct 
+  let (++)  (x : t ) (y : t ) : t =  append x y 
 end
-module Lam_compile_external_call : sig 
-#1 "lam_compile_external_call.mli"
+
+(* Fold right is more efficient *)
+let concat (xs : t list) : t = 
+  List.fold_right (fun x acc -> append x  acc) xs dummy
+
+let to_string x   = 
+  Js_dump.string_of_block (to_block x)
+
+end
+module Js_pass_debug : sig 
+#1 "js_pass_debug.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -81707,31 +82257,10 @@ module Lam_compile_external_call : sig
 
 
 
-
-
-(** Compile ocaml external function call to JS IR. *) 
-
-(** 
-    This module define how the FFI (via `external`) works with attributes. 
-    Note it will route to {!Lam_compile_global} 
-    for compiling normal functions without attributes.
- *)
-
-
-(** TODO: document supported attributes
-    Attributes starting with `js` are reserved
-    examples: "bs.splice"
- *)
-
-val translate :
-  Location.t ->
-  Lam_compile_defs.cxt -> 
-  Primitive.description -> 
-  J.expression list -> 
-  J.expression
+val dump : string  -> J.program -> J.program 
 
 end = struct
-#1 "lam_compile_external_call.ml"
+#1 "js_pass_debug.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -81760,334 +82289,563 @@ end = struct
 
 
 
-module E = Js_exp_make
-
-
-
-let handle_external 
-    ({bundle ; bind_name} : Ast_external_attributes.external_module_name)
-  =
-  match bind_name with 
-  | None -> 
-    Lam_compile_env.add_js_module bundle , bundle
-  | Some bind_name -> 
-    Lam_compile_env.add_js_module 
-      ~id:(Ext_ident.create_js_module bind_name) bundle,
-    bundle
-
-let handle_external_opt 
-    (module_name : Ast_external_attributes.external_module_name option) = 
-  match module_name with 
-  | Some module_name -> Some (handle_external module_name) 
-  | None -> None 
-
-type typ = Ast_core_type.t
-
-
-let ocaml_to_js_eff ({ Ast_external_attributes.arg_label;  arg_type = ty })
-    (arg : J.expression) 
-  : E.t list * E.t list  =
-  match ty with
-  | Unit ->  
-    [], 
-    (if Js_analyzer.no_side_effect_expression arg then 
-       []
-     else 
-       [arg]) (* leave up later to decide *)
-  | Ignore -> 
-    [], 
-    (if Js_analyzer.no_side_effect_expression arg then 
-       []
-     else 
-       [arg])
-  | NullString dispatches -> 
-    [Js_of_lam_variant.eval arg dispatches],[]
-  | NonNullString dispatches -> 
-    Js_of_lam_variant.eval_as_event arg dispatches,[]
-  | Int dispatches -> 
-    [Js_of_lam_variant.eval_as_int arg dispatches],[]
-  | Nothing  | Array -> 
-    begin match arg_label with 
-      | Optional label -> [Js_of_lam_option.get_default_undefined arg]
-      | Label _ | Empty ->  [arg]  
-    end, []
-
-
-let assemble_args arg_types args : E.t list * E.t option  = 
-  let args, eff = 
-    List.fold_right2 
-    (fun arg_type arg (accs, effs) -> 
-       match ocaml_to_js_eff arg_type arg with
-       | acc, eff  -> 
-         acc @ accs , eff @ effs 
-    ) arg_types args ([],[]) in
-  args, begin match eff with 
-    | [] -> None
-    | x::xs -> Some (List.fold_left (fun x y -> E.seq x y) x xs )
-  end
-
-let add_eff eff e =
-  match eff with
-  | None -> e 
-  | Some v -> E.seq v e 
-
-(* Note: can potentially be inconsistent, sometimes 
-   {[
-     { x : 3 , y : undefined}
-   ]}
-   and 
-   {[
-     {x : 3 }
-   ]}
-   But the default to be undefined  seems reasonable 
-*)
-let assemble_args_obj labels args = 
-  let map, eff  = 
-    List.fold_right2
-      (fun label ( arg : J.expression) (accs, eff ) -> 
-         match (label : Ast_core_type.arg_label) with 
-         | Empty ->  
-           accs , 
-           if Js_analyzer.no_side_effect_expression arg then eff 
-           else arg :: eff 
-         | Label label -> 
-           ( Js_op.Key label, arg) :: accs, eff  
-         | Optional label -> 
-           begin match arg.expression_desc with 
-             | Number _ -> (*Invariant: None encoding*)
-               accs, eff 
-             | _ ->  
-               ( Js_op.Key label, Js_of_lam_option.get_default_undefined arg) :: accs,
-               eff
-           end
-      ) labels args ([], []) in
-  match eff with
-  | [] -> 
-    E.obj map 
-  | x::xs -> E.seq (List.fold_left (fun x y -> E.seq x y) x xs) (E.obj map)
-
-
-(* TODO: fix splice, 
-   we need a static guarantee that it is static array construct
-   otherwise, we should provide a good error message here, 
-   no compiler failure here 
-   Invariant : Array encoding
-*)
 
-let ocaml_to_js ~js_splice:(js_splice : bool) call_loc ffi
-    last ({ Ast_external_attributes.arg_label;  arg_type = ty } as arg_ty)
-    (arg : J.expression) 
-  = 
-  if last && js_splice then
-    match ty with 
-    | Array -> 
-      begin match arg with 
-        | {expression_desc = Array (ls,_mutable_flag) } -> 
-          ls, [] 
-        | _ -> 
-          Location.raise_errorf ~loc:call_loc
-            "function call with %s  is a primitive with [@@bs.splice], it expects its arguments to be a syntactic array in the call site" (Ast_external_attributes.name_of_ffi ffi)
-      end
-    | _ -> assert  false
-  else 
-    ocaml_to_js_eff arg_ty arg 
+let log_counter = ref 0 
 
-let assemble_args_splice call_loc ffi  js_splice arg_types args : E.t list * E.t option = 
-  let args, eff = 
-    Ext_list.fold_right2_last (fun last arg_ty arg (accs, effs)  -> 
-      let (acc,eff) = ocaml_to_js call_loc ffi  ~js_splice last arg_ty arg  in acc @ accs, eff @ effs
-      ) arg_types args ([], []) in
-  args,
-  begin  match eff with
-    | [] -> None 
-    | x::xs ->  Some (List.fold_left (fun x y -> E.seq x y) x xs)
+let dump name (prog : J.program) =
+    
+  begin
+    let () = 
+      if Js_config.is_same_file ()
+      then 
+        begin
+          incr log_counter ; 
+          Ext_pervasives.with_file_as_chan       
+            (Ext_filename.chop_extension ~loc:__LOC__ (Js_config.get_current_file()) ^
+             (Printf.sprintf ".%02d.%s.jsx"  !log_counter name)
+            ) (fun chan -> Js_dump.dump_program prog chan )
+        end in
+    prog    
   end
 
+ 
 
-let translate_ffi call_loc (ffi : Ast_external_attributes.ffi ) prim_name
-    (cxt  : Lam_compile_defs.cxt)
-    arg_types result_type
-    (args : J.expression list) = 
-    match ffi with 
-    | Obj_create labels -> assemble_args_obj labels args 
-    | Js_call{ external_module_name = module_name; 
-                 name = fn; splice = js_splice ; 
-
-                     } -> 
-      let fn =  
-        match handle_external_opt module_name with 
-        | Some (id,_) -> 
-          E.dot (E.var id) fn
-        | None ->  E.js_var fn
-      in
-      let args, eff  = assemble_args_splice   call_loc ffi js_splice arg_types args in 
-      add_eff eff 
-      begin match (result_type : Ast_core_type.arg_type) with 
-      | Unit -> 
-        E.seq (E.call ~info:{arity=Full; call_info = Call_na} fn args) E.unit
-      | _ -> 
-        E.call ~info:{arity=Full; call_info = Call_na} fn args
-      end
-    | Js_module_as_var module_name -> 
-      let (id, name) =  handle_external  module_name  in
-      E.external_var_dot id name None
-
-    | Js_module_as_fn {external_module_name = module_name; splice} ->
-      let fn =
-        let (id, name) = handle_external  module_name  in
-        E.external_var_dot id name None           
-      in           
-      let args, eff = assemble_args_splice   call_loc ffi splice arg_types args in 
-        (* TODO: fix in rest calling convention *)          
-      add_eff eff 
-      begin match (result_type : Ast_core_type.arg_type) with 
-        | Unit -> 
-          E.seq (E.call ~info:{arity=Full; call_info = Call_na} fn args) E.unit
-        | _ -> 
-          E.call ~info:{arity=Full; call_info = Call_na} fn args
-      end
-    | Js_module_as_class module_name ->
-      let fn =
-        let (id,name) = handle_external  module_name in
-        E.external_var_dot id name None in           
-      let args,eff = assemble_args arg_types args in 
-        (* TODO: fix in rest calling convention *)   
-      add_eff eff        
-      begin 
-        (match cxt.st with 
-         | Declare (_, id) | Assign id  ->
-           (* Format.fprintf Format.err_formatter "%a@."Ident.print  id; *)
-           Ext_ident.make_js_object id 
-         | EffectCall | NeedValue -> ())
-        ;
-        E.new_ fn args
-      end            
-
-    | Js_new { external_module_name = module_name; 
-               name = fn;
-               splice 
-             } -> 
-      (* This has some side effect, it will 
-         mark its identifier (If it has) as an object,
-         ATTENTION: 
-         order also matters here, since we mark its jsobject property, 
-         it  will affect the code gen later
-         TODO: we should propagate this property 
-         as much as we can(in alias table)
-      *)
-      let args, eff = assemble_args_splice  call_loc  ffi splice arg_types args in
-      let fn =  
-        match handle_external_opt module_name with 
-        | Some (id,name) ->  
-          E.external_var_dot id name (Some fn)
-
-        | None -> 
-          (** TODO: check, no [@@bs.module], 
-              assume it's global *)
-          E.js_var fn
+end
+module Js_map
+= struct
+#1 "js_map.ml"
+(* BuckleScript compiler
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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.
+ *)
+(* Author: Hongbo Zhang  *)
+(** GENERATED CODE, map visitor for JS IR  *)
+open J
+  
+class virtual map =
+  object ((o : 'self_type))
+    method string : string -> string = o#unknown
+    method option :
+      'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option =
+      fun _f_a ->
+        function | None -> None | Some _x -> let _x = _f_a o _x in Some _x
+    method list :
+      'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list =
+      fun _f_a ->
+        function
+        | [] -> []
+        | _x :: _x_i1 ->
+            let _x = _f_a o _x in
+            let _x_i1 = o#list _f_a _x_i1 in _x :: _x_i1
+    method int : int -> int = o#unknown
+    method bool : bool -> bool = function | false -> false | true -> true
+    method vident : vident -> vident =
+      function
+      | Id _x -> let _x = o#ident _x in Id _x
+      | Qualified (_x, _x_i1, _x_i2) ->
+          let _x = o#ident _x in
+          let _x_i1 = o#kind _x_i1 in
+          let _x_i2 = o#option (fun o -> o#string) _x_i2
+          in Qualified (_x, _x_i1, _x_i2)
+    method variable_declaration :
+      variable_declaration -> variable_declaration =
+      fun { ident = _x; value = _x_i1; property = _x_i2; ident_info = _x_i3 }
+        ->
+        let _x = o#ident _x in
+        let _x_i1 = o#option (fun o -> o#expression) _x_i1 in
+        let _x_i2 = o#property _x_i2 in
+        let _x_i3 = o#ident_info _x_i3
+        in
+          { ident = _x; value = _x_i1; property = _x_i2; ident_info = _x_i3;
+          }
+    method tag_info : tag_info -> tag_info = o#unknown
+    method statement_desc : statement_desc -> statement_desc =
+      function
+      | Block _x -> let _x = o#block _x in Block _x
+      | Variable _x -> let _x = o#variable_declaration _x in Variable _x
+      | Exp _x -> let _x = o#expression _x in Exp _x
+      | If (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#block _x_i1 in
+          let _x_i2 = o#option (fun o -> o#block) _x_i2
+          in If (_x, _x_i1, _x_i2)
+      | While (_x, _x_i1, _x_i2, _x_i3) ->
+          let _x = o#option (fun o -> o#label) _x in
+          let _x_i1 = o#expression _x_i1 in
+          let _x_i2 = o#block _x_i2 in
+          let _x_i3 = o#unknown _x_i3 in While (_x, _x_i1, _x_i2, _x_i3)
+      | ForRange (_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5) ->
+          let _x = o#option (fun o -> o#for_ident_expression) _x in
+          let _x_i1 = o#finish_ident_expression _x_i1 in
+          let _x_i2 = o#for_ident _x_i2 in
+          let _x_i3 = o#for_direction _x_i3 in
+          let _x_i4 = o#block _x_i4 in
+          let _x_i5 = o#unknown _x_i5
+          in ForRange (_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)
+      | Continue _x -> let _x = o#label _x in Continue _x
+      | Break -> Break
+      | Return _x -> let _x = o#return_expression _x in Return _x
+      | Int_switch (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 =
+            o#list
+              (fun o ->
+                 (* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+                 (** Javascript IR
+  
+    It's a subset of Javascript AST specialized for OCaml lambda backend
 
-      in
-      add_eff eff 
-      begin 
-        (match cxt.st with 
-         | Declare (_, id) | Assign id  ->
-           (* Format.fprintf Format.err_formatter "%a@."Ident.print  id; *)
-           Ext_ident.make_js_object id 
-         | EffectCall | NeedValue -> ())
-        ;
-        E.new_ fn args
-      end            
+    Note it's not exactly the same as Javascript, the AST itself follows lexical
+    convention and [Block] is just a sequence of statements, which means it does 
+    not introduce new scope
+*)
+                 (** object literal, if key is ident, in this case, it might be renamed by 
+    Google Closure  optimizer,
+    currently we always use quote
+ *)
+                 (* Since camldot is only available for toplevel module accessors,
+       we don't need print  `A.length$2`
+       just print `A.length` - it's guarateed to be unique
+       
+       when the third one is None, it means the whole module 
 
+       TODO: 
+       invariant, when [kind] is [Runtime], then we can ignore [ident], 
+       since all [runtime] functions are unique, when do the 
+       pattern match we can ignore the first one for simplicity
+       for example       
+       {[
+         Qualified (_, Runtime, Some "caml_int_compare")         
+       ]}       
+     *)
+                 (* used in [js_create_array] primitive, note having
+       uninitilized array is not as bad as in ocaml, 
+       since GC does not rely on it
+     *)
+                 (* shallow copy, like [x.slice] *)
+                 (* For [caml_array_append]*)
+                 (* | Tag_ml_obj of expression *) (* js true/false*)
+                 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence 
+     [typeof] is an operator     
+  *)
+                 (* 1 - v *) (* !v *)
+                 (* String.fromCharCode.apply(null, args) *)
+                 (* Convert JS boolean into OCaml boolean 
+       like [+true], note this ast talks using js
+       terminnology unless explicity stated                       
+     *)
+                 (* TODO: in the future, it might make sense to group primitivie by type,
+     which makes optimizations easier
+     {[ JSON.stringify(value, replacer[, space]) ]}
+  *)
+                 (* for debugging utitlites, 
+     TODO:  [Dump] is not necessary with this primitive 
+     Note that the semantics is slightly different from [JSON.stringify]     
+     {[
+       JSON.stringify("x")       
+     ]}
+     {[
+       ""x""       
+     ]}     
+     {[
+       JSON.stringify(undefined)       
+     ]}     
+     {[
+       undefined       
+     ]}
+     {[ '' + undefined
+     ]}     
+     {[ 'undefined'
+     ]}     
+  *)
+                 (* TODO: 
+     add 
+     {[ Assert of bool * expression ]}     
+  *)
+                 (* to support 
+       val log1 : 'a -> unit
+       val log2 : 'a -> 'b -> unit 
+       val log3 : 'a -> 'b -> 'c -> unit 
+     *)
+                 (* TODO: Add some primitives so that [js inliner] can do a better job *)
+                 (* [int_op] will guarantee return [int32] bits 
+     https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators  *)
+                 (* | Int32_bin of int_op * expression * expression *)
+                 (* f.apply(null,args) -- Fully applied guaranteed 
+       TODO: once we know args's shape --
+       if it's know at compile time, we can turn it into
+       f(args[0], args[1], ... )
+     *)
+                 (* {[ Bind (a,b) ]}
+     is literally
+     {[ a.bind(b) ]}
+  *)
+                 (* Analysze over J expression is hard since, 
+        some primitive  call is translated 
+        into a plain call, it's better to keep them
+    *)
+                 (* Invariant: 
+       The second argument has to be type of [int],
+       This can be constructed either in a static way [E.index] or a dynamic way 
+       [E.access]
+     *)
+                 (* The third argument bool indicates whether we should 
+       print it as 
+       a["idd"] -- false
+       or 
+       a.idd  -- true
+       There are several kinds of properties
+       1. OCaml module dot (need to be escaped or not)
+          All exported declarations have to be OCaml identifiers
+       2. Javascript dot (need to be preserved/or using quote)
+     *)
+                 (* TODO: option remove *)
+                 (* The first parameter by default is false, 
+     it will be true when it's a method
+  *)
+                 (* A string is UTF-8 encoded, the string may contain
+       escape sequences.
+       The first argument is used to mark it is non-pure, please
+       don't optimize it, since it does have side effec, 
+       examples like "use asm;" and our compiler may generate "error;..." 
+       which is better to leave it alone
+     *)
+                 (* literally raw JS code 
+  *)
+                 (* The third argument is [tag] , forth is [tag_info] *)
+                 (* [tag] and [size] tailed  for [Obj.new_block] *)
+                 (* For setter, it still return the value of expression, 
+     we can not use 
+     {[
+       type 'a access = Get | Set of 'a
+     ]}
+     in another module, since it will break our code generator
+     [Caml_block_tag] can return [undefined], 
+     you have to use [E.tag] in a safe way     
+  *)
+                 (* It will just fetch tag, to make it safe, when creating it, 
+     we need apply "|0", we don't do it in the 
+     last step since "|0" can potentially be optimized
+  *)
+                 (* pure*) (* pure *)
+                 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/block
+   block can be nested, specified in ES3 
+ *)
+                 (* Delay some units like [primitive] into JS layer ,
+   benefit: better cross module inlining, and smaller IR size?
+ *)
+                 (* 
+  [closure] captured loop mutable values in the outer loop
 
+  check if it contains loop mutable values, happens in nested loop
+  when closured, it's no longer loop mutable value. 
+  which means the outer loop mutable value can not peek into the inner loop
+  {[
+  var i = f ();
+  for(var finish = 32; i < finish; ++i){
+  }
+  ]}
+  when [for_ident_expression] is [None], [var i] has to 
+  be initialized outside, so 
 
-    | Js_global {name; external_module_name} -> 
+  {[
+  var i = f ()
+  (function (xxx){
+  for(var finish = 32; i < finish; ++i)
+  }(..i))
+  ]}
+  This happens rare it's okay
 
-      (* TODO #11
-         1. check args -- error checking 
-         2. support [@@bs.scope "window"]
-         we need know whether we should call [add_js_module] or not 
-      *)
-      begin match name, handle_external_opt external_module_name with 
-        | "true", None -> E.js_bool true
-        | "false", None -> E.js_bool false
-        | "null", None -> E.nil 
-        | "undefined", None -> E.undefined
-        | _, Some(id,mod_name)
-          -> E.external_var_dot id mod_name (Some name)
-        | _, None -> 
+  this is because [i] has to be initialized outside, if [j] 
+  contains a block side effect
+  TODO: create such example
+*)
+                 (* Since in OCaml, 
+   
+  [for i = 0 to k end do done ]
+  k is only evaluated once , to encode this invariant in JS IR,
+  make sure [ident] is defined in the first b
 
-          E.var (Ext_ident.create_js name)
-      end
-    | Js_send {splice  = js_splice ; name ; pipe = false} -> 
-      begin match args  with
-        | self :: args -> 
-          let [@warning"-8"] ( self_type::arg_types )
-            = arg_types in
-          let args, eff = assemble_args_splice  call_loc ffi  js_splice arg_types args in
-          add_eff eff @@ 
-          E.call ~info:{arity=Full; call_info = Call_na}  (E.dot self name) args
-        | _ -> 
-          assert false 
-      end
-    | Js_send { name ; pipe = true ; splice = js_splice}
-      -> (* splice should not happen *)
-      (* assert (js_splice = false) ;  *)
-      let self, args = Ext_list.exclude_tail args in
-      let self_type, arg_types = Ext_list.exclude_tail arg_types in
-      let args, eff = assemble_args_splice call_loc ffi  js_splice arg_types args in
-      add_eff eff @@
-      E.call ~info:{arity=Full; call_info = Call_na}  (E.dot self name) args
+  TODO: currently we guarantee that [bound] was only 
+  excecuted once, should encode this in AST level
+*)
+                 (* Can be simplified to keep the semantics of OCaml
+   For (var i, e, ...){
+     let  j = ... 
+   }
 
-    | Js_get name -> 
-      begin match args with 
-      | [obj] ->
-        E.dot obj name        
-      | _ -> assert false 
-      end  
-    | Js_set name -> 
-      begin match args with 
-      | [obj; v] -> 
-        E.assign (E.dot obj name) v         
-      | _ -> 
-        assert false 
-      end
-    | Js_get_index 
-      -> 
-      begin match args with
-        | [obj; v ] -> 
-          Js_arr.ref_array obj v
-        | _ -> assert false 
-      end
-    | Js_set_index 
-      -> 
-      begin match args with 
-      | [obj; v ; value] -> 
-        Js_arr.set_array obj v value
-      | _ -> assert false
-      end
-    
+   if [i] or [j] is captured inside closure
 
+   for (var i , e, ...){
+     (function (){
+     })(i)
+   }
+*)
+                 (* Single return is good for ininling..
+   However, when you do tail-call optmization
+   you loose the expression oriented semantics
+   Block is useful for implementing goto
+   {[
+   xx:{
+   break xx;
+   }
+   ]}
+*)
+                 (* Function declaration and Variable declaration  *)
+                 (* check if it contains loop mutable values, happens in nested loop *)
+                 (* only used when inline a fucntion *)
+                 (* Here we need track back a bit ?, move Return to Function ...
+                              Then we can only have one Return, which is not good *)
+                 o#case_clause (fun o -> o#int))
+              _x_i1 in
+          let _x_i2 = o#option (fun o -> o#block) _x_i2
+          in Int_switch (_x, _x_i1, _x_i2)
+      | String_switch (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 =
+            o#list (fun o -> o#case_clause (fun o -> o#string)) _x_i1 in
+          let _x_i2 = o#option (fun o -> o#block) _x_i2
+          in String_switch (_x, _x_i1, _x_i2)
+      | Throw _x -> let _x = o#expression _x in Throw _x
+      | Try (_x, _x_i1, _x_i2) ->
+          let _x = o#block _x in
+          let _x_i1 =
+            o#option
+              (fun o (_x, _x_i1) ->
+                 let _x = o#exception_ident _x in
+                 let _x_i1 = o#block _x_i1 in (_x, _x_i1))
+              _x_i1 in
+          let _x_i2 = o#option (fun o -> o#block) _x_i2
+          in Try (_x, _x_i1, _x_i2)
+      | Debugger -> Debugger
+    method statement : statement -> statement =
+      fun { statement_desc = _x; comment = _x_i1 } ->
+        let _x = o#statement_desc _x in
+        let _x_i1 = o#option (fun o -> o#string) _x_i1
+        in { statement_desc = _x; comment = _x_i1; }
+    method return_expression : return_expression -> return_expression =
+      fun { return_value = _x } ->
+        let _x = o#expression _x in { return_value = _x; }
+    method required_modules : required_modules -> required_modules =
+      o#unknown
+    method property_name : property_name -> property_name = o#unknown
+    method property_map : property_map -> property_map =
+      o#list
+        (fun o (_x, _x_i1) ->
+           let _x = o#property_name _x in
+           let _x_i1 = o#expression _x_i1 in (_x, _x_i1))
+    method property : property -> property = o#unknown
+    method program : program -> program =
+      fun { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3 }
+        ->
+        let _x = o#string _x in
+        let _x_i1 = o#block _x_i1 in
+        let _x_i2 = o#exports _x_i2 in
+        let _x_i3 = o#unknown _x_i3
+        in { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3; }
+    method number : number -> number = o#unknown
+    method mutable_flag : mutable_flag -> mutable_flag = o#unknown
+    method length_object : length_object -> length_object = o#unknown
+    method label : label -> label = o#string
+    method kind : kind -> kind = o#unknown
+    method jsint : jsint -> jsint = o#unknown
+    method int_op : int_op -> int_op = o#unknown
+    method ident_info : ident_info -> ident_info = o#unknown
+    method ident : ident -> ident = o#unknown
+    method for_ident_expression :
+      for_ident_expression -> for_ident_expression = o#expression
+    method for_ident : for_ident -> for_ident = o#ident
+    method for_direction : for_direction -> for_direction = o#unknown
+    method finish_ident_expression :
+      finish_ident_expression -> finish_ident_expression = o#expression
+    method expression_desc : expression_desc -> expression_desc =
+      function
+      | Math (_x, _x_i1) ->
+          let _x = o#string _x in
+          let _x_i1 = o#list (fun o -> o#expression) _x_i1
+          in Math (_x, _x_i1)
+      | Length (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#length_object _x_i1 in Length (_x, _x_i1)
+      | Char_of_int _x -> let _x = o#expression _x in Char_of_int _x
+      | Char_to_int _x -> let _x = o#expression _x in Char_to_int _x
+      | Array_of_size _x -> let _x = o#expression _x in Array_of_size _x
+      | Array_copy _x -> let _x = o#expression _x in Array_copy _x
+      | Array_append (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Array_append (_x, _x_i1)
+      | String_append (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in String_append (_x, _x_i1)
+      | Int_of_boolean _x -> let _x = o#expression _x in Int_of_boolean _x
+      | Anything_to_number _x ->
+          let _x = o#expression _x in Anything_to_number _x
+      | Bool _x -> let _x = o#bool _x in Bool _x
+      | Typeof _x -> let _x = o#expression _x in Typeof _x
+      | Caml_not _x -> let _x = o#expression _x in Caml_not _x
+      | Js_not _x -> let _x = o#expression _x in Js_not _x
+      | String_of_small_int_array _x ->
+          let _x = o#expression _x in String_of_small_int_array _x
+      | Json_stringify _x -> let _x = o#expression _x in Json_stringify _x
+      | Anything_to_string _x ->
+          let _x = o#expression _x in Anything_to_string _x
+      | Dump (_x, _x_i1) ->
+          let _x = o#unknown _x in
+          let _x_i1 = o#list (fun o -> o#expression) _x_i1
+          in Dump (_x, _x_i1)
+      | Seq (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Seq (_x, _x_i1)
+      | Cond (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in
+          let _x_i2 = o#expression _x_i2 in Cond (_x, _x_i1, _x_i2)
+      | Bin (_x, _x_i1, _x_i2) ->
+          let _x = o#binop _x in
+          let _x_i1 = o#expression _x_i1 in
+          let _x_i2 = o#expression _x_i2 in Bin (_x, _x_i1, _x_i2)
+      | FlatCall (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in FlatCall (_x, _x_i1)
+      | Bind (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Bind (_x, _x_i1)
+      | Call (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#list (fun o -> o#expression) _x_i1 in
+          let _x_i2 = o#unknown _x_i2 in Call (_x, _x_i1, _x_i2)
+      | String_access (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in String_access (_x, _x_i1)
+      | Access (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Access (_x, _x_i1)
+      | Dot (_x, _x_i1, _x_i2) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#string _x_i1 in
+          let _x_i2 = o#bool _x_i2 in Dot (_x, _x_i1, _x_i2)
+      | New (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 =
+            o#option (fun o -> o#list (fun o -> o#expression)) _x_i1
+          in New (_x, _x_i1)
+      | Var _x -> let _x = o#vident _x in Var _x
+      | Fun (_x, _x_i1, _x_i2, _x_i3) ->
+          let _x = o#bool _x in
+          let _x_i1 = o#list (fun o -> o#ident) _x_i1 in
+          let _x_i2 = o#block _x_i2 in
+          let _x_i3 = o#unknown _x_i3 in Fun (_x, _x_i1, _x_i2, _x_i3)
+      | Str (_x, _x_i1) ->
+          let _x = o#bool _x in let _x_i1 = o#string _x_i1 in Str (_x, _x_i1)
+      | Raw_js_code (_x, _x_i1) ->
+          let _x = o#string _x in
+          let _x_i1 = o#code_info _x_i1 in Raw_js_code (_x, _x_i1)
+      | Array (_x, _x_i1) ->
+          let _x = o#list (fun o -> o#expression) _x in
+          let _x_i1 = o#mutable_flag _x_i1 in Array (_x, _x_i1)
+      | Caml_block (_x, _x_i1, _x_i2, _x_i3) ->
+          let _x = o#list (fun o -> o#expression) _x in
+          let _x_i1 = o#mutable_flag _x_i1 in
+          let _x_i2 = o#expression _x_i2 in
+          let _x_i3 = o#tag_info _x_i3
+          in Caml_block (_x, _x_i1, _x_i2, _x_i3)
+      | Caml_uninitialized_obj (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1
+          in Caml_uninitialized_obj (_x, _x_i1)
+      | Caml_block_tag _x -> let _x = o#expression _x in Caml_block_tag _x
+      | Caml_block_set_tag (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Caml_block_set_tag (_x, _x_i1)
+      | Caml_block_set_length (_x, _x_i1) ->
+          let _x = o#expression _x in
+          let _x_i1 = o#expression _x_i1 in Caml_block_set_length (_x, _x_i1)
+      | Number _x -> let _x = o#number _x in Number _x
+      | Object _x -> let _x = o#property_map _x in Object _x
+    method expression : expression -> expression =
+      fun { expression_desc = _x; comment = _x_i1 } ->
+        let _x = o#expression_desc _x in
+        let _x_i1 = o#option (fun o -> o#string) _x_i1
+        in { expression_desc = _x; comment = _x_i1; }
+    method exports : exports -> exports = o#unknown
+    method exception_ident : exception_ident -> exception_ident = o#ident
+    method deps_program : deps_program -> deps_program =
+      fun { program = _x; modules = _x_i1; side_effect = _x_i2 } ->
+        let _x = o#program _x in
+        let _x_i1 = o#required_modules _x_i1 in
+        let _x_i2 = o#option (fun o -> o#string) _x_i2
+        in { program = _x; modules = _x_i1; side_effect = _x_i2; }
+    method code_info : code_info -> code_info = o#unknown
+    method case_clause :
+      (* since in ocaml, it's expression oriented langauge, [return] in
+    general has no jumps, it only happens when we do 
+    tailcall conversion, in that case there is a jump.
+    However, currently  a single [break] is good to cover
+    our compilation strategy 
 
-let translate loc cxt 
-    ({prim_name ;  prim_native_name} 
-     : Primitive.description) args  = 
-  if Ast_external_attributes.is_bs_external_prefix prim_native_name then 
-    begin 
-      match Ast_external_attributes.unsafe_from_string prim_native_name with 
-      | Normal -> 
-        Lam_dispatch_primitive.translate prim_name args 
-      | Bs (arg_types, result_type, ffi) -> 
-        translate_ffi loc  ffi prim_name cxt arg_types result_type args 
-    end
-  else 
-    begin 
-      Lam_dispatch_primitive.translate prim_name args 
-    end
+    Attention: we should not insert [break] arbitrarily, otherwise 
+    it would break the semantics
+    A more robust signature would be 
+    {[ goto : label option ; ]}
+  *)
+        'a 'a_out.
+        ('self_type -> 'a -> 'a_out) -> 'a case_clause -> 'a_out case_clause =
+      fun _f_a { case = _x; 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; }
+    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 
+ *)
+      o#list (fun o -> o#statement)
+    method binop : binop -> binop = o#unknown
+    method unknown : 'a. 'a -> 'a = fun x -> x
+  end
+  
 
 
 end
-module Lam_compile_primitive : sig 
-#1 "lam_compile_primitive.mli"
+module Js_pass_flatten : sig 
+#1 "js_pass_flatten.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -82119,18 +82877,21 @@ module Lam_compile_primitive : sig
 
 
 
-(** Primitive compilation  *) 
+(** A pass converting nested js statement into a flatten visual appearance 
+
+    Note this module is used to convert some nested expressions to flat statements, 
+    in general, it's more human readable, and since it generate flat statements, we can spot
+    some inline opportunities for the produced statemetns, 
+    (inline) expressions inside a nested expression would generate ugly code.
 
-(* The entry point of compile primitives
-   Note it will call {!Lam_compile_external_call.translate} for c stubs compilation
- *)
+    Since we are aiming to flatten expressions, we should avoid some smart constructors in {!Js_helper}, 
+    it  tries to spit out expression istead of statements if it can
+*)
 
-val translate : 
-  Location.t -> 
-  Lam_compile_defs.cxt  -> Lam.primitive -> J.expression list -> J.expression
+val program : J.program -> J.program
 
 end = struct
-#1 "lam_compile_primitive.ml"
+#1 "js_pass_flatten.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -82151,664 +82912,84 @@ end = struct
  * 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 
-
-(* If it is the return value, since it is a side-effect call,
-   we return unit, otherwise just return it
- *)
-let decorate_side_effect ({st; should_return;_} : Lam_compile_defs.cxt) e : E.t = 
-  match st, should_return with 
-  | _, True _ 
-  | (Assign _ | Declare _ | NeedValue), _  -> E.seq e E.unit
-  | EffectCall, False -> e 
-  (* NeedValue should return a meaningful expression*)
-
-let translate  loc
-    ({ meta = { env; _}; _} as cxt : Lam_compile_defs.cxt) 
-    (prim : Lam.primitive)
-    (args : J.expression list) : J.expression = 
-  match prim with
-  | Pjs_unsafe_downgrade _
-  | Pdebugger 
-  | Pjs_fn_run _ 
-  | Pjs_fn_make _
-
-  | Pjs_fn_runmethod _ 
-    -> assert false (* already handled by {!Lam_compile} *)
-  | Pjs_fn_method _ -> assert false
-  | Pglobal_exception id ->
-    Js_of_lam_exception.get_builtin_by_name id.name    
-  | Pstringadd ->
-    begin match args with      
-      | [a;b] ->
-        E.string_append a b
-      | _ -> assert false          
-    end          
-  | Pinit_mod -> 
-    E.runtime_call Js_config.module_ "init_mod" args
-  | Pupdate_mod ->
-    E.runtime_call Js_config.module_ "update_mod" args
-  | Pmakeblock(tag, tag_info, mutable_flag ) ->  (* RUNTIME *)
-    Js_of_lam_block.make_block 
-      (Js_op_util.of_lam_mutable_flag mutable_flag) 
-      tag_info (E.small_int tag) args 
-  | Pfield (i, fld_info) -> 
-    begin match args with 
-      | [ e ]  -> 
-        Js_of_lam_block.field fld_info e (Int32.of_int i)
-      (* Invariant depends on runtime *)
-      | _ -> assert false
-    end
-
-(** Negate boxed int *)
-  | Pnegbint Pint32
-    ->
-    begin match args with
-    | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
-    | _ -> assert false
-    end
-  | Pnegbint Pnativeint
-    -> 
-    begin match args with
-    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
-    | _ -> assert false
-    end
-  | Pnegbint Pint64
-    -> 
-    Js_long.neg args 
-
-  | Pnegint
-    -> 
-    begin match args with
-    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
-    | _ -> assert false
-    end
-
-  | Pnegfloat 
-    -> 
-    begin match args with 
-    | [ e ] -> E.float_minus (E.zero_float_lit) e 
-    | _ -> assert false
-    end
-(** Negate boxed int end*)
-(* Int addition and subtraction *)
-  | Paddint 
-  | Paddbint  Pint32
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.int32_add  e1  e2
-      | _ -> assert false
-    end
-  | Paddbint Pnativeint 
-    -> 
-    begin match args with
-      | [e1;e2] ->
-        E.unchecked_int32_add  e1  e2
-      | _ -> assert false
-    end
-
-  | Paddbint Pint64
-    ->  
-    Js_long.add args 
-
-
-  | Paddfloat
-     -> 
-     begin match args with
-       | [e1;e2] ->
-         E.float_add  e1  e2
-       | _ -> assert false
-     end
-  | Psubint 
-    -> 
-    begin match args with 
-    | [e1; e2] ->     
-      E.int32_minus e1 e2 
-    | _ -> assert false
-    end
-  | Psubbint Pint32
-    -> 
-    begin match args with
-      | [e1;e2] ->
-          E.int32_minus   e1  e2
-      | _ -> assert false 
-    end
-  | Psubbint Pnativeint
-    -> 
-    begin match args with
-      | [e1;e2] ->
-          E.unchecked_int32_minus   e1  e2
-      | _ -> assert false 
-    end
-  | Psubbint Pint64
-    -> 
-    Js_long.sub args 
-  | Psubfloat
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.float_minus   e1  e2
-      | _ -> assert false 
-    end
-  | Pmulbint Lambda.Pnativeint
-    -> 
-    begin match args with
-      | [e1; e2]  ->
-        E.unchecked_int32_mul  e1  e2
-      | _ -> assert false 
-    end
-
-  | Pmulint 
-  | Pmulbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1; e2]  ->
-        E.int32_mul  e1  e2
-      | _ -> assert false 
-    end
-  | Pmulbint Pint64 
-    -> 
-    Js_long.mul args 
-  | Pmulfloat 
-    -> 
-      begin match args with
-      | [e1; e2]  ->
-          E.float_mul  e1  e2
-      | _ -> assert false 
-      end
-  | Pdivfloat -> 
-    begin match args with  
-      | [e1;e2] -> E.float_div  e1  e2
-      | _ -> assert false 
-    end
-  | Pdivbint Pnativeint
-    -> 
-    begin match args with 
-      | [e1;e2] ->
-        E.int32_div ~checked:false e1 e2
-      | _ -> assert false
-    end
-  | Pdivint 
-  | Pdivbint Pint32
-    -> 
-    begin match args with 
-      | [e1;e2] ->
-        E.int32_div ~checked:(!Js_config.check_div_by_zero) e1 e2
-      | _ -> assert false
-    end
-
-  | Pdivbint Pint64 
-    -> Js_long.div args 
-  | Pmodint 
-  | Pmodbint Pnativeint
-  | Pmodbint Pint32
-    ->
-    begin match args with
-      | [e1; e2] ->
-        E.int32_mod   ~checked:(!Js_config.check_div_by_zero) e1  e2
-      | _ -> assert false 
-    end
-  | Pmodbint Lambda.Pint64 
-    -> Js_long.mod_ args  
-  | Plslint 
-  | Plslbint Lambda.Pnativeint
-  | Plslbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.int32_lsl e1  e2
-      | _ -> assert false 
-    end
-  | Plslbint Lambda.Pint64 
-    -> Js_long.lsl_ args
-  | Plsrbint Lambda.Pnativeint
-    -> 
-    begin match args with
-      | [e1; e2] ->
-        E.int32_lsr   e1  e2
-      | _ -> assert false
-    end
-  | Plsrint 
-  | Plsrbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1; {J.expression_desc = Number (Int {i=0l; _}|Uint 0l | Nint 0n); _}]
-        -> 
-        e1
-      | [e1; e2] ->
-        E.to_int32 @@ E.int32_lsr   e1  e2
-      | _ -> assert false
-    end
-  | Plsrbint Lambda.Pint64
-    -> Js_long.lsr_ args
-  | Pasrint 
-  | Pasrbint Lambda.Pnativeint
-  | Pasrbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.int32_asr  e1  e2
-      | _ -> assert false
-    end
-  | Pasrbint Lambda.Pint64 
-    -> Js_long.asr_ args      
-  | Pandint 
-  | Pandbint Lambda.Pnativeint
-  | Pandbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.int32_band  e1  e2
-      | _ -> assert false
-    end
-  | Pandbint Lambda.Pint64
-    -> Js_long.and_ args
-  | Porint 
-  | Porbint Lambda.Pnativeint
-  | Porbint Lambda.Pint32
-    ->
-    begin match args with
-      | [e1;e2] ->
-        E.int32_bor  e1  e2
-      | _ -> assert false
-    end
-  | Porbint Lambda.Pint64 
-    -> Js_long.or_ args
-  | Pxorint 
-  | Pxorbint Lambda.Pnativeint
-  | Pxorbint Lambda.Pint32 
-    -> 
-    begin match args with
-      | [e1;e2] ->
-        E.int32_bxor  e1  e2
-      | _ -> assert false
-    end
-  | Pxorbint Lambda.Pint64 
-    ->
-    Js_long.xor args    
-  | Pbintcomp (Pnativeint ,cmp)
-  | Pfloatcomp cmp
-  | Pintcomp cmp
-  | Pbintcomp (Pint32 ,cmp)
-    ->
-    begin 
-      (* Global Builtin Exception is an int, like 
-         [Not_found] or [Invalid_argument] ?
-      *)
-      match args with 
-      | [e1;e2] -> E.int_comp cmp e1 e2
-      | _ -> assert false 
-    end
-        (* List --> stamp = 0 
-           Assert_false --> stamp = 26 
-         *)
-  | Pbintcomp (Pint64 ,cmp)
-    -> Js_long.comp cmp args
-
-  | Pcvtbint ((Pint32 | Pnativeint ), Pint64) 
-    -> Js_long.of_int32 args
-  | Pcvtbint (Pint64, Pint64)
-  | Pcvtbint ((Pnativeint|Pint32), (Pnativeint|Pint32))
-    ->   
-    begin match args with 
-      | [e0] -> e0 
-      | _ -> assert false
-    end
-  | Pcvtbint (Pint64, (Pnativeint|Pint32)) 
-    ->  
-    Js_long.to_int32 args 
-  | Pintoffloat -> 
-    begin
-      match args with 
-      | [e] -> E.to_int32 e 
-      | _ -> assert false 
-    end
-  | Pbintofint Pint64
-    -> Js_long.of_int32 args 
-  | Pbintofint (Pnativeint 
-               | Pint32 )
-  | Pintofbint Pnativeint
-  | Pintofbint Pint32
-  | Pfloatofint 
-    -> 
-    begin match args with 
-      | [e] -> e 
-      | _ -> assert false 
-    end
-  | Pintofbint Pint64
-    -> Js_long.to_int32 args
-  | Pabsfloat -> 
-    begin match args with 
-      | [e] ->
-        E.math "abs" [e]
-        (* GCC treat built-ins like Math in a dirfferent way*)
-      | _ -> assert false
-      end
-  | Pnot ->
-    begin match args with
-      | [e] ->  E.not  e 
-      | _ -> assert false
-    end
-  | Poffsetint n ->
-    begin match args with
-      | [e] ->  E.int32_add  e (E.small_int  n)
-      | _ -> assert false
-    end
-  | Poffsetref n ->
-    begin match args with
-      | [e] -> 
-        let v = (Js_of_lam_block.field Fld_na e 0l) in
-        E.assign  v (E.int32_add v (E.small_int  n))
-      | _ -> assert false
-    end
-
-  | Psequand -> (* TODO: rhs is possibly a tail call *)
-    begin match args with
-      | [e1;e2] ->
-        E.and_   e1  e2
-      | _ -> assert false
-    end
-  | Psequor -> (* TODO: rhs is possibly a tail call *)
-    begin match args with
-      | [e1;e2] ->
-        E.or_  e1  e2
-      | _ -> assert false
-    end
-  | Pisout -> 
-    begin match args with 
-      (* predicate: [x > range  or x < 0 ]
-         can be simplified if x is positive , x > range
-         if x is negative, fine, its uint is for sure larger than range,
-         the output is not readable, we might change it back.
-
-         Note that if range is small like [1], then the negative of 
-         it can be more precise (given integer)
-         a normal case of the compiler is  that it will do a shift 
-         in the first step [ (x - 1) > 1 or ( x - 1 ) < 0 ]
-      *)
-      | [range; e] -> E.is_out e range
-      | _ -> assert false
-    end
-  | Pbytes_of_string -> 
-    begin 
-      (* TODO: write a js primitive  - or is it necessary ?
-         if we have byte_get/string_get
-         still necessary, since you can set it now.
-      *)
-      match args with 
-      |[e] -> Js_of_lam_string.bytes_of_string e
-      | _ -> assert false
-    end
-  | Pbytes_to_string  -> 
-    begin 
-      match args with 
-      |[e] -> Js_of_lam_string.bytes_to_string e 
-      | _ -> assert false
-    end
-  | Pstringlength ->
-    begin match args with
-      | [e] -> E.string_length e 
-      | _ -> assert false 
-    end
-  | Pbyteslength  -> 
-    begin match args with
-      | [e] -> E.bytes_length e 
-      | _ -> assert false 
-    end
-  (* This should only be Pbyteset(u|s), which in js, is an int array 
-     Bytes is an int array in javascript
-  *)
-  | Pbytessetu
-  | Pbytessets -> 
-      begin match args with
-      | [e;e0;e1] -> decorate_side_effect cxt 
-            (Js_of_lam_string.set_byte e e0 e1)
-
-      | _ -> assert false
-      end
-  | Pbytesrefu ->
-      begin match args with
-      | [e;e1] -> Js_of_lam_string.ref_byte e e1
-      | _ -> assert false
-      end
-    
-  | Pbytesrefs ->
-    begin match args with
-      | [e ; e1] ->
-        if !Clflags.fast then
-          Js_of_lam_string.ref_byte e e1
-        else E.runtime_call Js_config.bytes "get" args            
-      | _ -> assert false         
-    end
-   (* For bytes and string, they both return [int] in ocaml 
-       we need tell Pbyteref from Pstringref
-       1. Pbyteref -> a[i]
-       2. Pstringref -> a.charCodeAt (a[i] is wrong)
-    *)
-  | Pstringrefu  ->
-      begin match args with
-      | [e;e1] -> Js_of_lam_string.ref_string e e1 
-      | _ -> assert false
-      end
-
-  | Pstringrefs ->
-      begin match args with
-        | [e;e1] ->
-          if !Clflags.fast then
-            Js_of_lam_string.ref_string e e1             
-          else       
-            E.runtime_call Js_config.string "get" args          
-      | _ -> assert false
-      end
-    
-  | Pgetglobal i   -> 
-    (* TODO -- check args, case by case -- 
-        1. include Array --> let include  = Array 
-        2. get exception
-    *)
-    Lam_compile_global.get_exp (i,env,true)
-  
-    (** only when Lapply -> expand = true*)
-  | Praise  -> assert false (* handled before here *)
-
-(* Runtime encoding relevant *)
-  | Parraylength Pgenarray
-  | Parraylength Paddrarray
-  | Parraylength Pintarray
-  | Parraylength Pfloatarray  -> 
-      begin match args with 
-      | [e] -> E.array_length e 
-      | _ -> assert false
-      end
-  | Psetfield (i, _, field_info) -> 
-      begin match args with 
-      | [e0;e1] ->  (** RUNTIME *)
-          decorate_side_effect cxt 
-            (Js_of_lam_block.set_field field_info e0 (Int32.of_int i) e1)
-            (*TODO: get rid of [E.unit ()]*)
-      | _ -> assert false
-      end
-  | Psetfloatfield (i,field_info)
-    -> (** RUNTIME --  RETURN VALUE SHOULD BE UNIT *)
-      begin 
-        match args with 
-        | [e;e0] -> 
-          decorate_side_effect cxt 
-            (Js_of_lam_float_record.set_double_field field_info e (Int32.of_int i) e0 ) 
-        | _ -> assert false
-      end
+ * 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. *)
 
 
-  | Pfloatfield (i, field_info) -> (** RUNTIME *)
-      begin 
-        match args with 
-        | [e] ->
-          Js_of_lam_float_record.get_double_feild field_info e
-            (Int32.of_int i) 
-        | _ -> assert false 
-      end
-  | Parrayrefu _kind
-  | Parrayrefs _kind ->  
-      begin match args with
-      | [e;e1] -> Js_of_lam_array.ref_array e e1 (* Todo: Constant Folding *)
-      | _ -> assert false
-      end
-  | Pmakearray kind -> 
-      Js_of_lam_array.make_array Mutable kind args 
-  | Parraysetu _kind
-  | Parraysets _kind -> 
-      begin match args with (* wrong*)
-      | [e;e0;e1] -> decorate_side_effect cxt @@ Js_of_lam_array.set_array  e e0 e1
-      | _ -> assert false
-      end
-  | Pccall prim -> 
-      Lam_compile_external_call.translate loc cxt prim args 
-     (* Test if the argument is a block or an immediate integer *)
-  | Pisint -> 
-    begin 
-      match args with 
-      | [e] ->  E.is_type_number e 
 
-      | _ ->   assert false
-    end
-  | Pctconst ct -> 
-    begin
-      match ct with 
-      | Big_endian -> 
-        if Sys.big_endian then  E.caml_true
-        else E.caml_false
-      | Word_size -> 
-        E.small_int  Sys.word_size
-      | Ostype_unix -> 
-        if Sys.unix then E.caml_true else E.caml_false
-      | Ostype_win32 -> 
-        if Sys.win32 then E.caml_true else E.caml_false
-      | Ostype_cygwin -> 
-        if Sys.cygwin then E.caml_true else E.caml_false
-    end
-  | Psetglobal _  -> 
-    assert false (* already handled *)
-    (* assert false *)
-  | Pduprecord ((Record_regular 
-                | Record_float ),0)
-  | Pduprecord ((Record_regular 
-                | Record_float ),_) -> 
-    begin match args with 
-    | [e] -> Js_of_lam_record.copy e
-    | _ -> assert false       
-    end
-  | Pbigarrayref (unsafe, dimension, kind, layout)
-    -> 
-    (* can be refined to 
-       [caml_bigarray_float32_c_get_1]
-       note that kind can be [generic]
-       and layout can be [unknown],
-       dimension is always available
-    *)
-    begin match dimension, kind, layout, unsafe with 
-      | 1,  ( Pbigarray_float32 | Pbigarray_float64
-            | Pbigarray_sint8 | Pbigarray_uint8
-            | Pbigarray_sint16 | Pbigarray_uint16
-            | Pbigarray_int32 | Pbigarray_int64
-            | Pbigarray_caml_int | Pbigarray_native_int
-            | Pbigarray_complex32 | Pbigarray_complex64), Pbigarray_c_layout, _
-        -> 
-        begin match args with
-        | [x;indx] -> Js_of_lam_array.ref_array x indx
-        | _ -> assert false
-        end
-    | _, _, _ ,_ -> 
-      E.not_implemented ("caml_ba_get_" ^ string_of_int dimension )
-      (* E.runtime_call Js_config.bigarray  *)
-      (*   ("caml_ba_get_" ^ string_of_int dimension ) args  *)
-    end
-  | Pbigarrayset (unsafe, dimension, kind, layout)
-    -> 
-    begin match dimension, kind, layout, unsafe with 
-      | 1,  ( Pbigarray_float32 | Pbigarray_float64
-            | Pbigarray_sint8 | Pbigarray_uint8
-            | Pbigarray_sint16 | Pbigarray_uint16
-            | Pbigarray_int32 | Pbigarray_int64
-            | Pbigarray_caml_int | Pbigarray_native_int
-            | Pbigarray_complex32 | Pbigarray_complex64), Pbigarray_c_layout, _
-        -> 
-        begin match args with 
-        | [x; index; value] -> 
-          Js_of_lam_array.set_array x index value          
-        | _ -> assert false
-        end
-      
-      | _ , _, _,_ 
-        -> 
-        E.not_implemented
-          ("caml_ba_set_" ^ string_of_int dimension )
-        (* E.runtime_call Js_config.bigarray  *)
-        (*   ("caml_ba_set_" ^ string_of_int dimension ) args  *)
-    end
 
-  | Pbigarraydim i
-    -> 
-    E.not_implemented ("caml_ba_dim_" ^ string_of_int i)
-    (* E.runtime_call Js_config.bigarray *)
-    (*   ("caml_ba_dim_" ^ string_of_int i) args        *)
-  | Pbswap16 
-    -> 
-    E.runtime_call Js_config.int32 "caml_bswap16" args
-  | Pbbswap Lambda.Pnativeint
-  | Pbbswap Lambda.Pint32
-    -> 
-    E.runtime_call Js_config.int32 "caml_int32_bswap" args
-  | Pbbswap Lambda.Pint64
-    -> Js_long.swap args 
-  | Pstring_load_16 unsafe
-    -> E.runtime_call Js_config.string "caml_string_get16" args
-  | Pstring_load_32 unsafe
-    -> E.runtime_call Js_config.string "caml_string_get32" args
-  | Pstring_load_64 unsafe
-    -> Js_long.get64 args
 
-  | Plazyforce
-  (* | Plazyforce -> *)
-  (*     let parm = Ident.create "prim" in *)
-  (*     Lfunction(Curried, [parm], *)
-  (*               Matching.inline_lazy_force (Lvar parm) Location.none) *)
-  (* It is inlined, this should not appear here *)    
-  | Pbittest 
-  
-  | Pstring_set_16 _
-  | Pstring_set_32 _
-  | Pstring_set_64 _
-  | Pbigstring_load_16 _
-  | Pbigstring_load_32 _
-  | Pbigstring_load_64 _
-  | Pbigstring_set_16 _
-  | Pbigstring_set_32 _
-  | Pbigstring_set_64 _
-    -> 
-      let comment = "Missing primitive" in       
-      let s = Lam_util.string_of_primitive prim in
-      let warn = Printf.sprintf  "%s: %s\n" comment s in
-      Ext_log.warn __LOC__ "%s"  warn;
-      (*we dont use [throw] here, since [throw] is an statement  *)        
-      E.dump  Error [ E.str warn]
 
 
 
+module E = Js_exp_make
+module S = Js_stmt_make 
+
+let flatten_map = 
+  object(self)
+    inherit Js_map.map as super
+    method! statement x = 
+      match x.statement_desc with 
+      |  Exp ({expression_desc = Seq _; _} as v) ->
+          (S.block ( List.rev_map (self#statement) (Js_analyzer.rev_flatten_seq v )))
+      |  Exp ({expression_desc = Cond(a,b,c); comment} ) -> 
+          (* Note that we need apply [self#statement] recursively *)
+          { statement_desc = If (a, [ self#statement (S.exp b)],  
+                                 Some [ self#statement (S.exp c)]); comment}
+          (* CHECK? Trick semantics difference *)
+          (* super#statement (S.if_ a ([ (\* self#statement *\) (S.exp b) ]) *)
+          (*     ~else_:([self#statement (S.exp c)]) *)
+          (*                 ) *)
+
+      |  Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} )
+        ->
+          let block = Js_analyzer.rev_flatten_seq v in
+          begin match block with
+          | {statement_desc = Exp last_one ; _} :: rest_rev
+            ->  
+              S.block (Ext_list.rev_map_append (self#statement) rest_rev 
+                [self#statement @@ S.exp (E.assign a  last_one)])
+                (* TODO: here we introduce a block, should avoid it *)
+              (* super#statement *)
+              (*   (S.block (List.rev_append rest_rev [S.exp (E.assign a  last_one)])) *)
+          | _ ->
+              assert false
+          end
+      | Return ( {return_value = {expression_desc = Cond (a,b,c);  comment}}) 
+        -> 
+          { statement_desc = If (a, [self#statement (S.return b)],  
+                                 Some [ self#statement (S.return c)]); comment}
+
+      | Return ({return_value = {expression_desc = Seq _; _} as v}) ->
+          let block = Js_analyzer.rev_flatten_seq v  in
+          begin match block with
+          | {statement_desc = Exp last_one ; _} :: rest_rev
+            ->  
+              super#statement 
+                (S.block (Ext_list.rev_map_append (self#statement) rest_rev [S.return last_one]))
+          | _ -> assert false
+          end
+      | Block [x]
+          -> 
+            self#statement x 
+      | _ -> super#statement x 
+
+    method! block b =
+      match b with
+      | {statement_desc = Block bs } :: rest ->
+          self#block ( bs @  rest)
+      | x::rest  
+        -> 
+          self#statement x :: self#block rest
+      | [] -> []
+  end
+
+let program ( x : J.program) = flatten_map # program x 
+
 end
-module Lam_exit_code : sig 
-#1 "lam_exit_code.mli"
+module Js_pass_flatten_and_mark_dead : sig 
+#1 "js_pass_flatten_and_mark_dead.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -82839,10 +83020,13 @@ module Lam_exit_code : sig
 
 
 
-val has_exit_code : (int -> bool ) -> Lam.t -> bool 
+
+(** A pass to mark some declarations in JS IR as dead code *)
+
+val program :  J.program -> J.program
 
 end = struct
-#1 "lam_exit_code.ml"
+#1 "js_pass_flatten_and_mark_dead.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -82872,77 +83056,294 @@ end = struct
 
 
 
-let rec has_exit_code exits  (lam : Lam.t)  : bool = 
-  match lam with
-  | Lvar _
-  | Lconst _ 
-  | Lfunction _ (* static exit can not across function boundary *)
-    -> false
-  | Lapply {fn = l; args; _ } 
-    -> has_exit_code exits l || List.exists (fun x -> has_exit_code exits x ) args 
 
-  | Llet (_kind,_id,v,body) 
-    -> has_exit_code exits v || has_exit_code exits body
-  | Lletrec (binding,body) ->
-    List.exists (fun (_, l) -> has_exit_code exits l ) binding ||
-    has_exit_code exits body    
-  | Lprim {args; _} 
-    -> List.exists (fun x -> has_exit_code exits x) args
-  | Lswitch (l,lam_switch) 
-    -> has_exit_code exits l || has_exit_code_lam_switch exits lam_switch
 
-  | Lstringswitch (l,ls,opt) -> 
-    has_exit_code exits l ||
-    List.exists (fun (_,l) -> has_exit_code exits l) ls ||
-    (match opt with 
-    | None -> false
-    | Some x -> has_exit_code exits l )
-  | Lstaticraise (v,ls) ->
-      exits v ||    
-    List.exists (has_exit_code exits) ls
-  | Lstaticcatch (l,_,handler) 
-    ->
-    has_exit_code exits l || has_exit_code exits handler
-  | Ltrywith (l,_, handler) 
-    ->
-    has_exit_code exits l || has_exit_code exits handler
-  | Lifthenelse (a,b,c) 
-    -> 
-    has_exit_code exits a || has_exit_code exits b || has_exit_code exits c
-  | Lsequence (a,b) 
-    ->
-    has_exit_code exits a || has_exit_code exits b
-  | Lwhile (a,b) 
-    ->
-    has_exit_code exits a || has_exit_code exits b
-  | Lfor (_,a,b,_dir,body) -> 
-    has_exit_code exits a 
-    || has_exit_code exits b
-    || has_exit_code exits body
-    
-  | Lassign (_,a) 
-    -> 
-    has_exit_code exits a
-  | Lsend (_,obj,l,ls,_loc) 
-    -> 
-    has_exit_code exits obj ||
-    has_exit_code exits l ||
-    List.exists (has_exit_code exits) ls
-  | Lifused (_,b) 
-    -> has_exit_code exits b
+module E = Js_exp_make
+module S = Js_stmt_make
+
+class count  var = object (self : 'self)
+  val mutable appears = 0
+  inherit Js_fold.fold as super
+  method! ident  x =
+    (if Ident.same x var then
+      appears <- appears + 1); 
+    self
+  method get_appears = appears 
+end
+
+(* rewrite return for current block, but don't go into
+   inner function, mostly for inlinning
+ *)
+class rewrite_return ?return_value ()=
+  let mk_return  = 
+    match return_value with 
+    | None -> fun e -> S.exp e 
+    | Some ident -> fun e -> S.define ~kind:Variable ident e in
+  object (self : 'self)
+    inherit Js_map.map as super
+    method! statement x =
+      match x.statement_desc with 
+      | Return {return_value = e} -> 
+          mk_return e 
+      | _ -> super#statement x 
+    method! expression x = x (* don't go inside *)
+  end  
+
+(* 
+    HERE we are using an object , so make sure to clean it up, 
+    remove stale cache
+ *)
+let mark_dead = object (self)
+  inherit Js_fold.fold as super
+
+  val mutable name = ""
+
+  val mutable ident_use_stats : [`Info of J.ident_info | `Recursive] Ident_hashtbl.t
+      = Ident_hashtbl.create 17
+  
+  val mutable export_set : Ident_set.t = Ident_set.empty    
+
+  method mark_not_dead ident =
+    match Ident_hashtbl.find_opt ident_use_stats ident with
+    | None -> (* First time *)
+        Ident_hashtbl.add ident_use_stats ident `Recursive 
+        (* recursive identifiers *)
+    | Some `Recursive
+      -> ()
+    | Some (`Info x) ->  Js_op_util.update_used_stats x Used 
+
+  method scan b ident (ident_info : J.ident_info) = 
+    let is_export = Ident_set.mem ident export_set in
+    let () = 
+      if is_export (* && false *) then 
+        Js_op_util.update_used_stats ident_info Exported 
+    in
+    match Ident_hashtbl.find_opt ident_use_stats ident with
+    | Some (`Recursive) -> 
+        Js_op_util.update_used_stats ident_info Used; 
+        Ident_hashtbl.replace ident_use_stats ident (`Info ident_info)
+    | Some (`Info _) ->  
+        (** check [camlinternlFormat,box_type] inlined twice 
+            FIXME: seems we have redeclared identifiers
+         *)
+      if Js_config.get_diagnose () then 
+        Ext_log.warn __LOC__ "@[%s$%d in %s@]" ident.name ident.stamp name
+        (* assert false *)
+    | None ->  (* First time *)
+        Ident_hashtbl.add ident_use_stats ident (`Info ident_info);
+        Js_op_util.update_used_stats ident_info 
+          (if b then Scanning_pure else Scanning_non_pure)
+  method promote_dead = 
+    Ident_hashtbl.iter (fun _id (info : [`Info of J.ident_info  | `Recursive]) ->
+      match info  with 
+      | `Info ({used_stats = Scanning_pure} as info) -> 
+          Js_op_util.update_used_stats info Dead_pure
+      | `Info ({used_stats = Scanning_non_pure} as info) -> 
+          Js_op_util.update_used_stats info Dead_non_pure
+      | _ -> ())
+      ident_use_stats;
+    Ident_hashtbl.clear ident_use_stats (* clear to make it re-entrant *)
+
+  method! program x = 
+    export_set <- x.export_set ; 
+    name <- x.name;
+    super#program x 
+
+  method! ident x = 
+    self#mark_not_dead x ; self 
+
+  method! variable_declaration vd =  
+    match vd with 
+    | { ident_info = {used_stats = Dead_pure } ; _}
+      -> self
+    | { ident_info = {used_stats = Dead_non_pure } ; value } -> 
+      begin match value with
+      | None -> self
+      | Some x -> self#expression x 
+      end
+    | {ident; ident_info ; value ; _} -> 
+      let pure = 
+        match value with 
+        | None  -> false 
+        | Some x -> ignore (self#expression x); Js_analyzer.no_side_effect_expression x in
+      self#scan pure ident ident_info; self
+end
+
+let mark_dead_code js = 
+  let _ =  (mark_dead#program js) in 
+  mark_dead#promote_dead;
+  js
+        
+(*
+   when we do optmizations, we might need track it will break invariant 
+   of other optimizations, especially for [mutable] meta data, 
+   for example, this pass will break [closure] information, 
+   it should be done before closure pass (even it does not use closure information)
+
+   Take away, it is really hard to change the code while collecting some information..
+   we should always collect info in a single pass
+
+   Note that, we should avoid reuse object, i.e,
+   {[
+     let v = 
+       object 
+       end      
+   ]}   
+   Since user may use `bsc.exe -c xx.ml xy.ml xz.ml` and we need clean up state
+ *)
+let subst_map name = object (self)
+  inherit Js_map.map as super
+
+  val mutable substitution :  J.expression Ident_hashtbl.t= Ident_hashtbl.create 17 
+
+  method get_substitution = substitution
+
+  method add_substitue (ident : Ident.t) (e:J.expression) = 
+    Ident_hashtbl.replace  substitution ident e
+
+  method! statement v = 
+    match v.statement_desc with 
+    | Variable ({ident; ident_info = {used_stats = Dead_pure } ; _}) -> 
+      {v with statement_desc = Block []}
+    | Variable ({ident; ident_info = {used_stats = Dead_non_pure } ; value = None}) -> 
+      {v with statement_desc = Block []}
+    | Variable ({ident; ident_info = {used_stats = Dead_non_pure } ; value = Some x}) -> 
+      {v with statement_desc =  (Exp x)}
+
+    | Variable ({ ident ; 
+                  property = (Strict | StrictOpt | Alias);
+                  value = Some (
+                      {expression_desc = (Caml_block ( _:: _ :: _ as ls, Immutable, tag, tag_info) 
+                                         )} as block)
+                } as variable) -> 
+      (** If we do this, we should prevent incorrect inlning to inline it into an array :) 
+          do it only when block size is larger than one
+      *)
+
+      let (_, e, bindings) = 
+        List.fold_left 
+          (fun  (i,e,  acc) (x : J.expression) -> 
+             match x.expression_desc with 
+             | J.Var _ | Number _ | Str _ 
+               -> 
+               (i + 1, x :: e, acc)
+             | _ ->                
+               (* tradeoff, 
+                   when the block is small, it does not make 
+                   sense too much -- 
+                   bottomline, when the block size is one, no need to do 
+                   this
+               *)
+               let v' = self#expression x in 
+               let match_id =
+                 Ext_ident.create
+                   (Printf.sprintf "%s_%03d"
+                      ident.name i) in
+               (i + 1, E.var match_id :: e, (match_id, v') :: acc)               
+          ) (0, [], []) ls  in
+      let e = 
+        {block with 
+         expression_desc = 
+           Caml_block(List.rev e, Immutable, tag, tag_info)
+        } in
+      let () = self#add_substitue ident e in
+      (* let bindings =  !bindings in *)
+      let original_statement = 
+        { v with 
+          statement_desc = Variable {variable with value =  Some   e }
+        } in
+      begin match bindings with 
+        | [] -> 
+          original_statement
+        | _ ->  
+          (* self#add_substitue ident e ; *)
+          S.block @@
+          (Ext_list.rev_map_acc [original_statement] (fun (id,v) -> 
+               S.define ~kind:Strict id v)  bindings  )
+      end
+    | _ -> super#statement v 
+
+  method! expression x =
+    match x.expression_desc with 
+    | Access ({expression_desc = Var (Id (id))}, 
+              {expression_desc = Number (Int {i; _})}) -> 
+      begin match Ident_hashtbl.find_opt self#get_substitution id with 
+        | Some {expression_desc = Caml_block (ls, Immutable, _, _) } 
+          -> 
+          (* user program can be wrong, we should not 
+             turn a runtime crash into compile time crash : )
+          *)          
+          begin match List.nth ls (Int32.to_int i) with 
+            | {expression_desc = J.Var _ | Number _ | Str _ } as x 
+              -> x 
+            | exception _ ->
+              begin
+                Ext_log.err __LOC__ "suspcious code %s when compiling %s@."
+                  (Printf.sprintf "%s/%d" id.name id.stamp)
+                  name  ;
+                super#expression x ;
+              end
+            | _ -> 
+              (** we can do here, however, we should 
+                  be careful that it can only be done 
+                  when it's accessed once and the array is not escaped,
+                  otherwise, we redo the computation,
+                  or even better, we re-order
 
-and has_exit_code_lam_switch exits (lam_switch : Lam.switch) = 
-  match lam_switch with
-   | { sw_numconsts = _; sw_consts; sw_numblocks = _ ; sw_blocks; sw_failaction } ->
-     List.exists (fun (_,l) -> has_exit_code exits l) sw_consts ||
-     List.exists (fun (_,l) -> has_exit_code exits l)  sw_blocks ||
-     (match sw_failaction with 
-     | None -> false 
-     | Some x -> has_exit_code exits x)
+                  {[
+                    var match = [/* tuple */0,Pervasives.string_of_int(f(1,2,3)),f3(2),arr];
+
+                        var a = match[1];
+
+                          var b = match[2];
+
+                  ]}
+
+                  --->
+
+                  {[
+                    var match$1 = Pervasives.string_of_int(f(1,2,3));
+                        var match$2 = f3(2);
+                            var match = [/* tuple */0,match$1,match$2,arr];
+                                var a = match$1;
+                                  var b = match$2;
+                                    var arr = arr; 
+                  ]}
+
+                  --> 
+                  since match$1 (after match is eliminated) is only called once 
+                  {[
+                    var a = Pervasives.string_of_int(f(1,2,3));
+                    var b = f3(2);
+                    var arr = arr; 
+                  ]}
+
+              *)
+              super#expression x 
+          end
+        | (Some _ | None) -> super#expression x 
+      end
+    | _ -> super#expression x
+end 
+
+(* Top down or bottom up ?*)
+(* A pass to support nullary argument in JS 
+    Nullary information can be done in one pass, 
+    there is no need to add another pass
+ *)
+
+let program  (js : J.program) = 
+  js 
+  |> (subst_map js.name )#program
+  |> mark_dead_code
+  (* |> mark_dead_code *)
+  (* mark dead code twice does have effect in some cases, however, we disabled it 
+    since the benefit is not obvious
+   *)
 
 end
-module Lam_compile : sig 
-#1 "lam_compile.mli"
+module Js_pass_scope : sig 
+#1 "js_pass_scope.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -82974,21 +83375,12 @@ module Lam_compile : sig
 
 
 
-(** Compile single lambda IR to JS IR  *)
-
-val compile_let : 
-  Lambda.let_kind ->
-  Lam_compile_defs.cxt -> 
-  J.ident -> 
-  Lam.t -> 
-  Js_output.t
-
-val compile_recursive_lets : Lam_compile_defs.cxt -> (Ident.t * Lam.t) list -> Js_output.t
+(** A module to do scope analysis over JS IR *)
 
-val compile_lambda : Lam_compile_defs.cxt -> Lam.t -> Js_output.t
+val program : J.program ->  Ident_set.t
 
 end = struct
-#1 "lam_compile.ml"
+#1 "js_pass_scope.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -83020,1623 +83412,975 @@ end = struct
 
 
 
-open Js_output.Ops 
-
-module E = Js_exp_make 
+let _l idents = 
+  Ext_log.err __LOC__ "hey .. %s@." 
+    (String.concat "," @@ List.map (fun  i -> i.Ident.name ) idents) 
 
-module S = Js_stmt_make  
+(* 
 
-let method_cache_id = ref 1 (*TODO: move to js runtime for re-entrant *)
+    Base line 
+    {[
+     for i = 1 to n do (function (i){...}(i))
+     done
+       (* This is okay, since all ocaml follow the lexical scope, 
+          for generrated code too (* TODO: check *)
+        *)
+    ]}
 
+  For nested loops 
+  {[
+   for i = 0 to n do 
+     for j = 0 to n do 
+       arrr.(j)<- ()=>{ i}
+     done
+   done
+ ]}
+    Three kind of variables  (defined in the loop scope)
+    1. loop mutable variables 
+       As long as variables change per iteration, defined in a loop (in the same loop)
+        and captured by a closure
+       the loop, iff  be lexically scoped 
+       Tailcall parameters are considered defined inside the loop
+    - unless it's defined 
+       outside all the loops - note that for nested loops, if it's defined 
+       in the outerloop and captured by the inner loop, 
+       it still has to be lexically scoped. 
 
-(* assume outer is [Lstaticcatch] *)
-let rec flat_catches acc (x : Lam.t)
-  : (int * Lam.t * Ident.t  list ) list * Lam.t = 
-  match x with 
-  | Lstaticcatch( Lstaticcatch(l, (code,bindings), handler), (code1, bindings1),handler1) 
-    when 
-      not @@ Lam_exit_code.has_exit_code 
-        (fun exit -> exit = code1 || List.exists (fun (c, _, _) -> c = exit ) acc ) handler
-    -> 
-    (* when handler does not have [exit code] which [code] belongs to collected,
-       it is okay to merge
-       *)
-    flat_catches ( (code, handler,bindings) :: (code1,handler1,bindings1)  :: acc)  l
-  | Lstaticcatch(l, (code, bindings), handler) ->
-    (code,handler,bindings)::acc, l
-    (* flat_catches ((code,handler,bindings)::acc) l  *)
-  | _ -> acc, x
+       How do we detect whether it is loop invariant or not 
+       - depend on loop variant 
+       - depend on mutuable valuse
+       - non pure (function call)
 
-let flatten_caches  x = flat_catches [] x 
+       so we need collect mutable variables 
+       1. from lambda + loop (for/i) + tailcall params
+       2. defined in the loop and can not determine it is invariant  
+          in such cases we can determine it's immutable
+          1. const 
+          2. only depend on immutable values and no function call?
 
-(* exception Not_an_expression *)
+    ## The following would take advantage of nested loops 
+    2. loop invariant observable varaibles 
+        {[ 
+         var x = (console.log(3), 32)
+        ]}
+    3. loop invariant non-observable variables 
 
-(* TODO:
-    for expression generation, 
-    name, should_return  is not needed,
-    only jmp_table and env needed
+    Invariant: 
+    loop invariant (observable or not) variables can not depend on 
+    loop mutable values so that once we detect loop Invariant variables 
+    all its dependency are loop invariant as well, so we can do loop 
+    Invariant code motion.
+    
+    TODO:
+    loop invariant can be layered, it will be loop invariant 
+    in the inner layer while loop variant in the outer layer.
+    {[
+    for i = 0 to 10 do 
+      for j  = 10 do 
+        let  k0 = param * 100 in (* loop invariant *)
+        let  k1 = i * i in (* inner loop invariant, loop variant *)
+        let  k2 = j * i in (* variant *)
+        ..
+      done 
+    done 
+    ]}
 *)
-let translate_dispatch = ref (fun _ -> assert false)
 
-type default_case = 
-  | Default of Lam.t
-  | Complete
-  | NonComplete
+let scope_pass  = 
+  object(self)
+    inherit Js_fold.fold as super
 
+    val  defined_idents = Ident_set.empty 
+        
+    (** [used_idents] 
+        does not contain locally defined idents *)
+    val  used_idents = Ident_set.empty 
+    (** we need collect mutable values and loop defined varaibles *)    
+    val loop_mutable_values = Ident_set.empty 
 
-let rec  
-  get_exp_with_index (cxt : Lam_compile_defs.cxt) lam 
-    ((id : Ident.t), (pos : int),env) : Js_output.t = 
-  let f =   Js_output.handle_name_tail cxt.st cxt.should_return lam in    
-  Lam_compile_env.find_and_add_if_not_exist (id,pos) env 
-    ~not_found:(fun id -> 
-        f (E.str ~pure:false (Printf.sprintf "Err %s %d %d" id.name id.flags pos))
-        (* E.index m (pos + 1) *) (** shift by one *)
-        (** This can not happen since this id should be already consulted by type checker *)
-      )
-    ~found:(fun {id; name; closed_lambda } ->
-        match id, name, closed_lambda with 
-        | {name = "Sys"; _}, "os_type" , _
-          (** We drop the ability of cross-compiling
-              the compiler has to be the same running 
-          *)
-          ->  f (E.str Sys.os_type)
-        | _, _, Some lam 
-          when Lam_util.not_function lam
-          (* since it's only for alias, there is no arguments, 
-             we should not inline function definition here, even though
-             it is very small             
-             TODO: add comment here, we should try to add comment for 
-             cross module inlining             
-          
-             if we do too agressive inlining here: 
+    val mutable_values = Ident_set.empty      
 
-             if we inline {!List.length} which will call {!A_list.length}, 
-             then we if we try inline {!A_list.length}, this means if {!A_list} 
-             is rebuilt, this module should also be rebuilt,
+    val closured_idents = Ident_set.empty 
 
-             But if the build system is content-based, suppose {!A_list} 
-             is changed, cmj files in {!List} is unchnaged, however, 
-             {!List.length} call {!A_list.length} which is changed, since
-             [ocamldep] only detect that we depend on {!List}, it will not 
-             get re-built, then we are screwed.                   
+    (** check if in loop or not *)    
+    val in_loop = false 
 
-             This is okay for stamp based build system.
+    method get_in_loop = in_loop
 
-             Another solution is that we add dependencies in the compiler
+    method get_defined_idents = defined_idents
 
-             -: we should not do functor application inlining in a 
-                non-toplevel, it will explode code very quickly              
-          *)               
-          ->  
-          compile_lambda cxt lam
-        | _ -> 
-          f (E.ml_var_dot id name)
-      ) 
-(* TODO: how nested module call would behave,
-   In the future, we should keep in track  of if 
-   it is fully applied from [Lapply]
-   Seems that the module dependency is tricky..
-   should we depend on [Pervasives] or not?
+    method get_used_idents = used_idents
 
-   we can not do this correctly for the return value, 
-   however we can inline the definition in Pervasives
-   TODO:
-   [Pervasives.print_endline]
-   [Pervasives.prerr_endline]
-   @param id external module id 
-   @param number the index of the external function 
-   @param env typing environment
-   @param args arguments 
- *)
+    method get_loop_mutable_values = loop_mutable_values 
 
-and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
-    (id : Ident.t) (pos : int) env : Js_output.t = 
-  Lam_compile_env.find_and_add_if_not_exist (id,pos) env ~not_found:(fun id -> 
-      (** This can not happen since this id should be already consulted by type checker 
-          Worst case 
-          {[
-            E.index m (pos + 1)
-          ]}
-          shift by one (due to module encoding)
-      *)
-      (* Js_output.handle_block_return cxt.st cxt.should_return lam args_code @@  *)
-      (* E.str ~pure:false  (Printf.sprintf "Err %s %d %d" *)
-      (*                       id.name *)
-      (*                       id.flags *)
-      (*                       pos *)
-      (*                    ) *)
-      assert false 
-    )
+    method get_mutable_values = mutable_values 
 
-    ~found:(fun {id; name;arity; closed_lambda ; _} -> 
-        let args_code, args = 
-          List.fold_right 
-            (fun (x : Lam.t) (args_code, args)  ->
-               match x with 
-               | Lprim {primitive = Pgetglobal i; args =  [];_ } -> 
-                 (* when module is passed as an argument - unpack to an array
-                     for the function, generative module or functor can be a function,
-                     however it can not be global -- global can only module
+    method get_closured_idents = closured_idents 
+
+    method with_in_loop b = 
+      if b = self#get_in_loop then self
+      else {< in_loop = b >}
+     (* Since it's loop mutable variable, for sure
+         it is mutable variable
+         *)       
+    method with_loop_mutable_values b = 
+      {< loop_mutable_values =  b >}
+
+    method add_loop_mutable_variable id = 
+      {< loop_mutable_values = Ident_set.add id loop_mutable_values;
+         mutable_values = Ident_set.add id mutable_values
+         >}
+
+    method add_mutable_variable id = 
+      {< mutable_values = Ident_set.add id mutable_values >}
+
+    method add_defined_ident ident = 
+      {< defined_idents = Ident_set.add ident defined_idents >} 
+
+    method! expression x = 
+      match x.expression_desc with 
+      | Fun (_method_, params, block , env) -> 
+        (* Function is the only place to introduce a new scope in 
+            ES5
+            TODO: check 
+            {[ try .. catch(exn) {.. }]}
+            what's the scope of exn
+        *)
+        (* Note that [used_idents] is not complete
+            it ignores some locally defined idents *)
+        let param_set = Ident_set.of_list params in
+        let obj =  {<defined_idents = Ident_set.empty;
+                     (** pass [empty]
+                         so that we can check which parameter was actually used *)
+                     used_idents = Ident_set.empty ;
+                     in_loop = false;
+                     loop_mutable_values = Ident_set.empty;
+                     mutable_values = Ident_set.of_list (Js_fun_env.get_mutable_params params env) ; 
+                     closured_idents = Ident_set.empty; (* think about nested function*)
+                   >} # block block in
+        let defined_idents', used_idents' = 
+          obj#get_defined_idents, obj#get_used_idents  in
+        (* mark which param is used *)
+        params |> List.iteri 
+          (fun i v -> 
+             if not (Ident_set.mem v used_idents') then 
+               Js_fun_env.mark_unused env i) ;
+        let closured_idents' =  (* pass param_set down *)
+          Ident_set.(diff used_idents' (union defined_idents' param_set )) in
+
+        (* Noe that we don't know which variables are exactly mutable yet ..
+           due to the recursive thing
+         *)
+        Js_fun_env.set_unbounded env closured_idents'   ; 
+        let lexical_scopes = Ident_set.(inter closured_idents' self#get_loop_mutable_values) in
+        Js_fun_env.set_lexical_scope env lexical_scopes;
+        (* tailcall , note that these varibles are used in another pass *)
+        {< used_idents = 
+             Ident_set.union used_idents closured_idents' ;
+           (* There is a bug in ocaml -dsource*)           
+           closured_idents = Ident_set.union closured_idents closured_idents'
+        >}
+      | _ -> super#expression x 
+            (* TODO: most variables are immutable *)
+
+    method! variable_declaration x = 
+      match x with
+      | { ident ; value; property  }  -> 
+        let obj = 
+          (match self#get_in_loop, property with 
+           | true, Variable 
+             -> 
+             self#add_loop_mutable_variable ident 
+           | true, (Strict | StrictOpt | Alias)
+           (* Not real true immutable in javascript 
+               since it's in the loop 
+
+               TODO: we should also 
+           *)
+             -> 
+             begin match value with 
+               | None -> self#add_loop_mutable_variable ident
+               (* TODO: Check why assertion failure *)
+               (* self#add_loop_mutable_variable ident *) (* assert false *)
+               | Some x
+                 ->
+                 (** 
+                     when x is an immediate immutable value, 
+                     (like integer .. )
+                     not a reference, it should be Immutable
+                     or string, 
+                     type system might help here
+                     TODO:
                  *)
+                 match x.expression_desc with
+                 | Fun _  | Number _ | Str _ 
+                   -> self 
+                 | _ -> 
+                   (* if Ident_set.(is_empty @@ *)
+                   (*   inter self#get_mutable_values  *)
+                   (*     ( ({<  *)
+                   (*         defined_idents = Ident_set.empty;  *)
+                   (*         used_idents = Ident_set.empty; *)
+                   (*         >} # expression x) # get_used_idents)) then *)
+                   (*   (\* FIXME: still need to check expression is pure or not*\) *)
+                   (*   self *)
+                   (* else  *)
+                   self#add_loop_mutable_variable ident
+             end
+           | false, Variable
+             -> 
+             self#add_mutable_variable ident      
+           | false, (Strict | StrictOpt | Alias)
+             -> self
+          )#add_defined_ident ident
+        in
+        begin match value with 
+          | None -> obj 
+          | Some x -> obj # expression x  
+        end 
 
-                 args_code, (Lam_compile_global.get_exp (i, env, true) :: args)
-               | _ -> 
-                 begin match compile_lambda {cxt with st = NeedValue; should_return = False} x with
-                   | {block = a; value = Some b} -> 
-                     (a @ args_code), (b :: args )
-                   | _ -> assert false
-                 end
-            ) args_lambda ([], []) in
+        
+    method! statement x = 
+      match x.statement_desc with 
+      | ForRange  (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *)
+          let obj = 
+            {< in_loop = true ;
+               loop_mutable_values = Ident_set.singleton loop_id ;
+               used_idents = Ident_set.empty; (* TODO: if unused, can we generate better code? *)
+               defined_idents = Ident_set.singleton loop_id ;
+               closured_idents = Ident_set.empty (* Think about nested for blocks *)
+                 (* Invariant: Finish id is never used *)
+                 >}
+              # statement_desc y in
+
+          let defined_idents', used_idents', closured_idents' = 
+            obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in
+
+
+          let lexical_scope =  Ident_set.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in
+          let () = Js_closure.set_lexical_scope a_env lexical_scope in
+          (* set scope *)
+          {< used_idents = Ident_set.union used_idents used_idents';
+             (* walk around ocaml -dsource bug 
+                {[ 
+                  Ident_set.(union used_idents used_idents)                  
+                ]}                
+             *)             
+             defined_idents = Ident_set.union defined_idents defined_idents';
+             (* TODO: if we our generated code also follow lexical scope,
+                this is not necessary ;
+                [varaibles] are mutable or not is known at definition
+              *)
+             closured_idents = Ident_set.union closured_idents lexical_scope
+             >}
+
+      | While (_label,pred,body, _env) ->  
+          (((self#expression pred)#with_in_loop true) # block  body )
+            #with_in_loop (self#get_in_loop)
+      | _ -> 
+          super#statement x 
+
+    method! exception_ident x = 
+      (* we can not simply skip it, since it can be used 
+          TODO: check loop exception
+          (loop {
+          excption(i){
+          () => {i}
+          } 
+          })
+       *)
+      {< used_idents = Ident_set.add x used_idents;
+         defined_idents = Ident_set.add x defined_idents
+         >}
+    method! for_ident x = {< loop_mutable_values = Ident_set.add x loop_mutable_values >}
+
+    method! ident x = 
+      if Ident_set.mem x defined_idents then 
+        self
+      else {< used_idents = Ident_set.add x used_idents >}
+  end
+
+let program js = 
+  (scope_pass # program js ) # get_loop_mutable_values
+
+end
+module Js_pass_tailcall_inline : sig 
+#1 "js_pass_tailcall_inline.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-        match closed_lambda with 
-        | Some (Lfunction{ params; body; _}) 
-          when Ext_list.same_length params args_lambda -> 
-          (* TODO: serialize it when exporting to save compile time *)
-          let (_, param_map)  = 
-            Lam_closure.is_closed_with_map Ident_set.empty params body in
-          compile_lambda cxt 
-            (Lam_beta_reduce.propogate_beta_reduce_with_map cxt.meta param_map
-               params body args_lambda)
-        | _ ->  
-          Js_output.handle_block_return cxt.st cxt.should_return lam args_code @@ 
-          (match id, name,  args with 
-           | {name = "Pervasives"; _}, "print_endline", ([ _ ] as args) ->  
-             E.seq (E.dump Log args) E.unit
-           | {name = "Pervasives"; _}, "prerr_endline", ([ _ ] as args) ->  
-             E.seq (E.dump Error args) E.unit
-           | _ -> 
-             let rec aux (acc : J.expression)
-                 (arity : Lam.function_arities) args (len : int)  =
-               match arity, len with
-               | _, 0 -> 
-                 acc (** All arguments consumed so far *)
-               | Determin (a, (x,_) :: rest, b), len   ->
-                 let x = 
-                   if x = 0 
-                   then 1 
-                   else x in (* Relax when x = 0 *)
-                 if  len >= x 
-                 then
-                   let first_part, continue =  (Ext_list.take x args) in
-                   aux
-                     (E.call ~info:{arity=Full; call_info = Call_ml} acc first_part)
-                     (Determin (a, rest, b))
-                     continue (len - x)
-                 else  acc 
-               (* alpha conversion now? --
-                  Since we did an alpha conversion before so it is not here
-               *)
-               | Determin (a, [], b ), _ ->
-                 (* can not happen, unless it's an exception ? *)
-                 E.call ~info:Js_call_info.dummy acc args
-               | NA, _ ->
-                 E.call ~info:Js_call_info.dummy acc args
-             in
-             aux (E.ml_var_dot id name) arity args (List.length args ))
-      )
 
-and  compile_let flag (cxt : Lam_compile_defs.cxt) id (arg : Lam.t) : Js_output.t =
 
 
-  match flag, arg  with 
-  |  let_kind, _  -> 
-    compile_lambda {cxt with st = Declare (let_kind, id); should_return = False } arg 
-(** 
-    The second return values are values which need to be wrapped using 
-   [caml_update_dummy] 
-   
-   Invariant:  jmp_table can not across function boundary,
-       here we share env 
 
+
+
+
+(** This pass detect functions used once and if it is used in used
+    in the tail position, it will get inlined, this will help 
+    remove some common use cases like This
+    {[
+      let length x = 
+        let rec aux n x = 
+          match x with 
+          | [] -> n 
+          | _ :: rest -> aux (n + 1) rest in
+        aux 0 x         
+    ]} 
 *)
-and compile_recursive_let 
-    (cxt : Lam_compile_defs.cxt)
-    (id : Ident.t)
-    (arg : Lam.t)   : Js_output.t * Ident.t list = 
-  match arg with 
-  |  Lfunction { kind; params; body; _}  -> 
 
-    let continue_label = Lam_util.generate_label ~name:id.name () in
-    (* TODO: Think about recursive value 
-       {[
-         let rec v = ref (fun _ ... 
-                         )
-       ]}
-        [Alias] may not be exact 
-    *)
-    Js_output.handle_name_tail (Declare (Alias, id)) False arg
-      (
-        let ret : Lam_compile_defs.return_label = 
-          {id; 
-           label = continue_label; 
-           params;
-           immutable_mask = Array.make (List.length params) true;
-           new_params = Ident_map.empty;
-           triggered = false} in
-        let output = 
-          compile_lambda
-            { cxt with 
-              st = EffectCall;  
-              should_return = True (Some ret );
-              jmp_table = Lam_compile_defs.empty_handler_map}  body in
-        if ret.triggered then 
-          let body_block = Js_output.to_block output in
-          E.ocaml_fun
-            (* TODO:  save computation of length several times 
-               Here we always create [ocaml_fun], 
-               it will be renamed into [method] 
-               when it is detected by a primitive
-            *)
-            ~immutable_mask:ret.immutable_mask
-            (List.map (fun x -> 
-                  Ident_map.find_default x ret.new_params x )
-                params)
-            [
-              S.while_ (* ~label:continue_label *)
-                E.caml_true   
-                (
-                  Ident_map.fold
-                    (fun old new_param  acc ->
-                       S.define ~kind:Alias old (E.var new_param) :: acc) 
-                    ret.new_params body_block
-                )
-            ]
+val tailcall_inline : J.program -> J.program 
 
-        else            (* TODO:  save computation of length several times *)
-          E.ocaml_fun params (Js_output.to_block output )
-      ), [] 
-  | Lprim {primitive = Pmakeblock (0, _, _) ; args =  ls}
-    when List.for_all (function  | Lam.Lvar _  -> true | _ -> false) ls 
-    ->
-    (* capture cases like for {!Queue}
-       {[let rec cell = { content = x; next = cell} ]}
-    *)
-    Js_output.of_block (
-      S.define ~kind:Variable id (E.arr Mutable []) :: 
-      (List.mapi (fun i x -> 
-          match x with  
-          | Lam.Lvar lid
-            -> S.exp 
-                 (Js_arr.set_array (E.var id) (E.int (Int32.of_int i)) (E.var lid))
-          | _ -> assert false
-         ) ls)
-    ), []
+end = struct
+#1 "js_pass_tailcall_inline.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  | Lprim{primitive = Pmakeblock _ ; _}   ->
-    (* FIXME: also should fill tag *)
-    (* Lconst should not appear here if we do [scc]
-       optimization, since it's faked recursive value,
-       however it would affect scope issues, we have to declare it first 
-    *)
-    (* Ext_log.err "@[recursive value %s/%d@]@." id.name id.stamp; *)
-    begin
-      match compile_lambda {cxt with st = NeedValue; should_return = False } arg with
-      | { block = b; value = Some v} -> 
-        (* TODO: check recursive value .. 
-            could be improved for simple cases
-        *)
-        Js_output.of_block  
-          (
-            b  @ 
-            [S.exp
-               (E.runtime_call Js_config.obj_runtime "caml_update_dummy" 
-                  [ E.var id;  v])]),
-        [id]
-      (* S.define ~kind:Variable id (E.arr Mutable [])::  *)
-      | _ -> assert false 
-    end
-  | Lvar _   ->
-    compile_lambda {cxt with st = Declare (Alias ,id); should_return = False } arg, []
-  | _ -> 
-    (* pathological case:
-        fail to capture taill call?
-       {[ let rec a = 
-         if  g > 30 then .. fun () -> a ()
-       ]}
 
-        Neither  below is not allowed in ocaml:
-       {[
-         let rec v = 
-           if sum 0 10 > 20 then 
-             1::v 
-           else 2:: v
-       ]}
-       {[
-         let rec v = 
-           if sum 0 10 > 20 then 
-             fun _ -> print_endline "hi"; v ()
-           else 
-             fun _-> print_endline "hey"; v ()
-       ]}
-    *)
-    compile_lambda {cxt with st = Declare (Alias ,id); should_return = False } arg, []
 
-and compile_recursive_lets cxt id_args : Js_output.t = 
-  let output_code, ids  = List.fold_right
-      (fun (ident,arg) (acc, ids) -> 
-         let code, declare_ids  = compile_recursive_let cxt ident arg in
-         (code ++ acc, declare_ids @ ids )
-      )  id_args (Js_output.dummy, [])
-  in
-  match ids with 
-  | [] -> output_code
-  | _ ->  
-    (Js_output.of_block  @@
-     List.map (fun id -> S.define ~kind:Variable id (E.dummy_obj ())) ids ) 
-    ++  output_code
 
-and compile_general_cases : 
-  'a . 
-  ('a -> J.expression) ->
-  (J.expression -> J.expression -> J.expression) -> 
-  Lam_compile_defs.cxt -> 
-  (?default:J.block ->
-   ?declaration:Lambda.let_kind * Ident.t  -> 
-   _ -> 'a J.case_clause list ->  J.statement) -> 
-  _ -> 
-  ('a * Lam.t) list -> default_case -> J.block 
-  = fun f eq cxt switch v table default -> 
-    let wrap (cxt : Lam_compile_defs.cxt) k =
-      let cxt, define =
-        match cxt.st with 
-        | Declare (kind, did)
-          -> 
-          {cxt with st = Assign did}, Some (kind,did)
-        | _ -> cxt, None
-      in
-      k cxt  define 
-    in
-    match table, default with 
-    | [], Default lam ->  
-      Js_output.to_block  (compile_lambda cxt lam)
-    | [], (Complete | NonComplete) ->  []
-    | [(id,lam)],Complete -> 
-      (* To take advantage of such optimizations, 
-          when we generate code using switch, 
-          we should always have a default,
-          otherwise the compiler engine would think that 
-          it's also complete
-      *)
-      Js_output.to_block @@ compile_lambda cxt lam 
-    | [(id,lam)], NonComplete 
-      ->
-      wrap cxt @@ fun cxt define  ->
-      [S.if_ ?declaration:define (eq v (f id) )
-         (Js_output.to_block @@ compile_lambda cxt lam )]
 
-    | ([(id,lam)], Default x) | ([(id,lam); (_,x)], Complete)
-      ->
-      wrap cxt  @@ fun cxt define -> 
-      let else_block = Js_output.to_block (compile_lambda cxt x) in
-      let then_block = Js_output.to_block (compile_lambda cxt lam)  in
-      [ S.if_ ?declaration:define (eq v (f id) )
-          then_block
-          ~else_:else_block
-      ]
-    | _ , _ -> 
-      (* TODO: this is not relevant to switch case
-          however, in a subset of switch-case if we can analysis 
-          its branch are the same, we can propogate which 
-          might encourage better inlining strategey
-          ---
-          TODO: grouping can be delayed untile JS IR
-      *)
-      (*TOOD: disabled temporarily since it's not perfect yet *)
-      wrap cxt @@ fun cxt declaration  ->
-      let default =
-        match default with
-        | Complete -> None
-        | NonComplete -> None
-        | Default lam -> Some (Js_output.to_block  (compile_lambda cxt lam))
-      in
-      let body = 
-        table 
-        |> Ext_list.stable_group (fun (_,lam) (_,lam1) -> Lam_analysis.eq_lambda lam lam1)
-        |> Ext_list.flat_map 
-          (fun group -> 
-             group 
-             |> Ext_list.map_last 
-               (fun last (x,lam) -> 
-                  if last 
-                  then {J.case =  x; body = Js_output.to_break_block (compile_lambda cxt lam) }
-                  else { case = x; body = [],false }))
-          (* TODO: we should also group default *)
-          (* The last clause does not need [break]
-              common break through, *)
 
-      in
-      [switch ?default ?declaration v body] 
+(* When we inline a function call, if we don't do a beta-reduction immediately, there is 
+   a chance that it is ignored, (we can not assume that each pass is robust enough)
 
-and compile_cases cxt = compile_general_cases (fun x -> E.small_int  x) E.int_equal cxt 
-    (fun  ?default ?declaration e clauses    -> S.int_switch ?default  ?declaration e clauses)
+   After we do inlining, it makes sense to do another constant folding and propogation 
+ *)
 
-and compile_string_cases cxt = compile_general_cases E.str E.string_equal cxt 
-    (fun  ?default ?declaration e clauses    -> S.string_switch ?default  ?declaration e clauses)
-(* TODO: optional arguments are not good 
-    for high order currying *)
-and
-  compile_lambda
-    ({st ; should_return; jmp_table; meta = {env ; _} } as cxt : Lam_compile_defs.cxt)
-    (lam : Lam.t)  : Js_output.t  =
-  begin
-    match lam with 
-    | Lfunction{ kind; params; body} ->
-      Js_output.handle_name_tail st should_return lam 
-        (E.ocaml_fun
-           params
-           (* Invariant:  jmp_table can not across function boundary,
-              here we share env
-           *)
-           (Js_output.to_block 
-              ( compile_lambda
-                  { cxt with st = EffectCall;  
-                             should_return = True None; (* Refine*)
-                             jmp_table = Lam_compile_defs.empty_handler_map}  body)))
+(* Check: shall we inline functions with while loop? if it is used only once, 
+   it makes sense to inline it
+*)
 
+module S = Js_stmt_make
+module E = Js_exp_make
 
-    | Lapply{
-        fn = Lapply{ fn = an; args =  args'; status = App_na ; };
-        args;  
-        status = App_na; loc }
-      ->    
-      (* After inlining we can generate such code, 
-         see {!Ari_regress_test}         
-      *)      
-      compile_lambda  cxt  
-        (Lam.apply an (args' @ args)  loc  App_na )
-    (* External function calll *)
-    | Lapply{ fn = 
-                Lprim{primitive = Pfield (n,_); 
-                      args = [ Lprim {primitive = Pgetglobal id; args = []}];_};
-             args = args_lambda;
-             status = App_na | App_ml_full} ->
-      (* Note we skip [App_js_full] since [get_exp_with_args] dont carry 
-         this information, we should fix [get_exp_with_args]
-      *)
-      get_exp_with_args cxt lam  args_lambda id n  env
 
+(** Update ident info use cases, it is a non pure function, 
+    it will annotate [program] with some meta data
+    TODO: Ident Hashtbl could be improved, 
+    since in this case it can not be global?  
 
-    | Lapply{ fn; args = args_lambda;   status} -> 
-      (* TODO: --- 
-         1. check arity, can be simplified for pure expression
-         2. no need create names
-      *)
-      begin 
-        let [@warning "-8" (* non-exhaustive pattern*)] (args_code, fn_code:: args) = 
-          List.fold_right (fun (x : Lam.t) (args_code, fn_code )-> 
-              match x with             
-              | Lprim {primitive = Pgetglobal ident; args =  []} -> 
-                (* when module is passed as an argument - unpack to an array
-                    for the function, generative module or functor can be a function, 
-                    however it can not be global -- global can only module 
-                *)
-                args_code, Lam_compile_global.get_exp  (ident, env,true) :: fn_code
-              | _ ->
-                begin
-                  match compile_lambda 
-                          {cxt with st = NeedValue ; should_return =  False} x with
-                  | {block = a; value =  Some b} -> a @ args_code , b:: fn_code 
-                  | _ -> assert false
-                end
-            ) (fn::args_lambda) ([],[]) in
+ *)
+let count_collects () = 
+  object (self)
+    inherit Js_fold.fold as super
+    (* collect used status*)
+    val stats : int ref Ident_hashtbl.t = Ident_hashtbl.create 83
+    (* collect all def sites *)
+    val defined_idents : J.variable_declaration Ident_hashtbl.t = Ident_hashtbl.create 83
 
+    val mutable export_set  : Ident_set.t = Ident_set.empty
+    val mutable name : string = ""
 
-        begin
-          match fn, should_return with
-          | (Lvar id',
-             True (Some ({id;label; params; _} as ret))) when Ident.same id id' ->
+    method add_use id = 
+      match Ident_hashtbl.find_opt stats id with
+      | None -> Ident_hashtbl.add stats id (ref 1)
+      | Some v -> incr v 
+    method! program x = 
+      export_set <- x.export_set ; 
+      name <- x.name;
+      super#program x
+    method! variable_declaration 
+        ({ident; value ; property  ; ident_info }  as v)
+      =  
+        Ident_hashtbl.add defined_idents ident v; 
+        match value with 
+        | None
+          -> 
+          self
+        | Some x
+          -> self#expression x 
+    method! ident id = self#add_use id; self
+    method get_stats = 
+      Ident_hashtbl.iter (fun ident (v : J.variable_declaration) -> 
+          if Ident_set.mem ident export_set then 
+            Js_op_util.update_used_stats v.ident_info Exported
+          else 
+            let pure = 
+              match v.value  with 
+              | None -> false  (* can not happen *)
+              | Some x -> Js_analyzer.no_side_effect_expression x  
+            in
+            match Ident_hashtbl.find_opt stats ident with 
+              | None -> 
+                Js_op_util.update_used_stats v.ident_info 
+                  (if pure then Dead_pure else Dead_non_pure)
+              | Some num -> 
+                if !num = 1 then 
+                  Js_op_util.update_used_stats v.ident_info 
+                    (if pure then Once_pure else Used) 
+        ) defined_idents; defined_idents
+  end
 
 
-            (* Ext_log.err "@[ %s : %a tailcall @]@."  cxt.meta.filename Ident.print id; *)
-            ret.triggered <- true;
-            (* Here we mark [finished] true, since the continuation 
-                does not make sense any more (due to that we have [continue])
-                TODO: [finished] is not a meaningful name, we should use [truncate] 
-                to mean the following statement should be truncated
-            *)
-            (* 
-                actually, there is no easy way to determin 
-                if the argument depends on an expresion, since 
-                it can be a function, then it may depend on anything
-                http://caml.inria.fr/pub/ml-archives/caml-list/2005/02/5727b4ecaaef6a7a350c9d98f5f68432.en.html
-                http://caml.inria.fr/pub/ml-archives/caml-list/2005/02/fe9bc4e23e6dc8c932c8ab34240ff195.en.html
+let get_stats program
+  =  ((count_collects ()) #program program) #get_stats
+
+
+(* 1. recursive value ? let rec x = 1 :: x
+    non-terminating
+    2. duplicative identifiers ..
+    remove it at the same time is a bit unsafe,
+    since we have to guarantee that the one use
+    case is substituted
+    we already have this? in [defined_idents]
+*)
+
+(** There is a side effect when traversing dead code, since 
+   we assume that substitue a node would mark a node as dead node,
+  
+    so if we traverse a dead node, this would get a wrong result.
+   it does happen in such scenario
+   {[
+     let generic_basename is_dir_sep current_dir_name name =
+       let rec find_end n =
+         if n < 0 then String.sub name 0 1
+         else if is_dir_sep name n then find_end (n - 1)
+         else find_beg n (n + 1)
+       and find_beg n p =
+         if n < 0 then String.sub name 0 p
+         else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+         else find_beg (n - 1) p
+       in
+       if name = ""
+       then current_dir_name
+       else find_end (String.length name - 1)
+   ]}
+   [find_beg] can potentially be expanded in [find_end] and in [find_end]'s expansion, 
+   if the order is not correct, or even worse, only the wrong one [find_beg] in [find_end] get expanded 
+   (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, 
+   while it is still called 
+*)
+let subst name export_set stats  = 
+  object (self)
+    inherit Js_map.map as super
+    method! statement st = 
+      match st with 
+      | {statement_desc =
+           Variable 
+             {value = _ ;
+              ident_info = {used_stats = Dead_pure}
+             } 
+        ; comment = _}
+        ->
+        S.block []
+      | {statement_desc = 
+           Variable { ident_info = {used_stats = Dead_non_pure} ;
+                      value = Some v  ; _ } 
+        ; _}
+        -> S.exp v
+      | _ -> super#statement st 
+    method! variable_declaration 
+        ({ident; value ; property  ; ident_info }  as v)
+      =  
+      (* TODO: replacement is a bit shaky, the problem is the lambda we stored is
+         not consistent after we did some subsititution, and the dead code removal
+         does rely on this (otherwise, when you do beta-reduction you have to regenerate names)
+      *)
+      let v = super # variable_declaration v in
+      Ident_hashtbl.add stats ident v; (* see #278 before changes *)
+      v
+    method! block bs = 
+      match bs with
+      | ({statement_desc = 
+            Variable ({value =
+                         Some ({expression_desc = Fun _; _ } as v )
+                      } as vd) ; comment = _} as st) :: rest  -> 
+        let is_export = Ident_set.mem vd.ident export_set in
+        if is_export then 
+          self#statement st :: self#block rest 
+        else 
+          begin 
+            match Ident_hashtbl.find_opt stats vd.ident with 
+            (* TODO: could be improved as [mem] *)
+            | None -> 
+              if Js_analyzer.no_side_effect_expression v 
+              then S.exp v  :: self#block rest 
+              else self#block rest 
 
-            *)
-            (* TODO: use [fold]*)            
-            let block =  args_code @
-                        (
-                          let (_,assigned_params,new_params) = 
-                            List.fold_left2 (fun (i,assigns,new_params) param (arg : J.expression) ->
-                                match arg with
-                                | {expression_desc = Var (Id x); _} when Ident.same x param ->
-                                  (i + 1, assigns, new_params)
-                                | _ ->
-                                  let new_param, m  = 
-                                    match Ident_map.find_opt  param ret.new_params with 
-                                    | None -> 
-                                      ret.immutable_mask.(i)<- false;
-                                      let v = Ext_ident.create ("_"^param.Ident.name) in
-                                      v, (Ident_map.add param v new_params) 
-                                    | Some v -> v, new_params  in
-                                  (i+1, (new_param, arg) :: assigns, m)
-                              ) (0, [], Ident_map.empty) params args  in 
-                          let () = ret.new_params <- Ident_map.disjoint_merge new_params ret.new_params in
-                          assigned_params |> List.map (fun (param, arg) -> S.assign param arg))
-                         @
-                        [S.continue ()(* label *)]
-                         (* Note true and continue needed to be handled together*)
-            in
-            begin
-              (* Ext_log.dwarn __LOC__ "size : %d" (List.length block); *)
-              Js_output.of_block  ~finished:True block 
-            end
+            | Some _ -> self#statement st  :: self#block rest 
+          end
 
- 
+      | {statement_desc = 
+           Return {return_value = 
+                     {expression_desc = 
+                        Call({expression_desc = Var (Id id)},args,_info)}} }
+        as st 
+           :: rest 
+        -> 
+        begin match Ident_hashtbl.find_opt stats id with 
 
-          (* match assigned_params with *)
-          (* | [] ->  [] *)
-          (* | [param,arg] -> [S.assign param arg ] *)
-          (* | _ -> *)
-          (*    let arg_map = Ident_map.of_list assigned_params in *)
-          (*    match Lam_util.sort_dag_args arg_map with *)
-          (*    | Some args -> *)
-          (*        List.map (fun a -> S.assign a (Ident_map.find a arg_map )) args *)
-          (*    | None -> *)
-          (*        let renamed_params_args = *)
-          (*          assigned_params |> *)
-          (*          List.map (fun (param, arg) -> (param, Ident.rename param, arg )) *)
-          (*        in *)
-          (*        List.map (fun (param, param2, arg) -> *)
-          (*          S.declare param2 arg *)
-          (*                 ) renamed_params_args *)
-          (*        @ *)
-          (*          List.map (fun (param, param2, _) -> *)
-          (*            S.assign param (E.var param2) *)
-          (*                   )  renamed_params_args *)
-          (*  Js_output.handle_block_return st should_return lam   *)
-          (* (E.call fn_code args)  *)
-          | _ -> 
+          | Some ({ value = 
+                Some {expression_desc = Fun (false, params, block, _env) ; comment = _}; 
+              (*TODO: don't inline method tail call yet, 
+                [this] semantics are weird 
+              *)              
+              property = (Alias | StrictOpt | Strict);
+              ident_info = {used_stats = Once_pure };
+              ident = _
+            } as v)
+            when Ext_list.same_length params args 
+            -> 
+            (* Ext_log.dwarn  __LOC__ "%s is dead \n %s " id.name  *)
+            (*   (Js_dump.string_of_block [st]); *)
+            Js_op_util.update_used_stats v.ident_info Dead_pure;
+            let block  = 
+              List.fold_right2 (fun param arg acc ->  S.define ~kind:Variable param arg :: acc)
+                params args  ( self#block block) (* see #278 before changes*)
+                                
+            in
+            (* Mark a function as dead means it will never be scanned, 
+               here we inline the function
+            *)
+            block @ self#block rest
+          | (None | Some _) ->
+            self#statement st :: self#block rest
+        end
+      | x :: xs 
+        ->
+        self#statement x :: self#block xs
+      | [] 
+        -> 
+        []
 
-            Js_output.handle_block_return st should_return lam args_code 
-              (E.call ~info:(match fn, status with 
-                   | _,  App_ml_full -> 
-                     {arity = Full ; call_info = Call_ml}
-                   | _,  App_js_full -> 
-                     {arity = Full ; call_info = Call_na}
-                   | _,   App_na -> 
-                     {arity = NA; call_info = Call_ml }
-                 ) fn_code args) 
-        end;
-      end
+  end
 
 
-    | Llet (let_kind,id,arg, body) ->
-      (* Order matters..  see comment below in [Lletrec] *)
-      let args_code =
-        compile_let  let_kind cxt id arg  in 
-      args_code ++
-      compile_lambda  cxt  body
+let tailcall_inline (program : J.program) = 
+  let _stats = get_stats program in
+  let _export_set = program.export_set in
+  program
+  |> (subst program.name _export_set _stats )# program
+  (* |> pass_beta #program *)
+    
 
-    | Lletrec (id_args, body) -> 
-      (* There is a bug in our current design, 
-         it requires compile args first (register that some objects are jsidentifiers)
-         and compile body wiht such effect.
-         So here we should compile [id_args] first, then [body] later.
-         Note it has some side effect over cache number as well, mostly the value of
-         [Caml_primitive["caml_get_public_method"](x,hash_tab, number)]
+end
+module Js_shake : sig 
+#1 "js_shake.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-         To fix this, 
-         1. scan the lambda layer first, register js identifier before proceeding
-         2. delay the method call into javascript ast
-      *)
-      let v =  compile_recursive_lets cxt  id_args in v ++ compile_lambda cxt  body
 
-    | Lvar id -> Js_output.handle_name_tail st  should_return lam (E.var id )
-    | Lconst c -> 
-      Js_output.handle_name_tail st should_return lam (Lam_compile_const.translate c)
 
-    | Lprim {primitive = Pfield (n,_); 
-             args = [ Lprim {primitive = Pgetglobal id; args = [] ; _}]; _} 
-      -> (* should be before Pgetglobal *)
-        get_exp_with_index cxt lam  (id,n, env)
 
-    | Lprim {primitive = Praise ; args =  [ e ]; _} -> 
-      begin
-        match compile_lambda {
-            cxt with should_return = False; st = NeedValue} e with 
-        | {block = b; value =  Some v} -> 
 
-          Js_output.make (b @ [S.throw v])
-            ~value:E.undefined ~finished:True
-        (* FIXME -- breaks invariant when NeedValue, reason is that js [throw] is statement 
-           while ocaml it's an expression, we should remove such things in lambda optimizations
-        *)
-        | {value =  None; _} -> assert false 
-      end
-    | Lprim{primitive = Psequand ; args =  [l;r] ; _}
-      ->
-      begin match cxt with 
-        | {should_return = True _ } 
-          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
-          ->
-          compile_lambda cxt (Lam.sequand  l r )
-        | _ -> 
-          let l_block,l_expr = 
-            match compile_lambda {cxt with st = NeedValue; should_return = False} l with 
-            | {block = a; value = Some b} -> a, b
-            | _ -> assert false 
-          in
-          let r_block, r_expr = 
-            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
-            | {block = a; value = Some b} -> a, b
-            | _ -> assert false 
-          in
-          let args_code =  l_block @ r_block  in
-          let exp =  E.and_ l_expr r_expr  in
-          Js_output.handle_block_return st should_return lam args_code exp           
-      end
 
-    | Lprim {primitive = Psequor; args =  [l;r]}
-      ->
-      begin match cxt with
-        | {should_return = True _ }
-          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
-          ->
-          compile_lambda cxt @@ Lam.sequor l r
-        | _ ->
-          let l_block,l_expr =
-            match compile_lambda {cxt with st = NeedValue; should_return = False} l with
-            | {block = a; value = Some b} -> a, b
-            | _ -> assert false
-          in
-          let r_block, r_expr =
-            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
-            | {block = a; value = Some b} -> a, b
-            | _ -> assert false
-          in
-          let args_code =  l_block @ r_block  in
-          let exp =  E.or_ l_expr r_expr  in
-          Js_output.handle_block_return st should_return lam args_code exp
-      end
-    | Lprim {primitive = Pdebugger ; _}
-      -> 
-      (* [%bs.debugger] guarantees that the expression does not matter 
-         TODO: make it even safer      *)
-        Js_output.handle_block_return st should_return lam [S.debugger] E.unit
 
 
+(** A module to shake JS IR
+   
+    Tree shaking is not going to change the closure 
+ *)
 
-    (* TODO: 
-       check the arity of fn before wrapping it 
-       we need mark something that such eta-conversion can not be simplified in some cases 
-    *)
+val shake_program : J.program -> J.program
 
-    | Lprim {primitive = Pjs_unsafe_downgrade (name,loc); 
-             args = [obj]}
-      when not (Ext_string.ends_with name Literals.setter_suffix) 
-      -> 
-      (**
-         either a getter {[ x #. height ]} or {[ x ## method_call ]}
-      *)
-      let property =  Lam_methname.translate ~loc name  in
-      begin 
-        match compile_lambda {cxt with st = NeedValue; should_return = False} obj
-        with 
-        | {block; value = Some b } -> 
-          let blocks, ret  = 
-            if block = [] then [],  E.dot b property
-            else 
-              (match Js_ast_util.named_expression b  with 
-               | None -> block,  E.dot b property
-               | Some (x, b) ->  
-                 (block @ [x]),  E.dot (E.var b) property
-              )
-          in 
-          Js_output.handle_block_return st should_return lam 
-            blocks ret 
-        | _ -> assert false 
-      end
-    | Lprim {primitive = Pjs_fn_run arity;  args = args_lambda}
-      ->
-      (* 1. prevent eta-conversion
-         by using [App_js_full]
-         2. invariant: `external` declaration will guarantee
-         the function application is saturated
-         3. we need a location for Pccall in the call site
-      *)
+end = struct
+#1 "js_shake.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-        begin match args_lambda with  
-        | [Lprim{
-            primitive = 
-              Pjs_unsafe_downgrade(method_name,loc);
-            args = [obj]} as fn;
-           arg]
-          -> 
-          begin 
-            let obj_block = 
-              compile_lambda {cxt with st = NeedValue; should_return = False} obj
-            in 
-            let value_block = 
-              compile_lambda {cxt with st = NeedValue; should_return = False} arg
-            in 
-            let cont block0 block1 obj_code = 
-              Js_output.handle_block_return st should_return lam 
-                (
-                  match obj_code with
-                  | None -> block0 @ block1
-                  | Some obj_code -> block0 @ obj_code :: block1
-                )
-            in 
-            match obj_block, value_block with 
-            | {block = block0; value = Some obj }, 
-              {block = block1; value = Some value}
-              ->
-               if  Ext_string.ends_with method_name Literals.setter_suffix then 
-                let property =
-                  Lam_methname.translate ~loc @@ 
-                  String.sub method_name 0 
-                    (String.length method_name - Literals.setter_suffix_len) in 
-                match Js_ast_util.named_expression  obj with
-                  | None ->
-                    cont block0 block1 None (E.assign (E.dot obj property) value)
-                  | Some (obj_code, obj)
-                    ->
-                    cont block0 block1 (Some obj_code)
-                      (E.assign (E.dot (E.var obj) property) value)
-              else 
-                compile_lambda cxt
-                  (Lam.apply fn [arg]  
-                     Location.none (* TODO *) App_js_full)
-            | _ -> 
-              assert false 
-          end
 
-        | fn :: rest -> 
-          compile_lambda cxt 
-            (Lam.apply fn rest 
-               Location.none (*TODO*)
-               App_js_full)
-        | _ -> assert false 
-        end
-    | Lprim {primitive = Pjs_fn_runmethod arity ; args }
-      -> 
-      begin match args with 
-        | (Lprim{primitive = Pjs_unsafe_downgrade (name,loc);
-                 args = [ _ ]} as fn) 
-          :: _obj
-          :: rest -> 
-        (* assert (Ident.same id2 id) ;  *)
-        (* we ignore the computation of [_obj], 
-           since our ast writer 
-           {[ obj#.f (x,y)
-           ]}
-           -->
-           {[ runmethod2 f obj#.f x y]}           
-        *)
-        compile_lambda cxt (Lam.apply fn rest loc App_js_full)
-      | _ -> assert false               
-      end
-    | Lprim {primitive = Pjs_fn_method arity;  args = args_lambda} -> 
-      begin match args_lambda with 
-        | [Lfunction{arity = len; kind; params; body} ] 
-          when len = arity -> 
-          Js_output.handle_block_return 
-            st
-            should_return             
-            lam 
-            []
-            (E.method_
-             params
-             (* Invariant:  jmp_table can not across function boundary,
-                here we share env
-             *)
-             (Js_output.to_block 
-                ( compile_lambda
-                    { cxt with st = EffectCall;  
-                               should_return = True None; 
-                               jmp_table = Lam_compile_defs.empty_handler_map} 
-                    body)))
-        | _ -> assert false 
-      end
 
 
-    | Lprim {primitive = Pjs_fn_make arity;  args = args_lambda} -> 
 
-        begin match args_lambda with 
-          | [fn] -> 
-            if arity = 0 then 
-              (* 
-                Invariant: mk0 : (unit -> 'a0) -> 'a0 t 
-                TODO: this case should be optimized, 
-                we need check where we handle [arity=0] 
-                as a special case -- 
-                if we do an optimization before compiling
-                into lambda
 
-                 {[Fn.mk0]} is not intended for use by normal users
 
-                 so we assume [Fn.mk0] is only used in such cases
-                 {[
-                   Fn.mk0 (fun _ -> .. )
-                 ]}
-                 when it is passed as a function directly
-              *)
-              begin match fn with 
-                | Lfunction {params =  [_]; body}
-                  ->
-                  compile_lambda cxt 
-                    (Lam.function_ 
-                       ~arity:0 
-                       ~kind:Curried
-                       ~params:[]
-                       ~body)
-                | _ -> 
 
-                  compile_lambda cxt  
-                    (Lam.function_ ~arity:0 
-                       ~kind:Curried ~params:[] 
-                       ~body:(
-                         Lam.apply fn
-                           [Lam.unit]
-                           Location.none App_na
-                       ))
-              end
-            else 
-              begin match fn with
-                | Lam.Lfunction{arity = len; kind; params = args; body}
-                  ->
-                  if len = arity then
-                    compile_lambda cxt fn 
-                  else if len > arity then 
-                    let params, rest  = Ext_list.take arity args  in 
-                    compile_lambda cxt 
-                      (Lam.function_ 
-                         ~arity
-                         ~kind ~params
-                         ~body:(Lam.function_ ~arity:(len - arity)
-                                  ~kind ~params:rest ~body)
-                      )
-                  else 
-                    compile_lambda cxt 
-                      (Lam_util.eta_conversion arity 
-                         Location.none App_na
-                         fn  [] )
-                (* let extra_args = Ext_list.init (arity - len) (fun _ ->   (Ident.create Literals.param)) in *)
-                (* let extra_lambdas = List.map (fun x -> Lambda.Lvar x) extra_args in *)
-                (* Lambda.Lfunction (kind, extra_args @ args , body ) *)
-                (*TODO: can be optimized ?
-                  {[\ x y -> (\u -> body x) x y]}
-                  {[\u x -> body x]}        
-                  rewrite rules 
-                  {[
-                    \x -> body 
-                          --
-                          \y (\x -> body ) y 
-                  ]}
-                  {[\ x y -> (\a b c -> g a b c) x y]}
-                  {[ \a b -> \c -> g a b c ]}
-                *)
-                | _ -> 
-                  compile_lambda cxt 
-                    (Lam_util.eta_conversion arity
-                       Location.none App_na  fn  [] )
-              end
-          | _ -> assert false 
-        end
-    | Lprim{primitive = prim; args =  args_lambda; loc} -> 
-      let args_block, args_expr =
-        Ext_list.split_map (fun (x : Lam.t) ->
-            match compile_lambda {cxt with st = NeedValue; should_return = False} x 
-            with 
-            | {block = a; value = Some b} -> a,b
-            | _ -> assert false ) args_lambda 
+(** we also need make it complete 
+ *)
+let get_initial_exports 
+    count_non_variable_declaration_statement 
+    (export_set : Ident_set.t) (block : J.block ) = 
+  let result = List.fold_left 
+    (fun acc (st : J.statement) -> 
+      match st.statement_desc with
+      | Variable {ident ; value; _} ->
+          if Ident_set.mem ident acc then 
+            begin match value with
+            | None -> acc  
+            | Some x -> 
+              (* If not a function, we have to calcuate again and again 
+                  TODO: add hashtbl for a cache
+               *)
+                Ident_set.(
+                union (Js_analyzer.free_variables_of_expression empty empty x) acc)
+            end
+          else 
+            begin match value with
+            | None -> acc 
+            | Some x -> 
+                if Js_analyzer.no_side_effect_expression x then acc 
+                else 
+                  Ident_set.(
+                  union (Js_analyzer.free_variables_of_expression empty empty x) 
+                    (add ident acc))
+            end
+      | _ -> 
+          (* recalcuate again and again ... *)
+          if Js_analyzer.no_side_effect_statement st || (not count_non_variable_declaration_statement)
+          then acc
+          else Ident_set.(union (Js_analyzer.free_variables_of_statement empty empty st) acc)
+    ) export_set block  in result, Ident_set.(diff result export_set)
 
-      in
-      let args_code  = List.concat args_block in
-      let exp  =  (* TODO: all can be done in [compile_primitive] *)
-        Lam_compile_primitive.translate loc cxt  prim args_expr in
-      Js_output.handle_block_return st should_return lam args_code exp  
+let shake_program (program : J.program) = 
+  let debug_file = "pervasives.ml" in
 
+  let _d () = 
+    if Ext_string.ends_with program.name  debug_file then 
+      Ext_log.err __LOC__ "@[%s@]@." program.name 
+  in
+  let shake_block block export_set = 
+    let block = List.rev @@ Js_analyzer.rev_toplevel_flatten block in 
+    let  loop block export_set : Ident_set.t = 
+      let rec aux acc block = 
+        let result, diff = get_initial_exports false acc block   in
+        (* let _d ()  =  *)
+        (*   if Ext_string.ends_with program.name  debug_file then  *)
+        (*     begin *)
+        (*       Ext_log.err "@[%a@]@." Ident_set.print result  ; *)
+        (*     end *)
+        (* in *)
+        if Ident_set.is_empty diff then 
+          result
+        else 
+          aux result block in
+      let first_iteration, delta  = get_initial_exports true export_set block  in
+      (* let _d ()  =  *)
+      (*   if Ext_string.ends_with program.name  debug_file then  *)
+      (*   begin   *)
+      (*     Ext_log.err "@[<v>%a@ %a@]@." *)
+      (*       Ident_set.print first_iteration   *)
+      (*       Ident_set.print delta (\* TODO: optimization, don't add persistent variables *\) *)
+      (*       ; *)
+      (*     Ext_log.err "init ---- @." *)
+      (*   end *)
+      (* in *)
 
-    | Lsequence (l1,l2) ->
-      let output_l1 = 
-        compile_lambda {cxt with st = EffectCall; should_return =  False} l1 in
-      let output_l2 = 
-        compile_lambda cxt l2  in
-       output_l1 ++ output_l2
+      if not @@ Ident_set.is_empty delta then
+        aux first_iteration block 
+      else first_iteration in
 
+    let really_set = loop block export_set in 
+    List.fold_right
+      (fun  (st : J.statement) acc -> 
+        match st.statement_desc with
+        | Variable {ident; value ; _} -> 
+            if Ident_set.mem ident really_set  then st:: acc 
+            else 
+              begin match value with 
+              | None -> acc 
+              | Some x -> 
+                  if Js_analyzer.no_side_effect_expression x then acc
+                  else st::acc
+              end
+        | _ -> if Js_analyzer.no_side_effect_statement st then acc else st::acc
+      ) block []
+  in
 
-    | Lifthenelse(p,t_br,f_br) ->
-      (*
-         This should be optimized in lambda layer 
-         (let (match/1038 = (apply g/1027 x/1028))
-         (catch
-         (stringswitch match/1038
-         case "aabb": 0
-         case "bbc": 1
-         default: (exit 1))
-         with (1) 2))
-      *)
-      begin 
-        match compile_lambda {cxt with st = NeedValue ; should_return = False } p with 
-        | {block = b; value =  Some e} ->
-          (match st, should_return, 
-                 compile_lambda {cxt with st= NeedValue}  t_br, 
-                 compile_lambda {cxt with st= NeedValue}  f_br with 
-          | NeedValue, _, 
-            {block = []; value =  Some out1}, 
-            {block = []; value =  Some out2} -> (* speical optimization *)
-            Js_output.make b ~value:(E.econd e out1 out2)
-          | NeedValue, _, _, _  -> 
-            (* we can not reuse -- here we need they have the same name, 
-                   TODO: could be optimized by inspecting assigment statement *)
-            let id = Ext_ident.gen_js () in
-            (match
-               compile_lambda  {cxt with st = Assign id} t_br,
-               compile_lambda {cxt with st = Assign id} f_br
-             with
-             | out1 , out2 -> 
-               Js_output.make 
-                 (S.declare_variable ~kind:Variable id :: b @ [
-                     S.if_ e 
-                       (Js_output.to_block out1) 
-                       ~else_:(Js_output.to_block out2 )
-                   ])
-                 ~value:(E.var id)
-            )
+  {program with block = shake_block program.block program.export_set}
 
-          | Declare (kind,id), _, 
-            {block = []; value =  Some out1},
-            {block = []; value =  Some out2} ->  
-            (* Invariant: should_return is false*)
-            Js_output.make [
-              S.define ~kind id (E.econd e out1 out2) ]
-          | Declare (kind, id), _, _, _ ->
-            Js_output.make 
-              ( b @ [
-                   S.if_ ~declaration:(kind,id) e 
-                     (Js_output.to_block @@ 
-                      compile_lambda {cxt with st = Assign id}  t_br)
-                     ~else_:(Js_output.to_block @@  
-                             (compile_lambda {cxt with st = Assign id} f_br))
-                 ])
+end
+module Js_arr : sig 
+#1 "js_arr.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-          | Assign id, _ , 
-            {block = []; value =  Some out1}, 
-            {block = []; value =  Some out2} ->  
-            (* Invariant:  should_return is false *)
-            Js_output.make [S.assign id (E.econd e out1 out2)]
-          | EffectCall, True _ , 
-            {block = []; value =  Some out1}, 
-            {block = []; value =  Some out2} ->
-            Js_output.make [S.return  (E.econd e  out1 out2)] ~finished:True
-              (* see PR#83 *)
-          | EffectCall, False , {block = []; value =  Some out1}, 
-            {block = []; value =  Some out2} ->
-            begin
-              match Js_exp_make.extract_non_pure out1 ,
-                    Js_exp_make.extract_non_pure out2 with
-              | None, None -> Js_output.make b
-              | Some out1, Some out2 -> 
-                Js_output.make b  ~value:(E.econd e  out1 out2)
-              | Some out1, None -> 
-                Js_output.make (b @ [S.if_ e  [S.exp out1]])
-              | None, Some out2 -> 
-                Js_output.make @@
-                b @ [S.if_ (E.not e)
-                       [S.exp out2]
-                    ]
-            end
-          | EffectCall , False , {block = []; value = Some out1}, _ -> 
-            (* assert branch 
-                TODO: here we re-compile two branches since
-                its context is different -- could be improved
-            *)
-            if Js_analyzer.no_side_effect_expression out1 then 
-              Js_output.make
-                (b @[ S.if_ (E.not e)
-                        (Js_output.to_block @@
-                         (compile_lambda cxt f_br))])
-            else 
-              Js_output.make 
-                (b @[S.if_ e 
-                       (Js_output.to_block 
-                        @@ compile_lambda cxt t_br)
-                       ~else_:(Js_output.to_block @@  
-                               (compile_lambda cxt f_br))]
-                )
 
-          | EffectCall , False , _, {block = []; value = Some out2} -> 
-            let else_ = 
-              if  Js_analyzer.no_side_effect_expression out2 then  
-                None 
-              else 
-                Some (
-                  Js_output.to_block @@
-                  compile_lambda cxt f_br) in 
-            Js_output.make 
-              (b @[S.if_ e 
-                     (Js_output.to_block @@
-                      compile_lambda cxt t_br)
-                     ?else_])
 
 
-          | (Assign _ | EffectCall), _, _, _  ->
-            let then_output = 
-              Js_output.to_block @@ 
-              (compile_lambda cxt  t_br) in
-            let else_output = 
-              Js_output.to_block @@ 
-              (compile_lambda cxt f_br) in
-            Js_output.make (b @ [
-                S.if_ e 
-                  then_output
-                  ~else_:else_output
-              ]))
-        | _ -> assert false 
-      end
-    | Lstringswitch(l, cases, default) -> 
 
-      (* TODO might better optimization according to the number of cases  
-          Be careful: we should avoid multiple evaluation of l,
-          The [gen] can be elimiated when number of [cases] is less than 3
-      *)
-      begin
-        match compile_lambda {cxt with should_return = False ; st = NeedValue} l 
-        with
-        | {block ; value =  Some e}  -> 
-          (* when should_return is true -- it's passed down 
-             otherwise it's ok *)
-          let default = 
-            match default with 
-            | Some x -> Default x 
-            | None -> Complete in
-          begin
-            match st with 
-            (* TODO: can be avoided when cases are less than 3 *)
-            | NeedValue -> 
-              let v = Ext_ident.gen_js () in 
-              Js_output.make (block @ 
-                              compile_string_cases 
-                                {cxt with st = Declare (Variable, v)}
-                                e cases default) ~value:(E.var v)
-            | _ -> 
-              Js_output.make (block @ compile_string_cases  cxt e cases default)  end
 
-        | _ -> assert false 
-      end
-    | Lswitch(lam,
-              {sw_numconsts; 
-               sw_consts;
-               sw_numblocks;
-               sw_blocks;
-               sw_failaction = default }) 
-      -> 
-      (* TODO: if default is None, we can do some optimizations
-          Use switch vs if/then/else
 
-          TODO: switch based optimiztion - hash, group, or using array,
-                also if last statement is throw -- should we drop remaining
-                statement?
-      *)
-      let default : default_case  = 
-        match default with 
-        | None -> Complete 
-        | Some x -> Default x in
-      let compile_whole  ({st; _} as cxt  : Lam_compile_defs.cxt ) =
-        begin
-          match sw_numconsts, sw_numblocks, 
-                compile_lambda {cxt with should_return = False; st = NeedValue}
-                  lam with 
-          | 0 , _ , {block; value =  Some e}  ->
-            compile_cases cxt (E.tag e )  sw_blocks default
-          | _, 0, {block; value =  Some e} ->  
-            compile_cases cxt e  sw_consts default
-          | _, _,  { block; value =  Some e} -> (* [e] will be used twice  *)
-            let dispatch e = 
-              [
-                S.if_ 
-                  (E.is_type_number e )
-                  (compile_cases cxt e sw_consts default)
-                  (* default still needed, could simplified*)
-                  ~else_:(
-                    (compile_cases  cxt (E.tag e ) sw_blocks default ))] in 
-            begin
-              match e.expression_desc with 
-              | J.Var _  -> dispatch e  
-              | _ -> 
-                let v = Ext_ident.gen_js () in  
-                (* Necessary avoid duplicated computation*)
-                (S.define ~kind:Variable v e ) ::  dispatch (E.var v)
-            end
-          | _, _, {value =  None; _}  -> assert false 
-        end in
-      begin
-        match st with  (* Needs declare first *)
-        | NeedValue -> 
-          (* Necessary since switch is a statement, we need they return 
-             the same value for different branches -- can be optmized 
-             when branches are minimial (less than 2)
-          *)
-          let v = Ext_ident.gen_js () in
-          Js_output.make (S.declare_variable ~kind:Variable v   :: compile_whole {cxt with st = Assign v})
-            ~value:(E.var  v)
+val set_array : J.expression -> J.expression -> J.expression -> J.expression
 
-        | Declare (kind,id) -> 
-          Js_output.make (S.declare_variable ~kind id
-                          :: compile_whole {cxt with st = Assign id} )
-        | EffectCall | Assign _  -> Js_output.make (compile_whole cxt)
-      end
+val ref_array : J.expression -> J.expression -> J.expression
 
-    | Lstaticraise(i, largs) ->  (* TODO handlding *largs*)
-      (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*)
-      begin
-        match Lam_compile_defs.HandlerMap.find i cxt.jmp_table  with 
-        | {exit_id; args ; order_id} -> 
-          let args_code  =
-            (Js_output.concat @@ List.map2 (
-                fun (x : Lam.t) (arg : Ident.t) ->
-                  match x with
-                  | Lvar id -> 
-                    Js_output.make [S.assign arg (E.var id)]
+end = struct
+#1 "js_arr.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-                  | _ -> (* TODO: should be Assign -- Assign is an optimization *)
-                    compile_lambda {cxt with st = Assign arg ; should_return =  False} x 
-              ) largs (args : Ident.t list)) 
-          in
-          args_code ++ (* Declared in [Lstaticraise ]*)
-          Js_output.make [S.assign exit_id (E.small_int  order_id)]
-            ~value:E.undefined
-        | exception Not_found ->
-          Js_output.make [S.unknown_lambda ~comment:"error" lam]
-          (* staticraise is always enclosed by catch  *)
-      end
-    (* Invariant: code can not be reused 
-        (catch l with (32)
-        (handler))
-        32 should not be used in another catch
-        Assumption: 
-        This is true in current ocaml compiler
-        currently exit only appears in should_return position relative to staticcatch
-        if not we should use ``javascript break`` or ``continue``
-    *)
-    | Lstaticcatch _  -> 
-      let code_table, body =  flatten_caches lam in
 
-      let exit_id =   Ext_ident.gen_js ~name:"exit" () in
-      let exit_expr = E.var exit_id in
-      let bindings = Ext_list.flat_map (fun (_,_,bindings) -> bindings) code_table in
 
-      (* compile_list name l false (\*\) *)
-      (* if exit_code_id == code 
-         handler -- ids are not useful, since 
-         when compiling `largs` we will do the binding there
-         - when exit_code is undefined internally, 
-           it should PRESERVE  ``tail`` property
-         - if it uses `staticraise` only once 
-           or handler is minimal, we can inline
-         - always inline also seems to be ok, but it might bloat the code
-         - another common scenario is that we have nested catch
-           (catch (catch (catch ..))
-      *)
-      (*
-        checkout example {!Digest.file}, you can not inline handler there, 
-        we can spot such patten and use finally there?
-        {[
-        let file filename =
-           let ic = open_in_bin filename in
-           match channel ic (-1) with
-           | d -> close_in ic; d
-           | exception e -> close_in ic; raise e
 
-        ]}
-       *)
-      (* TODO: handle NeedValue *)
-      let jmp_table, handlers =  Lam_compile_defs.add_jmps (exit_id, code_table) jmp_table in
 
-      (* Declaration First, body and handler have the same value *)
-      (* There is a bug in google closure compiler:
-            https://github.com/google/closure-compiler/issues/1234#issuecomment-151976340 
-            TODO: wait for a bug fix
-        *)
-      let declares = 
-        S.define ~kind:Variable exit_id
-          E.zero_int_literal :: 
-        (* we should always make it zero here, since [zero] is reserved in our mapping*)
-        List.map (fun x -> S.declare_variable ~kind:Variable x ) bindings in
 
-      begin match  st with 
-         (* could be optimized when cases are less than 3 *)
-         | NeedValue -> 
-           let v = Ext_ident.gen_js  () in 
-           let lbody = compile_lambda {cxt with 
-                                       jmp_table = jmp_table;
-                                       st = Assign v
-                                      } body in
-           Js_output.make  (S.declare_variable ~kind:Variable v  :: declares) ++ 
-           lbody ++ Js_output.make (
-             compile_cases 
-               {cxt with st = Assign v;
-                         jmp_table = jmp_table} 
-               exit_expr handlers  NonComplete)  ~value:(E.var v )
-         | Declare (kind, id)
-         (* declare first this we will do branching*) ->
-           let declares = 
-             S.declare_variable ~kind id  :: declares in   
-           let lbody = compile_lambda {cxt with jmp_table = jmp_table; st = Assign id } body in
-           Js_output.make  declares ++ 
-           lbody ++ 
-           Js_output.make (compile_cases 
-                             {cxt with jmp_table = jmp_table; st = Assign id} 
-                             exit_expr 
-                             handlers
-                             NonComplete
-                             (* place holder -- tell the compiler that 
-                                we don't know if it's complete
-                             *)
-                          )
-         | EffectCall | Assign _  -> 
-           let lbody = compile_lambda {cxt with jmp_table = jmp_table } body in
-           Js_output.make declares ++
-           lbody ++
-           Js_output.make (compile_cases
-                             {cxt with jmp_table = jmp_table}
-                             exit_expr
-                             handlers
-                             NonComplete)
-      end
-    | Lwhile(p,body) ->  
-      (* Note that ``J.While(expression * statement )``
-            idealy if ocaml expression does not need fresh variables, we can generate
-            while expression, here we generate for statement, leave optimization later. 
-            (Sine OCaml expression can be really complex..)
-      *)
-      (match compile_lambda {cxt with st = NeedValue; should_return = False } p 
-       with 
-       | {block; value =  Some e} -> 
-         (* st = NeedValue -- this should be optimized and never happen *)
-         let e = 
-           match block with
-           | [] -> e 
-           | _ -> E.of_block block ~e  in
-         let block = 
-           [
-             S.while_
-               e
-               (Js_output.to_block @@ 
-                compile_lambda 
-                  {cxt with st = EffectCall; should_return = False}
-                  body)
-           ] in
+module E = Js_exp_make
+ 
+let set_array  e e0 e1 = 
+  E.assign (E.access e e0)  e1
+
+let ref_array  e e0 = 
+  E.access  e  e0
+
+end
+module Js_ast_util : sig 
+#1 "js_ast_util.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-         begin
-           match st, should_return  with 
-           | Declare (_kind, x), _  ->  (* FIXME _kind not used *)
-             Js_output.make (block @ [S.declare_unit x ])
-           | Assign x, _  ->
-             Js_output.make (block @ [S.assign_unit x ])
-           | EffectCall, True _  -> 
-             Js_output.make (block @ [S.return_unit ()]) ~finished:True
-           | EffectCall, _ -> Js_output.make block
-           | NeedValue, _ -> Js_output.make block ~value:E.unit end
-       | _ -> assert false )
 
-    | Lfor (id,start,finish,direction,body) -> 
-      (* all non-tail *)
-      (* TODO: check semantics should start, finish be executed each time in both 
-           ocaml and js?, also check evaluation order..
-           in ocaml id is not in the scope of finish, so it should be safe here
+(** Simple expression, 
+    no computation involved so that  it is okay to be duplicated
+*)
+val is_simple_expression : J.expression -> bool 
 
-           for i  = 0 to (print_int 3; 10) do print_int i done;;
-           3012345678910- : unit = ()
 
-         for(var i =  0 ; i < (console.log(i),10); ++i){console.log('hi')}
-         print i each time, so they are different semantics...
-      *)
 
-      let block =
-        begin
-          match compile_lambda {cxt with st = NeedValue; should_return = False} start,
-                compile_lambda {cxt with st = NeedValue; should_return = False} finish with 
-          | {block = b1; value =  Some e1}, {block = b2; value =  Some e2} -> 
+val named_expression : 
+  J.expression -> (J.statement * Ident.t) option
 
-            (* order b1 -- (e1 -- b2 -- e2) 
-                in most cases we can shift it into such scenarios
-                b1, b2, [e1, e2]
-                - b2 is Empty
-                - e1 is pure
-                we can guarantee e1 is pure, if it literally contains a side effect call,
-                put it in the beginning
+end = struct
+#1 "js_ast_util.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-            *)
-            begin 
-              match b1,b2 with
-              | _,[] -> 
-                b1 @  [S.for_ (Some e1) e2  id direction 
-                         (Js_output.to_block @@ 
-                          compile_lambda {cxt with should_return = False ; st = EffectCall}
-                            body) ]
-              | _, _ when Js_analyzer.no_side_effect_expression e1 
-                (* 
-                     e1 > b2 > e2
-                     re-order 
-                     b2 > e1 > e2
-                   *)
-                -> 
-                b1 @ b2 @ [S.for_ (Some e1) e2  id direction 
-                             (Js_output.to_block @@ 
-                              compile_lambda {cxt with should_return = False ; st = EffectCall}
-                                body) ]
-              | _ , _
-                -> 
-                (*       let b2, e2 =  *)
-                (*   (\* e2 is of type [int]*\) *)
-                (*   match e2.expression_desc with *)
-                (*   | Number v  -> b2, J.Const v *)
-                (*   | Var v -> b2, J.Finish v *)
 
-                (*   | Array_length e  *)
-                (*   | Bytes_length e  *)
-                (*   | Function_length e  *)
-                (*   | String_length e  *)
-                (*     ->  *)
-                (*       let len = Ext_ident.create "_length" in *)
-                (*       b2 @ [ S.alias_variable len ~exp:e2 ],  J.Finish (Id len ) *)
-                (*   | _ ->  *)
-                (*       (\* TODO: guess a better name when possible*\) *)
-                (*       let len = Ext_ident.create "_finish" in *)
-                (*       b2 @ [S.alias_variable len ~exp:e2],  J.Finish (Id len) *)
-                (* in  *)
 
-                b1 @ (S.define ~kind:Variable id e1 :: b2 ) @ ([
-                    S.for_ None e2 id direction 
-                      (Js_output.to_block @@ 
-                       compile_lambda {cxt with should_return = False ; st = EffectCall}
-                         body) 
-                  ])
 
-            end
 
+module E = Js_exp_make 
 
-          | _ -> assert false end in
-      begin
-        match st, should_return with 
-        | EffectCall, False  -> Js_output.make block
-        | EffectCall, True _  -> 
-          Js_output.make (block @ [S.return_unit()]) ~finished:True
-        (* unit -> 0, order does not matter *)
-        | (Declare _ | Assign _), True _ -> Js_output.make [S.unknown_lambda lam]
-        | Declare (_kind, x), False  ->   
-          (* FIXME _kind unused *)
-          Js_output.make (block @   [S.declare_unit x ])
-        | Assign x, False  -> Js_output.make (block @ [S.assign_unit x ])
-        | NeedValue, _ 
-          ->  
-          Js_output.make block ~value:E.unit
-          (* TODO: fixme, here it's ok*)
-      end
-    | Lassign(id,lambda) -> 
-      let block = 
-        match lambda with
-        | Lprim {primitive = Poffsetint  v; args =  [Lvar id']}
-          when Ident.same id id' ->
-          [ S.exp (E.assign (E.var id) 
-                     (E.int32_add (E.var id) (E.small_int  v)))
-          ]
-        | _ ->
-          begin 
-            match compile_lambda {cxt with st = NeedValue; should_return = False} lambda with 
-            | {block = b; value =  Some v}  -> 
-              (b @ [S.assign id v ])
-            | _ -> assert false  
-          end
-      in
-      begin
-        match st, should_return with 
-        | EffectCall, False -> Js_output.make block
-        | EffectCall, True _ -> 
-          Js_output.make (block @ [S.return_unit ()]) ~finished:True
-        | (Declare _ | Assign _ ) , True _ -> 
-          Js_output.make [S.unknown_lambda lam]
-        (* bound by a name, while in a tail position, this can not happen  *)
-        | Declare (_kind, x) , False ->
-          (* FIXME: unused *)
-          Js_output.make (block @ [ S.declare_unit x ])
-        | Assign x, False  -> Js_output.make (block @ [S.assign_unit x ])
-        | NeedValue, _ -> 
-          Js_output.make block ~value:E.unit
-      end
-    | (Ltrywith(
-        (Lprim {primitive = Pccall {prim_name = "caml_sys_getenv"; _};
-                args = [Lconst _]} as body),
-        id, 
-        Lifthenelse
-          (Lprim{primitive = Pintcomp(Ceq);
-                 args = [Lvar id2 ; 
-                         Lprim{primitive = Pglobal_exception {name = "Not_found"}; _}]},
-           cont, _reraise )
-      )
-      | Ltrywith(
-          (Lprim {primitive = Pccall {prim_name = "caml_sys_getenv"; _};
-                  args = [Lconst _]} as body),
-          id, 
-          Lifthenelse(Lprim{primitive = Pintcomp(Ceq);
-                            args = [ 
-                              Lprim { primitive = Pglobal_exception {name = "Not_found"; _}; _}; Lvar id2 ]},
-                      cont, _reraise )
-        )) when Ident.same id id2 
-      -> 
-      compile_lambda cxt (Lam.try_ body id cont)
-    | Ltrywith(lam,id, catch) ->  (* generate documentation *)
-      (* 
-         tail --> should be renamed to `shouldReturn`  
-          in most cases ``shouldReturn`` == ``tail``, however, here is not, 
-          should return, but it is not a tail call in js
-          (* could be optimized using javascript style exceptions *)
-         {[
-           {try
-              {var $js=g(x);}
-                catch(exn){if(exn=Not_found){var $js=0;}else{throw exn;}}
-           return h($js);
-         }
-         ]}
-      *)
-      let aux st = 
-        (* should_return is passed down *)
-        [ S.try_ 
-            (Js_output.to_block (compile_lambda {cxt with st = st} lam))
-            ~with_:(id, 
-                    Js_output.to_block @@ 
-                    compile_lambda {cxt with st = st} catch )
+module S = Js_stmt_make  
 
-        ] in 
+let rec is_simple_expression (e : J.expression) = 
+  match e.expression_desc with  
+  | Var _ 
+  | Bool _ 
+  | Str _ 
+  | Number _ -> true
+  | Dot (e, _, _) -> is_simple_expression e 
+  | _ -> false 
 
-      begin
-        match st with 
-        | NeedValue -> 
-          let v = Ext_ident.gen_js () in
-          Js_output.make (S.declare_variable ~kind:Variable v :: aux (Assign v))  ~value:(E.var v )
-        | Declare (kind,  id) -> 
-          Js_output.make (S.declare_variable ~kind
-                            id :: aux (Assign id))
-        | Assign _ | EffectCall -> Js_output.make (aux st)
-      end
+let rec named_expression (e : J.expression)
+  :  (J.statement  * Ident.t) option = 
+  if is_simple_expression e then 
+    None 
+  else 
+    let obj = Ext_ident.create Literals.tmp in
+    let obj_code = 
+      S.define
+        ~kind:Strict obj e in 
 
+    Some (obj_code, obj)
 
-    | Lsend(meth_kind,met, obj, args,loc) -> 
-      (* Note that in [Texp_apply] for [%sendcache] the cache might not be used 
-         see {!CamlinternalOO.send_meth} and {!Translcore.transl_exp0} the branch
-         [Texp_apply] when [public_send ], args are simply dropped
+end
+module Js_of_lam_array : sig 
+#1 "js_of_lam_array.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-         reference 
-         [js_of_ocaml] 
-         1. GETPUBMET
-         2. GETDYNMET
-         3. GETMETHOD
-         [ocaml]
-         Lsend (bytegen.ml)
-         For the object layout refer to [camlinternalOO/create_object]
-         {[
-           let create_object table =
-             (* XXX Appel de [obj_block] *)
-             let obj = mark_ocaml_object @@ Obj.new_block Obj.object_tag table.size in
-             (* XXX Appel de [caml_modify] *)
-             Obj.set_field obj 0 (Obj.repr table.methods);
-             Obj.obj (set_id obj)
 
-           let create_object_opt obj_0 table =
-             if (Obj.magic obj_0 : bool) then obj_0 else begin
-               (* XXX Appel de [obj_block] *)
-               let obj = mark_ocaml_object @@ Obj.new_block Obj.object_tag table.size in
-               (* XXX Appel de [caml_modify] *)
-               Obj.set_field obj 0 (Obj.repr table.methods);
-               Obj.obj (set_id obj)
-             end
-         ]}
-         it's a block with tag [248], the first field is [table.methods] which is an array 
-         {[
-           type table =
-             { mutable size: int;
-               mutable methods: closure array;
-               mutable methods_by_name: meths;
-               mutable methods_by_label: labs;
-               mutable previous_states:
-                 (meths * labs * (label * item) list * vars *
-                  label list * string list) list;
-               mutable hidden_meths: (label * item) list;
-               mutable vars: vars;
-               mutable initializers: (obj -> unit) list }
-         ]}
-      *)
 
 
-      begin match 
-        (met :: obj :: args) 
-        |> Ext_list.split_map (fun (x : Lam.t) -> 
-            match x with 
-            | Lprim {primitive = Pgetglobal i; args =  []} -> 
-              [], Lam_compile_global.get_exp  (i, env, true)
-            | Lprim {primitive = Pccall {prim_name ; _}; args =  []}
-              (* nullary external call*)
-              -> 
-              [], E.var (Ext_ident.create_js prim_name)
-            | _ -> 
-              begin
-                match compile_lambda
-                        {cxt with st = NeedValue; should_return = False}
-                        x with
-                | {block = a; value = Some b} -> a, b 
-                | _ -> assert false
-              end
-          ) with  
-      | _, ([] | [_]) -> assert false
-      | (args_code, label::obj'::args) 
-        -> 
-        let cont3 obj' k = 
-          match Js_ast_util.named_expression obj' with 
-          | None -> 
-            let cont =
-              Js_output.handle_block_return 
-                st should_return lam (List.concat args_code)
-            in
-            cont (k obj')
-          | Some (obj_code, v) -> 
-            let cont2 obj_code v = 
-              Js_output.handle_block_return 
-                st should_return lam 
-                (obj_code :: List.concat args_code) v in 
-            let obj' = E.var v in 
-            cont2 obj_code (k obj') 
-        in
-        begin
-          match meth_kind with 
-          | Self -> 
-            (* TODO: horrible hack -- fixed later *)
-            cont3 obj' (fun obj' -> E.call ~info:Js_call_info.dummy 
-                   (Js_of_lam_array.ref_array 
-                    (Js_of_lam_record.field Fld_na obj' 0l) label )
-                 (obj' :: args))
-          (* [E.small_int 1] is because we use array, 
-              when we change the runtime represenation, it needs to be adapted 
-          *)
 
-          | Cached | Public None
-            (* TODO: check -- 1. js object propagate 2. js object create  *)
-            -> 
-            let get = E.runtime_ref  Js_config.oo "caml_get_public_method" in
-            let cache = !method_cache_id in
-            let () = incr method_cache_id  in
-            cont3 obj' (fun obj' -> 
-              E.call ~info:Js_call_info.dummy 
-                 (E.call ~info:Js_call_info.dummy get 
-                    [obj'; label; E.small_int cache]) (obj'::args)
-              ) (* avoid duplicated compuattion *)
 
 
-          | Public (Some name) -> 
-            let cache = !method_cache_id in
-            incr method_cache_id ;
-            cont3 obj' 
-              (fun obj' -> E.public_method_call name obj' label 
-                  (Int32.of_int cache) args )
 
-        end
-      end
+(** Utilities for creating Array of JS IR *)
 
-    (* [J.Empty,J.N] *)  (* TODO debugging, sourcemap, ignore lambda_event currently *)
-    (* 
-        seems to be an optimization trick for [translclass]
-        | Lifused(v, l) ->
-        if count_var v > 0 then simplif l else lambda_unit
-    *)
-    | Lifused(_,lam) -> compile_lambda cxt lam
-  end
+val make_array : J.mutable_flag -> Lambda.array_kind -> J.expression list -> J.expression
+(** create an array *)
 
-end
-module Lam_group : sig 
-#1 "lam_group.mli"
+val set_array : J.expression -> J.expression -> J.expression -> J.expression
+(** Here we don't care about [array_kind],  
+    In the future, we might used TypedArray for FloatArray
+ *)
+
+val ref_array :  J.expression -> J.expression -> J.expression
+
+end = struct
+#1 "js_of_lam_array.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -84666,23 +84410,50 @@ module Lam_group : sig
 
 
 
-type t = 
-  | Single of Lambda.let_kind  * Ident.t * Lam.t
-  | Recursive of (Ident.t * Lam.t) list
-  | Nop of Lam.t 
 
 
-val flatten : t list -> Lam.t -> Lam.t * t list
+(*
+   construct array,
+   set array,
+   ref array,
 
-val lambda_of_groups : Lam.t -> t list -> Lam.t
+   Also make sure, don't call any primitive array method, i.e [E.index] 
 
-val deep_flatten : Lam.t -> Lam.t
-(** Tricky to be complete *)
+   We also need check primitive [caml_make_vect], i.e, 
+   [Caml_primitive['caml_make_vect']] see if it's correct 
 
-val pp_group : Env.t -> Format.formatter -> t -> unit
+   [caml_make_vect]
+   [caml_array_sub]
+   [caml_array_append]
+   [caml_array_concat]
+   [caml_make_float_vect]
+   [caml_array_blit]
 
-end = struct
-#1 "lam_group.ml"
+   research: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Typed_arrays
+
+
+ *)
+
+module E  = Js_exp_make
+
+
+(* Parrayref(u|s) *)
+let make_array mt (kind : Lambda.array_kind) args = 
+  match kind with 
+  | Pgenarray
+  | Paddrarray -> E.arr ~comment:"array" mt args 
+  | Pintarray  -> E.arr ~comment:"int array" mt args 
+  | Pfloatarray -> E.arr ~comment:"float array" mt args
+
+let set_array  e e0 e1 = 
+  E.assign (E.access e e0)  e1
+
+let ref_array  e e0 = 
+  E.access  e  e0
+
+end
+module Js_of_lam_record : sig 
+#1 "js_of_lam_record.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -84711,341 +84482,80 @@ end = struct
 
 
 
-(** This is not a recursive type definition *)
-type t = 
-  | Single of Lambda.let_kind  * Ident.t * Lam.t
-  | Recursive of (Ident.t * Lam.t) list
-  | Nop of Lam.t 
 
+(** Utilities for compiling lambda record into JS IR *)
 
-let pp = Format.fprintf 
+(* val make : J.mutable_flag -> (string * J.expression) list -> J.expression *)
 
-let str_of_kind (kind : Lambda.let_kind) = 
-  match kind with 
-  | Alias -> "a"
-  | Strict -> ""
-  | StrictOpt -> "o"
-  | Variable -> "v" 
 
-let pp_group env fmt ( x : t) =
-  match x with
-  | Single (kind, id, lam) ->
-    Format.fprintf fmt "@[let@ %a@ =%s@ @[<hv>%a@]@ @]" Ident.print id (str_of_kind kind) 
-      (Lam_print.env_lambda env) lam
-  | Recursive lst -> 
-    List.iter (fun (id,lam) -> 
-        Format.fprintf fmt
-          "@[let %a@ =r@ %a@ @]" Ident.print id (Lam_print.env_lambda env) lam
-      ) lst
-  | Nop lam -> Lam_print.env_lambda env fmt lam
+val field : Lambda.field_dbg_info -> J.expression -> J.jsint ->J.expression
 
+val copy : Js_exp_make.unary_op
 
-let rec flatten 
-    (acc :  t list ) 
-    (lam : Lam.t) :  Lam.t *  t list = 
-  match lam with 
-  | Llet (str,id,arg,body) -> 
-    let (res,l) = flatten acc arg  in
-    flatten (Single(str, id, res ) :: l) body
-  (* begin *)
-  (*   match res with *)
-  (*   | Llet _ -> assert false *)
-  (*   | Lletrec _-> assert false *)
-  (*   | _ ->  *)
-  (*       Format.fprintf  Format.err_formatter "%a@." Printlambda.lambda res ; *)
-  (*       Format.pp_print_flush Format.err_formatter (); *)
-  (*       flatten (Single(str, id, res ) :: l) body *)
-  (* end *)
-  | Lletrec (bind_args, body) -> 
-    (** TODO: more flattening, 
-        - also for function compilation, flattening should be done first
-        - [compile_group] and [compile] become mutually recursive function
-    *)
-    (* Printlambda.lambda Format.err_formatter lam ; assert false  *)
-    flatten
-      (
-        Recursive
-          (List.map (fun (id, arg ) -> (id, arg)) bind_args)
-        :: acc
-      )
-      body
-  | Lsequence (l,r) -> 
-    let (res, l)  = flatten acc l in
-    flatten (Nop res :: l)  r
+end = struct
+#1 "js_of_lam_record.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  | x ->  
-    (*   x = Llet _ -> assert false (* sane check *)*)
-    x, acc
 
 
-(* [groups] are in reverse order *)
 
-let lambda_of_groups result groups = 
-  List.fold_left (fun acc x -> 
-      match x with 
-      | Nop l -> Lam.seq l acc
-      | Single(kind,ident,lam) -> Lam_util.refine_let ~kind ident lam acc
-      | Recursive bindings -> Lam.letrec bindings acc) 
-    result groups
 
 
-(* TODO: 
-    refine effectful [ket_kind] to be pure or not
-    Be careful of how [Lifused(v,l)] work 
-    since its semantics depend on whether v is used or not
-    return value are in reverse order, but handled by [lambda_of_groups]
-*)
-let deep_flatten
-    (lam : Lam.t) :  Lam.t  = 
-  let rec
-    flatten 
-      (acc :  t list ) 
-      (lam : Lam.t) :  Lam.t *  t list = 
-    match lam with 
-    | Llet (str, id, 
-            (Lprim {primitive = Pccall 
-                      {prim_name = 
-                         ("js_from_nullable" 
-                         | "js_from_def"
-                         |"js_from_nullable_def"); _ }
-                   ; args  =  [Lvar _]} as arg), body)
-      -> 
-      flatten (Single(str, id, (aux arg) ) :: acc) body
-    | Llet (str, id, 
-            Lprim {primitive = Pccall 
-                     ({prim_name = 
-                         ("js_from_nullable"
-                         | "js_from_def"
-                         | "js_from_nullable_def"); _ } as p );
-                   args = [arg]}, body)
-      -> 
-      let id' = Ident.rename id in 
-      flatten acc 
-        (Lam.let_ str id' arg 
-               (Lam.let_ Alias id 
-                  (Lam.prim 
-                     ~primitive:(Pccall p)
-                     ~args: [Lam.var id'] Location.none (* FIXME*))
-                  body)
-              )
-    | Llet (str,id,arg,body) -> 
-      let (res,l) = flatten acc arg  in
-      flatten (Single(str, id, res ) :: l) body
-    | Lletrec (bind_args, body) -> 
-      (** TODO: more flattening, 
-          - also for function compilation, flattening should be done first
-          - [compile_group] and [compile] become mutually recursive function
-      *)
-      (* Printlambda.lambda Format.err_formatter lam ; assert false  *)
-      flatten
-        (
-          (* let rec iter bind_args acc =  *)
-          (*   match bind_args with *)
-          (*   | [] ->  acc  *)
-          (*   | (id,arg) :: rest ->  *)
-          (*       flatten acc  *)
-          Recursive
-            (List.map (fun (id, arg ) -> (id, aux arg)) bind_args)
-          :: acc
-        )
-        body
-    | Lsequence (l,r) -> 
-      let (res, l)  = flatten acc l in
-      flatten (Nop res :: l)  r
-    | x ->  
-      aux x, acc      
 
-  and aux  (lam : Lam.t) : Lam.t= 
-    match lam with 
-    | Llet _ -> 
-      let res, groups = flatten [] lam  
-      in lambda_of_groups res groups
-    | Lletrec (bind_args, body) ->  
-      (** be careful to flatten letrec 
-          like below : 
-          {[
-            let rec even = 
-              let odd n =  if n ==1 then true else even (n - 1) in
-              fun n -> if n ==0  then true else odd (n - 1)
-          ]}
-          odd and even are recursive values, since all definitions inside 
-          e.g, [odd] can see [even] now, however, it should be fine
-          in our case? since ocaml's recursive value does not allow immediate 
-          access its value direclty?, seems no
-          {[
-            let rec even2 = 
-              let odd = even2 in
-              fun n -> if n ==0  then true else odd (n - 1)
-          ]}
-      *)
-      (* let module Ident_set = Lambda.IdentSet in *)
-      let rec iter bind_args acc =
-        match bind_args with
-        | [] ->   acc
-        | (id,arg) :: rest ->
-          let groups, set = acc in
-          let res, groups = flatten groups (aux arg)
-          in
-          iter rest (Recursive [(id,res)] :: groups, Ident_set.add id set) 
-      in
-      let groups, collections = iter bind_args ([], Ident_set.empty) in
-      (* FIXME:
-          here we try to move inner definitions of [recurisve value] upwards
-          for example:
-         {[
-           let rec x = 
-             let y = 32 in
-             y :: x
-           and z = ..
-             ---
-             le ty = 32 in
-           let rec x = y::x
-           and z = ..
-         ]}
-          however, the inner definitions can see [z] and [x], so we
-          can not blindly move it in the beginning, however, for 
-          recursive value, ocaml does not allow immediate access to 
-          recursive value, so what's the best strategy?
-          ---
-          the motivation is to capture real tail call
-      *)
-      let (result, _, wrap) = 
-        List.fold_left (fun  (acc, set, wrap)  g -> 
-            match g with 
-            | Recursive [ id, (Lconst _)]
-            | Single (Alias, id, ( Lconst _   ))
-            | Single ((Alias | Strict | StrictOpt), id, ( Lfunction _ )) -> 
-              (** FIXME: 
-                   It should be alias and alias will be optimized away
-                   in later optmizations, however, 
-                   this means if we don't optimize 
-                  {[ let u/a = v in ..]}
-                   the output would be wrong, we should *optimize 
-                   this away right now* instead of delaying it to the 
-                   later passes
-              *)
-              (acc, set, g :: wrap)
 
-            | Single (_, id, ( Lvar bid)) -> 
-              (acc, (if Ident_set.mem bid set then Ident_set.add id set else set ), g:: wrap)
-            | Single (_, id, lam) ->
-              let variables = Lam.free_variables  lam in
-              if Ident_set.(is_empty (inter variables collections)) 
-              then 
-                (acc, set, g :: wrap )
-              else 
-                ((id, lam ) :: acc , Ident_set.add id set, wrap)
-            | Recursive us -> 
-              (* could also be from nested [let rec] 
-                 like 
-                 {[
-                   let rec x = 
-                     let rec y = 1 :: y in
-                     2:: List.hd y:: x 
-                 ]}
-                 TODO: seems like we should update depenency graph, 
+module E = Js_exp_make 
 
-              *)
-              (us @ acc , 
-               List.fold_left (fun acc (id,_) -> Ident_set.add id acc) set us , 
-               wrap)
-            | Nop _ -> assert false 
-          ) ([], collections, []) groups in
-      lambda_of_groups 
-        (Lam.letrec 
-            result 
-            (* List.map (fun (id,lam) -> (id, aux lam )) bind_args *)
-            (aux body)) (List.rev wrap)
-    | Lsequence (l,r) -> Lam.seq (aux l) (aux r)
-    | Lconst _ -> lam
-    | Lvar _ -> lam 
-    (* | Lapply(Lfunction(Curried, params, body), args, _) *)
-    (*   when  List.length params = List.length args -> *)
-    (*     aux (beta_reduce  params body args) *)
-    (* | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) *)
-    (*     (\** TODO: keep track of this parameter in ocaml trunk, *)
-    (*           can we switch to the tupled backend? *\) *)
-    (*   when  List.length params = List.length args -> *)
-    (*       aux (beta_reduce params body args) *)
+let empty_record_info = Lambda.Blk_record [||] (* careful to share*)
 
-    | Lapply{fn = l1; args  = ll; loc; status} -> 
-      Lam.apply (aux l1) (List.map aux ll) loc status
 
-    (* This kind of simple optimizations should be done each time
-       and as early as possible *) 
+(* TODO: add label to the comment *)
+(* let make  mutable_flag (args : (string * J.expression) list) = *)
+(*   E.make_block ~comment:"record"  *)
+(*     E.zero_int_literal empty_record_info (List.map snd args) mutable_flag *)
 
-    | Lprim {primitive = Pccall{prim_name = "caml_int64_float_of_bits"; _};
-            args = [ Lconst (Const_base (Const_int64 i))]; _} 
-      ->  
-      Lam.const 
-        (Const_base (Const_float (Js_number.to_string (Int64.float_of_bits i) )))
-    | Lprim {primitive = Pccall{prim_name = "caml_int64_to_float"; _}; 
-             args = [ Lconst (Const_base (Const_int64 i))]; _} 
-      -> 
-      (* TODO: note when int is too big, [caml_int64_to_float] is unsafe *)
-      Lam.const 
-        (Const_base (Const_float (Js_number.to_string (Int64.to_float i) )))
-    | Lprim {primitive ; args; loc }
-      -> 
-      let args = List.map aux args in
-      Lam.prim ~primitive ~args loc
 
-    | Lfunction{arity; kind; params;  body = l} -> 
-      Lam.function_ ~arity ~kind ~params  ~body:(aux  l)
-    | Lswitch(l, {sw_failaction; 
-                  sw_consts; 
-                  sw_blocks;
-                  sw_numblocks;
-                  sw_numconsts;
-                 }) ->
-      Lam.switch (aux  l)
-              {sw_consts = 
-                 List.map (fun (v, l) -> v, aux  l) sw_consts;
-               sw_blocks = List.map (fun (v, l) -> v, aux  l) sw_blocks;
-               sw_numconsts = sw_numconsts;
-               sw_numblocks = sw_numblocks;
-               sw_failaction = 
-                 begin 
-                   match sw_failaction with 
-                   | None -> None
-                   | Some x -> Some (aux x)
-                 end}
-    | Lstringswitch(l, sw, d) ->
-      Lam.stringswitch (aux  l) 
-                    (List.map (fun (i, l) -> i,aux  l) sw)
-                    (match d with
-                     | Some d -> Some (aux d )
-                     | None -> None)
 
-    | Lstaticraise (i,ls) 
-      -> Lam.staticraise i (List.map aux  ls)
-    | Lstaticcatch(l1, ids, l2) 
-      -> 
-      Lam.staticcatch (aux  l1) ids (aux  l2)
-    | Ltrywith(l1, v, l2) ->
-      Lam.try_ (aux  l1) v (aux  l2)
-    | Lifthenelse(l1, l2, l3) 
-      -> 
-      Lam.if_ (aux  l1) (aux l2) (aux l3)
-    | Lwhile(l1, l2) 
-      -> 
-      Lam.while_ (aux  l1) (aux l2)
-    | Lfor(flag, l1, l2, dir, l3) 
-      -> 
-      Lam.for_ flag (aux  l1) (aux  l2) dir (aux  l3)
-    | Lassign(v, l) ->
-      (* Lalias-bound variables are never assigned, so don't increase
-         v's refaux *)
-      Lam.assign v (aux  l)
-    | Lsend(u, m, o, ll, v) -> 
-      Lam.send u (aux m) (aux o) (List.map aux ll) v
+let field field_info  e i =
+  match field_info with 
+  | Lambda.Fld_na -> 
+    E.index e i 
+  | Lambda.Fld_record s 
+  | Lambda.Fld_module s 
+    -> E.index ~comment:s e i
+
+(**
+   used in [Pduprecord]
+   this is due to we encode record as an array, it is going to change
+   if we have another encoding       
+*)    
+let copy  = E.array_copy
 
-    | Lifused(v, l) -> Lam.ifused v (aux  l)
-  in aux lam
 
 end
-module Lam_dce : sig 
-#1 "lam_dce.mli"
+module Lam_beta_reduce_util : sig 
+#1 "lam_beta_reduce_util.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85076,15 +84586,131 @@ module Lam_dce : sig
 
 
 
+val simple_beta_reduce : 
+  Ident.t list -> Lam.t -> Lam.t list -> Lam.t option
+
+end = struct
+#1 "lam_beta_reduce_util.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+
+
 
 
-(** Dead code eliminatiion on the lambda layer 
+(* 
+   Principle: since in ocaml, the apply order is not specified 
+   rules:
+   1. each argument it is only used once, (avoid eval duplication)
+   2. it's actually used, if not (Lsequence)
+   3. no nested  compuation, 
+      other wise the evaluation order is tricky (make sure eval order is correct)
 *)
 
-val remove : Ident.t list -> Lam_group.t list -> Lam_group.t list
+type value = 
+  { mutable used : bool ; 
+    lambda  : Lam.t
+  }
+let param_hash :  _ Ident_hashtbl.t = Ident_hashtbl.create 20
+let simple_beta_reduce params body args = 
+  let module E = struct exception Not_simple_apply end in
+  let rec find_param v  opt = 
+    match Ident_hashtbl.find_opt param_hash v with 
+    | Some exp ->  
+      if exp.used then raise E.Not_simple_apply
+      else exp.used <- true; exp.lambda
+    | None -> opt
+  in  
+  let rec aux acc (us : Lam.t list) = 
+    match us with 
+    | [] -> List.rev acc
+    | (Lvar x as a ) :: rest 
+      -> 
+      aux  (find_param x a  :: acc) rest 
+    | (Lconst  _  as u) :: rest 
+      -> aux (u :: acc) rest 
+    | _ :: _ -> raise E.Not_simple_apply 
+  in 
+  match (body : Lam.t) with 
+  | Lprim { primitive ; args =  args' ; loc}  (* There is no lambda in primitive *)
+    -> (* catch a special case of primitives *)
+    (* Note in a very special case we can avoid any allocation
+       {[
+         when Ext_list.for_all2_no_exn
+             (fun p a ->
+                match (a : Lam.t) with
+                | Lvar a -> Ident.same p a
+                | _ -> false ) params args'
+       ]}*)
+    let () = 
+      List.iter2 (fun p a -> Ident_hashtbl.add param_hash p {lambda = a; used = false }) params args  
+    in 
+    begin match aux [] args' with 
+    | args -> 
+      let result = 
+        Ident_hashtbl.fold (fun _param {lambda; used} code -> 
+            if not used then
+              Lam.seq lambda code
+            else code) param_hash (Lam.prim ~primitive ~args loc) in 
+      Ident_hashtbl.clear param_hash;
+      Some result 
+    | exception _ -> 
+      Ident_hashtbl.clear param_hash ;
+      None
+    end
+  | Lapply { fn = Lvar fn_name as f ; args =  args';  loc; status}
+    ->  
+    let () = 
+      List.iter2 (fun p a -> Ident_hashtbl.add param_hash p {lambda = a; used = false }) params args  
+    in 
+    (*since we adde each param only once, 
+      iff it is removed once, no exception, 
+      if it is removed twice there will be exception.
+      if it is never removed, we have it as rest keys 
+    *)
+    begin match aux [] args' with 
+      | us -> 
+        let f = find_param fn_name  f in
+        let result = 
+          Ident_hashtbl.fold 
+            (fun _param {lambda; used} code -> 
+               if not used then 
+                 Lam.seq lambda code
+               else code )
+            param_hash (Lam.apply  f us  loc status) in
+        Ident_hashtbl.clear param_hash;
+        Some result 
+      | exception _ -> 
+        Ident_hashtbl.clear param_hash; 
+        None
+    end
+  | _ -> None
 
-end = struct
-#1 "lam_dce.ml"
+end
+module Lam_closure : sig 
+#1 "lam_closure.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85109,90 +84735,211 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+(** [is_closed_by map lam]
+    return [true] if all unbound variables
+    belongs to the given [map] *)
+val is_closed_by : Ident_set.t -> Lam.t -> bool
+
+val is_closed : Lam.t -> bool
+
+
+
+
+
+type stats = 
+  { 
+    top : bool ; 
+    (* all appearances are in the top,  substitution is fine 
+       whether it is pure or not
+       {[
+         (fun x y          
+           ->  x + y + (f x )) (32) (console.log('hi'), 33)
+       ]}       
+       since in ocaml, the application order is intentionally undefined, 
+       note if [times] is not one, this field does not make sense       
+    *)    
+    times : int ; 
+  }
+
+val is_closed_with_map : 
+  Ident_set.t ->
+  Ident.t list -> Lam.t -> bool * stats Ident_map.t
+
+(* val param_map_of_list : Ident.t list -> stats Ident_map.t *)
+
+val free_variables : Ident_set.t -> stats Ident_map.t -> Lam.t -> stats Ident_map.t
+
+
+end = struct
+#1 "lam_closure.ml"
+
+
+
+type stats = 
+  { 
+    top : bool ; 
+    (* all appearances are in the top,  substitution is fine 
+       whether it is pure or not
+       {[
+         (fun x y          
+           ->  x + y + (f x )) (32) (console.log('hi'), 33)
+       ]}       
+       since in ocaml, the application order is intentionally undefined, 
+       note if [times] is not one, this field does not make sense       
+    *)    
+    times : int ; 
+  }
+type env = 
+  { top  : bool ; 
+    loop : bool 
+  }
+
+let no_substitute = { top = false; loop = true }
+let fresh_env = {top = true; loop = false }
+let fresh_stats  : stats = { top = true; times = 0 }
+
+let param_map_of_list lst : stats Ident_map.t = 
+  List.fold_left  (fun acc l -> Ident_map.add l fresh_stats acc) Ident_map.empty  lst 
+
+(** Sanity check, remove all varaibles in [local_set] in the last pass *)  
+
+let loop_use = 100 (** Used in loop, huge punishment *)
 
+(**
+   [param_stats = free_variables exports param_stats lam] 
+   This function tries to do more than detect free variable of [lam],  
+   given [param_stats] it tries to return a new stats with updated usage of 
+   recorded params and unbound parameters
+*)
+let free_variables (export_idents : Ident_set.t ) (params : stats Ident_map.t ) lam = 
+  let fv = ref params in
+  let local_set = ref export_idents in
 
+  let local_add k =
+    local_set := Ident_set.add k !local_set in
+  let local_add_list ks = 
+    local_set :=  
+      List.fold_left (fun acc k -> Ident_set.add k acc) !local_set ks 
+  in    
+  (* base don the envrionmet, recoring the use cases of arguments *)
+  let map_use {top; loop} v = 
+    (* relies on [identifier] uniquely bound *)    
+    if not (Ident_set.mem v !local_set) then 
+      fv := Ident_map.adjust 
+        v
+        (fun _ -> {top; times = if loop then loop_use else 1})
+        (fun v -> {times = if loop then loop_use else v.times + 1 ; top = v.top && top})
+        !fv 
+  in
+  let new_env lam (env : env) : env = 
+    if env.top then 
+      if Lam_analysis.no_side_effects lam 
+      then env 
+      (* no side effect, if argument has no side effect and used only once we can simply do the replacement *)
+      else { env with top = false}
+    else env      
+  in    
+  let rec iter (top : env) (lam : Lam.t) =
+    match lam with 
+    | Lvar v -> map_use top v 
+    | Lconst _ -> ()
+    | Lapply {fn; args; _} ->
+      iter top  fn; 
+      let top = new_env fn top in
+      List.iter (fun lam -> iter top lam ) args  
+    | Lprim {args ; _} -> 
+      (* Check: can top be propoaged for all primitives *)
+      List.iter (iter top) args
+    | Lfunction{ params; body} ->
+      local_add_list params;
+      iter no_substitute body 
+    | Llet(_let_kind, id, arg, body) ->
+      local_add id ;  
+      iter top  arg; iter no_substitute body
+    | Lletrec(decl, body) ->
+      local_set := List.fold_left (fun acc (id, _) -> 
+          Ident_set.add id acc) !local_set decl;        
+      List.iter (fun (_, exp) -> iter no_substitute exp) decl;
+      iter no_substitute body
+    | Lswitch(arg, sw) ->
+      iter top arg; 
+      let top = new_env arg top  in       
+      List.iter (fun (key, case) -> iter top case) sw.sw_consts;
+      List.iter (fun (key, case) -> iter top  case) sw.sw_blocks;
+  
+      begin match sw.sw_failaction with 
+        | None -> ()
+        | Some x ->
+          let nconsts = List.length sw.sw_consts in
+          let nblocks = List.length sw.sw_blocks in
 
+          if nconsts < sw.sw_numconsts  && nblocks < sw.sw_numblocks then
+            iter no_substitute x
+          else
+            iter top x
+      end
 
+    | Lstringswitch (arg,cases,default) ->
+      iter top arg ;
+      let top = new_env arg top  in       
+      List.iter (fun (_,act) -> iter top  act) cases ;
+      begin match default with 
+      | None -> ()
+      | Some x -> iter top x 
+      end
+    | Lstaticraise (_,args) ->
+      List.iter (iter no_substitute ) args
+    | Lstaticcatch(e1, (_,vars), e2) ->
+      iter no_substitute  e1; 
+      local_add_list vars;       
+      iter no_substitute e2
+    | Ltrywith(e1, exn, e2) ->
+      iter top  e1; iter no_substitute  e2
+    | Lifthenelse(e1, e2, e3) ->
+      iter top e1; 
+      let top = new_env e1 top  in
+      iter top e2; iter top e3
+    | Lsequence(e1, e2) ->
+      iter top e1; iter no_substitute e2
+    | Lwhile(e1, e2) ->
+      iter no_substitute e1; iter no_substitute e2 (* in the loop, no substitution any way *)
+    | Lfor(v, e1, e2, dir, e3) ->
+      local_add v ; 
+      iter no_substitute e1; iter no_substitute e2; iter no_substitute e3
+    | Lassign(id, e) ->
+      map_use top  id ; 
+      iter top e
+    | Lsend (_k, met, obj, args, _) ->
+      iter no_substitute met ; 
+      iter no_substitute obj;
+      List.iter (iter no_substitute) args
+    | Lifused (v, e) ->
+      iter no_substitute e in
+  iter fresh_env  lam ; !fv 
 
 
+let is_closed_by set lam = 
+  Ident_map.is_empty (free_variables set (Ident_map.empty ) lam   )
 
 
+(** A bit consverative , it should be empty *)
+let is_closed  lam = 
+  Ident_map.for_all (fun k _ -> Ident.global k)
+    (free_variables Ident_set.empty Ident_map.empty lam)  
 
 
-let transitive_closure 
-    (initial_idents : Ident.t list) 
-    (ident_freevars : Ident_set.t Ident_hashtbl.t) 
-  =
-  let visited  = Ident_hash_set.create 31 in 
-  let rec dfs (id : Ident.t) =
-    if Ident_hash_set.mem visited id || Ext_ident.is_js_or_global id  
-    then ()
-    else 
-      begin 
-        Ident_hash_set.add visited id;
-        match Ident_hashtbl.find_opt ident_freevars id with 
-        | None -> 
-          Ext_pervasives.failwithf ~loc:__LOC__ "%s/%d not found"  (Ident.name id) (id.Ident.stamp)  
-        | Some e -> Ident_set.iter (fun id -> dfs id) e
-      end  in 
-  List.iter dfs initial_idents;
-  visited
+let is_closed_with_map exports params body = 
+  let param_map = free_variables exports (param_map_of_list params) body in
+  let old_count = List.length params in
+  let new_count = Ident_map.cardinal param_map in
+  (old_count  = new_count, param_map)
 
-let remove export_idents (rest : Lam_group.t list) : Lam_group.t list  = 
-  let ident_free_vars :  _ Ident_hashtbl.t = Ident_hashtbl.create 17 in
-  (* calculate initial required idents, 
-     at the same time, populate dependency set [ident_free_vars]
-  *)
-  let initial_idents =
-    List.fold_left (fun acc (x : Lam_group.t) -> 
-        match x with
-        | Single(kind, id,lam) ->                   
-          begin
-            Ident_hashtbl.add ident_free_vars id 
-              (Lam.free_variables  lam);
-            match kind with
-            | Alias | StrictOpt -> acc
-            | Strict | Variable -> id :: acc 
-          end
-        | Recursive bindings -> 
-          List.fold_left (fun acc (id,lam) -> 
-              Ident_hashtbl.add ident_free_vars id (Lam.free_variables lam);
-              match (lam : Lam.t) with
-              | Lfunction _ -> acc 
-              | _ -> id :: acc
-            ) acc bindings 
-        | Nop lam ->
-          if Lam_analysis.no_side_effects lam then acc
-          else 
-            (** its free varaibles here will be defined above *)
-            Ident_set.fold (fun x acc -> x :: acc )  ( Lam.free_variables lam) acc                
-      )  export_idents rest in 
-  let visited = transitive_closure initial_idents ident_free_vars in 
-  List.fold_left (fun (acc : _ list) (x : Lam_group.t) ->
-      match x with 
-      | Single(_,id,_) -> 
-        if Ident_hash_set.mem visited id  then 
-          x :: acc 
-        else acc 
-      | Nop _ -> x :: acc  
-      | Recursive bindings ->
-        let b = 
-          List.fold_right (fun ((id,_) as v) acc ->
-              if Ident_hash_set.mem visited id then 
-                v :: acc 
-              else
-                acc  
-            ) bindings [] in            
-        match b with 
-        | [] -> acc  
-        | _ -> (Recursive b) :: acc
-    ) [] rest |> List.rev   
 
   
 
 end
-module Lam_stats_util : sig 
-#1 "lam_stats_util.mli"
+module Js_of_lam_module : sig 
+#1 "js_of_lam_module.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85222,22 +84969,13 @@ module Lam_stats_util : sig
 
 
 
-
-
-(** Utilities for lambda analysis *)
-
-val pp_alias_tbl : Format.formatter -> Lam_stats.alias_tbl  -> unit
-
-val pp_arities : Format.formatter -> Lam.function_arities -> unit
-
-val get_arity : Lam_stats.meta -> Lam.t -> Lam.function_arities
-
-(* val dump_exports_arities : Lam_stats.meta -> unit *)
-
+val make :
+  ?comment:string ->
+  J.expression list -> J.expression
 
 
 end = struct
-#1 "lam_stats_util.ml"
+#1 "js_of_lam_module.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85267,215 +85005,17 @@ end = struct
 
 
 
+module E = Js_exp_make 
 
-
-let pp = Format.fprintf
-
-let pp_arities (fmt : Format.formatter) (x : Lam.function_arities) = 
-  match x with 
-  | NA -> pp fmt "?"
-  | Determin (b,ls,tail) -> 
-    begin 
-      pp fmt "@[";
-      (if not b 
-       then 
-         pp fmt "~");
-      pp fmt "[";
-      Format.pp_print_list ~pp_sep:(fun fmt () -> pp fmt ",")
-        (fun fmt  (x,_) -> Format.pp_print_int fmt x)
-        fmt ls ;
-      if tail 
-      then pp fmt "@ *";
-      pp fmt "]@]";
-    end
-
-let pp_arities_tbl 
-    (fmt : Format.formatter) 
-    (arities_tbl : (Ident.t, Lam.function_arities ref) Hashtbl.t) = 
-  Hashtbl.fold (fun (i:Ident.t) (v : Lam.function_arities ref) _ -> 
-      pp Format.err_formatter "@[%s -> %a@]@."i.name pp_arities !v ) arities_tbl ()
-
-let pp_alias_tbl fmt (tbl : Lam_stats.alias_tbl) = 
-  Ident_hashtbl.iter (fun k v -> pp fmt "@[%a -> %a@]@." Ident.print k Ident.print v)
-    tbl
-
-let merge 
-    ((n : int ), params as y)
-    (x : Lam.function_arities) : Lam.function_arities = 
-  match x with 
-  | NA -> Determin(false, [y], false)
-  | Determin (b,xs,tail) -> Determin (b, y :: xs, tail)
-
-(* we need record all aliases -- since not all aliases are eliminated, 
-   mostly are toplevel bindings
-   We will keep iterating such environment
-   If not found, we will return [NA]
-*)
-let rec get_arity 
-    (meta : Lam_stats.meta) 
-    (lam : Lam.t) : 
-  Lam.function_arities = 
-  match lam with 
-  | Lconst _ -> Determin (true,[], false)
-  | Lvar v -> 
-    (** for functional parameter, if it is a high order function,
-        if it's not from function parameter, we should warn
-    *)
-    begin 
-      match Ident_hashtbl.find_opt meta.ident_tbl v with 
-      | Some (Function {arity;_}) -> arity
-      | Some _
-      | None ->
-        (* Format.fprintf Format.err_formatter *)
-        (*   "@[%s %a is not function/functor@]@." meta.filename Ident.print v ; *)
-        (NA : Lam.function_arities)
-
-    end
-  | Llet(_,_,_, l ) -> get_arity meta l 
-  (* | Lprim (Pccall {prim_name = "js_pure_expr"; prim_attributes},  *)
-  (*          [Lconst (Const_base (Const_string (_str,_)))]) *)
-  (*   -> *)
-  (*   (\* Ext_log.dwarn __LOC__ "called %s %d" str (List.length prim_attributes ); *\) *)
-  (*   begin match Parsetree_util.has_arity prim_attributes with *)
-  (*     | Some arity ->  *)
-  (*       (\* Ext_log.dwarn __LOC__ "arity %d" arity; *\) *)
-  (*       Determin(false, [arity, None], false) *)
-  (*     | None -> NA *)
-  (*   end *)
-  | Lprim {primitive = Pfield (n,_); 
-           args =  [Lprim {primitive = Pgetglobal id; args = []; _}]; _} ->
-    Lam_compile_env.find_and_add_if_not_exist (id, n) meta.env
-      ~not_found:(fun _ -> assert false)
-      ~found:(fun x -> x.arity )
-  | Lprim {primitive = Pfield _; _} -> NA (** TODO *)
-  | Lprim {primitive = Praise ;  _} -> Determin(true,[], true)
-  | Lprim {primitive = Pccall _; _} -> Determin(false, [], false)
-  | Lprim _  -> Determin(true,[] ,false)
-  (* shall we handle primitive in a direct way, 
-      since we know all the information
-      Invariant: all primitive application is fully applied, 
-      since this information  is already available
-
-      -- Check external c functions ?
-      -- it's not true for primitives 
-      like caml_set_oo_id  or  Lprim (Pmakeblock , [])
-
-      it seems true that primitive is always fully applied, however,
-      it can return a function
-  *)
-  | Lletrec(_, body) ->
-    get_arity meta body
-  (* | Lapply(Lprim( p, _), _args, _info) -> *)
-  (*     Determin(true, [], false) (\** Invariant : primtive application is always complete.. *\) *)
-
-  | Lapply{fn = app;  args; _ } -> (* detect functor application *)
-    let fn = get_arity meta app in 
-    begin match fn with 
-      | NA -> NA 
-      | Determin (b, xs, tail ) -> 
-        let rec take (xs : _ list) arg_length = 
-          match xs with 
-          | (x,y) :: xs ->
-            if arg_length = x then Lam.Determin (b, xs, tail) 
-            else if arg_length > x then
-              take xs (arg_length - x)
-            else Determin (b, 
-                           ((x -  arg_length ), 
-                            (match y with
-                            | Some y -> Some (Ext_list.drop arg_length y) 
-                            | None -> None)) :: xs ,
-                           tail)
-          | [] -> 
-            if tail then Determin(b, [], tail)
-            else if not b then 
-              NA
-            else NA
-            (* Actually, you can not have truly deministic arities
-               for example [fun x -> x ]
-            *)
-              (* Ext_pervasives.failwithf ~loc:__LOC__ "%s %s" *)
-              (*   (Format.asprintf "%a" pp_arities fn)  *)
-              (*   (Lam_util.string_of_lambda lam) *)
-        in
-        take xs (List.length args) 
-    end
-  | Lfunction {arity; kind; params; body = l} -> 
-    merge (arity, Some params)  (get_arity meta l)
-  | Lswitch(l, {sw_failaction; 
-                sw_consts; 
-                sw_blocks;
-                sw_numblocks = _;
-                sw_numconsts = _;
-               }) -> 
-    all_lambdas meta (
-      let rest = (sw_consts |> List.map snd) @ (sw_blocks |> List.map snd ) in
-      match sw_failaction with None -> rest | Some x -> x::rest )
-  | Lstringswitch(l, sw, d) -> 
-    begin match d with 
-      | None -> all_lambdas meta (List.map snd  sw )
-      | Some v -> all_lambdas meta (v:: List.map snd  sw)
-    end
-  | Lstaticraise _ -> NA (* since it will not be in tail position *)
-  | Lstaticcatch(_, _, handler) -> get_arity meta handler
-  | Ltrywith(l1, _, l2) -> 
-    all_lambdas meta [l1;l2]
-  | Lifthenelse(l1, l2, l3) ->
-    all_lambdas meta [l2;l3]
-  | Lsequence(_, l2) -> get_arity meta l2 
-  | Lsend(u, m, o, ll, v) -> NA
-  | Lifused(v, l) -> NA 
-  | Lwhile _ 
-  | Lfor _  
-  | Lassign _ -> Determin(true,[], false)
-
-and all_lambdas meta (xs : Lam.t list) = 
-  match xs with 
-  | y :: ys -> 
-    let arity =  get_arity meta y in 
-    List.fold_left (fun exist (v : Lam.t) -> 
-        match (exist : Lam.function_arities) with 
-        | NA -> NA 
-        | Determin (b, xs, tail) -> 
-          begin 
-            match get_arity meta v with 
-            | NA -> NA 
-            | Determin (u,ys,tail2) -> 
-              let rec aux (b,acc) xs ys = 
-                match xs,ys with
-                | [], [] -> (b, List.rev acc, tail && tail2) 
-                | [], y::ys when tail  -> 
-                  aux (b,y::acc) [] ys 
-                | x::xs, [] when tail2 -> 
-                  aux (b,x::acc) [] xs
-                | x::xs, y::ys when x = y -> aux (b, (y :: acc)) xs ys 
-                | _, _  -> (false, List.rev acc, false) in 
-              let (b,acc, tail3)  = aux ( u &&b, []) xs ys in 
-              Determin (b,acc, tail3)
-          end
-      ) arity ys 
-  | _ -> assert false 
-
-(*
-let dump_exports_arities (meta : Lam_stats.meta ) = 
-  let fmt = 
-    if meta.filename != "" then 
-      let cmj_file = Ext_filename.chop_extension meta.filename ^ Js_config.cmj_ext in
-      let out = open_out cmj_file in   
-      Format.formatter_of_out_channel out
-    else 
-      Format.err_formatter in 
-  begin 
-    List.iter (fun (i : Ident.t) ->  
-      pp fmt "@[%s: %s -> %a@]@." meta.filename i.name 
-        pp_arities  (get_arity meta (Lvar i))
-              ) meta.exports
-  end
-*)
+let make ?comment (args : J.expression list) =
+  E.make_block
+    ?comment E.zero_int_literal
+    (Blk_module None) args Immutable
 
 
 end
-module Lam_pass_alpha_conversion : sig 
-#1 "lam_pass_alpha_conversion.mli"
+module Lam_compile_global : sig 
+#1 "lam_compile_global.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85507,12 +85047,16 @@ module Lam_pass_alpha_conversion : sig
 
 
 
-(** alpha conversion based on arity *)
+(** Compile ocaml external module call , e.g [List.length] to  JS IR *)
+
+val get_exp : Lam_compile_env.key  -> J.expression
 
-val alpha_conversion : Lam_stats.meta -> Lam.t  -> Lam.t
+
+
+val query_lambda : Ident.t -> Env.t -> Lam.t
 
 end = struct
-#1 "lam_pass_alpha_conversion.ml"
+#1 "lam_compile_global.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85544,109 +85088,64 @@ end = struct
 
 
 
-let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t = 
-  let rec simpl  (lam : Lam.t) = 
-    match lam with 
-    | Lconst _ -> lam
-    | Lvar _ -> lam 
-    | Lapply {fn = l1; args =  ll;  loc ; status} 
-      -> (* detect functor application *)
-      begin 
-        match Lam_stats_util.get_arity meta l1 with 
-        | NA -> 
-          Lam.apply (simpl  l1) (List.map simpl  ll) loc status
-        | Determin (b, args, tail) -> 
-          let len = List.length ll in 
-          let rec take args = 
-            match args with 
-            | (x,_) :: xs -> 
-              if x = len 
-              then 
-                Lam.apply (simpl l1)
-                  (List.map simpl ll) loc App_ml_full
-              else if x > len  
-              then 
-                let fn = simpl l1 in
-                let args = List.map simpl ll in
-                Lam_util.eta_conversion (x - len) loc App_ml_full
-                  fn args 
-              else 
-                let first,rest = Ext_list.take x ll in 
-                Lam.apply (
-                  Lam.apply (simpl l1) 
-                         (List.map simpl first) 
-                         loc App_ml_full
-                )
-                  (List.map simpl rest) loc status (* TODO refien *)
-            | _ -> Lam.apply (simpl l1) (List.map simpl ll)  loc status
-          in take args
-      end
+module E = Js_exp_make  
+module S = Js_stmt_make
 
-    | Llet (str, v, l1, l2) ->
-      Lam.let_ str v (simpl l1) (simpl l2 )
-    | Lletrec (bindings, body) ->
-      let bindings = List.map (fun (k,l) -> (k, simpl l)) bindings in 
-      Lam.letrec bindings (simpl body) 
-    | Lprim {primitive; args ; loc} -> 
-      Lam.prim ~primitive ~args:(List.map simpl  args) loc
-    | Lfunction {arity; kind; params; body = l} ->
-      (* Lam_mk.lfunction kind params (simpl l) *)
-      Lam.function_ ~arity ~kind ~params  ~body:(simpl  l)
-    | Lswitch (l, {sw_failaction; 
-                  sw_consts; 
-                  sw_blocks;
-                  sw_numblocks;
-                  sw_numconsts;
-                 }) ->
-      Lam.switch (simpl  l)
-              {sw_consts = 
-                 List.map (fun (v, l) -> v, simpl  l) sw_consts;
-               sw_blocks = List.map (fun (v, l) -> v, simpl  l) sw_blocks;
-               sw_numconsts = sw_numconsts;
-               sw_numblocks = sw_numblocks;
-               sw_failaction = 
-                 begin 
-                   match sw_failaction with 
-                   | None -> None
-                   | Some x -> Some (simpl x)
-                 end}
-    | Lstringswitch (l, sw, d) ->
-      Lam.stringswitch (simpl  l)
-                    (List.map (fun (i, l) -> i,simpl  l) sw)
-                    (match d with
-                      | Some d -> Some (simpl d )
-                      | None -> None)
-                    
-    | Lstaticraise (i,ls) ->
-      Lam.staticraise i (List.map simpl  ls)
-    | Lstaticcatch (l1, ids, l2) 
-      -> 
-      Lam.staticcatch (simpl  l1) ids (simpl  l2)
-    | Ltrywith (l1, v, l2) 
-      -> 
-      Lam.try_ (simpl  l1) v (simpl  l2)
-    | Lifthenelse (l1, l2, l3) -> 
-      Lam.if_ (simpl  l1) (simpl  l2) (simpl  l3)
-    | Lsequence (l1, l2) 
-      -> Lam.seq (simpl  l1) (simpl  l2)
-    | Lwhile (l1, l2)
-      -> Lam.while_ (simpl  l1) (simpl l2)
-    | Lfor (flag, l1, l2, dir, l3)
-      -> Lam.for_ flag (simpl  l1) (simpl  l2) dir (simpl  l3)
-    | Lassign (v, l) ->
-      (* Lalias-bound variables are never assigned, so don't increase
-         v's refsimpl *)
-      Lam.assign v (simpl  l)
-    | Lsend (u, m, o, ll, v) -> 
-      Lam.send u (simpl m) (simpl o) (List.map simpl ll) v
-    | Lifused (v, l) -> Lam.ifused v (simpl  l)
-  in 
+open Js_output.Ops
+
+(* TODO: used in functor inlining, so that it can not be an exception
+   Make(S), S can not be an exception
+ *)
+
+
+
+let query_lambda id env = 
+  Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) 
+    (Has_env env)
+    ~not_found:(fun id -> assert false)
+    ~found:(fun {signature = sigs; _} 
+             -> 
+               Lam.prim
+                 ~primitive:(Pmakeblock(0, Blk_module None, Immutable))  
+                 ~args:(
+                   List.mapi (fun i _ -> 
+                       Lam.prim
+                         ~primitive:(Pfield (i, Lambda.Fld_na)) 
+                         ~args:[
+                           Lam.prim 
+                             ~primitive:(Pgetglobal id)
+                             ~args:[] Location.none (* FIXME*)] Location.none)
+                     sigs) Location.none (* FIXME*))
+
+
+(* Given an module name and position, find its corresponding name  *)  
+let get_exp (key : Lam_compile_env.key) : J.expression = 
+  match key with 
+   (id, env, expand) -> 
+    Lam_compile_env.query_and_add_if_not_exist 
+        (Lam_module_ident.of_ml id) 
+        (Has_env env)
+        ~not_found:(fun id -> assert false)
+        ~found:(fun   {signature = sigs; _} -> 
+            if expand 
+            then 
+              (** TODO: add module into taginfo*)
+              let len = List.length sigs in (** TODO: could be optimized *) 
+              Js_of_lam_module.make ~comment:id.name 
+                (Ext_list.init len (fun i -> 
+                     E.ml_var_dot id
+                       (Type_util.get_name sigs i )))
+                               
+
+            else 
+              E.ml_var id)
+
+  
 
-  simpl lam
 
 end
-module Lam_pass_collect : sig 
-#1 "lam_pass_collect.mli"
+module Lam_beta_reduce : sig 
+#1 "lam_beta_reduce.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85678,64 +85177,64 @@ module Lam_pass_collect : sig
 
 
 
+(** Beta reduction of lambda IR *)
 
-(** This pass is used to collect meta data information.
-
-    It includes:
-    alias table, arity for identifiers and might more information,
-    
-    ATTENTION:
-    For later pass to keep its information complete and up to date,
-    we  need update its table accordingly
-
-    - Alias inference is not for substitution, it is for analyze which module is 
-      actually a global module or an exception, so it can be relaxed a bit
-      (without relying on strict analysis)
-
-    - Js object (local) analysis 
-
-    Design choice:
-
-    Side effectful operations:
-       - Lassign 
-       - Psetfield
-
-    1. What information should be collected:
 
-    2. What's the key
-       If it's identifier, 
-       
-    Information that is always sound, not subject to change 
+val beta_reduce : Ident.t list -> Lam.t -> Lam.t list -> Lam.t
+(* Compile-time beta-reduction of functions immediately applied:
+      Lapply(Lfunction(Curried, params, body), args, loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+      Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+   Assumes |args| = |params|.
+*)
 
-    - shall we collect that if an identifier is passed as a parameter, (useful for escape analysis), 
-    however, since it's going to change after inlning (for local function)
+(*
+   Refresh all the identifiers, 
+   otherwise the identifier property can not be preserved, 
+   the obvious example is parameter
+ *)
 
-    - function arity, subject to change when you make it a mutable ref and change it later
-    
-    - Immutable blocks of identifiers
-     
-      if identifier itself is function/non block then the access can be inlined 
-      if identifier itself is immutable block can be inlined
-      if identifier is mutable block can be inlined (without Lassign) since
+val propogate_beta_reduce : 
+  Lam_stats.meta -> 
+  Ident.t list -> 
+  Lam.t -> 
+  Lam.t list -> 
+  Lam.t
 
-    - When collect some information, shall we propogate this information to 
-      all alias table immeidately
 
-      - annotation identifiers (at first time)
-      -
- *)
+val refresh : 
+  Lam.t -> 
+  Lam.t 
 
-(** Modify existing [meta] *)
-val collect_helper : Lam_stats.meta -> Lam.t -> unit
+(** 
+   {[ Lam_beta_reduce.propogate_beta_reduce_with_map 
+       meta param_map
+       params body args]}
 
-(** return a new [meta] *)
-val count_alias_globals : 
-    Env.t -> string -> Ident.t list -> Lam.t -> Lam_stats.meta
+   [param_map] collect the usage of parameters, it's readonly
+   it can be  produced by 
 
+   {[!Lam_analysis.free_variables meta.export_idents 
+       (Lam_analysis.param_map_of_list params) body]}
 
+   TODO:
+   replace [propogate_beta_reduce] with such implementation 
+   {[
+     let propogate_beta_reduce meta params body args = 
+       let (_, param_map) = 
+         Lam_analysis.is_closed_with_map Ident_set.empty params body in 
+       propogate_beta_reduce_with_map meta param_map params body args  
+   ]}
+*)
+val propogate_beta_reduce_with_map : 
+  Lam_stats.meta ->
+  Lam_closure.stats Ident_map.t ->
+  Ident.t list ->
+  Lam.t -> Lam.t list -> Lam.t
 
 end = struct
-#1 "lam_pass_collect.ml"
+#1 "lam_beta_reduce.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85767,182 +85266,291 @@ end = struct
 
 
 
+(*
+   Given an [map], rewrite all let bound variables into new variables, 
+   note that the [map] is changed
+   example    
+   {[
+     let a/112 = 3 in a/112      
+   ]}
+   would be converted into 
+   {[
+     let a/113 = 3 in a/113     
+   ]}   
+
+   ATTENTION: [let] bound idents have to be renamed, 
+   Note we rely on an invariant that parameter could not be rebound 
+ *)
+
+(* 
+  Small function inline heuristics:
+  Even if a function is small, it does not mean it is good for inlining,
+  for example, in list.ml
+   {[
+     let rec length_aux len = function
+         [] -> len
+       | a::l -> length_aux (len + 1) l
 
-let annotate (meta : Lam_stats.meta)
-    rec_flag    
-    (k:Ident.t) (v : Lam.function_arities) lambda = 
-  (* Ext_log.dwarn  __LOC__ "%s/%d" k.name k.stamp;     *)
-  match Ident_hashtbl.find_opt  meta.ident_tbl k  with 
-  | None -> 
-      Ident_hashtbl.add meta.ident_tbl k (Function {kind = NA; arity = v; lambda; rec_flag})
-  |  Some (Function old)  ->  
-      (** Check, it is shared across ident_tbl, 
-          Only [Lassign] will break such invariant,
-          how about guarantee that [Lassign] only check the local ref 
-          and we track which ids are [Lassign]ed
-       *)
-      (**
-         might not be the same due to refinement
-         assert (old.arity = v) 
-       *)
-      old.arity <- v
-      
+     let length l = length_aux 0 l
+   ]}   
+   if we inline [length], it will expose [length_aux] to the user, first, it make 
+   the code not very friendly, also since [length_aux] is used everywhere now, it 
+   may affect that we will not do the inlining of [length_aux] in [length]
 
-  | _ -> assert false (* TODO -- avoid exception *)
+   Criteior for sure to inline   
+   1. small size, does not introduce extra symbols, non-exported and non-recursive   
+      non-recursive is required if we re-apply the strategy
 
+   Other Factors:   
+   2. number of invoked times
+   3. arguments are const or not   
+*)
+let rewrite (map :   _ Ident_hashtbl.t) 
+    (lam : Lam.t) : Lam.t = 
 
-(** it only make senses recording arities for 
-    function definition,
-    alias propgation - and toplevel identifiers, this needs to be exported
- *)
-let collect_helper  (meta : Lam_stats.meta) (lam : Lam.t)  = 
-  let rec collect_bind rec_flag
-      (kind : Lambda.let_kind) 
-      (ident : Ident.t)
-      (lam : Lam.t) = 
+  let rebind i = 
+    let i' = Ident.rename i in 
+    Ident_hashtbl.add map i (Lam.var i');
+    i' in
+  (* order matters, especially for let bindings *)
+  let rec 
+    option_map op = 
+    match op with 
+    | None -> None 
+    | Some x -> Some (aux x)
+  and aux (lam : Lam.t) : Lam.t = 
     match lam with 
-    | Lconst v 
-      -> 
-      Ident_hashtbl.replace meta.ident_tbl ident (Constant v); (** *)
-    | Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args=  ls}
-      -> 
-      Ident_hashtbl.replace meta.ident_tbl ident 
-        (Lam_util.kind_of_lambda_block Normal ls);
-      List.iter collect ls 
+    | Lvar v ->
+      Ident_hashtbl.find_default map v lam 
+    | Llet(str, v, l1, l2) ->
+      let v = rebind v in
+      let l1 = aux l1 in      
+      let l2 = aux l2 in
+      Lam.let_ str v  l1  l2 
+    | Lletrec(bindings, body) ->
+      (*order matters see GPR #405*)
+      let vars = List.map (fun (k, _) -> rebind k) bindings in 
+      let bindings = List.map2 (fun var (_,l) -> var, aux l) vars bindings in 
+      let body = aux body in       
+      Lam.letrec bindings body
+    | Lfunction{arity; kind; params; body} -> 
+      let params =  List.map rebind params in
+      let body = aux body in      
+      Lam.function_ ~arity ~kind ~params ~body
+    | Lstaticcatch(l1, (i,xs), l2) -> 
+      let l1 = aux l1 in
+      let xs = List.map rebind xs in
+      let l2 = aux l2 in
+      Lam.staticcatch l1 (i,xs) l2
+    | Lfor(ident, l1, l2, dir, l3) ->
+      let ident = rebind ident in 
+      let l1 = aux l1 in
+      let l2 = aux l2 in
+      let l3 = aux l3 in
+      Lam.for_ ident (aux  l1)  l2 dir  l3
+    | Lconst _ -> lam
+    | Lprim {primitive; args ; loc} ->
+      (* here it makes sure that global vars are not rebound *)      
+      Lam.prim ~primitive ~args:(List.map aux  args) loc
+    | Lapply {fn;  args; loc;  status } ->
+      let fn = aux fn in       
+      let args = List.map aux  args in 
+      Lam.apply fn  args loc status
+    | Lswitch(l, {sw_failaction; 
+                  sw_consts; 
+                  sw_blocks;
+                  sw_numblocks;
+                  sw_numconsts;
+                 }) ->
+      let l = aux l in
+      Lam.switch l
+              {sw_consts = 
+                 List.map (fun (v, l) -> v, aux  l) sw_consts;
+               sw_blocks = List.map (fun (v, l) -> v, aux  l) sw_blocks;
+               sw_numconsts = sw_numconsts;
+               sw_numblocks = sw_numblocks;
+               sw_failaction =  option_map sw_failaction
+              }
+    | Lstringswitch(l, sw, d) ->
+      let l = aux  l in
+      Lam.stringswitch l 
+                     (List.map (fun (i, l) -> i,aux  l) sw)
+                     (option_map d)
+    | Lstaticraise (i,ls) 
+      -> Lam.staticraise i (List.map aux  ls)
+    | Ltrywith(l1, v, l2) -> 
+      let l1 = aux l1 in
+      let v = rebind v in
+      let l2 = aux l2 in
+      Lam.try_ l1 v l2
+    | Lifthenelse(l1, l2, l3) -> 
+      let l1 = aux l1 in
+      let l2 = aux l2 in
+      let l3 = aux l3 in
+      Lam.if_ l1  l2   l3
+    | Lsequence(l1, l2) -> 
+      let l1 = aux l1 in
+      let l2 = aux l2 in
+      Lam.seq l1 l2
+    | Lwhile(l1, l2) -> 
+      let l1 = aux l1 in
+      let l2 = aux l2 in
+      Lam.while_  l1  l2
+    | Lassign(v, l) 
+      -> Lam.assign v (aux  l)
+    | Lsend(u, m, o, ll, v) ->
+      let m = aux m in 
+      let o = aux o in 
+      let ll = List.map aux ll in
+      Lam.send u  m  o  ll v
+    | Lifused(v, l) -> 
+      let l = aux l in 
+      Lam.ifused v  l
+  in 
+  aux lam
 
-    | Lprim {primitive = Pccall {prim_name = "js_from_nullable"; _}; 
-             args = ([ Lvar _] as ls) ; _}
-      ->
-      Ident_hashtbl.replace meta.ident_tbl ident 
-        (Lam_util.kind_of_lambda_block Null ls )
-    | Lprim {primitive = Pccall {prim_name = "js_from_def"; _}; 
-             args = ([ Lvar _] as ls); _}
-      ->
-      Ident_hashtbl.replace meta.ident_tbl ident 
-        (Lam_util.kind_of_lambda_block Undefined ls )
-    | Lprim {primitive = Pccall {prim_name = "js_from_nullable_def"; _};
-             args = ([ Lvar _] as ls);}
-      ->
-      Ident_hashtbl.replace meta.ident_tbl ident 
-        (Lam_util.kind_of_lambda_block Null_undefined ls )
-      
-    | Lprim {primitive = Pgetglobal v; args = []; _} 
-      -> 
-      begin 
-        Lam_util.alias meta  ident v (Module  v) kind; 
-        begin match kind with 
-          | Alias -> ()
-          | Strict | StrictOpt | Variable -> 
-            Lam_util.add_required_module v meta
-        end;
-      end
-    | Lvar v 
-      -> 
-        (
-         (* if Ident.global v then  *)
-         Lam_util.alias meta  ident v NA kind
-           (* enven for not subsitution, it still propogate some properties *)
-           (* else () *)
-        )
-    | Lfunction{ params; body = l}
-        (** TODO record parameters ident ?, but it will be broken after inlining *)  
-      -> 
-        (** TODO could be optimized in one pass? 
-            -- since collect would iter everywhere,
-            so -- it would still iterate internally
-         *)
 
-      List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
-      let arity = Lam_stats_util.get_arity meta lam in       
-      (* Ext_log.dwarn __LOC__ "%s/%d : %a : %a function collected"  *)
-      (*   ident.name ident.stamp  *)
-      (*   Printlambda.lambda lam *)
-      (*   Lam_stats_util.pp_arities arity *)
-      (* ; *)
-      annotate meta rec_flag ident  arity lam;
-      collect l
-    | x -> 
-        collect x ;
-        if Ident_set.mem ident meta.export_idents then 
-          annotate meta rec_flag ident (Lam_stats_util.get_arity meta x ) lam
+let refresh lam = rewrite (Ident_hashtbl.create 17 : Lam.t Ident_hashtbl.t ) lam
 
 
-  and collect  (lam : Lam.t)  =
-    match lam with 
 
-        (** TODO: 
-            how about module aliases..
-            record dependency
-            --- tricky -- if we inlining, 
-            is it safe to remove it? probably not...
-         *)
-    | Lconst _ -> ()
-    | Lvar _ -> ()
-    | Lapply{fn = l1; args =  ll; _} ->
-        collect  l1; List.iter collect  ll
-    | Lfunction { params; body =  l} -> (* functor ? *)
-        List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
-        collect  l
-    | Llet (kind,ident,arg,body) -> 
-        collect_bind Non_rec kind ident arg ; collect body
-    | Lletrec (bindings, body) -> 
-        List.iter (fun (ident,arg) -> collect_bind Rec  Strict ident arg ) bindings;
-        collect body
-    | Lprim {args; _} -> List.iter collect  args
-    | Lswitch(l, {sw_failaction; sw_consts; sw_blocks}) ->
-        collect  l;
-        List.iter (fun (_, l) -> collect  l) sw_consts;
-        List.iter (fun (_, l) -> collect  l) sw_blocks;
-        begin match sw_failaction with 
-        | None -> ()
-        | Some x -> collect x
-        end
-    | Lstringswitch(l, sw, d) ->
-        collect  l ;
-        List.iter (fun (_, l) -> collect  l) sw ;
-        begin match d with
-        | Some d -> collect d 
-        | None -> ()
-        end
-    | Lstaticraise (code,ls) -> 
-        Int_hash_set.add meta.exit_codes code;
-        List.iter collect  ls
-    | Lstaticcatch(l1, (_,_), l2) -> collect  l1; collect  l2
-    | Ltrywith(l1, _, l2) -> collect  l1; collect  l2
-    | Lifthenelse(l1, l2, l3) -> collect  l1; collect  l2; collect  l3
-    | Lsequence(l1, l2) -> collect  l1; collect  l2
-    | Lwhile(l1, l2) -> collect  l1; collect l2
-    | Lfor(_, l1, l2, dir, l3) -> collect  l1; collect  l2; collect  l3
-    | Lassign(v, l) ->
-        (* Lalias-bound variables are never assigned, so don't increase
-           v's refcollect *)
-        collect  l
-    | Lsend(_, m, o, ll, _) -> List.iter collect  (m::o::ll)
-    | Lifused(_, l) -> collect  l in collect lam 
+
+(* 
+    A naive beta reduce would break the invariants of the optmization.
+
+
+    The sane but slowest  way:
+      when we do a beta reduction, we need rename all variables inlcuding 
+      let-bound ones
+
+    A conservative one:
+      - for internal one 
+        rename params and let bound variables
+      - for external one (seriaized)
+        if it's enclosed environment should be good enough
+        so far, we only inline enclosed lambdas
+    TODO: rename 
+
+   Optimizations:   
+   {[
+     (fun x y -> ...     ) 100 3 
+   ]}   
+   we can bound [x] to [100] in a single step     
+ *)
+let propogate_beta_reduce 
+    (meta : Lam_stats.meta) params body args =
+  match Lam_beta_reduce_util.simple_beta_reduce params body  args with 
+  | Some x -> x 
+  | None -> 
+  let rest_bindings, rev_new_params  = 
+    List.fold_left2 
+      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
+         match arg with          
+         | Lconst _
+         | Lvar _  -> rest_bindings , arg :: acc 
+         | _ -> 
+           let p = Ident.rename old_param in 
+           (p,arg) :: rest_bindings , (Lam.var p) :: acc 
+      )  ([],[]) params args in
+  let new_body = rewrite (Ident_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
+  List.fold_right
+    (fun (param, (arg : Lam.t)) l -> 
+       let arg = 
+         match arg with 
+         | Lvar v -> 
+           begin 
+             match Ident_hashtbl.find_opt meta.ident_tbl v with 
+             | None -> ()
+             | Some ident_info -> 
+               Ident_hashtbl.add meta.ident_tbl param ident_info 
+           end;
+           arg 
+         | Lprim {primitive = Pgetglobal ident;  args = [];  _} -> 
+           (* It's not completeness, its to make it sound.. 
+              Pass global module as an argument
+           *)
+           Lam_compile_global.query_lambda ident meta.env 
+         (* alias meta param ident (Module (Global ident)) Strict *)
+         | Lprim {primitive = Pmakeblock (_, _, Immutable) ;args ; _} -> 
+           Ident_hashtbl.replace meta.ident_tbl param 
+             (Lam_util.kind_of_lambda_block Normal args ); (** *)
+           arg
+         | _ -> arg in
+       Lam_util.refine_let param arg l) 
+     rest_bindings new_body
+
+let propogate_beta_reduce_with_map  
+    (meta : Lam_stats.meta) (map : Lam_closure.stats Ident_map.t ) params body args =
+  match Lam_beta_reduce_util.simple_beta_reduce params body args with
+  | Some x -> x
+  | None ->
+  let rest_bindings, rev_new_params  = 
+    List.fold_left2 
+      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
+         match arg with          
+         | Lconst _
+         | Lvar _  -> rest_bindings , arg :: acc 
+         | Lprim {primitive = Pgetglobal ident; args = []}
+           (* TODO: we can pass Global, but you also need keep track of it*)
+           ->
+           let p = Ident.rename old_param in 
+           (p,arg) :: rest_bindings , (Lam.var p) :: acc 
+
+         | _ -> 
+           if  Lam_analysis.no_side_effects arg then
+             begin match Ident_map.find_exn old_param map with 
+               | exception Not_found -> assert false 
+               | {top = true ; times = 0 }
+               | {top = true ; times = 1 } 
+                 -> 
+                 rest_bindings, arg :: acc                
+               | _  ->  
+                 let p = Ident.rename old_param in 
+                 (p,arg) :: rest_bindings , (Lam.var p) :: acc 
+             end
+           else
+             let p = Ident.rename old_param in 
+             (p,arg) :: rest_bindings , (Lam.var p) :: acc 
+      )  ([],[]) params args in
+  let new_body = rewrite (Ident_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
+  List.fold_right
+    (fun (param, (arg : Lam.t)) l -> 
+       let arg = 
+         match arg with 
+         | Lvar v -> 
+           begin 
+             match Ident_hashtbl.find_opt meta.ident_tbl v with 
+             | None -> ()
+             | Some ident_info -> 
+               Ident_hashtbl.add meta.ident_tbl param ident_info 
+           end;
+           arg 
+         | Lprim {primitive = Pgetglobal ident; args =  []} -> 
+           (* It's not completeness, its to make it sound.. *)
+           Lam_compile_global.query_lambda ident meta.env 
+         (* alias meta param ident (Module (Global ident)) Strict *)
+         | Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args} -> 
+           Ident_hashtbl.replace meta.ident_tbl param 
+             (Lam_util.kind_of_lambda_block Normal args ); (** *)
+           arg
+         | _ -> arg in
+       Lam_util.refine_let param arg l) 
+     rest_bindings new_body
 
 
 
-let count_alias_globals 
-    env 
-    filename
-    export_idents
-    (lam : Lam.t) : Lam_stats.meta =
-  let meta : Lam_stats.meta = 
-    {alias_tbl = Ident_hashtbl.create 31 ; 
-     ident_tbl = Ident_hashtbl.create 31;
-     exit_codes = Int_hash_set.create 31 ;
-     exports =  export_idents;
-     required_modules = [] ;
-     filename;
-     env;
-     export_idents = Lam_util.ident_set_of_list export_idents; 
-   } in 
-  collect_helper  meta lam ; 
-  meta
+let beta_reduce params body args =
+  match Lam_beta_reduce_util.simple_beta_reduce params body args with 
+  | Some x -> x 
+  | None -> 
+    List.fold_left2 
+      (fun l param arg ->
+         Lam_util.refine_let param arg l)
+      body params args
 
 end
-module Int_hashtbl : sig 
-#1 "int_hashtbl.mli"
+module Js_long : sig 
+#1 "js_long.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -85969,959 +85577,350 @@ module Int_hashtbl : sig
 
 
 
-include Hashtbl_gen.S with type key = int
-
-
-
-
-end = struct
-#1 "int_hashtbl.ml"
-# 15 "ext/hashtbl.cppo.ml"
-type key = int 
-type 'a t = (key, 'a)  Hashtbl_gen.t 
-let key_index (h : _ t ) (key : key) =
-  (Bs_hash_stubs.hash_int  key ) land (Array.length h.data - 1)
-let eq_key = Ext_int.equal   
-
-
-# 33
-type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist
-let create = Hashtbl_gen.create
-let clear = Hashtbl_gen.clear
-let reset = Hashtbl_gen.reset
-let copy = Hashtbl_gen.copy
-let iter = Hashtbl_gen.iter
-let fold = Hashtbl_gen.fold
-let length = Hashtbl_gen.length
-let stats = Hashtbl_gen.stats
-
-
-
-let add (h : _ t) key info =
-  let i = key_index h key in
-  let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in
-  h.data.(i) <- bucket;
-  h.size <- h.size + 1;
-  if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h
-
-(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *)
-let modify_or_init (h : _ t) key modf default =
-  let rec find_bucket (bucketlist : _ bucketlist)  =
-    match bucketlist with
-    | Cons(k,i,next) ->
-      if eq_key k key then begin modf i; false end
-      else find_bucket next 
-    | Empty -> true in
-  let i = key_index h key in 
-  if find_bucket h.data.(i) then
-    begin 
-      h.data.(i) <- Cons(key,default (),h.data.(i));
-      h.size <- h.size + 1 ;
-      if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h 
-    end
-
-let remove (h : _ t ) key =
-  let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with  
-    | Empty ->
-        Empty
-    | Cons(k, i, next) ->
-        if eq_key k key 
-        then begin h.size <- h.size - 1; next end
-        else Cons(k, i, remove_bucket next) in
-  let i = key_index h key in
-  h.data.(i) <- remove_bucket h.data.(i)
-
-let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with  
-  | Empty ->
-      raise Not_found
-  | Cons(k, d, rest) ->
-      if eq_key key k then d else find_rec key rest
-
-let find_exn (h : _ t) key =
-  match h.data.(key_index h key) with
-  | Empty -> raise Not_found
-  | Cons(k1, d1, rest1) ->
-      if eq_key key k1 then d1 else
-      match rest1 with
-      | Empty -> raise Not_found
-      | Cons(k2, d2, rest2) ->
-          if eq_key key k2 then d2 else
-          match rest2 with
-          | Empty -> raise Not_found
-          | Cons(k3, d3, rest3) ->
-              if eq_key key k3  then d3 else find_rec key rest3
-
-let find_opt (h : _ t) key =
-  Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key))
-let find_default (h : _ t) key default = 
-  Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key))
-let find_all (h : _ t) key =
-  let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with 
-  | Empty ->
-      []
-  | Cons(k, d, rest) ->
-      if eq_key k key 
-      then d :: find_in_bucket rest
-      else find_in_bucket rest in
-  find_in_bucket h.data.(key_index h key)
-
-let replace h key info =
-  let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with 
-    | Empty ->
-        raise_notrace Not_found
-    | Cons(k, i, next) ->
-        if eq_key k key
-        then Cons(key, info, next)
-        else Cons(k, i, replace_bucket next) in
-  let i = key_index h key in
-  let l = h.data.(i) in
-  try
-    h.data.(i) <- replace_bucket l
-  with Not_found ->
-    h.data.(i) <- Cons(key, info, l);
-    h.size <- h.size + 1;
-    if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h
-
-let mem (h : _ t) key =
-  let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with 
-  | Empty ->
-      false
-  | Cons(k, d, rest) ->
-      eq_key k key  || mem_in_bucket rest in
-  mem_in_bucket h.data.(key_index h key)
-
-
-let of_list2 ks vs = 
-  let map = create 51 in 
-  List.iter2 (fun k v -> add map k v) ks vs ; 
-  map
-
 
-end
-module Lam_pass_exits : sig 
-#1 "lam_pass_exits.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-(* Adapted for Javascript backend: Hongbo Zhang,                       *)
 
 
-(** A pass used to optimize the exit code compilation, adaped from the compiler's
-    [simplif] module
- *)
+type int64_call = J.expression list -> J.expression  
 
-val count_helper : Lam.t -> int ref Int_hashtbl.t
+val make_const : lo:Int32.t -> hi:Int32.t -> J.expression
 
-type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
+val of_const : int64 -> J.expression
 
-val subst_helper : subst_tbl -> (int -> int) -> Lam.t -> Lam.t
+val to_int32 : int64_call
 
-val simplify_exits : Lam.t -> Lam.t
+val of_int32 : int64_call
+val comp : Lambda.comparison -> int64_call
+val neg : int64_call
+val add : int64_call
+val sub : int64_call
+val mul : int64_call
+val div : int64_call
+val xor : int64_call
+val mod_ : int64_call
+val lsl_ : int64_call
+val lsr_ : int64_call
+val asr_ : int64_call
+val and_ : int64_call
+val or_ : int64_call
+val swap : int64_call
+val discard_sign : int64_call
+val div_mod : int64_call
+val to_hex : int64_call  
+val to_float : int64_call
+val of_float : int64_call
+val compare : int64_call
+val of_string : int64_call
+val float_of_bits : int64_call
+val bits_of_float : int64_call  
+val get64 : int64_call
 
 end = struct
-#1 "lam_pass_exits.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-(* Adapted for Javascript backend: Hongbo Zhang                        *)
-
-(*
-   TODO: 
-   we should have a pass called, always inlinable
-   as long as its length is smaller than [exit=exit_id], for example
-   
-   {[
-      switch(box_name)
-       {case "":exit=178;break;
-        case "b":exit=178;break;
-        case "h":box_type=/* Pp_hbox */0;break;
-        case "hov":box_type=/* Pp_hovbox */3;break;
-        case "hv":box_type=/* Pp_hvbox */2;break;
-        case "v":box_type=/* Pp_vbox */1;break;
-        default:box_type=invalid_box(/* () */0);}
-      
-      switch(exit){case 178:box_type=/* Pp_box */4;break}
-   ]}
-*)
-
-(* Count occurrences of (exit n ...) statements *)
-let count_exit exits i =
-  match 
-    (Int_hashtbl.find_opt exits i)
-  with
-  | None -> 0
-  | Some v -> !v 
-
-and incr_exit exits i =
-  Int_hashtbl.modify_or_init exits i incr (fun _ -> ref 1)
+#1 "js_long.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-let count_helper  (lam : Lam.t) : int ref Int_hashtbl.t  = 
-  let exits  = Int_hashtbl.create 17 in
-  let rec count (lam : Lam.t) = 
-    match lam with 
-    | Lstaticraise (i,ls) -> incr_exit exits i ; List.iter count ls
-    | Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
-      (* i will be replaced by j in l1, so each occurence of i in l1
-         increases j's ref count *)
-      count l1 ;
-      let ic = count_exit exits i in
-      Int_hashtbl.modify_or_init exits j (fun x -> x := !x + ic) (fun _ -> ref ic)
-    | Lstaticcatch(l1, (i,_), l2) ->
-      count l1;
-      (* If l1 does not contain (exit i),
-         l2 will be removed, so don't count its exits *)
-      if count_exit exits i > 0 
-      then
-        count l2
-    | Lstringswitch(l, sw, d) ->
-      count l;
-      List.iter (fun (_, l) -> count l) sw;
-      begin 
-        match  d with
-        | None -> ()
-        | Some d -> 
-          (* See https://github.com/ocaml/ocaml/commit/fcf3571123e2c914768e34f1bd17e4cbaaa7d212#diff-704f66c0fa0fc9339230b39ce7d90919 
-             might only necessary for native backend
-          *)
-          count d
-          (* begin match sw with *)
-          (* | []|[_] -> count d *)
-          (* | _ -> count d; count d (\** ASK: default will get replicated *\) *)
-          (* end *)
-      end
-    | Lvar _| Lconst _ -> ()
-    | Lapply{fn = l1; args =  ll; _} -> count l1; List.iter count ll
-    | Lfunction {body = l} -> count l
-    | Llet(_, _, l1, l2) ->
-      count l2; count l1
-    | Lletrec(bindings, body) ->
-      List.iter (fun (_, l) -> count l) bindings;
-      count body
-    | Lprim {args;  _} -> List.iter count args
-    | Lswitch(l, sw) ->
-      count_default sw ;
-      count l;
-      List.iter (fun (_, l) -> count l) sw.sw_consts;
-      List.iter (fun (_, l) -> count l) sw.sw_blocks
-    | Ltrywith(l1, v, l2) -> count l1; count l2
-    | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
-    | Lsequence(l1, l2) -> count l1; count l2
-    | Lwhile(l1, l2) -> count l1; count l2
-    | Lfor(_, l1, l2, dir, l3) -> count l1; count l2; count l3
-    | Lassign(_, l) -> count l
-    | Lsend(_, m, o, ll, _) -> count m; count o; List.iter count ll
-    | Lifused(_, l) -> count l 
 
-  and count_default sw =
-    match sw.sw_failaction with
-    | None -> ()
-    | Some al ->
-      let nconsts = List.length sw.sw_consts
-      and nblocks = List.length sw.sw_blocks in
-      if
-        nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
-      then 
-        begin (* default action will occur twice in native code *)
-          count al ; count al
-          (** 
-              Reason: for pattern match, 
-              we will  test whether it is 
-              an integer or block, both have default cases
-              predicate: [sw_numconsts] vs nconsts
-          *)
-        end 
-      else 
-        begin (* default action will occur once *)
-          assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
-          count al
-        end in 
-  count lam ; 
-  exits
-;;
 
-type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
 
-(*
-   Second pass simplify  ``catch body with (i ...) handler''
-      - if (exit i ...) does not occur in body, suppress catch
-      - if (exit i ...) occurs exactly once in body,
-        substitute it with handler
-      - If handler is a single variable, replace (exit i ..) with it
-*)
-(*
-  Note:
-    In ``catch body with (i x1 .. xn) handler''
-     Substituted expression is
-      let y1 = x1 and ... yn = xn in
-      handler[x1 <- y1 ; ... ; xn <- yn]
-     For the sake of preserving the uniqueness  of bound variables.
-   ASKS: This documentation seems outdated
-     (No alpha conversion of ``handler'' is presently needed, since
-     substitution of several ``(exit i ...)''
-     occurs only when ``handler'' is a variable.)
-*)
 
+module E = Js_exp_make
+type int64_call = J.expression list -> J.expression  
 
-let subst_helper (subst : subst_tbl) query lam = 
-  let rec simplif (lam : Lam.t) = 
-    match lam with 
-    | Lstaticraise (i,[])  ->
-      begin match Int_hashtbl.find_opt subst i with
-        | Some (_, handler) -> handler
-        | None -> lam
-      end
-    | Lstaticraise (i,ls) ->
-      let ls = List.map simplif ls in
-      begin 
-        match Int_hashtbl.find_opt subst i with
-        | Some (xs,handler) -> 
-          let ys = List.map Ident.rename xs in
-          let env =
-            List.fold_right2
-              (fun x y t -> Ident_map.add x (Lam.var y) t)
-              xs ys Ident_map.empty in
-          List.fold_right2
-            (fun y l r -> Lam.let_ Alias y l r)
-            ys ls 
-               (Lam_util.subst_lambda  env  handler)
-        | None -> Lam.staticraise i ls
-      end
-    | Lstaticcatch (l1,(i,[]),(Lstaticraise (j,[]) as l2)) ->
-      Int_hashtbl.add subst i ([],simplif l2) ;
-      simplif l1 (** l1 will inline the exit handler *)
-    | Lstaticcatch (l1,(i,xs),l2) ->
-      begin 
-        match query i, l2 with
-        | 0,_ -> simplif l1
+let int64_call (fn : string) args  = 
+  E.runtime_call Js_config.int64 fn args 
 
-        (* Note that 
-           for [query] result = 2, 
-           the non-inline cost is 
-           {[
-             var exit ;
 
-             exit = 11;
-             exit = 11;
+(* TODO: make layout easier to change later *)
+let record_info = Lambda.Blk_record [| "hi"; "lo"|]
+let make_const ~lo ~hi = 
+   E.make_block 
+     ~comment:"int64" (E.zero_int_literal) 
+     record_info
+     [E.int hi; E.to_uint32 @@ E.int lo ; ]
+     (* If we use unsigned int for lo field, 
+        then we can not use [E.int] which is 
+        assumed to to be signed int.
+        Or we can use [Int64] to encode 
+        in the ast node?
+     *)
+     Immutable
+let make ~lo ~hi = 
+   E.make_block 
+     ~comment:"int64" (E.zero_int_literal) 
+     record_info [   hi; E.to_uint32 lo ]
+     Immutable
+let get_lo x = E.index x 1l
+let get_hi x = E.index x 0l
 
-             switch(exit){
-               case exit = 11 : body ; break
-             }
 
-           ]}
-           the inline cost is 
+(* below should  not depend on layout *)
 
-           {[
-             body;
-             body;
-           ]}
 
-           when [i] is negative, we can not inline in general, 
-           since the outer is a traditional [try .. catch] body, 
-           if it is guaranteed to be non throw, then we can inline
-        *)
-        | ( _ , Lvar _
-          | _, Lconst _) ->  
-          Int_hashtbl.add subst i (xs,simplif l2) ;
-          simplif l1 (** l1 will inline *)
-        | 1,_ when i >= 0 -> (** Ask: Note that we have predicate i >=0 *)
-          Int_hashtbl.add subst i (xs,simplif l2) ;
-          simplif l1 (** l1 will inline *)
-        | j,_ ->
+let of_const (v : Int64.t) = 
+  make_const
+    ~lo:(Int64.to_int32 v )
+    ~hi:(Int64.to_int32 (Int64.shift_right v 32))
 
-          (** TODO: better heuristics, also if we can group same exit code [j] 
-              in a very early stage -- maybe we can define our enhanced [Lambda] 
-              representation and counter can be more precise, for example [apply] 
-              does not need patch from the compiler
+let to_int32 args = 
+  begin match args with
+  | [v] ->  E.to_int32 @@ get_lo v
+  | _ -> assert false
+  end
 
-              FIXME:   when inlining, need refresh local bound identifiers
-          *)
-          let lam_size = Lam_analysis.size l2 in
-          let ok_to_inline = 
-             i >=0 && 
-             ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
-               || lam_size < 5)
-             (*TODO: when we do the case merging on the js side, 
-               the j is not very indicative                
-             *)             
-          in 
-          if ok_to_inline (* && false *) 
-          then 
-            begin 
-              Int_hashtbl.add subst i (xs, Lam_beta_reduce.refresh @@ simplif l2) ;
-              simplif l1 (** l1 will inline *)
-            end
-          else Lam.staticcatch (simplif l1) (i,xs) (simplif l2)
-      end
+let of_int32 (args : J.expression list) = 
+  match args with 
+  | [{expression_desc = Number (Int {i}) ; _}] 
+    -> 
+    if i < 0l then make_const ~lo:i ~hi:(-1l)
+    else make_const ~lo:i ~hi:0l
+  | _ -> int64_call  "of_int32" args
 
-    | Lvar _|Lconst _  -> lam
-    | Lapply {fn = l1; args =  ll;  loc; status } -> 
-      Lam.apply (simplif l1) (List.map simplif ll) loc status
-    | Lfunction {arity; kind; params; body =  l} -> 
-      Lam.function_ ~arity ~kind ~params ~body:(simplif l)
-    | Llet (kind, v, l1, l2) -> 
-      Lam.let_ kind v (simplif l1) (simplif l2)
-    | Lletrec (bindings, body) ->
-      Lam.letrec
-        ( List.map (fun (v, l) -> (v, simplif l)) bindings) 
-        (simplif body)
-    | Lprim {primitive; args; loc} -> 
-      let args = List.map simplif args in
-      Lam.prim ~primitive ~args loc
-    | Lswitch(l, sw) ->
-      let new_l = simplif l
-      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
-      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
-      and new_fail = Misc.may_map simplif sw.sw_failaction in
-      Lam.switch
-        new_l
-         { 
-           sw with 
-           sw_consts = new_consts ;
-           sw_blocks = new_blocks; 
-           sw_failaction = new_fail}
-    | Lstringswitch(l,sw,d) ->
-      Lam.stringswitch
-        (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
-         (Misc.may_map simplif d)
-    | Ltrywith (l1, v, l2) -> 
-      Lam.try_ (simplif l1) v (simplif l2)
-    | Lifthenelse (l1, l2, l3) -> 
-      Lam.if_ (simplif l1) (simplif l2) (simplif l3)
-    | Lsequence (l1, l2) -> Lam.seq (simplif l1) (simplif l2)
-    | Lwhile (l1, l2) -> Lam.while_ (simplif l1) (simplif l2)
-    | Lfor (v, l1, l2, dir, l3) ->
-      Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
-    | Lassign (v, l) -> 
-      Lam.assign v (simplif l)
-    | Lsend (k, m, o, ll, loc) ->
-      Lam.send k (simplif m) (simplif o) (List.map simplif ll) loc
-    | Lifused (v, l) -> 
-      Lam.ifused v (simplif l)
-  in 
-  simplif lam 
- 
-let simplify_exits (lam : Lam.t) =
-  let exits = count_helper lam in
-  subst_helper (Int_hashtbl.create 17 ) (count_exit exits) lam
+let comp (cmp : Lambda.comparison) args = 
+  E.runtime_call  Js_config.int64
+    (match cmp with 
+     | Ceq -> "eq"
+     | Cneq -> "neq"
+     | Clt -> "lt"
+     | Cgt -> "gt"
+     | Cle -> "le"
+     | Cge -> "ge") args 
 
-(* Compile-time beta-reduction of functions immediately applied:
-      Lapply(Lfunction(Curried, params, body), args, loc) ->
-        let paramN = argN in ... let param1 = arg1 in body
-      Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) ->
-        let paramN = argN in ... let param1 = arg1 in body
-   Assumes |args| = |params|.
-*)
+let neg args = 
+  int64_call "neg" args
 
-end
-module Lam_pass_lets_dce : sig 
-#1 "lam_pass_lets_dce.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-(* Adapted for Javascript backend: Hongbo Zhang                        *)
+let add args = 
+  int64_call "add" args 
 
-(**
-   This pass would do beta reduction, and dead code elimination (adapted from compiler's built-in [Simplif] module )
+let sub args = 
+  int64_call "sub" args
 
-   1. beta reduction -> Llet (Strict )
-  
-   2. The global table [occ] associates to each let-bound identifier
-   the number of its uses (as a reference):
-     - 0 if never used
-     - 1 if used exactly once in and *not under a lambda or within a loop
-     - > 1 if used several times or under a lambda or within a loop.
+let mul args =  
+  int64_call "mul" args
 
-   The local table [bv] associates to each locally-let-bound variable
-   its reference count, as above.  [bv] is enriched at let bindings
-   but emptied when crossing lambdas and loops. 
+let div args =
+  int64_call "div" args
 
-   For this pass, when it' used under a lambda or within a loop, we don't do anything,
-   in theory, we can still do something if it's pure but we are conservative here.
+let bit_op  op args = 
+  match args  with 
+  | [l;r] -> 
+    make ~lo:(op (get_lo l) (get_lo r))
+      ~hi:(op (get_hi l) (get_hi r))
+  | _ -> assert false
 
-   [bv] is used to help caculate [occ] it is not useful outside
+let xor  = bit_op E.int32_bxor 
+let or_ = bit_op E.int32_bor
+let and_ = bit_op E.int32_band
 
- *)
-val simplify_lets :  Lam.t -> Lam.t
 
-end = struct
-#1 "lam_pass_lets_dce.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-(* Adapted for Javascript backend : Hongbo Zhang,  *)
+let lsl_ args = 
+  int64_call "lsl_" args
 
+let lsr_ args = 
+  int64_call "lsr_" args
 
-open Asttypes
+let asr_ args = 
+  int64_call "asr_" args
 
-exception Real_reference
+let mod_ args = 
+  int64_call "mod_" args
 
-let rec eliminate_ref id (lam : Lam.t) = 
-  match lam with  (** we can do better escape analysis in Javascript backend *)
-  | Lvar v ->
-    if Ident.same v id then raise Real_reference else lam
-  | Lprim {primitive = Pfield (0,_); args =  [Lvar v]} when Ident.same v id ->
-    Lam.var id
-  | Lfunction{ kind; params; body} as lam ->
-    if Ident_set.mem id (Lam.free_variables  lam)
-    then raise Real_reference
-    else lam
-  (* In Javascript backend, its okay, we can reify it later
-     a failed case 
-     {[
-       for i = .. 
-           let v = ref 0 
-               for j = .. 
-                   incr v 
-                     a[j] = ()=>{!v}
 
-     ]}
-     here v is captured by a block, and it's a loop mutable value,
-     we have to generate 
-     {[
-       for i = .. 
-           let v = ref 0 
-               (function (v){for j = .. 
-                                   a[j] = ()=>{!v}}(v)
+let swap args = 
+  int64_call "swap" args
 
-     ]}
-     now, v is a real reference 
-     TODO: we can refine analysis in later
-  *)
-  (* Lfunction(kind, params, eliminate_ref id body) *)
-  | Lprim {primitive = Psetfield(0, _,_); 
-           args =  [Lvar v; e]} when Ident.same v id ->
-    Lam.assign id (eliminate_ref id e)
-  | Lprim {primitive = Poffsetref delta ; 
-           args =  [Lvar v]; loc } when Ident.same v id ->
-    Lam.assign id (Lam.prim ~primitive:(Poffsetint delta) ~args:[Lam.var id] loc)
-  | Lconst _  -> lam
-  | Lapply{fn = e1; args =  el;  loc; status} ->
-    Lam.apply 
-      (eliminate_ref id e1)
-      (List.map (eliminate_ref id) el)
-      loc status
-  | Llet(str, v, e1, e2) ->
-    Lam.let_ str v (eliminate_ref id e1) (eliminate_ref id e2)
-  | Lletrec(idel, e2) ->
-    Lam.letrec
-      (List.map (fun (v, e) -> (v, eliminate_ref id e)) idel)
-      (eliminate_ref id e2)
-  | Lprim {primitive ; args ; loc} ->
-    Lam.prim  ~primitive ~args:(List.map (eliminate_ref id) args) loc
-  | Lswitch(e, sw) ->
-    Lam.switch(eliminate_ref id e)
-            {sw_numconsts = sw.sw_numconsts;
-             sw_consts =
-               List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_consts;
-             sw_numblocks = sw.sw_numblocks;
-             sw_blocks =
-               List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
-             sw_failaction =
-               Misc.may_map (eliminate_ref id) sw.sw_failaction; }
-  | Lstringswitch(e, sw, default) ->
-    Lam.stringswitch
-      (eliminate_ref id e)
-      (List.map (fun (s, e) -> (s, eliminate_ref id e)) sw)
-      (Misc.may_map (eliminate_ref id) default)
-  | Lstaticraise (i,args) ->
-    Lam.staticraise i (List.map (eliminate_ref id) args)
-  | Lstaticcatch(e1, i, e2) ->
-    Lam.staticcatch (eliminate_ref id e1) i (eliminate_ref id e2)
-  | Ltrywith(e1, v, e2) ->
-    Lam.try_ (eliminate_ref id e1) v (eliminate_ref id e2)
-  | Lifthenelse(e1, e2, e3) ->
-    Lam.if_ (eliminate_ref id e1) (eliminate_ref id e2) (eliminate_ref id e3)
-  | Lsequence(e1, e2) ->
-    Lam.seq (eliminate_ref id e1) (eliminate_ref id e2)
-  | Lwhile(e1, e2) ->
-    Lam.while_ (eliminate_ref id e1) (eliminate_ref id e2)
-  | Lfor(v, e1, e2, dir, e3) ->
-    Lam.for_ v
-      (eliminate_ref id e1) 
-      (eliminate_ref id e2)
-      dir
-      (eliminate_ref id e3)
-  | Lassign(v, e) ->
-    Lam.assign v (eliminate_ref id e)
-  | Lsend(k, m, o, el, loc) ->
-    Lam.send k 
-      (eliminate_ref id m) (eliminate_ref id o)
-      (List.map (eliminate_ref id) el) loc
-  | Lifused(v, e) ->
-    Lam.ifused v (eliminate_ref id e)
+(* Safe constant propgation 
+   {[
+     Number.MAX_SAFE_INTEGER:
+       Math.pow(2,53) - 1
+   ]}
+   {[
+     Number.MIN_SAFE_INTEGER:
+       - (Math.pow(2,53) -1)
+   ]}
+   Note that [Number._SAFE_INTEGER] is in ES6, 
+   we can hard code this number without bringing browser issue.
+*)
+let of_float (args : J.expression list ) = 
+  int64_call "of_float" args
 
-(*A naive dead code elimination *)
-type used_info = { 
-  mutable times : int ; 
-  mutable captured : bool;
-    (* captured in functon or loop, 
-       inline in such cases should be careful
-       1. can not inline mutable values
-       2. avoid re-computation 
-    *)
-}
+let compare (args : J.expression list) = 
+  int64_call "compare" args 
 
-type occ_tbl  = used_info Ident_hashtbl.t
-(* First pass: count the occurrences of all let-bound identifiers *)
+let of_string (args : J.expression list) = 
+  int64_call "of_string" args 
+let discard_sign (args : J.expression list) =
+  int64_call "discard_sign" args
+let div_mod (args : J.expression list) =
+  int64_call "div_mod" args
+let to_hex (args : J.expression list) =
+  int64_call "to_hex"  args
+let get64 = int64_call "get64"
+let float_of_bits  =  int64_call "float_of_bits" 
+let bits_of_float = int64_call "bits_of_float"
+let to_float (args : J.expression list ) = 
+  match args with
+  (* | [ {expression_desc  *)
+  (*      = Caml_block (  *)
+  (*          [lo =  *)
+  (*           {expression_desc = Number (Int {i = lo; _}) }; *)
+  (*           hi =  *)
+  (*           {expression_desc = Number (Int {i = hi; _}) }; *)
+  (*          ], _, _, _); _ }]  *)
+  (*   ->  *)
+    
+  | [ _ ] -> 
+      int64_call "to_float" args
+  | _ -> 
+    assert false    
 
-type local_tbl = used_info  Ident_map.t
+end
+module Js_of_lam_block : sig 
+#1 "js_of_lam_block.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let dummy_info () = {times =  0 ; captured = false }
-(* y is untouched *)
 
-let absorb_info (x : used_info) (y : used_info) = 
-  match x, y with
-  | {times = x0} , {times = y0; captured } -> 
-    x.times <- x0 + y0;
-    if captured then x.captured <- true
 
-let lets_helper (count_var : Ident.t -> used_info) lam = 
-  let subst : Lam.t Ident_hashtbl.t = Ident_hashtbl.create 31 in
-  let used v = (count_var v ).times > 0 in
-  let rec simplif (lam : Lam.t) = 
-    match lam with 
-    | Lvar v  -> Ident_hashtbl.find_default subst v lam 
-    | Llet( (Strict | Alias | StrictOpt) , v, Lvar w, l2) 
-      ->
-      Ident_hashtbl.add subst v (simplif (Lam.var w));
-      simplif l2
-    | Llet((Strict | StrictOpt as kind) ,
-           v, (Lprim {primitive = (Pmakeblock(0, tag_info, Mutable) 
-                                   as primitive); 
-                      args = [linit] ; loc}), lbody)
-      ->
-      let slinit = simplif linit in
-      let slbody = simplif lbody in
-      begin 
-        try (** TODO: record all references variables *)
-          Lam_util.refine_let
-            ~kind:Variable v slinit (eliminate_ref v slbody)
-        with Real_reference ->
-          Lam_util.refine_let 
-            ~kind v (Lam.prim ~primitive ~args:[slinit] loc)
-            slbody
-      end
-    | Llet(Alias, v, l1, l2) ->
-      (** For alias, [l1] is pure, we can always inline,
-          when captured, we should avoid recomputation
-      *)
-      begin 
-        match count_var v, l1  with
-        | {times = 0; _}, _  -> simplif l2 
-        | {times = 1; captured = false }, _ 
-        | {times = 1; captured = true }, (Lconst _ | Lvar _)
-        |  _, (Lconst 
-                 (Const_base (
-                     Const_int _ | Const_char _ | Const_float _ | Const_int32 _ 
-                     | Const_nativeint _ )
-                 | Const_pointer _ ) (* could be poly-variant [`A] -> [65a]*)
-              | Lprim {primitive = Pfield (_);
-                       args = [Lprim {primitive = Pgetglobal _;  _}]}
-            ) 
-          (* Const_int64 is no longer primitive
-             Note for some constant which is not 
-             inlined, we can still record it and
-             do constant folding independently              
-          *)
-          ->
-          Ident_hashtbl.add subst v (simplif l1); simplif l2
-        | _ -> Lam.let_ Alias v (simplif l1) (simplif l2)
-      end
-    | Llet(StrictOpt as kind, v, l1, l2) ->
-      (** can not be inlined since [l1] depend on the store
-          {[
-            let v = [|1;2;3|]
-          ]}
-          get [StrictOpt] here,  we can not inline v, 
-          since the value of [v] can be changed
-      *)
-      if not @@ used v 
-      then simplif l2
-      else Lam_util.refine_let ~kind v (simplif l1 ) (simplif l2)
-    (* TODO: check if it is correct rollback to [StrictOpt]? *)
 
-    | Llet((Strict | Variable as kind), v, l1, l2) -> 
-      if not @@ used v 
-      then
-        let l1 = simplif l1 in
-        let l2 = simplif l2 in
-        if Lam_analysis.no_side_effects l1 
-        then l2 
-        else Lam.seq l1 l2
-      else Lam_util.refine_let ~kind v (simplif l1) (simplif l2)
 
-    | Lifused(v, l) ->
-      if used  v then
-        simplif l
-      else Lam.unit
-    | Lsequence(Lifused(v, l1), l2) ->
-      if used v 
-      then Lam.seq (simplif l1) (simplif l2)
-      else simplif l2
-    | Lsequence(l1, l2) -> Lam.seq (simplif l1) (simplif l2)
 
-    | Lapply{fn = Lfunction{kind =  Curried; params; body};  args; _}
-      when  Ext_list.same_length params args ->
-      simplif (Lam_beta_reduce.beta_reduce  params body args)
-    | Lapply{ fn = Lfunction{kind = Tupled; params; body};
-             args = [Lprim {primitive = Pmakeblock _;  args; _}]; _}
-      (** TODO: keep track of this parameter in ocaml trunk,
-          can we switch to the tupled backend?
-      *)
-      when  Ext_list.same_length params  args ->
-      simplif (Lam_beta_reduce.beta_reduce params body args)
 
-    | Lapply{fn = l1;args =  ll; loc; status} -> 
-      Lam.apply (simplif l1) (List.map simplif ll) loc status
-    | Lfunction{arity; kind; params; body = l} ->
-      Lam.function_ ~arity ~kind ~params ~body:(simplif l)
-    | Lconst _ -> lam
-    | Lletrec(bindings, body) ->
-      Lam.letrec 
-        (List.map (fun (v, l) -> (v, simplif l)) bindings) 
-        (simplif body)
-    | Lprim {primitive; args; loc} 
-      -> Lam.prim ~primitive ~args:(List.map simplif args) loc
-    | Lswitch(l, sw) ->
-      let new_l = simplif l
-      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
-      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
-      and new_fail = Misc.may_map simplif sw.sw_failaction in
-      Lam.switch
-        new_l
-        {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
-                 sw_failaction = new_fail}
-    | Lstringswitch (l,sw,d) ->
-      Lam.stringswitch
-        (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
-         (Misc.may_map simplif d)
-    | Lstaticraise (i,ls) ->
-      Lam.staticraise i (List.map simplif ls)
-    | Lstaticcatch(l1, (i,args), l2) ->
-      Lam.staticcatch (simplif l1) (i,args) (simplif l2)
-    | Ltrywith(l1, v, l2) -> Lam.try_ (simplif l1) v (simplif l2)
-    | Lifthenelse(l1, l2, l3) -> 
-      Lam.if_ (simplif l1) (simplif l2) (simplif l3)
-    | Lwhile(l1, l2) 
-      -> 
-      Lam.while_ (simplif l1) (simplif l2)
-    | Lfor(v, l1, l2, dir, l3) ->
-      Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
-    | Lassign(v, l) -> Lam.assign v (simplif l)
-    | Lsend(k, m, o, ll, loc) ->
-      Lam.send k (simplif m) (simplif o) (List.map simplif ll) loc
-  in simplif lam ;;
 
+(** Utilities for creating block of lambda expression in JS IR *)
 
-(* To transform let-bound references into variables *)
-let apply_lets  occ lambda = 
-  let count_var v =
-    match
-      Ident_hashtbl.find_opt occ v 
-    with
-    | None -> dummy_info ()
-    | Some  v -> v in
-  lets_helper count_var lambda      
+val make_block : 
+  Js_op.mutable_flag -> Lambda.tag_info ->
+  J.expression -> J.expression list -> J.expression
 
-let collect_occurs  lam : occ_tbl =
-  let occ : occ_tbl = Ident_hashtbl.create 83 in
-  (* The global table [occ] associates to each let-bound identifier
-     the number of its uses (as a reference):
-     - 0 if never used
-     - 1 if used exactly once in and not under a lambda or within a loop
-         - when under a lambda, 
-         - it's probably a closure
-         - within a loop
-         - update reference,
-         niether is good for inlining
-     - > 1 if used several times or under a lambda or within a loop.
-     The local table [bv] associates to each locally-let-bound variable
-     its reference count, as above.  [bv] is enriched at let bindings
-     but emptied when crossing lambdas and loops. *)
+val field : Lambda.field_dbg_info -> J.expression -> J.jsint -> J.expression
+
+val set_field : 
+  Lambda.set_field_dbg_info -> 
+  J.expression -> J.jsint -> J.expression -> J.expression
+
+
+end = struct
+#1 "js_of_lam_block.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  (* Current use count of a variable. *)
-  let used v = 
-    match Ident_hashtbl.find_opt occ v with 
-    | None -> false 
-    | Some {times ; _} -> times > 0  in
 
-  (* Entering a [let].  Returns updated [bv]. *)
-  let bind_var bv ident =
-    let r = dummy_info () in
-    Ident_hashtbl.add occ ident r;
-    Ident_map.add ident r bv in
 
-  (* Record a use of a variable *)
-  let add_one_use bv ident  =
-    match Ident_map.find_opt ident bv with 
-    | Some r  -> r.times <- r.times + 1 
-    | None ->
-      (* ident is not locally bound, therefore this is a use under a lambda
-         or within a loop.  Increase use count by 2 -- enough so
-         that single-use optimizations will not apply. *)
-      match Ident_hashtbl.find_opt occ ident with 
-      | Some r -> absorb_info r {times = 1; captured =  true}
-      | None ->
-        (* Not a let-bound variable, ignore *)
-        () in
 
-  let inherit_use bv ident bid =
-    let n =
-      match Ident_hashtbl.find_opt occ bid with
-      | None -> dummy_info ()
-      | Some v -> v in
-    match Ident_map.find_opt ident bv with 
-    | Some r  -> absorb_info r n
-    | None ->
-      (* ident is not locally bound, therefore this is a use under a lambda
-         or within a loop.  Increase use count by 2 -- enough so
-         that single-use optimizations will not apply. *)
-      match Ident_hashtbl.find_opt occ ident with 
-      | Some r -> absorb_info r {n with captured = true} 
-      | None ->
-        (* Not a let-bound variable, ignore *)
-        () in
 
-  let rec count (bv : local_tbl) (lam : Lam.t) = 
-    match lam with 
-    | Lfunction{body = l} ->
-      count Ident_map.empty l
-    (** when entering a function local [bv] 
-        is cleaned up, so that all closure variables will not be
-        carried over, since the parameters are never rebound, 
-        so it is fine to kep it empty
-    *)
-    | Lvar v ->
-      add_one_use bv v 
-    | Llet(_, v, Lvar w, l2)  ->
-      (* v will be replaced by w in l2, so each occurrence of v in l2
-         increases w's refcount *)
-      count (bind_var bv v) l2;
-      inherit_use bv w v 
-    (* | Lprim(Pmakeblock _, ll)  *)
-    (*     ->  *)
-    (*       List.iter (fun x -> count bv x ; count bv x) ll *)
-    (* | Llet(kind, v, (Lprim(Pmakeblock _, _) as l1),l2) -> *)
-    (*     count (bind_var bv v) l2; *)
-    (*     (\* If v is unused, l1 will be removed, so don't count its variables *\) *)
-    (*     if kind = Strict || count_var v > 0 then *)
-    (*       count bv l1; count bv l1 *)
 
-    | Llet(kind, v, l1, l2) ->
-      count (bind_var bv v) l2;
-      (* If v is unused, l1 will be removed, so don't count its variables *)
-      if kind = Strict || used v then count bv l1
 
-    | Lprim {args; _} -> List.iter (count bv ) args
 
-    | Lletrec(bindings, body) ->
-      List.iter (fun (v, l) -> count bv l) bindings;
-      count bv body
-    | Lapply{fn = Lfunction{kind= Curried; params; body};  args; _}
-      when  Ext_list.same_length params args ->
-      count bv (Lam_beta_reduce.beta_reduce  params body args)
-    | Lapply{fn = Lfunction{kind = Tupled; params; body};
-             args = [Lprim {primitive = Pmakeblock _;  args; _}]; _}
-      when  Ext_list.same_length params  args ->
-      count bv (Lam_beta_reduce.beta_reduce   params body args)
-    | Lapply{fn = l1; args= ll; _} ->
-      count bv l1; List.iter (count bv) ll
-    | Lassign(_, l) ->
-      (* Lalias-bound variables are never assigned, so don't increase
-         this ident's refcount *)
-      count bv l
-    | Lconst cst -> ()
-    | Lswitch(l, sw) ->
-      count_default bv sw ;
-      count bv l;
-      List.iter (fun (_, l) -> count bv l) sw.sw_consts;
-      List.iter (fun (_, l) -> count bv l) sw.sw_blocks
-    | Lstringswitch(l, sw, d) ->
-      count bv l ;
-      List.iter (fun (_, l) -> count bv l) sw ;
-      begin 
-        match d with
-        | Some d -> count bv d 
-        (* begin match sw with *)
-        (* | []|[_] -> count bv d *)
-        (* | _ -> count bv d ; count bv d *)
-        (* end *)
-        | None -> ()
-      end
-    | Lstaticraise (i,ls) -> List.iter (count bv) ls
-    | Lstaticcatch(l1, (i,_), l2) -> count bv l1; count bv l2
-    | Ltrywith(l1, v, l2) -> count bv l1; count bv l2
-    | Lifthenelse(l1, l2, l3) -> count bv l1; count bv l2; count bv l3
-    | Lsequence(l1, l2) -> count bv l1; count bv l2
-    | Lwhile(l1, l2) -> count Ident_map.empty l1; count Ident_map.empty l2
-    | Lfor(_, l1, l2, dir, l3) -> 
-      count bv l1;
-      count bv l2; 
-      count Ident_map.empty l3
-    | Lsend(_, m, o, ll, _) -> List.iter (count bv) (m::o::ll)
-    | Lifused(v, l) ->
-      if used v then count bv l
+module E = Js_exp_make
+
+(* TODO: it would be even better, if the [tag_info] contains more information
+   about immutablility
+ *)
+let make_block mutable_flag (tag_info : Lambda.tag_info) tag args  = 
+
+  match mutable_flag, tag_info with
+  | _, Blk_array -> Js_of_lam_array.make_array mutable_flag  Pgenarray args
+  | _ , _ -> E.make_block tag tag_info args mutable_flag
+  (* | _, (  Tuple | Variant _ ) -> (\** TODO: check with inline record *\) *)
+  (*     E.arr Immutable *)
+  (*       (E.small_int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
+  (*        :: args) *)
+  (* | _, _  ->  *)
+  (*     E.arr mutable_flag *)
+  (*       (E.int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
+  (*        :: args) *)
+
+let field field_info e i =
+  match field_info with 
+  | Lambda.Fld_na -> 
+    E.index e i 
+  | Lambda.Fld_record s 
+  | Lambda.Fld_module s 
+    -> E.index ~comment:s e i
+
+
+
+let set_field field_info e i e0 =
+  let comment = 
+    match field_info with 
+    | Lambda.Fld_set_na 
+      -> None
+    | Fld_record_set s -> Some (s)
+  in (* see GPR#631*)
+  E.index_addr ?comment e i  ~no:e0 ~yes:(fun v -> E.assign v e0)
+
+
+
 
-  and count_default bv sw = 
-    match sw.sw_failaction with
-    | None -> ()
-    | Some al ->
-      let nconsts = List.length sw.sw_consts
-      and nblocks = List.length sw.sw_blocks in
-      if nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
-      then 
-        begin (* default action will occur twice in native code *)
-          count bv al ; count bv al
-        end 
-      else 
-        begin (* default action will occur once *)
-          assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
-          count bv al
-        end
-  in
-  count Ident_map.empty  lam;
-  occ
 
-let simplify_lets  (lam : Lam.t) = 
-  let occ =  collect_occurs  lam in 
-  apply_lets  occ   lam
 
 end
-module Lam_inline_util : sig 
-#1 "lam_inline_util.mli"
+module Js_of_lam_string : sig 
+#1 "js_of_lam_string.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -86953,14 +85952,30 @@ module Lam_inline_util : sig
 
 
 
-(** Utilities for lambda inlining *)
+(** Utilities to wrap [string] and [bytes] compilation, 
 
-val maybe_functor : string -> bool
+   this is isolated, so that we can swap different representation in the future.
+   [string] is Immutable, so there is not [set_string] method
+*)
 
-val should_be_functor : string -> Lam.t -> bool 
+val ref_string : J.expression -> J.expression -> J.expression
+
+val ref_byte : J.expression -> J.expression -> J.expression
+
+val set_byte : J.expression -> J.expression -> J.expression -> J.expression 
+
+val caml_char_of_int : ?comment:string -> J.expression -> J.expression
+
+val caml_char_to_int : ?comment:string -> J.expression -> J.expression
+
+val const_char : char -> J.expression
+
+val bytes_to_string : J.expression -> J.expression
+
+val bytes_of_string : J.expression -> J.expression
 
 end = struct
-#1 "lam_inline_util.ml"
+#1 "js_of_lam_string.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -86991,25 +86006,119 @@ end = struct
 
 
 
-(* TODO: add a context, like 
-    [args]
-    [Lfunction(params,body)]
+
+
+module E = Js_exp_make
+
+module A = struct 
+
+  let const_char (i : char) = 
+    E.str (String.make 1 i)
+
+  let caml_char_of_int ?comment (v : J.expression)  =  
+    E.char_of_int ?comment v
+
+  let caml_char_to_int ?comment v =  
+    E.char_to_int ?comment v
+
+  (* string [s[i]] expects to return a [ocaml_char] *)
+  let ref_string e e1 = 
+    E.string_access e e1
+
+  (* [s[i]] excepts to return a [ocaml_char]
+     We use normal array for [bytes]
+     TODO: we can use [Buffer] in the future 
+   *)
+  let ref_byte e e0  =
+    E.char_of_int (E.access  e  e0)
+
+  (* {Bytes.set : bytes -> int -> char -> unit }*)
+  let set_byte  e e0 e1 = 
+    E.assign (E.access e e0)  (E.char_to_int e1)
+
+(*
+   Note that [String.fromCharCode] also works, but it only 
+   work for small arrays, however, for {bytes_to_string} it is likely the bytes 
+   will become big
+   {[
+   String.fromCharCode.apply(null,[87,97])
+   "Wa"
+   String.fromCharCode(87,97)
+   "Wa" 
+   ]}
+   This does not work for large arrays
+   {[
+   String.fromCharCode.apply(null, prim = Array[1048576]) 
+   Maxiume call stack size exceeded
+   ]}
  *)
 
+  let bytes_to_string e = 
+    E.runtime_call Js_config.string "bytes_to_string" [e]
 
-let maybe_functor (name : string) = 
-  name.[0] >= 'A' && name.[0] <= 'Z'
+  let bytes_of_string s =
+    E.runtime_call Js_config.string "bytes_of_string" [s]
+end
+
+(* We use module B for string compilation, once the upstream can make changes to the 
+    patten match of range patterns, we can use module [A] which means [char] is [string] in js, 
+    currently, it follows the same patten of ocaml, [char] is [int]
+ *)
 
+module B = struct 
 
-let should_be_functor (name : string) (lam : Lam.t) = 
-  maybe_functor name  &&
-  (match lam with Lfunction _ -> true | _ -> false)
+  let const_char (i : char) = 
+    E.int  ~comment:("\"" ^ Ext_string.escaped (String.make 1 i) ^ "\"") 
+      ~c:i (Int32.of_int @@ Char.code i)
+
+  let caml_char_of_int ?comment (v : J.expression)  =  v
+
+  let caml_char_to_int ?comment v =  v
+
+  (* string [s[i]] expects to return a [ocaml_char] *)
+  let ref_string e e1 = 
+    E.char_to_int (E.string_access e e1)
+
+  (* [s[i]] excepts to return a [ocaml_char]
+     We use normal array for [bytes]
+     TODO: we can use [Buffer] in the future 
+   *)
+  let ref_byte e e0  = E.access  e  e0
+
+  (* {Bytes.set : bytes -> int -> char -> unit }*)
+  let set_byte  e e0 e1 = 
+    E.assign (E.access e e0)  e1
+
+(**
+   Note that [String.fromCharCode] also works, but it only 
+   work for small arrays, however, for {bytes_to_string} it is likely the bytes 
+   will become big
+   {[
+   String.fromCharCode.apply(null,[87,97])
+   "Wa"
+   String.fromCharCode(87,97)
+   "Wa" 
+   ]}
+   This does not work for large arrays
+   {[
+   String.fromCharCode.apply(null, prim = Array[1048576]) 
+   Maxiume call stack size exceeded
+   ]}
+ *)
+
+  let bytes_to_string e = 
+    E.runtime_call Js_config.string "bytes_to_string" [e]
 
+  let bytes_of_string s =
+    E.runtime_call Js_config.string "bytes_of_string" [s]
+end
 
+(* include A *)
+include B
 
 end
-module Lam_pass_remove_alias : sig 
-#1 "lam_pass_remove_alias.mli"
+module Lam_compile_const : sig 
+#1 "lam_compile_const.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87041,26 +86150,109 @@ module Lam_pass_remove_alias : sig
 
 
 
-(** Keep track of the global module Aliases *) 
+(** Compile lambda constant to JS *)
 
-(**
-    One way:  guarantee that all global aliases *would be removed* ,
-    it will not be aliased 
-    
-    So the only remaining place for globals is either 
-    just  Pgetglobal in functor application or 
-    `Lprim (Pfield( i ), [Pgetglobal])`
+val translate : Lambda.structured_constant -> J.expression
 
-    This pass does not change meta  data
-*)
+end = struct
+#1 "lam_compile_const.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-val simplify_alias : 
-  Lam_stats.meta -> 
-  Lam.t ->
-  Lam.t
 
-end = struct
-#1 "lam_pass_remove_alias.ml"
+
+
+
+
+
+
+module E = Js_exp_make
+
+let rec translate (x : Lambda.structured_constant ) : J.expression = 
+  match x with 
+  | Const_base c -> 
+    begin match c with 
+      | Const_int i -> E.int (Int32.of_int i)
+      | Const_char i ->
+        Js_of_lam_string.const_char i
+      | Const_int32 i -> E.int i 
+          (* E.float (Int32.to_string i) *)
+      | Const_int64 i -> 
+          (*
+            TODO:
+            {[
+            Int64.to_string 0x7FFFFFFFFFFFFFFFL;;
+            - : string = "9223372036854775807"
+            ]}
+            {[
+            Int64.(to_float max_int);;
+            - : float = 9.22337203685477581e+18
+            ]}
+            Note we should compile it to Int64 as JS's 
+            speical representation -- 
+            it is not representatble in JS number
+           *)
+          (* E.float (Int64.to_string i) *)
+        Js_long.of_const i
+        (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
+      | Const_nativeint i -> E.nint i 
+      | Const_float f -> E.float f (* TODO: preserve float *)
+      | Const_string (i,_) (*TODO: here inline js*) -> 
+        E.str i
+    end
+
+  | Const_pointer (c,pointer_info) -> 
+    E.int ?comment:(Lam_compile_util.comment_of_pointer_info pointer_info)
+      (Int32.of_int c )
+
+  | Const_block(tag, tag_info, xs ) -> 
+    Js_of_lam_block.make_block NA tag_info 
+      (E.small_int  tag) (List.map translate xs)
+
+  | Const_float_array ars -> 
+    (* according to the compiler 
+        const_float_array is immutable 
+       {[ Lprim(Pccall prim_obj_dup, [master]) ]},
+        however, we can not translate 
+       {[ prim_obj_dup(x) =>  x' ]}
+        since x' is now mutable, prim_obj_dup does a copy,
+
+        the compiler does this  is mainly to extract common data into data section, 
+        we  deoptimized this in js backend? so it is actually mutable 
+    *)
+    (* TODO-- *)
+    Js_of_lam_array.make_array Mutable Pfloatarray 
+      (List.map (fun x ->  E.float  x ) ars)
+    (* E.arr Mutable ~comment:"float array" *)
+    (*   (List.map (fun x ->  E.float  x ) ars) *)
+
+  | Const_immstring s ->  (*TODO *)
+    E.str s  (* TODO: check *)
+
+end
+module Js_of_lam_exception : sig 
+#1 "js_of_lam_exception.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87090,263 +86282,97 @@ end = struct
 
 
 
+  
+val get_builtin_by_name : string -> J.expression
 
 
-let simplify_alias 
-    (meta : Lam_stats.meta)
-    (lam : Lam.t) 
-  :  Lam.t  = 
 
-  let rec simpl  (lam : Lam.t) : Lam.t = 
-    match lam with 
-    | Lvar v ->
-      begin match (Ident_hashtbl.find_opt meta.alias_tbl v) with
-      | None -> lam
-      | Some v -> Lam.var v
-      end
-      (* GLOBAL module needs to be propogated *)
-    | Llet(kind, k, (Lprim {primitive = Pgetglobal i; args = [] ; _} as g),
-           l ) -> 
-      (* This is detection of MODULE ALIAS 
-          we need track all global module aliases, when it's
-          passed as a parameter(escaped), we need do the expansion
-          since global module access is not the same as local module
-          TODO: 
-          since we aliased k, so it's safe to remove it?
-      *)
-      let v = simpl l in
-      if Ident_set.mem k meta.export_idents 
-      then 
-        Lam.let_ kind k g v
-        (* in this case it is preserved, but will still be simplified 
-            for the inner expression
-        *)
-      else v
-    | Lprim {primitive = Pfield (i,_); args =  [Lvar v]; _} -> 
-      (* ATTENTION: 
-         Main use case, we should detect inline all immutable block .. *)
-      Lam_util.get lam v  i meta.ident_tbl 
-    | Lifthenelse(Lvar id as l1, l2, l3) 
-      -> 
-      begin match Ident_hashtbl.find_opt meta.ident_tbl id with 
-      | Some (ImmutableBlock ( _, Normal))
-      | Some (MutableBlock _  )
-        -> simpl l2 
-      | Some (ImmutableBlock ( [| SimpleForm l |]  , x) )
-        -> 
-        let l1 = 
-          match x with 
-          | Null 
-            -> Lam.not_ (Location.none) ( Lam.prim ~primitive:Lam.Prim.js_is_nil ~args:[l] Location.none) 
-          | Undefined 
-            -> 
-            Lam.not_  Location.none (Lam.prim ~primitive:Lam.Prim.js_is_undef ~args:[l] Location.none)
-          | Null_undefined
-            -> 
-            Lam.not_ Location.none
-              ( Lam.prim ~primitive:Lam.Prim.js_is_nil_undef  ~args:[l] Location.none) 
-          | Normal ->  l1 
-        in 
-        Lam.if_ l1 (simpl l2) (simpl l3)
-      | Some _
-      | None -> Lam.if_ l1 (simpl l2) (simpl l3)
-      end
-    | Lifthenelse (l1, l2, l3) -> 
-        Lam.if_ (simpl  l1) (simpl  l2) (simpl  l3)
+val caml_set_oo_id : J.expression list -> J.expression
+
+end = struct
+#1 "js_of_lam_exception.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-    | Lconst _ -> lam
-    | Llet(str, v, l1, l2) ->
-      Lam.let_ str v (simpl l1) (simpl l2 )
-    | Lletrec(bindings, body) ->
-      let bindings = List.map (fun (k,l) ->  (k, simpl l) ) bindings in 
-      Lam.letrec bindings (simpl body) 
-    | Lprim {primitive; args; loc } 
-      -> Lam.prim ~primitive ~args:(List.map simpl  args) loc
 
-    (* complicated 
-        1. inline this function
-        2. ...
-        exports.Make=
-        function(funarg)
-      {var $$let=Make(funarg);
-        return [0, $$let[5],... $$let[16]]}
-    *)      
-    | Lapply{fn = 
-               Lprim {primitive = Pfield (index, _) ;
-                      args = [Lprim {primitive = Pgetglobal ident; args =  []}];
-                      _} as l1;
-             args; loc ; status} ->
-      begin
-        Lam_compile_env.find_and_add_if_not_exist (ident,index) meta.env
-          ~not_found:(fun _ -> assert false)
-          ~found:(fun i ->
-              match i with
-              | {closed_lambda=Some Lfunction{params; body; _} } 
-                (** be more cautious when do cross module inlining *)
-                when
-                  ( Ext_list.same_length params args &&
-                    List.for_all (fun (arg : Lam.t) ->
-                        match arg with 
-                        | Lvar p -> 
-                          begin 
-                            match Ident_hashtbl.find_opt meta.ident_tbl p with
-                            | Some v  -> v <> Parameter
-                            | None -> true 
-                          end
-                        |  _ -> true 
-                      ) args) -> 
-                simpl @@
-                Lam_beta_reduce.propogate_beta_reduce
-                  meta params body args
-              | _ -> 
-                Lam.apply (simpl l1) (List.map simpl args) loc status
-            )
 
-      end
-    (* Function inlining interact with other optimizations...
 
-        - parameter attributes
-        - scope issues 
-        - code bloat 
-    *)      
-    | Lapply{fn = (Lvar v as fn);  args; loc ; status} ->
-      (* Check info for always inlining *)
 
-      (* Ext_log.dwarn __LOC__ "%s/%d" v.name v.stamp;     *)
-      let normal () = Lam.apply ( simpl fn) (List.map simpl args) loc status in
-      begin 
-        match Ident_hashtbl.find_opt meta.ident_tbl v with
-        | Some (Function {lambda = Lfunction {params; body} as _m;
-                    rec_flag;                     
-                    _ })
-          -> 
-        
-          if Ext_list.same_length args params (* && false *)
-          then               
-            if Lam_inline_util.maybe_functor v.name  
-              (* && (Ident_set.mem v meta.export_idents) && false *)
-            then 
-              (* TODO: check l1 if it is exported, 
-                 if so, maybe not since in that case, 
-                 we are going to have two copy?
-              *)
 
-              (* Check: recursive applying may result in non-termination *)
-              begin
-                (* Ext_log.dwarn __LOC__ "beta .. %s/%d" v.name v.stamp ; *)
-                simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args) 
-              end
-            else 
-            if (* Lam_analysis.size body < Lam_analysis.small_inline_size *)
-              Lam_analysis.ok_to_inline ~body params args 
-            then 
+(** An pattern match on {!caml_set_oo_id args}
+    Note that in the trunk, it is immutable by default now 
+ *)
+module E = Js_exp_make 
 
-                (* let param_map =  *)
-                (*   Lam_analysis.free_variables meta.export_idents  *)
-                (*     (Lam_analysis.param_map_of_list params) body in *)
-                (* let old_count = List.length params in *)
-                (* let new_count = Ident_map.cardinal param_map in *)
-                let param_map = 
-                  Lam_closure.is_closed_with_map 
-                    meta.export_idents params body in
-                let is_export_id = Ident_set.mem v meta.export_idents in
-                match is_export_id, param_map with 
-                | false, (_, param_map)
-                | true, (true, param_map) -> 
-                  if rec_flag = Rec then               
-                    begin
-                      (* Ext_log.dwarn __LOC__ "beta rec.. %s/%d" v.name v.stamp ; *)
-                      (* Lam_beta_reduce.propogate_beta_reduce meta params body args *)
-                      Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args
-                    end
-                  else 
-                    begin
-                      (* Ext_log.dwarn __LOC__ "beta  nonrec..[%d] [%a]  %s/%d"  *)
-                      (*   (List.length args)  *)
-                      (*   Printlambda.lambda body                      *)
-                      (*   v.name v.stamp ; *)
-                      simpl (Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args)
+let match_exception_def (args : J.expression list) = 
+  match args with   
+  | [{ expression_desc  = 
+               Caml_block (
+                 [ exception_str; 
+                   {expression_desc = J.Number (Int { i = 0l; _}); _}
+                 ],
+                 mutable_flag, 
+                 {expression_desc = J.Number (Int {i = object_tag; _}); _}, _ );
+              _} ] -> 
+    if object_tag = 248l (* Obj.object_tag *) then
+      Some ( exception_str, mutable_flag)    
+    else
+      None
+  | _ -> None
 
-                    end
-                | _ -> normal ()
-              else 
-                normal ()
-          else
-            normal ()
-        | Some _
-        | None -> normal ()
+(* Sync up with [caml_set_oo_id] 
+   Note if we inline {!Caml_exceptions.create}, 
+   it seems can be useful for optimizations in theory, 
+   in practice, it never happen, since the pattern match 
+   never dig into it internally, so maybe {!Obj.set_tag} 
+   is not necessary at all
+*)
+let make_exception exception_str mutable_flag : J.expression = 
+  E.runtime_call Js_config.exceptions Literals.create [exception_str]
 
-      end
 
-    | Lapply{ fn = Lfunction{ kind = Curried ; params; body}; args; _}
-      when  Ext_list.same_length params args ->
-      simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
-    | Lapply{ fn = Lfunction{kind =  Tupled;  params; body}; 
-             args = [Lprim {primitive = Pmakeblock _; args; _}]; _}
-      (** TODO: keep track of this parameter in ocaml trunk,
-          can we switch to the tupled backend?
-      *)
-      when  Ext_list.same_length params args ->
-      simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
 
-    | Lapply {fn = l1; args =  ll;  loc ; status} ->
-      Lam.apply (simpl  l1) (List.map simpl  ll) loc status
-    | Lfunction {arity; kind; params; body = l}
-      -> Lam.function_ ~arity ~kind ~params  ~body:(simpl  l)
-    | Lswitch (l, {sw_failaction; 
-                   sw_consts; 
-                   sw_blocks;
-                   sw_numblocks;
-                   sw_numconsts;
-                  }) ->
-      Lam.switch (simpl  l)
-               {sw_consts = 
-                  List.map (fun (v, l) -> v, simpl  l) sw_consts;
-                sw_blocks = List.map (fun (v, l) -> v, simpl  l) sw_blocks;
-                sw_numconsts = sw_numconsts;
-                sw_numblocks = sw_numblocks;
-                sw_failaction = 
-                  begin 
-                    match sw_failaction with 
-                    | None -> None
-                    | Some x -> Some (simpl x)
-                  end}
-    | Lstringswitch(l, sw, d) ->
-      Lam.stringswitch (simpl  l )
-                    (List.map (fun (i, l) -> i,simpl  l) sw)
-                    (match d with
-                     | Some d -> Some (simpl d )
-                     | None -> None)
-    | Lstaticraise (i,ls) -> 
-      Lam.staticraise i (List.map simpl  ls)
-    | Lstaticcatch (l1, ids, l2) -> 
-      Lam.staticcatch (simpl  l1) ids (simpl  l2)
-    | Ltrywith (l1, v, l2) -> Lam.try_ (simpl  l1) v (simpl  l2)
 
-    | Lsequence (Lprim {primitive = Pgetglobal (id); args = []}, l2)
-      when Lam_compile_env.is_pure (Lam_module_ident.of_ml id) 
-      -> simpl l2
-    | Lsequence(l1, l2)
-      -> Lam.seq (simpl  l1) (simpl  l2)
-    | Lwhile(l1, l2)
-      -> Lam.while_ (simpl  l1) (simpl l2)
-    | Lfor(flag, l1, l2, dir, l3)
-      -> 
-      Lam.for_ flag (simpl  l1) (simpl  l2) dir (simpl  l3)
-    | Lassign(v, l) ->
-      (* Lalias-bound variables are never assigned, so don't increase
-         v's refsimpl *)
-      Lam.assign v (simpl  l)
-    | Lsend (u, m, o, ll, v) 
+let get_builtin_by_name name = 
+  E.runtime_ref Js_config.builtin_exceptions (String.lowercase name)
+
+let caml_set_oo_id args = 
+    begin match match_exception_def args with 
+    | Some ( exception_str, mutable_flag)
       -> 
-      Lam.send u (simpl m) (simpl o) (List.map simpl ll) v
-    | Lifused (v, l) -> Lam.ifused v (simpl  l)
-  in 
-  simpl lam
+      make_exception exception_str mutable_flag      
+    | _ ->
+      (**
+         If we can guarantee this code path is never hit, we can do 
+         a better job for encoding of exception and extension?
+      *)
+      E.runtime_call Js_config.exceptions "caml_set_oo_id" args 
+    end
 
 end
-module Ext_option : sig 
-#1 "ext_option.mli"
+module Js_of_lam_float_record : sig 
+#1 "js_of_lam_float_record.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87376,14 +86402,21 @@ module Ext_option : sig
 
 
 
+(** Compile a special representation in OCaml when all fields are of type [float] 
+    check the invariant in {!Js_of_lam_array.make_array}
+*)
 
+val set_double_field : 
+  Lambda.set_field_dbg_info -> 
+  J.expression -> J.jsint -> 
+  J.expression -> J.expression
 
-(** Utilities for [option] type *)
-
-val bind : 'a option -> ('a -> 'b) -> 'b option
+val get_double_feild : 
+  Lambda.field_dbg_info -> 
+  J.expression -> J.jsint -> J.expression
 
 end = struct
-#1 "ext_option.ml"
+#1 "js_of_lam_float_record.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87413,16 +86446,31 @@ end = struct
 
 
 
+module E = Js_exp_make 
+
+let get_double_feild field_info e i = 
+  match field_info with 
+  | Lambda.Fld_na -> 
+    E.index e i 
+  | Lambda.Fld_record s 
+  | Lambda.Fld_module s 
+    -> E.index ~comment:s e i
+
 
+let set_double_field field_info e  i e0 = 
+  let v = 
+    match field_info with 
+    | Lambda.Fld_set_na 
+      -> 
+      E.index e i 
+    | Fld_record_set s -> 
+      E.index ~comment:s e i in 
+  E.assign v  e0
 
-let bind v f = 
-  match v with 
-  | None -> None
-  | Some x -> Some (f x )
 
 end
-module Lam_stats_export : sig 
-#1 "lam_stats_export.mli"
+module Ast_literal : sig 
+#1 "ast_literal.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87448,19 +86496,40 @@ module Lam_stats_export : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+type 'a  lit = ?loc: Location.t -> unit -> 'a
+module Lid : sig
+  type t = Longident.t 
+  val val_unit : t 
+  val type_unit : t 
+  val js_fn : t 
+  val js_meth : t 
+  val js_meth_callback : t 
+  val js_obj : t 
+
+  val ignore_id : t 
+  val js_null : t 
+  val js_undefined : t
+  val js_null_undefined : t 
+  val js_re_id : t 
+  val js_unsafe : t 
+end
+
+type expression_lit = Parsetree.expression lit 
+type core_type_lit = Parsetree.core_type lit 
+type pattern_lit = Parsetree.pattern lit 
 
+val val_unit : expression_lit
 
+val type_unit : core_type_lit
 
+val type_string : core_type_lit
 
-val export_to_cmj : 
-  Lam_stats.meta ->
-  Js_cmj_format.effect ->
-  Lam_module_ident.t list ->
-  Lam.t Ident_map.t -> Js_cmj_format.t
+val type_any : core_type_lit
 
+val pat_unit : pattern_lit
 
 end = struct
-#1 "lam_stats_export.ml"
+#1 "ast_literal.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -87485,8493 +86554,9433 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+open Ast_helper
 
 
+module Lid = struct 
+  type t = Longident.t 
+  let val_unit : t = Lident "()"
+  let type_unit : t = Lident "unit"
+  let type_string : t = Lident "string"
+  (* TODO should be renamed in to {!Js.fn} *)
+  (* TODO should be moved into {!Js.t} Later *)
+  let js_fn = Longident.Ldot (Lident "Js", "fn")
+  let js_meth = Longident.Ldot (Lident "Js", "meth")
+  let js_meth_callback = Longident.Ldot (Lident "Js", "meth_callback")
+  let js_obj = Longident.Ldot (Lident "Js", "t") 
+  let ignore_id = Longident.Ldot (Lident "Pervasives", "ignore")
+  let js_null  = Longident.Ldot (Lident "Js", "null")
+  let js_undefined = Longident.Ldot (Lident "Js", "undefined")
+  let js_null_undefined = Longident.Ldot (Lident "Js", "null_undefined")
+  let js_re_id = Longident.Ldot (Lident "Js_re", "t")
+  let js_unsafe = Longident.Lident "Js_unsafe"
+end
 
+module No_loc = struct 
+  let loc = Location.none
+  let val_unit = 
+    Ast_helper.Exp.construct {txt = Lid.val_unit; loc }  None
+  let type_unit =   
+    Ast_helper.Typ.mk  (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
 
+  let type_string =   
+    Ast_helper.Typ.mk  (Ptyp_constr ({ txt = Lid.type_string; loc}, []))
 
-let pp = Format.fprintf 
-(* we should exclude meaninglist names and do the convert as well *)
+  let type_any = Ast_helper.Typ.any ()
+  let pat_unit = Pat.construct {txt = Lid.val_unit; loc} None
+end 
 
-let meaningless_names  = ["*opt*"; "param";]
+type 'a  lit = ?loc: Location.t -> unit -> 'a
+type expression_lit = Parsetree.expression lit 
+type core_type_lit = Parsetree.core_type lit 
+type pattern_lit = Parsetree.pattern lit 
 
-let rec dump_ident fmt (id : Ident.t) (arity : Lam.function_arities)  = 
-  pp fmt  "@[<2>export var %s:@ %a@ ;@]" (Ext_ident.convert true id.name ) dump_arity arity
+let val_unit ?loc () = 
+  match loc with 
+  | None -> No_loc.val_unit
+  | Some loc -> Ast_helper.Exp.construct {txt = Lid.val_unit; loc}  None
 
-and dump_arity fmt (arity : Lam.function_arities) = 
-  match arity with 
-  | NA -> pp fmt "any"
-  | Determin (_, [], _) -> pp fmt "any"
-  | Determin (_, (n,args)::xs, _) -> 
-    let args = match args with 
-    | Some args -> args 
-    | None -> Ext_list.init n (fun _ -> Ident.create "param") in
-    pp fmt "@[(%a)@ =>@ any@]" 
-      (Format.pp_print_list  
-         ~pp_sep:(fun fmt _ -> 
-             Format.pp_print_string fmt ",";
-             Format.pp_print_space fmt ();
-           )
-         (fun fmt ident -> pp fmt "@[%s@ :@ any@]" 
-             (Ext_ident.convert true  @@ Ident.name ident))
-      ) args 
 
+let type_unit ?loc () = 
+  match loc with
+  | None ->     
+    No_loc.type_unit
+  | Some loc -> 
+    Ast_helper.Typ.mk ~loc  (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
 
-(* Note that 
-   [lambda_exports] is 
-   lambda expression to be exported
-   for the js backend, we compile to js 
-   for the inliner, we try to seriaize it -- 
-   relies on other optimizations to make this happen
-   {[
-     exports.Make = function () {.....}
-   ]}
-   TODO: check that we don't do this in browser environment
-*)
-let export_to_cmj 
-    (meta : Lam_stats.meta ) 
-    maybe_pure
-    external_ids 
-    export_map
 
-  : Js_cmj_format.t = 
-  let values = 
+let type_string ?loc () = 
+  match loc with 
+  | None -> No_loc.type_string 
+  | Some loc ->     
+    Ast_helper.Typ.mk ~loc  (Ptyp_constr ({ txt = Lid.type_string; loc}, []))
 
-    List.fold_left
-      (fun   acc (x : Ident.t)  ->
-         let arity =  Lam_stats_util.get_arity meta (Lam.var x) in
-         match Ident_map.find_opt x export_map with 
-         | Some lambda  -> 
-           if Lam_analysis.safe_to_inline lambda
-           (* when inlning a non function, we have to be very careful,
-              only truly immutable values can be inlined
-           *)
-           then
-             let closed_lambda = 
-               if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *)
-               then
-                 if Lam_closure.is_closed lambda (* TODO: seriealize more*)
-                 then Some lambda
-                 else None
-               else 
-                 let lam_size = Lam_analysis.size lambda in
-                 (* TODO:
-                    1. global need re-assocate when do the beta reduction 
-                    2. [lambda_exports] is not precise
-                 *)
-                 let free_variables =
-                   Lam_closure.free_variables Ident_set.empty
-                   (* meta.export_idents *)  Ident_map.empty 
-                     lambda in
-                 if  lam_size < Lam_analysis.small_inline_size  && 
-                     Ident_map.is_empty free_variables
-                 then 
-                   begin
-                     Ext_log.dwarn __LOC__ "%s recorded for inlining @." x.name ;
-                     Some lambda
-                   end
-                 else 
-                   begin
-                     (* Ext_log.dwarn __LOC__ "%s : %d : {%s} not inlined @."  *)
-                     (*   x.name lam_size   *)
-                     (*   (String.concat ", " @@  *)
-                     (*    List.map (fun x -> x.Ident.name) @@ Ident_map.keys free_variables) ; *)
-                     None 
-                   end
-             in 
-             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda } acc 
-           else
-             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None } acc 
-         | None
-           -> String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None} acc  
-      )
-      String_map.empty
-      meta.exports 
+let type_any ?loc () = 
+  match loc with 
+  | None -> No_loc.type_any
+  | Some loc -> Ast_helper.Typ.any ~loc ()
+
+let pat_unit ?loc () = 
+  match loc with 
+  | None -> No_loc.pat_unit
+  | Some loc -> 
+    Pat.construct ~loc {txt = Lid.val_unit; loc} None
+
+end
+module Ast_comb : sig 
+#1 "ast_comb.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
+
+val exp_apply_no_label : 
+  ?loc:Location.t ->
+  ?attrs:Parsetree.attributes ->
+  Parsetree.expression -> Parsetree.expression list -> Parsetree.expression
+
+val fun_no_label : 
+  ?loc:Location.t ->
+  ?attrs:Parsetree.attributes ->
+  Parsetree.pattern -> Parsetree.expression -> Parsetree.expression
+
+val arrow_no_label : 
+  ?loc:Location.t ->
+  ?attrs:Parsetree.attributes ->
+  Parsetree.core_type -> Parsetree.core_type -> Parsetree.core_type
+
+(* note we first declare its type is [unit], 
+   then [ignore] it, [ignore] is necessary since 
+   the js value  maybe not be of type [unit] and 
+   we can use [unit] value (though very little chance) 
+   sometimes
+*)
+val discard_exp_as_unit : 
+  Location.t -> Parsetree.expression -> Parsetree.expression
 
 
-  in
+val tuple_type_pair : 
+  ?loc:Ast_helper.loc ->
+  [< `Make | `Run ] ->
+  int -> Parsetree.core_type * Parsetree.core_type list * Parsetree.core_type
 
-  let rec dump fmt ids = 
-    (* TODO: also use {[Ext_pp]} module instead *)
-    match ids with 
-    | [] -> ()
-    | x::xs -> 
-      dump_ident fmt x (Lam_stats_util.get_arity meta (Lam.var x)) ; 
-      Format.pp_print_space fmt ();
-      dump fmt xs in
+val to_js_type :
+  Location.t -> Parsetree.core_type -> Parsetree.core_type
 
-  let () =
-    if !Js_config.default_gen_tds && not ( Ext_string.is_empty meta.filename) then
-      Ext_pervasives.with_file_as_pp
-        (Ext_filename.chop_extension ~loc:__LOC__ meta.filename ^ ".d.ts")
-      @@ fun fmt ->
-        pp fmt "@[<v>%a@]@." dump meta.exports
-  in
-  let effect = 
-    match maybe_pure with
-    | None ->  
-      Ext_option.bind ( Ext_list.for_all_ret 
-                          (fun (id : Lam_module_ident.t) -> 
-                             Lam_compile_env.query_and_add_if_not_exist id 
-                               (Has_env meta.env )
-                               ~not_found:(fun _ -> false ) ~found:(fun i -> 
-                                   i.pure)
-                          ) external_ids) (fun x -> Lam_module_ident.name x)
-    | Some _ -> maybe_pure
 
-  in
-  {values; 
-   effect ; 
-   npm_package_path = Js_config.get_packages_info ();
-  }
+(** TODO: make it work for browser too *)
+val to_undefined_type :
+  Location.t -> Parsetree.core_type -> Parsetree.core_type  
 
+val to_js_re_type : Location.t -> Parsetree.core_type
 
-end
-module Printlambda : sig 
-#1 "printlambda.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+end = struct
+#1 "ast_comb.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-open Lambda
 
-open Format
+open Ast_helper 
 
-val structured_constant: formatter -> structured_constant -> unit
+let exp_apply_no_label ?loc ?attrs a b = 
+  Exp.apply ?loc ?attrs a (List.map (fun x -> "", x) b)
 
-val env_lambda : Env.t -> formatter -> lambda -> unit
-val lambda : formatter -> lambda -> unit
-val primitive: formatter -> primitive -> unit
+let fun_no_label ?loc ?attrs  pat body = 
+  Exp.fun_ ?loc ?attrs "" None pat body
 
-val lambda_as_module : Env.t  -> Format.formatter -> Lambda.lambda -> unit
+let arrow_no_label ?loc ?attrs b c = 
+  Typ.arrow ?loc ?attrs "" b c 
 
+let discard_exp_as_unit loc e = 
+  exp_apply_no_label ~loc     
+    (Exp.ident ~loc {txt = Ast_literal.Lid.ignore_id; loc})
+    [Exp.constraint_ ~loc e 
+       (Ast_literal.type_unit ~loc ())]
 
-val seriaize: Env.t -> string -> lambda -> unit
 
-val serialize_raw_js: 
-    (Env.t -> Types.signature ->  string  -> lambda  -> unit) ref
-val serialize_js: (Env.t -> string  -> lambda  -> unit) ref
+let tuple_type_pair ?loc kind arity = 
+  let prefix  = "a" in
+  if arity = 0 then 
+    let ty = Typ.var ?loc ( prefix ^ "0") in 
+    match kind with 
+    | `Run -> ty,  [], ty 
+    | `Make -> 
+      (Typ.arrow "" ?loc
+         (Ast_literal.type_unit ?loc ())
+         ty ,
+       [], ty)
+  else
+    let number = arity + 1 in
+    let tys = Ext_list.init number (fun i -> 
+        Typ.var ?loc (prefix ^ string_of_int (number - i - 1))
+      )  in
+    match tys with 
+    | result :: rest -> 
+      Ext_list.reduce_from_left (fun r arg -> Typ.arrow "" ?loc arg r) tys, 
+      List.rev rest , result
+    | [] -> assert false
+    
+    
 
-end = struct
-#1 "printlambda.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-[@@@ocaml.warning "-40"]
-open Format
-open Asttypes
-open Primitive
-open Types
-open Lambda
+let js_obj_type_id  = 
+  Ast_literal.Lid.js_obj 
 
+let re_id  = 
+  Ast_literal.Lid.js_re_id 
 
-let rec struct_const ppf = function
-  | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) -> fprintf ppf "%C" c
-  | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
-  | Const_immstring s -> fprintf ppf "#%S" s
-  | Const_base(Const_float f) -> fprintf ppf "%s" f
-  | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
-  | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
-  | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
-  | Const_pointer (n,_) -> fprintf ppf "%ia" n
-  | Const_block(tag,_, []) ->
-      fprintf ppf "[%i]" tag
-  | Const_block(tag,_, sc1::scl) ->
-      let sconsts ppf scl =
-        List.iter (fun sc -> fprintf ppf "@ %a" struct_const sc) scl in
-      fprintf ppf "@[<1>[%i:@ @[%a%a@]]@]" tag struct_const sc1 sconsts scl
-  | Const_float_array [] ->
-      fprintf ppf "[| |]"
-  | Const_float_array (f1 :: fl) ->
-      let floats ppf fl =
-        List.iter (fun f -> fprintf ppf "@ %s" f) fl in
-      fprintf ppf "@[<1>[|@[%s%a@]|]@]" f1 floats fl
+let to_js_type loc  x  = 
+  Typ.constr ~loc {txt = js_obj_type_id; loc} [x]
 
-let boxed_integer_name = function
-  | Pnativeint -> "nativeint"
-  | Pint32 -> "int32"
-  | Pint64 -> "int64"
+let to_js_re_type loc  =
+  Typ.constr ~loc { txt = re_id ; loc} []
+    
+let to_undefined_type loc x =
+  Typ.constr ~loc
+    {txt = Ast_literal.Lid.js_undefined ; loc}
+    [x]  
 
-let print_boxed_integer name ppf bi =
-  fprintf ppf "%s_%s" (boxed_integer_name bi) name
 
-let print_boxed_integer_conversion ppf bi1 bi2 =
-  fprintf ppf "%s_of_%s" (boxed_integer_name bi2) (boxed_integer_name bi1)
+end
+module Ast_core_type : sig 
+#1 "ast_core_type.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let boxed_integer_mark name = function
-  | Pnativeint -> Printf.sprintf "Nativeint.%s" name
-  | Pint32 -> Printf.sprintf "Int32.%s" name
-  | Pint64 -> Printf.sprintf "Int64.%s" name
+type t = Parsetree.core_type 
 
-let print_boxed_integer name ppf bi =
-  fprintf ppf "%s" (boxed_integer_mark name bi);;
 
-let print_bigarray name unsafe kind ppf layout =
-  fprintf ppf "Bigarray.%s[%s,%s]"
-    (if unsafe then "unsafe_"^ name else name)
-    (match kind with
-     | Pbigarray_unknown -> "generic"
-     | Pbigarray_float32 -> "float32"
-     | Pbigarray_float64 -> "float64"
-     | Pbigarray_sint8 -> "sint8"
-     | Pbigarray_uint8 -> "uint8"
-     | Pbigarray_sint16 -> "sint16"
-     | Pbigarray_uint16 -> "uint16"
-     | Pbigarray_int32 -> "int32"
-     | Pbigarray_int64 -> "int64"
-     | Pbigarray_caml_int -> "camlint"
-     | Pbigarray_native_int -> "nativeint"
-     | Pbigarray_complex32 -> "complex32"
-     | Pbigarray_complex64 -> "complex64")
-    (match layout with
-    |  Pbigarray_unknown_layout -> "unknown"
-     | Pbigarray_c_layout -> "C"
-     | Pbigarray_fortran_layout -> "Fortran")
 
-let record_rep ppf r =
-  match r with
-  | Record_regular -> fprintf ppf "regular"
-  | Record_float -> fprintf ppf "float"
-;;
+val replace_result : t -> t -> t
 
-let string_of_loc_kind = function
-  | Loc_FILE -> "loc_FILE"
-  | Loc_LINE -> "loc_LINE"
-  | Loc_MODULE -> "loc_MODULE"
-  | Loc_POS -> "loc_POS"
-  | Loc_LOC -> "loc_LOC"
+val is_unit : t -> bool 
+val is_array : t -> bool 
+type arg_label =
+  | Label of string 
+  | Optional of string 
+  | Empty
+type arg_type = 
+  | NullString of (int * string) list 
+  | NonNullString of (int * string) list 
+  | Int of (int * int ) list 
+  | Array 
+  | Unit
+  | Nothing
+  | Ignore
 
-let primitive ppf = function
-  | Pidentity -> fprintf ppf "id"
-  | Pbytes_to_string -> fprintf ppf "bytes_to_string"
-  | Pbytes_of_string -> fprintf ppf "bytes_of_string"
-  | Pignore -> fprintf ppf "ignore"
-  | Prevapply  -> fprintf ppf "revapply"
-  | Pdirapply  -> fprintf ppf "dirapply"
-  | Ploc kind -> fprintf ppf "%s" (string_of_loc_kind kind)
-  | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
-  | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
-  | Pmakeblock(tag, _, Immutable) -> fprintf ppf "makeblock %i" tag
-  | Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag
-  | Pfield (n,_) -> fprintf ppf "field %i" n
-  | Psetfield(n, ptr, _) ->
-      let instr = if ptr then "setfield_ptr " else "setfield_imm " in
-      fprintf ppf "%s%i" instr n
-  | Pfloatfield (n,_) -> fprintf ppf "floatfield %i" n
-  | Psetfloatfield (n,_) -> fprintf ppf "setfloatfield %i" n
-  | Pduprecord (rep, size) -> fprintf ppf "duprecord %a %i" record_rep rep size
-  | Plazyforce -> fprintf ppf "force"
-  | Pccall p -> fprintf ppf "%s" p.prim_name
-  | Praise k -> fprintf ppf "%s" (Lambda.raise_kind k)
-  | Psequand -> fprintf ppf "&&"
-  | Psequor -> fprintf ppf "||"
-  | Pnot -> fprintf ppf "not"
-  | Pnegint -> fprintf ppf "~"
-  | Paddint -> fprintf ppf "+"
-  | Psubint -> fprintf ppf "-"
-  | Pmulint -> fprintf ppf "*"
-  | Pdivint -> fprintf ppf "/"
-  | Pmodint -> fprintf ppf "mod"
-  | Pandint -> fprintf ppf "and"
-  | Porint -> fprintf ppf "or"
-  | Pxorint -> fprintf ppf "xor"
-  | Plslint -> fprintf ppf "lsl"
-  | Plsrint -> fprintf ppf "lsr"
-  | Pasrint -> fprintf ppf "asr"
-  | Pintcomp(Ceq) -> fprintf ppf "=="
-  | Pintcomp(Cneq) -> fprintf ppf "!="
-  | Pintcomp(Clt) -> fprintf ppf "<"
-  | Pintcomp(Cle) -> fprintf ppf "<="
-  | Pintcomp(Cgt) -> fprintf ppf ">"
-  | Pintcomp(Cge) -> fprintf ppf ">="
-  | Poffsetint n -> fprintf ppf "%i+" n
-  | Poffsetref n -> fprintf ppf "+:=%i"n
-  | Pintoffloat -> fprintf ppf "int_of_float"
-  | Pfloatofint -> fprintf ppf "float_of_int"
-  | Pnegfloat -> fprintf ppf "~."
-  | Pabsfloat -> fprintf ppf "abs."
-  | Paddfloat -> fprintf ppf "+."
-  | Psubfloat -> fprintf ppf "-."
-  | Pmulfloat -> fprintf ppf "*."
-  | Pdivfloat -> fprintf ppf "/."
-  | Pfloatcomp(Ceq) -> fprintf ppf "==."
-  | Pfloatcomp(Cneq) -> fprintf ppf "!=."
-  | Pfloatcomp(Clt) -> fprintf ppf "<."
-  | Pfloatcomp(Cle) -> fprintf ppf "<=."
-  | Pfloatcomp(Cgt) -> fprintf ppf ">."
-  | Pfloatcomp(Cge) -> fprintf ppf ">=."
-  | Pstringlength -> fprintf ppf "string.length"
-  | Pstringrefu -> fprintf ppf "string.unsafe_get"
-  | Pstringsetu -> fprintf ppf "string.unsafe_set"
-  | Pstringrefs -> fprintf ppf "string.get"
-  | Pstringsets -> fprintf ppf "string.set"
-  | Pbyteslength -> fprintf ppf "bytes.length"
-  | Pbytesrefu -> fprintf ppf "bytes.unsafe_get"
-  | Pbytessetu -> fprintf ppf "bytes.unsafe_set"
-  | Pbytesrefs -> fprintf ppf "bytes.get"
-  | Pbytessets -> fprintf ppf "bytes.set"
+(** for 
+       [x:t] -> "x"
+       [?x:t] -> "?x"
+*)
+val label_name : string -> arg_label
 
-  | Parraylength _ -> fprintf ppf "array.length"
-  | Pmakearray _ -> fprintf ppf "makearray "
-  | Parrayrefu _ -> fprintf ppf "array.unsafe_get"
-  | Parraysetu _ -> fprintf ppf "array.unsafe_set"
-  | Parrayrefs _ -> fprintf ppf "array.get"
-  | Parraysets _ -> fprintf ppf "array.set"
-  | Pctconst c ->
-     let const_name = match c with
-       | Big_endian -> "big_endian"
-       | Word_size -> "word_size"
-       | Ostype_unix -> "ostype_unix"
-       | Ostype_win32 -> "ostype_win32"
-       | Ostype_cygwin -> "ostype_cygwin" in
-     fprintf ppf "sys.constant_%s" const_name
-  | Pisint -> fprintf ppf "isint"
-  | Pisout -> fprintf ppf "isout"
-  | Pbittest -> fprintf ppf "testbit"
-  | Pbintofint bi -> print_boxed_integer "of_int" ppf bi
-  | Pintofbint bi -> print_boxed_integer "to_int" ppf bi
-  | Pcvtbint (bi1, bi2) -> print_boxed_integer_conversion ppf bi1 bi2
-  | Pnegbint bi -> print_boxed_integer "neg" ppf bi
-  | Paddbint bi -> print_boxed_integer "add" ppf bi
-  | Psubbint bi -> print_boxed_integer "sub" ppf bi
-  | Pmulbint bi -> print_boxed_integer "mul" ppf bi
-  | Pdivbint bi -> print_boxed_integer "div" ppf bi
-  | Pmodbint bi -> print_boxed_integer "mod" ppf bi
-  | Pandbint bi -> print_boxed_integer "and" ppf bi
-  | Porbint bi -> print_boxed_integer "or" ppf bi
-  | Pxorbint bi -> print_boxed_integer "xor" ppf bi
-  | Plslbint bi -> print_boxed_integer "lsl" ppf bi
-  | Plsrbint bi -> print_boxed_integer "lsr" ppf bi
-  | Pasrbint bi -> print_boxed_integer "asr" ppf bi
-  | Pbintcomp(bi, Ceq) -> print_boxed_integer "==" ppf bi
-  | Pbintcomp(bi, Cneq) -> print_boxed_integer "!=" ppf bi
-  | Pbintcomp(bi, Clt) -> print_boxed_integer "<" ppf bi
-  | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi
-  | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi
-  | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi
-  | Pbigarrayref(unsafe, n, kind, layout) ->
-      print_bigarray "get" unsafe kind ppf layout
-  | Pbigarrayset(unsafe, n, kind, layout) ->
-      print_bigarray "set" unsafe kind ppf layout
-  | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
-  | Pstring_load_16(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_get16"
-     else fprintf ppf "string.get16"
-  | Pstring_load_32(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_get32"
-     else fprintf ppf "string.get32"
-  | Pstring_load_64(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_get64"
-     else fprintf ppf "string.get64"
-  | Pstring_set_16(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_set16"
-     else fprintf ppf "string.set16"
-  | Pstring_set_32(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_set32"
-     else fprintf ppf "string.set32"
-  | Pstring_set_64(unsafe) ->
-     if unsafe then fprintf ppf "string.unsafe_set64"
-     else fprintf ppf "string.set64"
-  | Pbigstring_load_16(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_get16"
-     else fprintf ppf "bigarray.array1.get16"
-  | Pbigstring_load_32(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_get32"
-     else fprintf ppf "bigarray.array1.get32"
-  | Pbigstring_load_64(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_get64"
-     else fprintf ppf "bigarray.array1.get64"
-  | Pbigstring_set_16(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_set16"
-     else fprintf ppf "bigarray.array1.set16"
-  | Pbigstring_set_32(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_set32"
-     else fprintf ppf "bigarray.array1.set32"
-  | Pbigstring_set_64(unsafe) ->
-     if unsafe then fprintf ppf "bigarray.array1.unsafe_set64"
-     else fprintf ppf "bigarray.array1.set64"
-  | Pbswap16 -> fprintf ppf "bswap16"
-  | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
-  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
 
-type print_kind = 
-  | Alias 
-  | Strict 
-  | StrictOpt 
-  | Variable 
-  | Recursive 
 
-let kind = function
-  | Alias -> "a"
-  | Strict -> ""
-  | StrictOpt -> "o"
-  | Variable -> "v" 
-  | Recursive -> "r"
 
-let to_print_kind (k : Lambda.let_kind) : print_kind = 
-  match k with 
-  | Alias -> Alias 
-  | Strict -> Strict
-  | StrictOpt -> StrictOpt
-  | Variable -> Variable
-  
-let rec aux (acc : (print_kind * Ident.t * lambda ) list) lam = 
-  match lam with 
-  | Llet (str3, id3, arg3, body3) ->
-      aux ((to_print_kind str3,id3, arg3)::acc) body3
-  | Lletrec (bind_args, body) ->
-      aux 
-        (List.map (fun (id,l) -> (Recursive,id,l)) bind_args 
-         @ acc) body
-  | e ->  (acc , e) 
 
-type left_var = 
-    {
-     kind : print_kind ;
-     id : Ident.t
-   }
+(** return a function type 
+    [from_labels ~loc tyvars labels]
+    example output:
+    {[x:'a0 -> y:'a1 -> < x :'a0 ;y :'a1  > Js.t]}
+*)
+val from_labels :
+  loc:Location.t -> int ->  string Asttypes.loc list -> t
 
-type left = 
-  | Id of left_var
-  | Nop
+val make_obj :
+  loc:Location.t ->
+  (string * Parsetree.attributes * t) list ->
+  t
+
+end = struct
+#1 "ast_core_type.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
+type t = Parsetree.core_type 
+type arg_label =
+  | Label of string 
+  | Optional of string 
+  | Empty (* it will be ignored , side effect will be recorded *)
 
+type arg_type = 
+  | NullString of (int * string) list 
+  | NonNullString of (int * string) list 
+  | Int of (int * int ) list 
+  | Array 
+  | Unit
+  | Nothing
+  | Ignore
 
+open Ast_helper
 
-let  flatten lam : (print_kind * Ident.t * lambda ) list * lambda = 
-  match lam with 
-  | Llet(str,id, arg, body) ->
-      aux [to_print_kind str, id, arg] body
-  | Lletrec(bind_args, body) ->
-      aux 
-        (List.map (fun (id,l) -> (Recursive, id,l)) bind_args) 
-        body
-  | _ -> assert false
+let replace_result ty result = 
+  let rec aux (ty : Parsetree.core_type) = 
+    match ty with 
+    | { ptyp_desc = 
+          Ptyp_arrow (label,t1,t2)
+      } -> { ty with ptyp_desc = Ptyp_arrow(label,t1, aux t2)}
+    | {ptyp_desc = Ptyp_poly(fs,ty)} 
+      ->  {ty with ptyp_desc = Ptyp_poly(fs, aux ty)}
+    | _ -> result in 
+  aux ty 
 
-        
-let get_string ((id : Ident.t), (pos : int)) (env : Env.t) : string = 
-  match  Env.find_module (Pident id) env with 
-  | {md_type = Mty_signature signature  ; _ } -> 
-      (* Env.prefix_idents, could be cached  *)
-      let serializable_sigs = 
-        List.filter (fun x ->
-            match x with 
-            | Sig_typext _ 
-            | Sig_module _
-            | Sig_class _ -> true
-            | Sig_value(_, {val_kind = Val_prim _}) -> false
-            | Sig_value _ -> true
-            | _ -> false
-                    ) signature  in
-      (begin match List.nth  serializable_sigs  pos  with 
-      | Sig_value (i,_) 
-      | Sig_module (i,_,_) -> i 
-      | Sig_typext (i,_,_) -> i 
-      | Sig_modtype(i,_) -> i 
-      | Sig_class (i,_,_) -> i 
-      | Sig_class_type(i,_,_) -> i 
-      | Sig_type(i,_,_) -> i 
-      end).name
-  | _ -> assert false
+let is_unit (ty : t ) = 
+  match ty.ptyp_desc with 
+  | Ptyp_constr({txt =Lident "unit"}, []) -> true
+  | _ -> false 
 
+let is_array (ty : t) = 
+  match ty.ptyp_desc with 
+  | Ptyp_constr({txt =Lident "array"}, [_]) -> true
+  | _ -> false 
 
+let is_optional l =
+  String.length l > 0 && l.[0] = '?'
 
-let lambda use_env env ppf v  =
-  let rec lam ppf = function
-  | Lvar id ->
-      Ident.print ppf id
-  | Lconst cst ->
-      struct_const ppf cst
-  | Lapply(lfun, largs, _) ->
-      let lams ppf largs =
-        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      fprintf ppf "@[<2>(apply@ %a%a)@]" lam lfun lams largs
-  | Lfunction(kind, params, body) ->
-      let pr_params ppf params =
-        match kind with
-        | Curried ->
-            List.iter (fun param -> fprintf ppf "@ %a" Ident.print param) params
-        | Tupled ->
-            fprintf ppf " (";
-            let first = ref true in
-            List.iter
-              (fun param ->
-                if !first then first := false else fprintf ppf ",@ ";
-                Ident.print ppf param)
-              params;
-            fprintf ppf ")" in
-      fprintf ppf "@[<2>(function%a@ %a)@]" pr_params params lam body
-  | Llet _ | Lletrec _ as x ->
-      let args, body =   flatten x  in
-      let bindings ppf id_arg_list =
-        let spc = ref false in
-        List.iter
-          (fun (k, id, l) ->
-            if !spc then fprintf ppf "@ " else spc := true;
-            fprintf ppf "@[<2>%a =%s@ %a@]" Ident.print id (kind k) lam l)
-          id_arg_list in
-      fprintf ppf
-        "@[<2>(let@ (@[<hv 1>%a@]" bindings (List.rev args);
-      fprintf ppf ")@ %a)@]"  lam body
-  | Lprim(Pfield (n,_), [ Lprim(Pgetglobal id,[],_)],_) when use_env ->
-      fprintf ppf "%s.%s/%d" id.name (get_string (id,n) env) n
+let label_name l : arg_label =
+  if l = "" then Empty else 
+  if is_optional l 
+  then Optional (String.sub l 1 (String.length l - 1))
+  else Label l
 
-  | Lprim(Psetfield (n,_,_), [ Lprim(Pgetglobal id,[],_) ;  e ], _) when use_env  ->
-      fprintf ppf "@[<2>(%s.%s/%d <- %a)@]" id.name (get_string (id,n) env) n
-        lam e
-  | Lprim(prim, largs,_) ->
-      let lams ppf largs =
-        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      fprintf ppf "@[<2>(%a%a)@]" primitive prim lams largs
-  | Lswitch(larg, sw) ->
-      let switch ppf sw =
-        let spc = ref false in
-        List.iter
-         (fun (n, l) ->
-           if !spc then fprintf ppf "@ " else spc := true;
-           fprintf ppf "@[<hv 1>case int %i:@ %a@]" n lam l)
-         sw.sw_consts;
-        List.iter
-          (fun (n, l) ->
-            if !spc then fprintf ppf "@ " else spc := true;
-            fprintf ppf "@[<hv 1>case tag %i:@ %a@]" n lam l)
-          sw.sw_blocks ;
-        begin match sw.sw_failaction with
-        | None  -> ()
-        | Some l ->
-            if !spc then fprintf ppf "@ " else spc := true;
-            fprintf ppf "@[<hv 1>default:@ %a@]" lam l
-        end in
-      fprintf ppf
-       "@[<1>(%s %a@ @[<v 0>%a@])@]"
-       (match sw.sw_failaction with None -> "switch*" | _ -> "switch")
-       lam larg switch sw
-  | Lstringswitch(arg, cases, default,_) ->
-      let switch ppf cases =
-        let spc = ref false in
-        List.iter
-         (fun (s, l) ->
-           if !spc then fprintf ppf "@ " else spc := true;
-           fprintf ppf "@[<hv 1>case \"%s\":@ %a@]" (String.escaped s) lam l)
-          cases;
-        begin match default with
-        | Some default ->
-            if !spc then fprintf ppf "@ " else spc := true;
-            fprintf ppf "@[<hv 1>default:@ %a@]" lam default
-        | None -> ()
-        end in
-      fprintf ppf
-       "@[<1>(stringswitch %a@ @[<v 0>%a@])@]" lam arg switch cases
-  | Lstaticraise (i, ls)  ->
-      let lams ppf largs =
-        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      fprintf ppf "@[<2>(exit@ %d%a)@]" i lams ls;
-  | Lstaticcatch(lbody, (i, vars), lhandler) ->
-      fprintf ppf "@[<2>(catch@ %a@;<1 -1>with (%d%a)@ %a)@]"
-        lam lbody i
-        (fun ppf vars -> match vars with
-          | [] -> ()
-          | _ ->
-              List.iter
-                (fun x -> fprintf ppf " %a" Ident.print x)
-                vars)
-        vars
-        lam lhandler
-  | Ltrywith(lbody, param, lhandler) ->
-      fprintf ppf "@[<2>(try@ %a@;<1 -1>with %a@ %a)@]"
-        lam lbody Ident.print param lam lhandler
-  | Lifthenelse(lcond, lif, lelse) ->
-      fprintf ppf "@[<2>(if@ %a@ %a@ %a)@]" lam lcond lam lif lam lelse
-  | Lsequence(l1, l2) ->
-      fprintf ppf "@[<2>(seq@ %a@ %a)@]" lam l1 sequence l2
-  | Lwhile(lcond, lbody) ->
-      fprintf ppf "@[<2>(while@ %a@ %a)@]" lam lcond lam lbody
-  | Lfor(param, lo, hi, dir, body) ->
-      fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
-       Ident.print param lam lo
-       (match dir with Upto -> "to" | Downto -> "downto")
-       lam hi lam body
-  | Lassign(id, expr) ->
-      fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
-  | Lsend (k, met, obj, largs, _) ->
-      let args ppf largs =
-        List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      let kind =
-        if k = Self then "self" else if k = Cached then "cache" else "" in
-      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
-  | Levent(expr, _ev) ->
-      lam ppf expr
-      (* let kind = *)
-      (*  match ev.lev_kind with *)
-      (*  | Lev_before -> "before" *)
-      (*  | Lev_after _  -> "after" *)
-      (*  | Lev_function -> "funct-body" in *)
-      (* fprintf ppf "@[<2>(%s %s(%i)%s:%i-%i@ %a)@]" kind *)
-      (*         ev.lev_loc.Location.loc_start.Lexing.pos_fname *)
-      (*         ev.lev_loc.Location.loc_start.Lexing.pos_lnum *)
-      (*         (if ev.lev_loc.Location.loc_ghost then "<ghost>" else "") *)
-      (*         ev.lev_loc.Location.loc_start.Lexing.pos_cnum *)
-      (*         ev.lev_loc.Location.loc_end.Lexing.pos_cnum *)
-      (*         lam expr *)
-  | Lifused(id, expr) ->
-      fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr
 
-and sequence ppf = function
-  | Lsequence(l1, l2) ->
-      fprintf ppf "%a@ %a" sequence l1 sequence l2
-  | l ->
-      lam ppf l
+(* Note that OCaml type checker will not allow arbitrary 
+   name as type variables, for example:
+   {[
+     '_x'_
+   ]}
+   will be recognized as a invalid program
+*)
+let from_labels ~loc arity labels 
+  : t =
+  let tyvars = 
+    ((Ext_list.init arity (fun i ->      
+           Typ.var ~loc ("a" ^ string_of_int i)))) in
+  let result_type =
+    Ast_comb.to_js_type loc  
+      (Typ.object_ ~loc
+         (List.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
   in 
-  lam ppf v
-
-let structured_constant = struct_const
+  List.fold_right2 
+    (fun {Asttypes.loc ; txt = label }
+      tyvar acc -> Typ.arrow ~loc label tyvar acc) labels tyvars  result_type
 
-let env_lambda = lambda true 
-let lambda = lambda false Env.empty
 
-let rec flatten_seq acc lam =
-  match lam with 
-  | Lsequence(l1,l2) -> 
-      flatten_seq (flatten_seq acc l1) l2
-  | x -> x :: acc 
+let make_obj ~loc xs =
+  Ast_comb.to_js_type loc @@
+  Ast_helper.Typ.object_  ~loc xs   Closed
 
-exception Not_a_module
+end
+module Ast_payload : sig 
+#1 "ast_payload.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let rec flat (acc : (left * lambda) list ) (lam : lambda) = 
-  match lam with 
-  | Llet (str,id,arg,body) ->
-      flat ( (Id {kind = to_print_kind str;  id}, arg) :: acc) body 
-  | Lletrec (bind_args, body) ->
-      flat ( List.map (fun (id, arg ) -> (Id {kind = Recursive;  id}, arg)) bind_args @ acc) body 
-  | Lsequence (l,r) -> 
-      flat (flat acc l) r
-  | x -> (Nop, x) :: acc 
 
-let lambda_as_module env  ppf lam = 
-  try
-  match lam with
-  | Lprim(Psetglobal(id), [biglambda],_)  (* might be wrong in toplevel *) ->
-      
-      begin match flat [] biglambda  with 
-      | (Nop, Lprim (Pmakeblock (_, _, _), toplevels,_)) :: rest ->
-          (* let spc = ref false in *)
-          List.iter
-            (fun (left, l) ->
-              match left with 
-              | Id { kind = k; id } ->
-                  fprintf ppf "@[<2>%a =%s@ %a@]@." Ident.print id (kind k) (env_lambda env) l
-              | Nop -> 
 
-                  fprintf ppf "@[<2>%a@]@."   (env_lambda env) l
-            )
+(** A utility module used when destructuring parsetree attributes, used for 
+    compiling FFI attributes and built-in ppx  *)
 
-            @@ List.rev rest
-          
-          
-      | _ -> raise Not_a_module
-      end
-  | _ -> raise Not_a_module
-  with _ -> 
-    env_lambda env ppf lam;
-    fprintf ppf "; lambda-failure"
-let seriaize env (filename : string) (lam : Lambda.lambda) : unit =
-  let ou = open_out filename  in
-  let old = Format.get_margin () in
-  let () = Format.set_margin 10000 in
-  let fmt = Format.formatter_of_out_channel ou in
-  begin
-    (* lambda_as_module env fmt lambda; *)
-    lambda fmt lam;
-    Format.pp_print_flush fmt ();
-    close_out ou;
-    Format.set_margin old
-  end
+type t = Parsetree.payload
+type lid = string Asttypes.loc
+type label_expr = lid  * Parsetree.expression
+type action = 
+   lid * Parsetree.expression option 
 
-let serialize_raw_js = ref(fun _ _ _ _ -> ())    
-let serialize_js = ref (fun _ _ _ -> ())
+val is_single_string : t -> string option
+val is_single_int : t -> int option 
 
-end
-module Switch : sig 
-#1 "switch.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Luc Maranget, projet Moscova, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+val as_string_exp : t -> Parsetree.expression option
+val as_core_type : Location.t -> t -> Parsetree.core_type    
+val as_empty_structure :  t -> bool 
+val as_ident : t -> Longident.t Asttypes.loc option
+val raw_string_payload : Location.t -> string -> t 
+val assert_strings :
+  Location.t -> t -> string list  
 
-(*
-  This module transforms generic switches in combinations
-  of if tests and switches.
+(** as a record or empty 
+    it will accept 
+    {[ [@@@bs.config ]]}
+    or 
+    {[ [@@@bs.config { property  .. } ]]}    
+    Note that we only 
+    {[
+      { flat_property}
+    ]}
+    below  is not allowed 
+    {[
+      {M.flat_property}
+    ]}
 *)
+val as_config_record_and_process : 
+  Location.t ->
+  t -> action list 
 
-(* For detecting action sharing, object style *)
-
-(* Store for actions in object style:
-  act_store : store an action, returns index in table
-              In case an action with equal key exists, returns index
-              of the stored action. Otherwise add entry in table.
-  act_store_shared : This stored action will always be shared.
-  act_get   : retrieve table
-  act_get_shared : retrieve table, with sharing explicit
-*)
+val assert_bool_lit : Parsetree.expression -> bool
 
-type 'a shared = Shared of 'a | Single of 'a
+val empty : t 
 
-type 'a t_store =
-    {act_get : unit -> 'a array ;
-     act_get_shared : unit -> 'a shared array ;
-     act_store : 'a -> int ;
-     act_store_shared : 'a -> int ; }
+val table_dispatch : 
+  (Parsetree.expression option  -> 'a) String_map.t -> action -> 'a
 
-exception Not_simple
+end = struct
+#1 "ast_payload.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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 type Stored = sig
-  type t
-  type key
-  val make_key : t -> key option
-end
+type t = Parsetree.payload
 
-module Store(A:Stored) :
-    sig
-      val mk_store : unit -> A.t t_store
-    end
+let is_single_string (x : t ) = 
+  match x with  (** TODO also need detect empty phrase case *)
+  | PStr [ {
+      pstr_desc =  
+        Pstr_eval (
+          {pexp_desc = 
+             Pexp_constant 
+               (Const_string (name,_));
+           _},_);
+      _}] -> Some name
+  | _  -> None
 
-(* Arguments to the Make functor *)
-module type S =
-  sig
-    (* type of basic tests *)
-    type primitive
-    (* basic tests themselves *)
-    val eqint : primitive
-    val neint : primitive
-    val leint : primitive
-    val ltint : primitive
-    val geint : primitive
-    val gtint : primitive
-    (* type of actions *)
-    type act
+let is_single_int (x : t ) = 
+  match x with  (** TODO also need detect empty phrase case *)
+  | PStr [ {
+      pstr_desc =  
+        Pstr_eval (
+          {pexp_desc = 
+             Pexp_constant 
+               (Const_int name);
+           _},_);
+      _}] -> Some name
+  | _  -> None
 
-    (* Various constructors, for making a binder,
-        adding one integer, etc. *)
-    val bind : act -> (act -> act) -> act
-    val make_const : int -> act
-    val make_offset : act -> int -> act
-    val make_prim : primitive -> act list -> act
-    val make_isout : act -> act -> act
-    val make_isin : act -> act -> act
-    val make_if : act -> act -> act -> act
-   (* construct an actual switch :
-      make_switch arg cases acts
-      NB:  cases is in the value form *)
-    val make_switch :
-        act -> int array -> act array -> act
-   (* Build last minute sharing of action stuff *)
-   val make_catch : act -> int * (act -> act)
-   val make_exit : int -> act
+let as_string_exp (x : t ) = 
+  match x with  (** TODO also need detect empty phrase case *)
+  | PStr [ {
+      pstr_desc =  
+        Pstr_eval (
+          {pexp_desc = 
+             Pexp_constant 
+               (Const_string (_,_));
+           _} as e ,_);
+      _}] -> Some e
+  | _  -> None
 
-  end
+let as_core_type loc x =
+  match  x with
+  | Parsetree.PTyp x -> x
+  | _ -> Location.raise_errorf ~loc "except a core type"
+           
+let as_ident (x : t ) =
+  match x with
+  | PStr [
+      {pstr_desc =
+         Pstr_eval (
+           {
+             pexp_desc =
+               Pexp_ident ident 
+                 
+           } , _)
+      }
+    ] -> Some ident
+  | _ -> None
+open Ast_helper
 
+let raw_string_payload loc (s : string) : t =
+  PStr [ Str.eval ~loc (Exp.constant ~loc (Const_string (s,None)  ))]
+    
+let as_empty_structure (x : t ) = 
+  match x with 
+  | PStr ([]) -> true
+  | PTyp _ | PPat _ | PStr (_ :: _ ) -> false 
 
-(*
-  Make.zyva arg low high cases actions where
-    - arg is the argument of the switch.
-    - low, high are the interval limits.
-    - cases is a list of sub-interval and action indices
-    - actions is an array of actions.
+type lid = string Asttypes.loc
+type label_expr = lid  * Parsetree.expression
 
-  All these arguments specify a switch construct and zyva
-  returns an action that performs the switch,
+type action = 
+   lid * Parsetree.expression option 
+(** None means punning is hit 
+    {[ { x } ]}
+    otherwise it comes with a payload 
+    {[ { x = exp }]}
 *)
-module Make :
-  functor (Arg : S) ->
-    sig
-(* Standard entry point, sharing is tracked *)
-      val zyva :
-          (int * int) ->
-           Arg.act ->
-           (int * int * int) array ->
-           Arg.act t_store ->
-           Arg.act
 
-(* Output test sequence, sharing tracked *)
-     val test_sequence :
-           Arg.act ->
-           (int * int * int) array ->
-           Arg.act t_store ->
-           Arg.act
+let as_config_record_and_process 
+    loc
+    (x : Parsetree.payload) 
+  = 
+  match  x with 
+  | PStr 
+      [ {pstr_desc = Pstr_eval
+             ({pexp_desc = Pexp_record (label_exprs, with_obj) ; pexp_loc = loc}, _); 
+         _
+        }]
+    -> 
+    begin match with_obj with
+    | None ->
+      List.map
+        (fun (x,y) -> 
+           match (x,y) with 
+           | ({Asttypes.txt = Longident.Lident name; loc} ) , 
+             ({Parsetree.pexp_desc = Pexp_ident{txt = Lident name2}} )
+             when name2 = name -> 
+              ({Asttypes.txt = name ; loc}, None)
+           | ({Asttypes.txt = Longident.Lident name; loc} ), y 
+             -> 
+             ({Asttypes.txt = name ; loc}, Some y)
+           | _ -> 
+             Location.raise_errorf ~loc "Qualified label is not allood"
+        )
+        label_exprs
+    | Some _ -> 
+      Location.raise_errorf ~loc "with is not supported"
     end
+  | Parsetree.PStr [] -> []
+  | _ -> 
+    Location.raise_errorf ~loc "this is not a valid record config"
 
-end = struct
-#1 "switch.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Luc Maranget, projet Moscova, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
 
 
-type 'a shared = Shared of 'a | Single of 'a
+let assert_strings loc (x : t) : string list
+   = 
+  let module M = struct exception Not_str end  in 
+  match x with 
+  | PStr [ {pstr_desc =  
+              Pstr_eval (
+                {pexp_desc = 
+                   Pexp_tuple strs;
+                 _},_);
+            pstr_loc = loc ;            
+            _}] ->
+    (try 
+        strs |> List.map (fun e ->
+           match (e : Parsetree.expression) with
+           | {pexp_desc = Pexp_constant (Const_string (name,_)); _} -> 
+             name
+           | _ -> raise M.Not_str)
+     with M.Not_str ->
+       Location.raise_errorf ~loc "expect string tuple list"
+    )
+  | PStr [ {
+      pstr_desc =  
+        Pstr_eval (
+          {pexp_desc = 
+             Pexp_constant 
+               (Const_string (name,_));
+           _},_);
+      _}] ->  [name] 
+  | PStr [] ->  []
+  | PStr _                
+  | PTyp _ | PPat _ ->
+    Location.raise_errorf ~loc "expect string tuple list"
+let assert_bool_lit  (e : Parsetree.expression) = 
+  match e.pexp_desc with
+  | Pexp_construct ({txt = Lident "true" }, None)
+    -> true
+  | Pexp_construct ({txt = Lident "false" }, None)
+    -> false 
+  | _ ->
+    Location.raise_errorf ~loc:e.pexp_loc "expect `true` or `false` in this field"
 
-let share_out = function
-  | Shared act|Single act -> act
 
+let empty : t = Parsetree.PStr []
 
-type 'a t_store =
-    {act_get : unit -> 'a array ;
-     act_get_shared : unit -> 'a shared array ;
-     act_store : 'a -> int ;
-     act_store_shared : 'a -> int ; }
 
-exception Not_simple
 
-module type Stored = sig
-  type t
-  type key
-  val make_key : t -> key option
+let table_dispatch table (action : action)
+     = 
+  match action with 
+  | {txt =  name; loc  }, y -> 
+    begin match String_map.find_exn name table with 
+      | fn -> fn y
+      | exception _ -> Location.raise_errorf ~loc "%s is not supported" name
+    end
+
 end
+module Ast_attributes : sig 
+#1 "ast_attributes.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+type attr =  Parsetree.attribute
+type t =  attr list 
 
-module Store(A:Stored) = struct
-  module AMap =
-    Map.Make(struct type t = A.key let compare = Pervasives.compare end)
+type ('a,'b) st = 
+  { get : 'a option ; 
+    set : 'b option }
 
-  type intern =
-      { mutable map : (bool * int)  AMap.t ;
-        mutable next : int ;
-        mutable acts : (bool * A.t) list; }
+val process_method_attributes_rev : 
+  t ->
+  (bool * bool , [`Get | `No_get ]) st * t 
 
-  let mk_store () =
-    let st =
-      { map = AMap.empty ;
-        next = 0 ;
-        acts = [] ; } in
+val process_attributes_rev : 
+  t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t 
 
-    let add mustshare act =
-      let i = st.next in
-      st.acts <- (mustshare,act) :: st.acts ;
-      st.next <- i+1 ;
-      i in
+val process_bs : 
+  t -> [ `Nothing | `Has] * t 
 
-    let store mustshare act = match A.make_key act with
-    | Some key ->
-        begin try
-          let (shared,i) = AMap.find key st.map in
-          if not shared then st.map <- AMap.add key (true,i) st.map ;
-          i
-        with Not_found ->
-          let i = add mustshare act in
-          st.map <- AMap.add key (mustshare,i) st.map ;
-          i
-        end
-    | None ->
-        add mustshare act
+val process_external : t -> bool 
 
-    and get () = Array.of_list (List.rev_map (fun (_,act) -> act) st.acts)
+type derive_attr = {
+  explict_nonrec : bool;
+  bs_deriving : [`Has_deriving of Ast_payload.action list | `Nothing ]
+}
+val process_bs_string_int : 
+  t -> [`Nothing | `String | `Int | `Ignore]  * t 
 
-    and get_shared () =
-      let acts =
-        Array.of_list
-          (List.rev_map
-             (fun (shared,act) ->
-               if shared then Shared act else Single act)
-             st.acts) in
-      AMap.iter
-        (fun _ (shared,i) ->
-          if shared then match acts.(i) with
-          | Single act -> acts.(i) <- Shared act
-          | Shared _ -> ())
-        st.map ;
-      acts in
-    {act_store = store false ; act_store_shared = store true ;
-     act_get = get; act_get_shared = get_shared; }
-end
+val process_bs_string_as :
+  t -> string option * t 
+val process_bs_int_as : 
+  t -> int option * t 
 
 
+val process_derive_type : 
+  t -> derive_attr * t 
 
-module type S =
- sig
-   type primitive
-   val eqint : primitive
-   val neint : primitive
-   val leint : primitive
-   val ltint : primitive
-   val geint : primitive
-   val gtint : primitive
-   type act
 
-   val bind : act -> (act -> act) -> act
-   val make_const : int -> act
-   val make_offset : act -> int -> act
-   val make_prim : primitive -> act list -> act
-   val make_isout : act -> act -> act
-   val make_isin : act -> act -> act
-   val make_if : act -> act -> act -> act
-   val make_switch : act -> int array -> act array -> act
-   val make_catch : act -> int * (act -> act)
-   val make_exit : int -> act
- end
 
-(* The module will ``produce good code for the case statement'' *)
-(*
-  Adaptation of
-   R.L. Berstein
-   ``Producing good code for the case statement''
-   Sofware Practice and Experience, 15(10) (1985)
- and
-   D.L. Spuler
-    ``Two-Way Comparison Search Trees, a Generalisation of Binary Search Trees
-      and Split Trees''
-    ``Compiler Code Generation for Multiway Branch Statement as
-      a Static Search Problem''
-   Technical Reports, James Cook University
-*)
-(*
-  Main adaptation is considering interval tests
- (implemented as one addition + one unsigned test and branch)
-  which leads to exhaustive search for finding the optimal
-  test sequence in small cases and heuristics otherwise.
-*)
-module Make (Arg : S) =
-  struct
+val bs : attr 
+val bs_this : attr
+val bs_method : attr
 
-    type 'a inter =
-        {cases : (int * int * int) array ;
-          actions : 'a array}
 
-type 'a t_ctx =  {off : int ; arg : 'a}
 
-let cut = ref 8
-and more_cut = ref 16
+end = struct
+#1 "ast_attributes.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let pint chan i =
-  if i = min_int then Printf.fprintf chan "-oo"
-  else if i=max_int then Printf.fprintf chan "oo"
-  else Printf.fprintf chan "%d" i
+type attr =  Parsetree.attribute
+type t =  attr list 
 
-let pcases chan cases =
-  for i =0 to Array.length cases-1 do
-    let l,h,act = cases.(i) in
-    if l=h then
-      Printf.fprintf chan "%d:%d " l act
-    else
-      Printf.fprintf chan "%a..%a:%d " pint l pint h act
-  done
+type ('a,'b) st = 
+  { get : 'a option ; 
+    set : 'b option }
 
-    let prerr_inter i = Printf.fprintf stderr
-        "cases=%a" pcases i.cases
 
-let get_act cases i =
-  let _,_,r = cases.(i) in
-  r
-and get_low cases i =
-  let r,_,_ = cases.(i) in
-  r
+let process_method_attributes_rev (attrs : t) = 
+  List.fold_left (fun (st,acc) (({txt ; loc}, payload) as attr : attr) -> 
 
-type ctests = {
-    mutable n : int ;
-    mutable ni : int ;
-  }
+      match txt  with 
+      | "bs.get" (* [@@bs.get{null; undefined}]*)
+        -> 
+        let result = 
+          List.fold_left 
+          (fun 
+            (null, undefined)
+            (({txt ; loc}, opt_expr) : Ast_payload.action) -> 
+            if txt =  "null" then 
+              (match opt_expr with 
+              | None -> true
+              | Some e -> 
+                Ast_payload.assert_bool_lit e), undefined
 
-let too_much = {n=max_int ; ni=max_int}
+            else if txt = "undefined" then 
+              null, 
+              (match opt_expr with
+               | None ->  true
+               | Some e -> 
+                 Ast_payload.assert_bool_lit e)
 
-let ptests chan {n=n ; ni=ni} =
-  Printf.fprintf chan "{n=%d ; ni=%d}" n ni
+            else Location.raise_errorf ~loc "unsupported predicates"
+          ) (false, false) (Ast_payload.as_config_record_and_process loc payload)  in 
 
-let pta chan t =
-  for i =0 to Array.length t-1 do
-    Printf.fprintf chan "%d: %a\n" i ptests t.(i)
-  done
+        ({st with get = Some result}, acc  )
 
-let count_tests s =
-  let r =
-    Array.init
-      (Array.length s.actions)
-      (fun _ -> {n=0 ; ni=0 }) in
-  let c = s.cases in
-  let imax = Array.length c-1 in
-  for i=0 to imax do
-    let l,h,act = c.(i) in
-    let x = r.(act) in
-    x.n <- x.n+1 ;
-    if l < h && i<> 0 && i<>imax then
-      x.ni <- x.ni+1 ;
-  done ;
-  r
+      | "bs.set"
+        -> 
+        let result = 
+          List.fold_left 
+          (fun st (({txt ; loc}, opt_expr) : Ast_payload.action) -> 
+            if txt =  "no_get" then 
+              match opt_expr with 
+              | None -> `No_get 
+              | Some e -> 
+                if Ast_payload.assert_bool_lit e then 
+                  `No_get
+                else `Get
+            else Location.raise_errorf ~loc "unsupported predicates"
+          ) `Get (Ast_payload.as_config_record_and_process loc payload)  in 
+        (* properties -- void 
+              [@@bs.set{only}]
+           *)
+        {st with set = Some result }, acc
+      | _ -> 
+        (st, attr::acc  )
+    ) ( {get = None ; set = None}, []) attrs
 
 
-let less_tests c1 c2 =
-  if c1.n < c2.n then
-    true
-  else if c1.n = c2.n then begin
-    if c1.ni < c2.ni then
-      true
-    else
-      false
-  end else
-    false
+let process_attributes_rev (attrs : t) = 
+  List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) -> 
+      match txt, st  with 
+      | "bs", (`Nothing | `Uncurry) 
+        -> 
+        `Uncurry, acc
+      | "bs.this", (`Nothing | `Meth_callback)
+        ->  `Meth_callback, acc
+      | "bs.meth",  (`Nothing | `Method)
+        -> `Method, acc
+      | "bs", _
+      | "bs.this", _
+        -> Location.raise_errorf 
+             ~loc
+             "[@bs.this], [@bs], [@bs.meth] can not be applied at the same time"
+      | _ , _ -> 
+        st, attr::acc 
+    ) ( `Nothing, []) attrs
 
-and eq_tests c1 c2 = c1.n = c2.n && c1.ni=c2.ni
+let process_bs attrs = 
+  List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) -> 
+      match txt, st  with 
+      | "bs", _
+        -> 
+        `Has, acc
+      | _ , _ -> 
+        st, attr::acc 
+    ) ( `Nothing, []) attrs
 
-let min_tests c1 c2 = if less_tests c1 c2 then c1 else c2
+let process_external attrs = 
+  List.exists (fun (({txt; }, _)  : attr) -> 
+      if Ext_string.starts_with txt "bs." then true 
+      else false
+    ) attrs
 
-let less2tests (c1,d1) (c2,d2) =
-  if eq_tests c1 c2 then
-    less_tests d1 d2
-  else
-    less_tests c1 c2
 
-let add_test t1 t2 =
-  t1.n <- t1.n + t2.n ;
-  t1.ni <- t1.ni + t2.ni ;
+type derive_attr = {
+  explict_nonrec : bool;
+  bs_deriving : [`Has_deriving of Ast_payload.action list | `Nothing ]
+}
 
-type t_ret = Inter of int * int  | Sep of int | No
+let process_derive_type attrs =
+  List.fold_left 
+    (fun (st, acc) 
+      (({txt ; loc}, payload  as attr): attr)  ->
+      match  st, txt  with
+      |  {bs_deriving = `Nothing}, "bs.deriving"
+        ->
+        {st with
+         bs_deriving = `Has_deriving 
+             (Ast_payload.as_config_record_and_process loc payload)}, acc 
+      | {bs_deriving = `Has_deriving _}, "bs.deriving"
+        -> 
+        Location.raise_errorf ~loc "duplicated bs.deriving attribute"
+      | _ , _ ->
+        let st = 
+          if txt = "nonrec" then 
+            { st with explict_nonrec = true }
+          else st in 
+        st, attr::acc
+    ) ( {explict_nonrec = false; bs_deriving = `Nothing }, []) attrs
 
-let pret chan = function
-  | Inter (i,j)-> Printf.fprintf chan "Inter %d %d" i j
-  | Sep i -> Printf.fprintf chan "Sep %d" i
-  | No -> Printf.fprintf chan "No"
 
-let coupe cases i =
-  let l,_,_ = cases.(i) in
-  l,
-  Array.sub cases 0 i,
-  Array.sub cases i (Array.length cases-i)
 
+let process_bs_string_int attrs = 
+  List.fold_left 
+    (fun (st,attrs)
+      (({txt ; loc}, payload ) as attr : attr)  ->
+      match  txt, st  with
+      | "bs.string", (`Nothing | `String)
+        -> `String, attrs
+      | "bs.int", (`Nothing | `Int)
+        ->  `Int, attrs
+      | "bs.ignore", (`Nothing | `Ignore)
+        -> `Ignore, attrs
+      | "bs.int", _
+      | "bs.string", _
+      | "bs.ignore", _
+        -> 
+        Location.raise_errorf ~loc "conflict attributes "
+      | _ , _ -> st, (attr :: attrs )
+    ) (`Nothing, []) attrs
+
+let process_bs_string_as  attrs = 
+  List.fold_left 
+    (fun (st, attrs)
+      (({txt ; loc}, payload ) as attr : attr)  ->
+      match  txt, st  with
+      | "bs.as", None
+        ->
+        begin match Ast_payload.is_single_string payload with 
+          | None -> 
+            Location.raise_errorf ~loc "expect string literal "
+          | Some  _ as v->  (v, attrs)  
+        end
+      | "bs.as",  _ 
+        -> 
+          Location.raise_errorf ~loc "duplicated bs.as "
+      | _ , _ -> (st, attr::attrs) 
+    ) (None, []) attrs
+
+let process_bs_int_as  attrs = 
+  List.fold_left 
+    (fun (st, attrs)
+      (({txt ; loc}, payload ) as attr : attr)  ->
+      match  txt, st  with
+      | "bs.as", None
+        ->
+        begin match Ast_payload.is_single_int payload with 
+          | None -> 
+            Location.raise_errorf ~loc "expect int literal "
+          | Some  _ as v->  (v, attrs)  
+        end
+      | "bs.as",  _ 
+        -> 
+          Location.raise_errorf ~loc "duplicated bs.as "
+      | _ , _ -> (st, attr::attrs) 
+    ) (None, []) attrs
 
-let case_append c1 c2 =
-  let len1 = Array.length c1
-  and len2 = Array.length c2 in
-  match len1,len2 with
-  | 0,_ -> c2
-  | _,0 -> c1
-  | _,_ ->
-      let l1,h1,act1 = c1.(Array.length c1-1)
-      and l2,h2,act2 = c2.(0) in
-      if act1 = act2 then
-        let r = Array.make (len1+len2-1) c1.(0) in
-        for i = 0 to len1-2 do
-          r.(i) <- c1.(i)
-        done ;
 
-        let l =
-          if len1-2 >= 0 then begin
-            let _,h,_ = r.(len1-2) in
-            if h+1 < l1 then
-              h+1
-            else
-              l1
-          end else
-            l1
-        and h =
-          if 1 < len2-1 then begin
-            let l,_,_ = c2.(1) in
-            if h2+1 < l then
-              l-1
-            else
-              h2
-          end else
-            h2 in
-        r.(len1-1) <- (l,h,act1) ;
-        for i=1 to len2-1  do
-          r.(len1-1+i) <- c2.(i)
-        done ;
-        r
-      else if h1 > l1 then
-        let r = Array.make (len1+len2) c1.(0) in
-        for i = 0 to len1-2 do
-          r.(i) <- c1.(i)
-        done ;
-        r.(len1-1) <- (l1,l2-1,act1) ;
-        for i=0 to len2-1  do
-          r.(len1+i) <- c2.(i)
-        done ;
-        r
-      else if h2 > l2 then
-        let r = Array.make (len1+len2) c1.(0) in
-        for i = 0 to len1-1 do
-          r.(i) <- c1.(i)
-        done ;
-        r.(len1) <- (h1+1,h2,act2) ;
-        for i=1 to len2-1  do
-          r.(len1+i) <- c2.(i)
-        done ;
-        r
-      else
-        Array.append c1 c2
+let bs : attr
+  =  {txt = "bs" ; loc = Location.none}, Ast_payload.empty
+let bs_this : attr
+  =  {txt = "bs.this" ; loc = Location.none}, Ast_payload.empty
 
+let bs_method : attr 
+  =  {txt = "bs.meth"; loc = Location.none}, Ast_payload.empty
 
-let coupe_inter i j cases =
-  let lcases = Array.length cases in
-  let low,_,_ = cases.(i)
-  and _,high,_ = cases.(j) in
-  low,high,
-  Array.sub cases i (j-i+1),
-  case_append (Array.sub cases 0 i) (Array.sub cases (j+1) (lcases-(j+1)))
 
-type kind = Kvalue of int | Kinter of int | Kempty
 
-let pkind chan = function
-  | Kvalue i ->Printf.fprintf chan "V%d" i
-  | Kinter i -> Printf.fprintf chan "I%d" i
-  | Kempty -> Printf.fprintf chan "E"
+end
+module Bs_loc : sig 
+#1 "bs_loc.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let rec pkey chan  = function
-  | [] -> ()
-  | [k] -> pkind chan k
-  | k::rem ->
-      Printf.fprintf chan "%a %a" pkey rem pkind k
+type t = Location.t = {
+  loc_start : Lexing.position;
+  loc_end : Lexing.position ; 
+  loc_ghost : bool
+} 
 
-let t = Hashtbl.create 17
+val is_ghost : t -> bool
+val merge : t -> t -> t 
+val none : t 
 
-let make_key  cases =
-  let seen = ref []
-  and count = ref 0 in
-  let rec got_it act = function
-    | [] ->
-        seen := (act,!count):: !seen ;
-        let r = !count in
-        incr count ;
-        r
-    | (act0,index) :: rem ->
-        if act0 = act then
-          index
-        else
-          got_it act rem in
 
-  let make_one l h act =
-    if l=h then
-      Kvalue (got_it act !seen)
-    else
-      Kinter (got_it act !seen) in
+end = struct
+#1 "bs_loc.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  let rec make_rec i pl =
-    if i < 0 then
-      []
-    else
-      let l,h,act = cases.(i) in
-      if pl = h+1 then
-        make_one l h act::make_rec (i-1) l
-      else
-        Kempty::make_one l h act::make_rec (i-1) l in
 
-  let l,h,act = cases.(Array.length cases-1) in
-  make_one l h act::make_rec (Array.length cases-2) l
+type t = Location.t = {
+  loc_start : Lexing.position;
+  loc_end : Lexing.position ; 
+  loc_ghost : bool
+} 
 
+let is_ghost x = x.loc_ghost
 
-    let same_act t =
-      let len = Array.length t in
-      let a = get_act t (len-1) in
-      let rec do_rec i =
-        if i < 0 then true
-        else
-          let b = get_act t i in
-          b=a && do_rec (i-1) in
-      do_rec (len-2)
+let merge (l: t) (r : t) = 
+  if is_ghost l then r 
+  else if is_ghost r then l 
+  else match l,r with 
+  | {loc_start ; }, {loc_end; _} (* TODO: improve*)
+    -> 
+    {loc_start ;loc_end; loc_ghost = false}
 
+let none = Location.none
 
-(*
-  Intervall test x in [l,h] works by checking x-l in [0,h-l]
-   * This may be false for arithmetic modulo 2^31
-   * Subtracting l may change the relative ordering of values
-     and invalid the invariant that matched values are given in
-     increasing order
+end
+module Lam_methname : sig 
+#1 "lam_methname.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-   To avoid this, interval check is allowed only when the
-   integers indeed present in the whole case interval are
-   in [-2^16 ; 2^16]
 
-   This condition is checked by zyva
-*)
 
-let inter_limit = 1 lsl 16
+val translate : ?loc:Location.t -> string -> string
 
-let ok_inter = ref false
+end = struct
+#1 "lam_methname.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let rec opt_count top cases =
-  let key = make_key cases in
-  try
-    let r = Hashtbl.find t key in
-    r
-  with
-  | Not_found ->
-      let r =
-        let lcases = Array.length cases in
-        match lcases with
-        | 0 -> assert false
-        | _ when same_act cases -> No, ({n=0; ni=0},{n=0; ni=0})
-        | _ ->
-            if lcases < !cut then
-              enum top cases
-            else if lcases < !more_cut then
-              heuristic top cases
-            else
-              divide top cases in
-      Hashtbl.add t key r ;
-      r
 
-and divide top cases =
-  let lcases = Array.length cases in
-  let m = lcases/2 in
-  let _,left,right = coupe cases m in
-  let ci = {n=1 ; ni=0}
-  and cm = {n=1 ; ni=0}
-  and _,(cml,cleft) = opt_count false left
-  and _,(cmr,cright) = opt_count false right in
-  add_test ci cleft ;
-  add_test ci cright ;
-  if less_tests cml cmr then
-    add_test cm cmr
-  else
-    add_test cm cml ;
-  Sep m,(cm, ci)
+let translate ?loc name =
+  let i = Ext_string.rfind ~sub:"_" name  in
+  if name.[0] = '_' then
+    if i <= 0 then
+      let len = (String.length name - 1) in
+      if len = 0 then
+        Location.raise_errorf ?loc "invalid label %s" name
+      else String.sub name 1 len
+    else
+      let len = (i - 1) in
+      if len = 0 then
+        Location.raise_errorf ?loc "invalid label %s" name 
+      else
+        String.sub name 1 len
+  else if i > 0 then
+    String.sub name 0 i
+  else name
 
-and heuristic top cases =
-  let lcases = Array.length cases in
+end
+module Ast_external_attributes : sig 
+#1 "ast_external_attributes.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  let sep,csep = divide false cases
 
-  and inter,cinter =
-    if !ok_inter then begin
-      let _,_,act0 = cases.(0)
-      and _,_,act1 = cases.(lcases-1) in
-      if act0 = act1 then begin
-        let low, high, inside, outside = coupe_inter 1 (lcases-2) cases in
-        let _,(cmi,cinside) = opt_count false inside
-        and _,(cmo,coutside) = opt_count false outside
-        and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
-        and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
-        add_test cij cinside ;
-        add_test cij coutside ;
-        if less_tests cmi cmo then
-          add_test cmij cmo
-        else
-          add_test cmij cmi ;
-        Inter (1,lcases-2),(cmij,cij)
-      end else
-        Inter (-1,-1),(too_much, too_much)
-    end else
-      Inter (-1,-1),(too_much, too_much) in
-  if less2tests csep cinter then
-    sep,csep
-  else
-    inter,cinter
+type external_module_name = 
+  { bundle : string ; 
+    bind_name : string option
+  }
 
+type js_call = { 
+  name : string;
+  external_module_name : external_module_name option;
+  splice : bool 
+}
+type pipe = bool 
+type js_send = { 
+  name : string ;
+  splice : bool ; 
+  pipe : pipe   
+} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
 
-and enum top cases =
-  let lcases = Array.length cases in
-  let lim, with_sep =
-    let best = ref (-1) and best_cost = ref (too_much,too_much) in
+type js_global_val = {
+  name : string ; 
+  external_module_name : external_module_name option
+  }
 
-    for i = 1 to lcases-(1) do
-      let _,left,right = coupe cases i in
-      let ci = {n=1 ; ni=0}
-      and cm = {n=1 ; ni=0}
-      and _,(cml,cleft) = opt_count false left
-      and _,(cmr,cright) = opt_count false right in
-      add_test ci cleft ;
-      add_test ci cright ;
-      if less_tests cml cmr then
-        add_test cm cmr
-      else
-        add_test cm cml ;
+type js_new_val = {
+  name : string ; 
+  external_module_name : external_module_name option;
+  splice : bool ;
+}
 
-      if
-        less2tests (cm,ci) !best_cost
-      then begin
-        if top then
-          Printf.fprintf stderr "Get it: %d\n" i ;
-        best := i ;
-        best_cost := (cm,ci)
-      end
-    done ;
-    !best, !best_cost in
+type arg_type = Ast_core_type.arg_type
+  
+type arg_label = Ast_core_type.arg_label 
 
-  let ilow, ihigh, with_inter =
-    if not !ok_inter then
-      let rlow = ref (-1) and rhigh = ref (-1)
-      and best_cost= ref (too_much,too_much) in
-      for i=1 to lcases-2 do
-        let low, high, inside, outside = coupe_inter i i cases in
-         if low=high then begin
-           let _,(cmi,cinside) = opt_count false inside
-           and _,(cmo,coutside) = opt_count false outside
-           and cmij = {n=1 ; ni=0}
-           and cij = {n=1 ; ni=0} in
-           add_test cij cinside ;
-           add_test cij coutside ;
-           if less_tests cmi cmo then
-             add_test cmij cmo
-           else
-             add_test cmij cmi ;
-           if less2tests (cmij,cij) !best_cost then begin
-             rlow := i ;
-             rhigh := i ;
-             best_cost := (cmij,cij)
-           end
-         end
-      done ;
-      !rlow, !rhigh, !best_cost
-    else
-      let rlow = ref (-1) and rhigh = ref (-1)
-      and best_cost= ref (too_much,too_much) in
-      for i=1 to lcases-2 do
-        for j=i to lcases-2 do
-          let low, high, inside, outside = coupe_inter i j cases in
-          let _,(cmi,cinside) = opt_count false inside
-          and _,(cmo,coutside) = opt_count false outside
-          and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
-          and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
-          add_test cij cinside ;
-          add_test cij coutside ;
-          if less_tests cmi cmo then
-            add_test cmij cmo
-          else
-            add_test cmij cmi ;
-          if less2tests (cmij,cij) !best_cost then begin
-            rlow := i ;
-            rhigh := j ;
-            best_cost := (cmij,cij)
-          end
-        done
-      done ;
-      !rlow, !rhigh, !best_cost in
-  let r = ref (Inter (ilow,ihigh)) and rc = ref with_inter in
-  if less2tests with_sep !rc then begin
-    r := Sep lim ; rc := with_sep
-  end ;
-  !r, !rc
+type arg_kind = 
+  {
+    arg_type : arg_type;
+    arg_label : arg_label
+  }
+type js_module_as_fn = 
+  { external_module_name : external_module_name;
+    splice : bool 
+  }
+type ffi = 
+  | Obj_create of arg_label list
+  | Js_global of js_global_val 
+  | Js_module_as_var of  external_module_name
+  | Js_module_as_fn of js_module_as_fn
+  | Js_module_as_class of external_module_name       
+  | Js_call of js_call
+  | Js_send of js_send
+  | Js_new of js_new_val
+  | Js_set of string
+  | Js_get of string
+  | Js_get_index
+  | Js_set_index
 
-    let make_if_test test arg i ifso ifnot =
-      Arg.make_if
-        (Arg.make_prim test [arg ; Arg.make_const i])
-        ifso ifnot
+  (* When it's normal, it is handled as normal c functional ffi call *)
 
-    let make_if_lt arg i  ifso ifnot = match i with
-    | 1 ->
-        make_if_test Arg.leint arg 0 ifso ifnot
-    | _ ->
-        make_if_test Arg.ltint arg i ifso ifnot
+type t  = 
+  | Bs of arg_kind list  * arg_type *   ffi
+  | Normal 
 
-    and make_if_le arg i ifso ifnot = match i with
-    | -1 ->
-        make_if_test Arg.ltint arg 0 ifso ifnot
-    | _ ->
-        make_if_test Arg.leint arg i ifso ifnot
 
-    and make_if_gt arg i  ifso ifnot = match i with
-    | -1 ->
-        make_if_test Arg.geint arg 0 ifso ifnot
-    | _ ->
-        make_if_test Arg.gtint arg i ifso ifnot
 
-    and make_if_ge arg i  ifso ifnot = match i with
-    | 1 ->
-        make_if_test Arg.gtint arg 0 ifso ifnot
-    | _ ->
-        make_if_test Arg.geint arg i ifso ifnot
 
-    and make_if_eq  arg i ifso ifnot =
-      make_if_test Arg.eqint arg i ifso ifnot
 
-    and make_if_ne  arg i ifso ifnot =
-      make_if_test Arg.neint arg i ifso ifnot
+(**
+   return value is of [pval_type, pval_prim]
+*)    
+val handle_attributes_as_string : 
+  Bs_loc.t ->
+  string  ->
+  Ast_core_type.t ->
+  Ast_attributes.t -> 
+  string   ->
+  Ast_core_type.t * string list * Ast_attributes.t
 
-    let do_make_if_out h arg ifso ifno =
-      Arg.make_if (Arg.make_isout h arg) ifso ifno
 
-    let make_if_out ctx l d mk_ifso mk_ifno = match l with
-    | 0 ->
-        do_make_if_out
-          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
-    | _ ->
-        Arg.bind
-          (Arg.make_offset ctx.arg (-l))
-          (fun arg ->
-            let ctx = {off= (-l+ctx.off) ; arg=arg} in
-            do_make_if_out
-              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
+val bs_external : string 
+val to_string : t -> string 
+val from_string : string -> t 
+val unsafe_from_string : string -> t 
+val is_bs_external_prefix : string -> bool
 
-    let do_make_if_in h arg ifso ifno =
-      Arg.make_if (Arg.make_isin h arg) ifso ifno
 
-    let make_if_in ctx l d mk_ifso mk_ifno = match l with
-    | 0 ->
-        do_make_if_in
-          (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
-    | _ ->
-        Arg.bind
-          (Arg.make_offset ctx.arg (-l))
-          (fun arg ->
-            let ctx = {off= (-l+ctx.off) ; arg=arg} in
-            do_make_if_in
-              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
 
-    let rec c_test ctx ({cases=cases ; actions=actions} as s) =
-      let lcases = Array.length cases in
-      assert(lcases > 0) ;
-      if lcases = 1 then
-        actions.(get_act cases 0) ctx
+val pval_prim_of_labels : string Asttypes.loc list -> string list
 
-      else begin
+val name_of_ffi : ffi -> string
 
-        let w,c = opt_count false cases in
-(*
-  Printf.fprintf stderr
-  "off=%d tactic=%a for %a\n"
-  ctx.off pret w pcases cases ;
-  *)
-    match w with
-    | No -> actions.(get_act cases 0) ctx
-    | Inter (i,j) ->
-        let low,high,inside, outside = coupe_inter i j cases in
-        let _,(cinside,_) = opt_count false inside
-        and _,(coutside,_) = opt_count false outside in
-(* Costs are retrieved to put the code with more remaining tests
-   in the privileged (positive) branch of ``if'' *)
-        if low=high then begin
-          if less_tests coutside cinside then
-            make_if_eq
-              ctx.arg
-              (low+ctx.off)
-              (c_test ctx {s with cases=inside})
-              (c_test ctx {s with cases=outside})
-          else
-            make_if_ne
-              ctx.arg
-              (low+ctx.off)
-              (c_test ctx {s with cases=outside})
-              (c_test ctx {s with cases=inside})
-        end else begin
-          if less_tests coutside cinside then
-            make_if_in
-              ctx
-              (low+ctx.off)
-              (high-low)
-              (fun ctx -> c_test ctx {s with cases=inside})
-              (fun ctx -> c_test ctx {s with cases=outside})
-          else
-            make_if_out
-              ctx
-              (low+ctx.off)
-              (high-low)
-              (fun ctx -> c_test ctx {s with cases=outside})
-              (fun ctx -> c_test ctx {s with cases=inside})
-        end
-    | Sep i ->
-        let lim,left,right = coupe cases i in
-        let _,(cleft,_) = opt_count false left
-        and _,(cright,_) = opt_count false right in
-        let left = {s with cases=left}
-        and right = {s with cases=right} in
+end = struct
+#1 "ast_external_attributes.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-        if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
-          make_if_ne
-            ctx.arg 0
-            (c_test ctx right) (c_test ctx left)
-        else if less_tests cright cleft then
-          make_if_lt
-            ctx.arg (lim+ctx.off)
-            (c_test ctx left) (c_test ctx right)
-        else
-          make_if_ge
-             ctx.arg (lim+ctx.off)
-            (c_test ctx right) (c_test ctx left)
 
-  end
 
+type external_module_name = 
+  { bundle : string ; 
+    bind_name : string option
+  }
 
-(* Minimal density of switches *)
-let theta = ref 0.33333
+type pipe = bool 
+type js_call = { 
+  name : string;
+  external_module_name : external_module_name option;
+  splice : bool 
+}
 
-(* Minmal number of tests to make a switch *)
-let switch_min = ref 3
+type js_send = { 
+  name : string ;
+  splice : bool ; 
+  pipe : pipe   
+} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
 
-(* Particular case 0, 1, 2 *)
-let particular_case cases i j =
-  j-i = 2 &&
-  (let l1,h1,act1 = cases.(i)
-  and  l2,h2,act2 = cases.(i+1)
-  and  l3,h3,act3 = cases.(i+2) in
-  l1+1=l2 && l2+1=l3 && l3=h3 &&
-  act1 <> act3)
+type js_global_val = {
+  name : string ; 
+  external_module_name : external_module_name option
+  }
 
-let approx_count cases i j n_actions =
-  let l = j-i+1 in
-  if l < !cut then
-     let _,(_,{n=ntests}) = opt_count false (Array.sub cases i l) in
-     ntests
-  else
-    l-1
+type js_new_val = {
+  name : string ; 
+  external_module_name : external_module_name option;
+  splice : bool ;
+}
 
-(* Sends back a boolean that says whether is switch is worth or not *)
+type js_module_as_fn = 
+  { external_module_name : external_module_name;
+    splice : bool 
+  }
 
-let dense {cases=cases ; actions=actions} i j =
-  if i=j then true
-  else
-    let l,_,_ = cases.(i)
-    and _,h,_ = cases.(j) in
-    let ntests =  approx_count cases i j (Array.length actions) in
-(*
-  (ntests+1) >= theta * (h-l+1)
-*)
-    particular_case cases i j ||
-    (ntests >= !switch_min &&
-    float_of_int ntests +. 1.0 >=
-    !theta *. (float_of_int h -. float_of_int l +. 1.0))
+type arg_type = Ast_core_type.arg_type
+type arg_label = Ast_core_type.arg_label
 
-(* Compute clusters by dynamic programming
-   Adaptation of the correction to Bernstein
-   ``Correction to `Producing Good Code for the Case Statement' ''
-   S.K. Kannan and T.A. Proebsting
-   Software Practice and Exprience Vol. 24(2) 233 (Feb 1994)
-*)
+type arg_kind = 
+  {
+    arg_type : arg_type;
+    arg_label : arg_label
+  }
 
-let comp_clusters ({cases=cases ; actions=actions} as s) =
-  let len = Array.length cases in
-  let min_clusters = Array.make len max_int
-  and k = Array.make len 0 in
-  let get_min i = if i < 0 then 0 else min_clusters.(i) in
 
-  for i = 0 to len-1 do
-    for j = 0 to i do
-      if
-        dense s j i &&
-        get_min (j-1) + 1 < min_clusters.(i)
-      then begin
-        k.(i) <- j ;
-        min_clusters.(i) <- get_min (j-1) + 1
-      end
-    done ;
-  done ;
-  min_clusters.(len-1),k
+type ffi = 
+  | Obj_create of arg_label list
+  | Js_global of js_global_val 
+  | Js_module_as_var of  external_module_name
+  | Js_module_as_fn of js_module_as_fn
+  | Js_module_as_class of external_module_name             
+  | Js_call of js_call 
+  | Js_send of js_send
+  | Js_new of js_new_val
+  | Js_set of string
+  | Js_get of string
+  | Js_get_index
+  | Js_set_index
 
-(* Assume j > i *)
-let make_switch  {cases=cases ; actions=actions} i j =
-  let ll,_,_ = cases.(i)
-  and _,hh,_ = cases.(j) in
-  let tbl = Array.make (hh-ll+1) 0
-  and t = Hashtbl.create 17
-  and index = ref 0 in
-  let get_index act =
-    try
-      Hashtbl.find t act
-    with
-    | Not_found ->
-        let i = !index in
-        incr index ;
-        Hashtbl.add t act i ;
-        i in
+let name_of_ffi ffi =
+  match ffi with 
+  | Js_get_index -> "[@@bs.get_index]"
+  | Js_set_index -> "[@@bs.set_index]"
+  | Js_get s -> Printf.sprintf "[@@bs.get %S]" s 
+  | Js_set s -> Printf.sprintf "[@@bs.set %S]" s 
+  | Js_call v  -> Printf.sprintf "[@@bs.val %S]" v.name
+  | Js_send v  -> Printf.sprintf "[@@bs.send %S]" v.name
+  | Js_module_as_fn v  -> Printf.sprintf "[@@bs.val %S]" v.external_module_name.bundle
+  | Js_new v  -> Printf.sprintf "[@@bs.new %S]" v.name                    
+  | Js_module_as_class v
+    -> Printf.sprintf "[@@bs.module] %S " v.bundle
+  | Js_module_as_var v
+    -> 
+      Printf.sprintf "[@@bs.module] %S " v.bundle
+  | Js_global v 
+    -> 
+      Printf.sprintf "[@@bs.val] %S " v.name                    
+  | Obj_create _ -> 
+    Printf.sprintf "[@@bs.obj]"
+type t  = 
+  | Bs of arg_kind list  * Ast_core_type.arg_type * ffi
+  | Normal 
+  (* When it's normal, it is handled as normal c functional ffi call *)
 
-  for k=i to j do
-    let l,h,act = cases.(k) in
-    let index = get_index act in
-    for kk=l-ll to h-ll do
-      tbl.(kk) <- index
-    done
-  done ;
-  let acts = Array.make !index actions.(0) in
-  Hashtbl.iter
-    (fun act i -> acts.(i) <- actions.(act))
-    t ;
-  (fun ctx ->
-    match -ll-ctx.off with
-    | 0 -> Arg.make_switch ctx.arg tbl acts
-    | _ ->
-        Arg.bind
-          (Arg.make_offset ctx.arg (-ll-ctx.off))
-          (fun arg -> Arg.make_switch arg tbl acts))
 
 
-let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
-  let len = Array.length cases in
-  let r = Array.make n_clusters (0,0,0)
-  and t = Hashtbl.create 17
-  and index = ref 0
-  and bidon = ref (Array.length actions) in
-  let get_index act =
-    try
-      let i,_ = Hashtbl.find t act in
-      i
-    with
-    | Not_found ->
-        let i = !index in
-        incr index ;
-        Hashtbl.add
-          t act
-          (i,(fun _ -> actions.(act))) ;
-        i
-  and add_index act =
-    let i = !index in
-    incr index ;
-    incr bidon ;
-    Hashtbl.add t !bidon (i,act) ;
-    i in
+let get_arg_type ({ptyp_desc; ptyp_attributes; ptyp_loc = loc} as ptyp : Ast_core_type.t) : 
+  arg_type * Ast_core_type.t  = 
+    match Ast_attributes.process_bs_string_int ptyp_attributes, ptyp_desc with 
+    | (`String, ptyp_attributes),  Ptyp_variant ( row_fields, Closed, None)
+      -> 
+      let case, result, row_fields  = 
+        (List.fold_right (fun tag (nullary, acc, row_fields) -> 
+             match nullary, tag with 
+             | (`Nothing | `Null), 
+               Parsetree.Rtag (label, attrs, true,  [])
+               -> 
+               begin match Ast_attributes.process_bs_string_as attrs with 
+                 | Some name, new_attrs  -> 
+                   `Null, ((Ext_pervasives.hash_variant label, name) :: acc ), 
+                   Parsetree.Rtag(label, new_attrs, true, []) :: row_fields
 
-  let rec zyva j ir =
-    let i = k.(j) in
-    begin if i=j then
-      let l,h,act = cases.(i) in
-      r.(ir) <- (l,h,get_index act)
-    else (* assert i < j *)
-      let l,_,_ = cases.(i)
-      and _,h,_ = cases.(j) in
-      r.(ir) <- (l,h,add_index (make_switch s i j))
-    end ;
-    if i > 0 then zyva (i-1) (ir-1) in
+                 | None, _ -> 
+                   `Null, ((Ext_pervasives.hash_variant label, label) :: acc ), 
+                   tag :: row_fields
+               end
+             | (`Nothing | `NonNull), Parsetree.Rtag(label, attrs, false, ([ _ ] as vs)) 
+               -> 
+               begin match Ast_attributes.process_bs_string_as attrs with 
+                 | Some name, new_attrs -> 
+                   `NonNull, ((Ext_pervasives.hash_variant label, name) :: acc),
+                   Parsetree.Rtag (label, new_attrs, false, vs) :: row_fields
+                 | None, _ -> 
+                   `NonNull, ((Ext_pervasives.hash_variant label, label) :: acc),
+                   (tag :: row_fields)
+               end
+             | _ -> Location.raise_errorf ~loc "Not a valid string type"
+           ) row_fields (`Nothing, [], [])) in 
+       (match case with 
+        | `Nothing -> Location.raise_errorf ~loc "Not a valid string type"
+        | `Null -> NullString result 
+        | `NonNull -> NonNullString result) , 
+       {ptyp with ptyp_desc = Ptyp_variant(row_fields, Closed, None);
+        ptyp_attributes ;
+       }
+    | (`String, _),  _ -> Location.raise_errorf ~loc "Not a valid string type"
+
+    | (`Ignore, ptyp_attributes), _  -> 
+      (Ignore, {ptyp with ptyp_attributes})
+    | (`Int , ptyp_attributes),  Ptyp_variant ( row_fields, Closed, None) -> 
+      let _, acc, rev_row_fields = 
+        (List.fold_left 
+           (fun (i,acc, row_fields) rtag -> 
+              match rtag with 
+              | Parsetree.Rtag (label, attrs, true,  [])
+                -> 
+                  begin match Ast_attributes.process_bs_int_as attrs with 
+                  | Some i, new_attrs -> 
+                    i + 1, ((Ext_pervasives.hash_variant label , i):: acc ), 
+                    Parsetree.Rtag (label, new_attrs, true, []) :: row_fields
+                  | None, _ -> 
+                    i + 1 , ((Ext_pervasives.hash_variant label , i):: acc ), rtag::row_fields
+                  end
+
+              | _ -> Location.raise_errorf ~loc "Not a valid string type"
+           ) (0, [],[]) row_fields) in 
+      Int (List.rev acc),
+      {ptyp with 
+       ptyp_desc = Ptyp_variant(List.rev rev_row_fields, Closed, None );
+       ptyp_attributes
+      }
+      
+    | (`Int, _), _ -> Location.raise_errorf ~loc "Not a valid string type"
+    | (`Nothing, ptyp_attributes),  ptyp_desc ->
+      begin match ptyp_desc with
+        | Ptyp_constr ({txt = Lident "bool"}, [])
+          -> 
+          Bs_warnings.prerr_warning loc Unsafe_ffi_bool_type;
+          Nothing
+        | Ptyp_constr ({txt = Lident "unit"}, [])
+          -> Unit 
+        | Ptyp_constr ({txt = Lident "array"}, [_])
+          -> Array
+        | Ptyp_variant _ ->
+          Bs_warnings.prerr_warning loc Unsafe_poly_variant_type;
+          Nothing           
+        | _ ->
+          Nothing           
+      end, ptyp
+
+
+let valid_js_char =
+  let a = Array.init 256 (fun i ->
+    let c = Char.chr i in
+    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' || c = '$'
+  ) in
+  (fun c -> Array.unsafe_get a (Char.code c))
+
+let valid_first_js_char = 
+  let a = Array.init 256 (fun i ->
+    let c = Char.chr i in
+    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$'
+  ) in
+  (fun c -> Array.unsafe_get a (Char.code c))
+
+(** Approximation could be improved *)
+let valid_ident (s : string) =
+  let len = String.length s in
+  len > 0 && valid_js_char s.[0] && valid_first_js_char s.[0] &&
+  (let module E = struct exception E end in
+   try
+     for i = 1 to len - 1 do
+       if not (valid_js_char (String.unsafe_get s i)) then
+         raise E.E         
+     done ;
+     true     
+   with E.E -> false )  
+  
+let valid_global_name ?loc txt =
+  if not (valid_ident txt) then
+    let v = Ext_string.split_by ~keep_empty:true (fun x -> x = '.') txt in
+    List.iter
+      (fun s ->
+         if not (valid_ident s) then
+           Location.raise_errorf ?loc "Not a valid  name %s"  txt
+      ) v      
+
+let valid_method_name ?loc txt =         
+  if not (valid_ident txt) then
+    Location.raise_errorf ?loc "Not a valid  name %s"  txt
+
+
+
+let check_external_module_name ?loc x = 
+  match x with 
+  | {bundle = ""; _ } | {bind_name = Some ""} -> 
+    Location.raise_errorf ?loc "empty name encountered"
+  | _ -> ()
+let check_external_module_name_opt ?loc x = 
+  match x with 
+  | None -> ()
+  | Some v -> check_external_module_name ?loc v 
 
-  zyva (len-1) (n_clusters-1) ;
-  let acts = Array.make !index (fun _ -> assert false) in
-  Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
-  {cases = r ; actions = acts}
-;;
 
+let check_ffi ?loc ffi = 
+  match ffi with 
+  | Js_global {name} -> valid_global_name ?loc  name
+  | Js_send {name } 
+  | Js_set  name
+  | Js_get name
+    ->  valid_method_name ?loc name
+  | Obj_create _ -> ()
+  | Js_get_index | Js_set_index 
+    -> ()
 
-let do_zyva (low,high) arg cases actions =
-  let old_ok = !ok_inter in
-  ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
-  if !ok_inter <> old_ok then Hashtbl.clear t ;
+  | Js_module_as_var external_module_name
+  | Js_module_as_fn {external_module_name; _}
+  | Js_module_as_class external_module_name             
+    -> check_external_module_name external_module_name
+  | Js_new {external_module_name ;  name}
+  | Js_call {external_module_name ;  name ; _}
+    -> 
+    check_external_module_name_opt ?loc external_module_name ;
+    valid_global_name ?loc name     
 
-  let s = {cases=cases ; actions=actions} in
-(*
-  Printf.eprintf "ZYVA: %b\n" !ok_inter ;
-  pcases stderr cases ;
-  prerr_endline "" ;
-*)
-  let n_clusters,k = comp_clusters s in
-  let clusters = make_clusters s n_clusters k in
-  let r = c_test {arg=arg ; off=0} clusters in
-  r
 
-let abstract_shared actions =
-  let handlers = ref (fun x -> x) in
-  let actions =
-    Array.map
-      (fun act -> match  act with
-      | Single act -> act
-      | Shared act ->
-          let i,h = Arg.make_catch act in
-          let oh = !handlers in
-          handlers := (fun act -> h (oh act)) ;
-          Arg.make_exit i)
-      actions in
-  !handlers,actions
+(** 
+   [@@bs.module "react"]
+   [@@bs.module "react"]
+   ---
+   [@@bs.module "@" "react"]
+   [@@bs.module "@" "react"]
 
-let zyva lh arg cases actions =
-  let actions = actions.act_get_shared () in
-  let hs,actions = abstract_shared actions in
-  hs (do_zyva lh arg cases actions)
+   They should have the same module name 
 
-and test_sequence arg cases actions =
-  let actions = actions.act_get_shared () in
-  let hs,actions = abstract_shared actions in
-  let old_ok = !ok_inter in
-  ok_inter := false ;
-  if !ok_inter <> old_ok then Hashtbl.clear t ;
-  let s =
-    {cases=cases ;
-    actions=Array.map (fun act -> (fun _ -> act)) actions} in
-(*
-  Printf.eprintf "SEQUENCE: %b\n" !ok_inter ;
-  pcases stderr cases ;
-  prerr_endline "" ;
+   TODO: we should emit an warning if we bind 
+   two external files to the same module name
 *)
-  hs (c_test {arg=arg ; off=0} s)
-;;
-
-end
+type bundle_source =
+  [`Nm_payload of string
+  |`Nm_external of string
+  | `Nm_val of string      
+  ]  
 
-end
-module Typeopt : sig 
-#1 "typeopt.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+let string_of_bundle_source (x : bundle_source) =
+  match x with
+  | `Nm_payload x
+  | `Nm_external x
+  | `Nm_val x -> x   
+type name_source =
+  [ bundle_source  
+  | `Nm_na
 
-(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+  ]
+type st = 
+  { val_name : name_source;
+    external_module_name : external_module_name option;
+    module_as_val : external_module_name option;
+    val_send : name_source ;
+    val_send_pipe : Ast_core_type.t option;    
+    splice : bool ; (* mutable *)
+    set_index : bool; (* mutable *)
+    get_index : bool;
+    new_name : name_source ;
+    call_name : name_source ;
+    set_name : name_source ;
+    get_name : name_source ;
+    mk_obj : bool ;
 
-val has_base_type : Typedtree.expression -> Path.t -> bool
-val maybe_pointer : Typedtree.expression -> bool
-val array_kind : Typedtree.expression -> Lambda.array_kind
-val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
-val bigarray_kind_and_layout :
-      Typedtree.expression -> Lambda.bigarray_kind * Lambda.bigarray_layout
+  }
 
-end = struct
-#1 "typeopt.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+let init_st = 
+  {
+    val_name = `Nm_na; 
+    external_module_name = None ;
+    module_as_val = None;
+    val_send = `Nm_na;
+    val_send_pipe = None;    
+    splice = false;
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    call_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na ;
+    mk_obj = false ; 
 
-(* Auxiliaries for type-based optimizations, e.g. array kinds *)
+  }
 
-open Path
-open Types
-open Typedtree
-open Lambda
 
-let scrape env ty =
-  (Ctype.repr (Ctype.expand_head_opt env (Ctype.correct_levels ty))).desc
+let bs_external = "BS:" ^ Bs_version.version
+let bs_external_length = String.length bs_external
 
-let has_base_type exp base_ty_path =
-  match scrape exp.exp_env exp.exp_type with
-  | Tconstr(p, _, _) -> Path.same p base_ty_path
-  | _ -> false
+let is_bs_external_prefix s = 
+  Ext_string.starts_with s bs_external
 
-let maybe_pointer exp =
-  match scrape exp.exp_env exp.exp_type with
-  | Tconstr(p, args, abbrev) ->
-      not (Path.same p Predef.path_int) &&
-      not (Path.same p Predef.path_char) &&
-      begin try
-        match Env.find_type p exp.exp_env with
-        | {type_kind = Type_variant []} -> true (* type exn *)
-        | {type_kind = Type_variant cstrs} ->
-            List.exists (fun c -> c.Types.cd_args <> []) cstrs
-        | _ -> true
-      with Not_found -> true
-        (* This can happen due to e.g. missing -I options,
-           causing some .cmi files to be unavailable.
-           Maybe we should emit a warning. *)
-      end
-  | _ -> true
+let to_string  t = 
+  bs_external ^ Marshal.to_string t []
+let unsafe_from_string s = 
+    Marshal.from_string  s bs_external_length 
+let from_string s : t  = 
+  if is_bs_external_prefix s then 
+    Marshal.from_string  s (String.length bs_external)
+  else Ext_pervasives.failwithf ~loc:__LOC__
+      "compiler version mismatch, please do a clean build" 
 
-let array_element_kind env ty =
-  match scrape env ty with
-  | Tvar _ | Tunivar _ ->
-      Pgenarray
-  | Tconstr(p, args, abbrev) ->
-      if Path.same p Predef.path_int || Path.same p Predef.path_char then
-        Pintarray
-      else if Path.same p Predef.path_float then
-        Pfloatarray
-      else if Path.same p Predef.path_string
-           || Path.same p Predef.path_array
-           || Path.same p Predef.path_nativeint
-           || Path.same p Predef.path_int32
-           || Path.same p Predef.path_int64 then
-        Paddrarray
-      else begin
-        try
-          match Env.find_type p env with
-            {type_kind = Type_abstract} ->
-              Pgenarray
-          | {type_kind = Type_variant cstrs}
-            when List.for_all (fun c -> c.Types.cd_args = []) cstrs ->
-              Pintarray
-          | {type_kind = _} ->
-              Paddrarray
-        with Not_found ->
-          (* This can happen due to e.g. missing -I options,
-             causing some .cmi files to be unavailable.
-             Maybe we should emit a warning. *)
-          Pgenarray
-      end
-  | _ ->
-      Paddrarray
+let process_external_attributes 
+    no_arguments 
+    (prim_name_or_pval_prim: [< bundle_source ] as 'a)
+    pval_prim
+    prim_attributes =
+  let name_from_payload_or_prim payload : name_source =
+    match Ast_payload.is_single_string payload with
+    | Some  val_name ->  `Nm_payload val_name
+    | None ->  (prim_name_or_pval_prim :> name_source)
+  in
+  List.fold_left 
+    (fun (st, attrs)
+      (({txt ; loc}, payload) as attr : Ast_attributes.attr) 
+      ->
+        if Ext_string.starts_with txt "bs." then
+          begin match txt with 
+            | "bs.val" ->  
+              if no_arguments then
+                {st with val_name = name_from_payload_or_prim payload}
+              else 
+                {st with call_name = name_from_payload_or_prim payload}
 
-let array_kind_gen ty env =
-  match scrape env ty with
-  | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
-    when Path.same p Predef.path_array ->
-      array_element_kind env elt_ty
-  | _ ->
-      (* This can happen with e.g. Obj.field *)
-      Pgenarray
+            | "bs.module" -> 
+              begin match Ast_payload.assert_strings loc payload with 
+                | [name] ->
+                  {st with external_module_name =
+                             Some {bundle=name; bind_name = None}}
+                | [bundle;bind_name] -> 
+                  {st with external_module_name =
+                             Some {bundle; bind_name = Some bind_name}}
+                | [] ->
+                  { st with
+                    module_as_val = 
+                      Some
+                        { bundle =
+                            string_of_bundle_source
+                              (prim_name_or_pval_prim :> bundle_source) ;
+                          bind_name = Some pval_prim}
+                  }
+                | _  -> Location.raise_errorf ~loc "Illegal attributes"
+              end
+            | "bs.splice" -> {st with splice = true}
+            | "bs.send" -> 
+              { st with val_send = name_from_payload_or_prim payload}
+            | "bs.send.pipe"
+              ->
+              { st with val_send_pipe = Some (Ast_payload.as_core_type loc payload)}                
+            | "bs.set" -> 
+              {st with set_name = name_from_payload_or_prim payload}
+            | "bs.get" -> {st with get_name = name_from_payload_or_prim payload}
 
-let array_kind exp = array_kind_gen exp.exp_type exp.exp_env
+            | "bs.new" -> {st with new_name = name_from_payload_or_prim payload}
+            | "bs.set_index" -> {st with set_index = true}
+            | "bs.get_index"-> {st with get_index = true}
+            | "bs.obj" -> {st with mk_obj = true}
+            | _ -> (Bs_warnings.warn_unused_attribute loc txt; st)
+          end, attrs
+        else (st , attr :: attrs)
+    )
+    (init_st, []) prim_attributes 
 
-let array_pattern_kind pat = array_kind_gen pat.pat_type pat.pat_env
 
-let bigarray_decode_type env ty tbl dfl =
-  match scrape env ty with
-  | Tconstr(Pdot(Pident mod_id, type_name, _), [], _)
-    when Ident.name mod_id = "Bigarray" ->
-      begin try List.assoc type_name tbl with Not_found -> dfl end
-  | _ ->
-      dfl
+let list_of_arrow (ty : Parsetree.core_type) = 
+  let rec aux (ty : Parsetree.core_type) acc = 
+    match ty.ptyp_desc with 
+    | Ptyp_arrow(label,t1,t2) -> 
+      aux t2 ((label,t1,ty.ptyp_attributes,ty.ptyp_loc) ::acc)
+    | Ptyp_poly(_, ty) -> (* should not happen? *)
+      Location.raise_errorf ~loc:ty.ptyp_loc "Unhandled poly type"
+    | return_type -> ty, List.rev acc
+  in aux ty []
 
-let kind_table =
-  ["float32_elt", Pbigarray_float32;
-   "float64_elt", Pbigarray_float64;
-   "int8_signed_elt", Pbigarray_sint8;
-   "int8_unsigned_elt", Pbigarray_uint8;
-   "int16_signed_elt", Pbigarray_sint16;
-   "int16_unsigned_elt", Pbigarray_uint16;
-   "int32_elt", Pbigarray_int32;
-   "int64_elt", Pbigarray_int64;
-   "int_elt", Pbigarray_caml_int;
-   "nativeint_elt", Pbigarray_native_int;
-   "complex32_elt", Pbigarray_complex32;
-   "complex64_elt", Pbigarray_complex64]
+(** Note that the passed [type_annotation] is already processed by visitor pattern before 
+*)
+let handle_attributes 
+    (loc : Bs_loc.t)
+    (pval_prim : string ) 
+    (type_annotation : Parsetree.core_type)
+    (prim_attributes : Ast_attributes.t) (prim_name : string)
+  : Ast_core_type.t * string * t * Ast_attributes.t =
+  let prim_name_or_pval_prim =
+    if String.length prim_name = 0 then  `Nm_val pval_prim
+    else  `Nm_external prim_name  (* need check name *)
+  in    
+  let result_type, arg_types_ty =
+    list_of_arrow type_annotation in
+  let result_type_spec, new_result_type  = get_arg_type result_type in
+  let (st, left_attrs) = 
+    process_external_attributes 
+      (arg_types_ty = [])
+      prim_name_or_pval_prim pval_prim prim_attributes in 
 
-let layout_table =
-  ["c_layout", Pbigarray_c_layout;
-   "fortran_layout", Pbigarray_fortran_layout]
+  let splice = st.splice in 
+  let arg_type_specs, new_arg_types_ty, arg_type_specs_length   = 
+    List.fold_right 
+      (fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) -> 
+         let spec, new_ty = get_arg_type ty in
+         (if i = 0 && splice  then
+           match spec with 
+           | Array  -> ()
+           | _ ->  Location.raise_errorf ~loc "[@@bs.splice] expect last type to array");
+         ({ arg_label = Ast_core_type.label_name label ; 
+            arg_type = spec 
+          } :: arg_type_specs,
+          (label, new_ty,attr,loc) :: arg_types,
+          i + 1)
+      ) arg_types_ty 
+      (match st with
+       | {val_send_pipe = Some obj} ->      
+         let spec, new_ty = get_arg_type obj in 
+         [{ arg_label = Empty ; 
+           arg_type = spec
+          }],
+         ["", new_ty, [], obj.ptyp_loc]
+         ,0
+       | {val_send_pipe = None } -> [],[], 0) in 
 
-let bigarray_kind_and_layout exp =
-  match scrape exp.exp_env exp.exp_type with
-  | Tconstr(p, [caml_type; elt_type; layout_type], abbrev) ->
-      (bigarray_decode_type exp.exp_env elt_type kind_table Pbigarray_unknown,
-       bigarray_decode_type exp.exp_env layout_type layout_table
-                            Pbigarray_unknown_layout)
-  | _ ->
-      (Pbigarray_unknown, Pbigarray_unknown_layout)
 
-end
-module Matching : sig 
-#1 "matching.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+  let ffi = 
+    match st with 
+    | { mk_obj = true;
+        val_name = `Nm_na; 
+        external_module_name = None ;
+        module_as_val = None;
+        val_send = `Nm_na;
+        val_send_pipe = None;    
+        splice = false;
+        new_name = `Nm_na;
+        call_name = `Nm_na;
+        set_name = `Nm_na ;
+        get_name = `Nm_na ;
+        get_index = false ;
+      } ->
+      if String.length prim_name <> 0 then 
+        Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string";
+      Obj_create (List.map (function
+          | {arg_label = (Empty as l) ; arg_type = Unit  }
+            -> l 
+          | {arg_label = Empty ; arg_type = _ }
+            -> Location.raise_errorf ~loc "expect label, optional, or unit here"
+          | {arg_label = (Label _) ; arg_type = (Ignore | Unit) ; }
+            -> Empty
+          | {arg_label = Label name ; arg_type = (Nothing | Array)} -> 
+            Label (Lam_methname.translate ~loc name)            
+          | {arg_label = Label l ; arg_type = (NullString _ | NonNullString _ | Int _ ) }
+            -> Location.raise_errorf ~loc 
+                 "bs.obj label %s does not support such arg type" l
+          | {arg_label = Optional name ; arg_type = (Nothing | Array | Unit | Ignore)} 
+            -> Optional (Lam_methname.translate ~loc name)
+          | {arg_label = Optional l ; arg_type = (NullString _ | NonNullString _ | Int _)} 
+            -> Location.raise_errorf ~loc 
+                 "bs.obj optional %s does not support such arg type" l )
+          arg_type_specs)(* Need fetch label here, for better error message *)
+    | {mk_obj = true; _}
+      ->
+      Location.raise_errorf ~loc "conflict attributes found"                
+    | {set_index = true;
 
-(* Compilation of pattern-matching *)
+       val_name = `Nm_na; 
+       external_module_name = None ;
+       module_as_val = None;
+       val_send = `Nm_na;
+       val_send_pipe = None;    
+       splice = false;
+       get_index = false;
+       new_name = `Nm_na;
+       call_name = `Nm_na;
+       set_name = `Nm_na ;
+       get_name = `Nm_na ;
+       mk_obj = false ; 
 
-open Typedtree
-open Lambda
+      } 
+      ->
+      if String.length prim_name <> 0 then 
+        Location.raise_errorf ~loc "[@@bs.set_index] expect external names to be empty string";
+      if arg_type_specs_length = 3 then 
+          Js_set_index
+      else 
+        Location.raise_errorf ~loc "Ill defined attribute [@@bs.set_index](arity of 3)"
 
+    | {set_index = true; _}
+      ->
+      Location.raise_errorf ~loc "conflict attributes found"        
 
-(* Entry points to match compiler *)
-val for_function:
-        Location.t -> int ref option -> lambda -> (pattern * lambda) list ->
-        partial -> lambda
-val for_trywith:
-        lambda -> (pattern * lambda) list -> lambda
-val for_let:
-        Location.t -> lambda -> pattern -> lambda -> lambda
-val for_multiple_match:
-        Location.t -> lambda list -> (pattern * lambda) list -> partial ->
-        lambda
+    | {get_index = true;
 
-val for_tupled_function:
-        Location.t -> Ident.t list -> (pattern list * lambda) list ->
-        partial -> lambda
+       val_name = `Nm_na; 
+       external_module_name = None ;
+       module_as_val = None;
+       val_send = `Nm_na;
+       val_send_pipe = None;    
 
-exception Cannot_flatten
+       splice = false;
+       new_name = `Nm_na;
+       call_name = `Nm_na;
+       set_name = `Nm_na ;
+       get_name = `Nm_na ;
+       mk_obj = false ; 
+      } ->
+      if String.length prim_name <> 0 then 
+        Location.raise_errorf ~loc "[@@bs.get_index] expect external names to be empty string";
+      if arg_type_specs_length = 2 then 
+          Js_get_index
+      else Location.raise_errorf ~loc "Ill defined attribute [@@bs.get_index] (arity of 2)"
 
-val flatten_pattern: int -> pattern -> pattern list
+    | {get_index = true; _}
+      -> Location.raise_errorf ~loc "conflict attributes found"        
+    | {module_as_val = Some external_module_name ;
 
-(* Expand stringswitch to  string test tree *)
-val expand_stringswitch:
-    Location.t -> lambda -> (string * lambda) list -> lambda option -> lambda
+       get_index = false;
+       val_name ;
+       new_name ;
+       (*TODO: a better way to avoid breaking existing code,
+         we need tell the difference from 
+         {[
+           1. [@@bs.val "x"]
+           2. external x : .. "x" [@@bs.val ]
+           3. external x : .. ""  [@@bs.val]    ]}
+                                                *)         
+      external_module_name = None ;
+      val_send = `Nm_na;
+      val_send_pipe = None;    
+      splice ;
+      call_name = `Nm_na;
+      set_name = `Nm_na ;
+      get_name = `Nm_na ;
+      mk_obj = false ;} ->
+   begin match arg_types_ty, new_name, val_name  with         
+    | [], `Nm_na,  _ -> Js_module_as_var external_module_name
+    | _, `Nm_na, _ -> Js_module_as_fn {splice; external_module_name }
+    | _, #bundle_source, #bundle_source ->
+      Location.raise_errorf ~loc "conflict attributes found"
+    | _, (`Nm_val _ | `Nm_external _) , `Nm_na
+      -> Js_module_as_class external_module_name
+    | _, `Nm_payload _ , `Nm_na
+      ->
+      Location.raise_errorf ~loc
+        "conflict attributes found: (bs.new should not carry payload here)"
 
-val inline_lazy_force : lambda -> Location.t -> lambda
+  end
+ | {module_as_val = Some _}
+   -> Location.raise_errorf ~loc "conflict attributes found" 
+ | {call_name = (`Nm_val name | `Nm_external name | `Nm_payload name) ;
+    splice; 
+    external_module_name;
 
-end = struct
-#1 "matching.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+    val_name = `Nm_na ;
+    module_as_val = None;
+    val_send = `Nm_na ;
+    val_send_pipe = None;    
 
-(* Compilation of pattern matching *)
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na 
+   } -> 
+   Js_call {splice; name; external_module_name}
+ | {call_name = #bundle_source } 
+   -> Location.raise_errorf ~loc "conflict attributes found"
 
-open Misc
-open Asttypes
-open Primitive
-open Types
-open Typedtree
-open Lambda
-open Parmatch
-open Printf
+ | {val_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
+    external_module_name;
 
+    call_name = `Nm_na ;
+    module_as_val = None;
+    val_send = `Nm_na ;
+    val_send_pipe = None;    
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na 
 
-let dbg = false
+   } 
+   -> 
+   Js_global { name; external_module_name}
+ | {val_name = #bundle_source }
+   -> Location.raise_errorf ~loc "conflict attributes found"
+ | {splice ;
+    external_module_name = (Some _ as external_module_name);
 
-(*  See Peyton-Jones, ``The Implementation of functional programming
-    languages'', chapter 5. *)
-(*
-  Bon, au commencement du monde c'etait vrai.
-  Now, see Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001
-*)
+    val_name = `Nm_na ;         
+    call_name = `Nm_na ;
+    module_as_val = None;
+    val_send = `Nm_na ;
+    val_send_pipe = None;             
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na ;
 
+   }
+   ->
+   let name = string_of_bundle_source prim_name_or_pval_prim in
+   if arg_type_specs_length  = 0 then
+     Js_global { name; external_module_name}
+   else  Js_call {splice; name; external_module_name}                     
+ | {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name); 
+    splice;
+    val_send_pipe = None;
+    val_name = `Nm_na  ;
+    call_name = `Nm_na ;
+    module_as_val = None;
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na ;
+    external_module_name = None ;
+   } -> 
+   if arg_type_specs_length > 0 then 
+       Js_send {splice ; name; pipe = false}
+   else 
+       Location.raise_errorf ~loc "Ill defined attribute [@@bs.send] (at least one argument)"
+ | {val_send = #bundle_source} 
+   -> Location.raise_errorf ~loc "conflict attributes found"
 
-(*
-   Many functions on the various data structures of the algorithm :
-     - Pattern matrices.
-     - Default environments: mapping from matrices to exit numbers.
-     - Contexts:  matrices whose column are partitioned into
-       left and right.
-     - Jump summaries: mapping from exit numbers to contexts
-*)
+ | {val_send_pipe = Some typ; 
+    (* splice = (false as splice); *)
+    val_send = `Nm_na;
+    val_name = `Nm_na  ;
+    call_name = `Nm_na ;
+    module_as_val = None;
+    set_index = false;
+    get_index = false;
+    new_name = `Nm_na;
+    set_name = `Nm_na ;
+    get_name = `Nm_na ;
+    external_module_name = None ;
+   } -> 
+   (** can be one argument *)
+   Js_send {splice  ;
+            name = string_of_bundle_source prim_name_or_pval_prim;
+            pipe = true}
 
-let string_of_lam lam =
-  Printlambda.lambda Format.str_formatter lam ;
-  Format.flush_str_formatter ()
+ | {val_send_pipe = Some _ } 
+   -> Location.raise_errorf ~loc "conflict attributes found"
 
-type matrix = pattern list list
+ | {new_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
+    external_module_name;
 
-let add_omega_column pss = List.map (fun ps -> omega::ps) pss
+    val_name = `Nm_na  ;
+    call_name = `Nm_na ;
+    module_as_val = None;
+    set_index = false;
+    get_index = false;
+    val_send = `Nm_na ;
+    val_send_pipe = None;             
+    set_name = `Nm_na ;
+    get_name = `Nm_na ;
+    splice 
+   } 
+   -> Js_new {name; external_module_name; splice}
+ | {new_name = #bundle_source }
+   -> Location.raise_errorf ~loc "conflict attributes found"
 
-type ctx = {left:pattern list ; right:pattern list}
+ | {set_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
 
-let pretty_ctx ctx =
-  List.iter
-    (fun {left=left ; right=right} ->
-      prerr_string "LEFT:" ;
-      pretty_line left ;
-      prerr_string " RIGHT:" ;
-      pretty_line right ;
-      prerr_endline "")
-    ctx
+    val_name = `Nm_na  ;
+    call_name = `Nm_na ;
+    module_as_val = None;
+    set_index = false;
+    get_index = false;
+    val_send = `Nm_na ;
+    val_send_pipe = None;             
+    new_name = `Nm_na ;
+    get_name = `Nm_na ;
+    external_module_name = None
+   } 
+   -> 
+   if arg_type_specs_length = 2 then 
+       Js_set name 
+   else  Location.raise_errorf ~loc "Ill defined attribute [@@bs.set] (two args required)"
 
-let le_ctx c1 c2 =
-  le_pats c1.left c2.left &&
-  le_pats c1.right c2.right
+ | {set_name = #bundle_source}
+   -> Location.raise_errorf ~loc "conflict attributes found"
 
-let lshift {left=left ; right=right} = match right with
-| x::xs -> {left=x::left ; right=xs}
-| _ ->  assert false
+ | {get_name = (`Nm_val name | `Nm_external name | `Nm_payload name);
 
-let lforget {left=left ; right=right} = match right with
-| x::xs -> {left=omega::left ; right=xs}
-|  _ -> assert false
+    val_name = `Nm_na  ;
+    call_name = `Nm_na ;
+    module_as_val = None;
+    set_index = false;
+    get_index = false;
+    val_send = `Nm_na ;
+    val_send_pipe = None;             
+    new_name = `Nm_na ;
+    set_name = `Nm_na ;
+    external_module_name = None
+   }
+   ->
+   if arg_type_specs_length = 1 then  
+     Js_get name
+   else 
+       Location.raise_errorf ~loc "Ill defined attribute [@@bs.get] (only one argument)"
+ | {get_name = #bundle_source}
+   -> Location.raise_errorf ~loc "conflict attributes found"
+ | _ ->  Location.raise_errorf ~loc "Illegal attribute found"  in
+  begin 
+    check_ffi ~loc ffi;
+    (match ffi, new_result_type with
+     | Obj_create arg_labels ,  {ptyp_desc = Ptyp_any; _}
+       ->
+       (* special case: 
+          {[ external f : int -> string -> _ = "" ]}
+       *)
+       let result =
+         Ast_core_type.make_obj ~loc (
+           List.fold_right2  (fun arg label acc ->
+               match arg, label with
+               | (_, ty, _,_), Ast_core_type.Label s
+                 -> (s , [], ty) :: acc                 
+               | (_, ty, _,_), Optional s
+                 ->
+                 begin match (ty : Ast_core_type.t) with
+                   | {ptyp_desc =
+                        Ptyp_constr({txt =
+                                       Ldot (Lident "*predef*", "option") },
+                                    [ty])}
+                     ->                
+                     (s, [], Ast_comb.to_undefined_type loc ty) :: acc
+                   | _ -> assert false                 
+                 end                 
+               | (_, _, _,_), Ast_core_type.Empty -> acc                
+             ) arg_types_ty arg_labels [])  in
 
-let rec small_enough n = function
-  | [] -> true
-  | _::rem ->
-      if n <= 0 then false
-      else small_enough (n-1) rem
+       List.fold_right (fun (label,ty,attrs,loc) acc -> 
+           Ast_helper.Typ.arrow ~loc  ~attrs label ty acc 
+           ) new_arg_types_ty result 
 
-let ctx_lshift ctx =
-  if small_enough 31 ctx then
-    List.map lshift ctx
-  else (* Context pruning *) begin
-    get_mins le_ctx (List.map lforget ctx)
+       (* Ast_core_type.replace_result type_annotation result *)
+     | _  ->
+       List.fold_right (fun (label,ty,attrs,loc) acc -> 
+           Ast_helper.Typ.arrow ~loc  ~attrs label ty acc 
+           ) new_arg_types_ty new_result_type
+    ) ,
+    prim_name,
+    (Bs(arg_type_specs, result_type_spec,  ffi)), left_attrs
   end
 
-let  rshift {left=left ; right=right} = match left with
-| p::ps -> {left=ps ; right=p::right}
-| _ -> assert false
-
-let ctx_rshift ctx = List.map rshift ctx
+let handle_attributes_as_string 
+    pval_loc
+    pval_prim 
+    (typ : Ast_core_type.t) attrs v = 
+  let pval_type, prim_name, ffi, processed_attrs  = 
+    handle_attributes pval_loc pval_prim typ attrs v  in
+  pval_type, [prim_name; to_string ffi], processed_attrs
+    
+let pval_prim_of_labels labels = 
+  let encoding = 
+    let (arg_kinds, vs) = 
+      List.fold_right 
+        (fun {Asttypes.loc ; txt } (arg_kinds,v)
+          ->
+            let arg_label =  Ast_core_type.Label (Lam_methname.translate ~loc txt) in
+            {arg_type = Nothing ; 
+             arg_label  } :: arg_kinds, arg_label :: v
+        )
+        labels ([],[]) in 
+    to_string @@
+    Bs (arg_kinds , Nothing, Obj_create vs) in 
+  [""; encoding]
 
-let rec nchars n ps =
-  if n <= 0 then [],ps
-  else match ps with
-  | p::rem ->
-    let chars, cdrs = nchars (n-1) rem in
-    p::chars,cdrs
-  | _ -> assert false
 
-let  rshift_num n {left=left ; right=right} =
-  let shifted,left = nchars n left in
-  {left=left ; right = shifted@right}
+end
+module Js_of_lam_option : sig 
+#1 "js_of_lam_option.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let ctx_rshift_num n ctx = List.map (rshift_num n) ctx
 
-(* Recombination of contexts (eg: (_,_)::p1::p2::rem ->  (p1,p2)::rem)
-  All mutable fields are replaced by '_', since side-effects in
-  guards can alter these fields *)
 
-let combine {left=left ; right=right} = match left with
-| p::ps -> {left=ps ; right=set_args_erase_mutable p right}
-| _ -> assert false
 
-let ctx_combine ctx = List.map combine ctx
 
-let ncols = function
-  | [] -> 0
-  | ps::_ -> List.length ps
 
 
-exception NoMatch
-exception OrPat
+val get_default_undefined : J.expression -> J.expression
 
-let filter_matrix matcher pss =
+val none : J.expression 
 
-  let rec filter_rec = function
-    | (p::ps)::rem ->
-        begin match p.pat_desc with
-        | Tpat_alias (p,_,_) ->
-            filter_rec ((p::ps)::rem)
-        | Tpat_var _ ->
-            filter_rec ((omega::ps)::rem)
-        | _ ->
-            begin
-              let rem = filter_rec rem in
-              try
-                matcher p ps::rem
-              with
-              | NoMatch -> rem
-              | OrPat   ->
-                match p.pat_desc with
-                | Tpat_or (p1,p2,_) -> filter_rec [(p1::ps) ;(p2::ps)]@rem
-                | _ -> assert false
-            end
-        end
-    | [] -> []
-    | _ ->
-        pretty_matrix pss ;
-        fatal_error "Matching.filter_matrix" in
-  filter_rec pss
+val some : J.expression -> J.expression
 
-let make_default matcher env =
-  let rec make_rec = function
-    | [] -> []
-    | ([[]],i)::_ -> [[[]],i]
-    | (pss,i)::rem ->
-        let rem = make_rec rem in
-        match filter_matrix matcher pss with
-        | [] -> rem
-        | ([]::_) -> ([[]],i)::rem
-        | pss -> (pss,i)::rem in
-  make_rec env
+end = struct
+#1 "js_of_lam_option.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let ctx_matcher p =
-  let p = normalize_pat p in
-  match p.pat_desc with
-  | Tpat_construct (_, cstr,omegas) ->
-      begin match cstr.cstr_tag with
-      | Cstr_extension _ ->
-          let nargs = List.length omegas in
-          (fun q rem -> match q.pat_desc with
-          | Tpat_construct (_, cstr',args)
-            when List.length args = nargs ->
-                p,args @ rem
-          | Tpat_any -> p,omegas @ rem
-          | _ -> raise NoMatch)
-      | _ ->
-          (fun q rem -> match q.pat_desc with
-          | Tpat_construct (_, cstr',args)
-            when cstr.cstr_tag=cstr'.cstr_tag ->
-              p,args @ rem
-          | Tpat_any -> p,omegas @ rem
-          | _ -> raise NoMatch)
-      end
-  | Tpat_constant cst ->
-      (fun q rem -> match q.pat_desc with
-      | Tpat_constant cst' when const_compare cst cst' = 0 ->
-          p,rem
-      | Tpat_any -> p,rem
-      | _ -> raise NoMatch)
-  | Tpat_variant (lab,Some omega,_) ->
-      (fun q rem -> match q.pat_desc with
-      | Tpat_variant (lab',Some arg,_) when lab=lab' ->
-          p,arg::rem
-      | Tpat_any -> p,omega::rem
-      | _ -> raise NoMatch)
-  | Tpat_variant (lab,None,_) ->
-      (fun q rem -> match q.pat_desc with
-      | Tpat_variant (lab',None,_) when lab=lab' ->
-          p,rem
-      | Tpat_any -> p,rem
-      | _ -> raise NoMatch)
-  | Tpat_array omegas ->
-      let len = List.length omegas in
-      (fun q rem -> match q.pat_desc with
-      | Tpat_array args when List.length args=len ->
-          p,args @ rem
-      | Tpat_any -> p, omegas @ rem
-      | _ -> raise NoMatch)
-  | Tpat_tuple omegas ->
-      (fun q rem -> match q.pat_desc with
-      | Tpat_tuple args -> p,args @ rem
-      | _          -> p, omegas @ rem)
-  | Tpat_record (l,_) -> (* Records are normalized *)
-      (fun q rem -> match q.pat_desc with
-      | Tpat_record (l',_) ->
-          let l' = all_record_args l' in
-          p, List.fold_right (fun (_, _,p) r -> p::r) l' rem
-      | _ -> p,List.fold_right (fun (_, _,p) r -> p::r) l rem)
-  | Tpat_lazy omega ->
-      (fun q rem -> match q.pat_desc with
-      | Tpat_lazy arg -> p, (arg::rem)
-      | _          -> p, (omega::rem))
- | _ -> fatal_error "Matching.ctx_matcher"
 
 
 
 
-let filter_ctx q ctx =
 
-  let matcher = ctx_matcher q in
+module E = Js_exp_make 
+ 
+(**
+  Invrariant: 
+  - optional encoding
+  -  None encoding
 
-  let rec filter_rec = function
-    | ({right=p::ps} as l)::rem ->
-        begin match p.pat_desc with
-        | Tpat_or (p1,p2,_) ->
-            filter_rec ({l with right=p1::ps}::{l with right=p2::ps}::rem)
-        | Tpat_alias (p,_,_) ->
-            filter_rec ({l with right=p::ps}::rem)
-        | Tpat_var _ ->
-            filter_rec ({l with right=omega::ps}::rem)
-        | _ ->
-            begin let rem = filter_rec rem in
-            try
-              let to_left, right = matcher p ps in
-              {left=to_left::l.left ; right=right}::rem
-            with
-            | NoMatch -> rem
-            end
-        end
-    | [] -> []
-    | _ ->  fatal_error "Matching.filter_ctx" in
+  when no argumet is supplied, [undefined] 
+  if we detect that all rest arguments are [null], 
+  we can remove them
 
-  filter_rec ctx
 
-let select_columns pss ctx =
-  let n = ncols pss in
-  List.fold_right
-    (fun ps r ->
-      List.fold_right
-        (fun {left=left ; right=right} r ->
-          let transfert, right = nchars n right in
-          try
-            {left = lubs transfert ps @ left ; right=right}::r
-          with
-          | Empty -> r)
-        ctx r)
-    pss []
+  - avoid duplicate evlauation of [arg] when it
+   is not a variable
+  {!Js_ast_util.named_expression} does not help 
+   since we need an expression here, it might be a statement
+*)
+let get_default_undefined (arg : J.expression) : J.expression = 
+  match arg.expression_desc with 
+  | Number _ -> E.undefined
+  | Array ([x],_) 
+  | Caml_block([x],_,_,_) -> x (* invariant: option encoding *)
+  | _ -> 
+    if Js_ast_util.is_simple_expression arg then 
+      E.econd arg (E.index arg 0l) E.undefined
+    else E.runtime_call Js_config.js_primitive "option_get" [arg]
+  
+(** Another way: 
+    {[
+      | Var _  ->
+        can only bd detected at runtime thing
+          (E.bin EqEqEq (E.typeof arg)
+             (E.str "number"))
+    ]}
+*)
+let none : J.expression = 
+  {expression_desc = Number (Int {i = 0l; c  = None}); comment = Some "None" }
 
-let ctx_lub p ctx =
-  List.fold_right
-    (fun {left=left ; right=right} r ->
-      match right with
-      | q::rem ->
-          begin try
-            {left=left ; right = lub p q::rem}::r
-          with
-          | Empty -> r
-          end
-      | _ -> fatal_error "Matching.ctx_lub")
-    ctx []
+let some x : J.expression = 
+  {expression_desc = Caml_block ( [x], Immutable, E.zero_int_literal , Blk_constructor ("Some",1) );
+   comment = None}
 
-let ctx_match ctx pss =
-  List.exists
-    (fun {right=qs} ->
-      List.exists
-        (fun ps -> compats qs ps)
-        pss)
-    ctx
 
-type jumps = (int * ctx list) list
 
-let pretty_jumps (env : jumps) = match env with
-| [] -> ()
-| _ ->
-    List.iter
-      (fun (i,ctx) ->
-        Printf.fprintf stderr "jump for %d\n" i ;
-        pretty_ctx ctx)
-      env
 
 
-let rec jumps_extract i = function
-  | [] -> [],[]
-  | (j,pss) as x::rem as all ->
-      if i=j then pss,rem
-      else if j < i then [],all
-      else
-        let r,rem = jumps_extract i rem in
-        r,(x::rem)
 
-let rec jumps_remove i = function
-  | [] -> []
-  | (j,_)::rem when i=j -> rem
-  | x::rem -> x::jumps_remove i rem
 
-let jumps_empty = []
-and jumps_is_empty = function
-  |  [] -> true
-  |  _ -> false
 
-let jumps_singleton i = function
-  | []  -> []
-  | ctx ->  [i,ctx]
+end
+module Js_of_lam_variant : sig 
+#1 "js_of_lam_variant.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let jumps_add i pss jumps = match pss with
-| [] -> jumps
-| _  ->
-    let rec add = function
-      | [] -> [i,pss]
-      | (j,qss) as x::rem as all ->
-          if j > i then x::add rem
-      else if j < i then (i,pss)::all
-      else (i,(get_mins le_ctx (pss@qss)))::rem in
-    add jumps
+val eval : J.expression -> (int * string) list -> J.expression
+val eval_as_event : J.expression -> (int * string) list -> J.expression list 
+val eval_as_int : J.expression -> (int * int) list -> J.expression
 
+end = struct
+#1 "js_of_lam_variant.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with
-| [],_ -> env2
-| _,[] -> env1
-| ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) ->
-    if i1=i2 then
-      (i1,get_mins le_ctx (pss1@pss2))::jumps_union rem1 rem2
-    else if i1 > i2 then
-      x1::jumps_union rem1 env2
-    else
-      x2::jumps_union env1 rem2
+module E = Js_exp_make
+module S = Js_stmt_make
 
+let eval (arg : J.expression) (dispatches : (int * string) list ) = 
+  match arg.expression_desc with
+  | Number (Int {i} | Uint i) -> 
+    begin match List.assoc (Int32.to_int i) dispatches with 
+    | exception Not_found -> assert false 
+    | v ->  E.str v 
+    end
 
-let rec merge = function
-  | env1::env2::rem ->  jumps_union env1 env2::merge rem
-  | envs -> envs
+  | _ ->  
+    E.of_block
+      [(S.int_switch arg
+      (List.map (fun (i,r) -> 
+              {J.case = i ; 
+               body = [S.return (E.str r)],
+                      false (* FIXME: if true, still print break*)
+              }) dispatches))]
 
-let rec jumps_unions envs = match envs with
-  | [] -> []
-  | [env] -> env
-  | _ -> jumps_unions (merge envs)
+let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) = 
+  match arg.expression_desc with
+  | Array ([{expression_desc = Number (Int {i} | Uint i)}; cb], _)
+  | Caml_block([{expression_desc = Number (Int {i} | Uint i)}; cb], _, _, _)
+    -> 
+    begin match (List.assoc (Int32.to_int i) dispatches) with 
+    | v ->     [E.str v ; cb]
+    | exception Not_found -> assert false 
+    end
 
-let jumps_map f env =
-  List.map
-    (fun (i,pss) -> i,f pss)
-    env
+  | _ ->  
+    let event = Ext_ident.create "action" in
+    [
+      E.ocaml_fun [event]
+      [(S.int_switch arg
+      (List.map (fun (i,r) -> 
+              {J.case = i ; 
+               body = [S.return (E.index (E.var event) 0l)],
+                      false (* FIXME: if true, still print break*)
+              }) dispatches))]
+      ; (* TODO: improve, one dispatch later, 
+           the problem is that we can not create bindings 
+           due to the 
+        *)
+      E.ocaml_fun [event]
+      [(S.int_switch arg
+      (List.map (fun (i,r) -> 
+              {J.case = i ; 
+               body = [S.return (E.index (E.var event) 1l)],
+                      false (* FIXME: if true, still print break*)
+              }) dispatches))]
+    ]
 
-(* Pattern matching before any compilation *)
+let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) = 
+  match arg.expression_desc with
+  | Number (Int {i} | Uint i) ->
+    begin match  (List.assoc (Int32.to_int i) dispatches) with
+    | e -> E.int (Int32.of_int e)
+    | exception Not_found -> assert false 
+    end
+  | _ ->  
+    E.of_block
+      [(S.int_switch arg
+      (List.map (fun (i,r) -> 
+              {J.case = i ; 
+               body = [S.return (E.int (Int32.of_int  r))],
+                      false (* FIXME: if true, still print break*)
+              }) dispatches))]
 
-type pattern_matching =
-  { mutable cases : (pattern list * lambda) list;
-    args : (lambda * let_kind) list ;
-    default : (matrix * int) list}
+end
+module Js_of_lam_tuple : sig 
+#1 "js_of_lam_tuple.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* Pattern matching after application of both the or-pat rule and the
-   mixture rule *)
 
-type pm_or_compiled =
-  {body : pattern_matching ;
-   handlers : (matrix * int * Ident.t list * pattern_matching) list ;
-   or_matrix : matrix ; }
 
-type pm_half_compiled =
-  | PmOr of pm_or_compiled
-  | PmVar of pm_var_compiled
-  | Pm of pattern_matching
 
-and pm_var_compiled =
-    {inside : pm_half_compiled ; var_arg : lambda ; }
 
-type pm_half_compiled_info =
-    {me : pm_half_compiled ;
-     matrix : matrix ;
-     top_default : (matrix * int) list ; }
 
-let pretty_cases cases =
-  List.iter
-    (fun ((ps),l) ->
-      List.iter
-        (fun p ->
-          Parmatch.top_pretty Format.str_formatter p ;
-          prerr_string " " ;
-          prerr_string (Format.flush_str_formatter ()))
-        ps ;
-(*
-      prerr_string " -> " ;
-      Printlambda.lambda Format.str_formatter l ;
-      prerr_string (Format.flush_str_formatter ()) ;
-*)
-      prerr_endline "")
-    cases
 
-let pretty_def def =
-  prerr_endline "+++++ Defaults +++++" ;
-  List.iter
-    (fun (pss,i) ->
-      Printf.fprintf stderr "Matrix for %d\n"  i ;
-      pretty_matrix pss)
-    def ;
-  prerr_endline "+++++++++++++++++++++"
 
-let pretty_pm pm = pretty_cases pm.cases
+(** Utilities for compiling lambda tuple into JS IR *)
 
+val make : J.expression list -> J.expression
 
-let rec pretty_precompiled = function
-  | Pm pm ->
-      prerr_endline "++++ PM ++++" ;
-      pretty_pm pm
-  | PmVar x ->
-      prerr_endline "++++ VAR ++++" ;
-      pretty_precompiled x.inside
-  | PmOr x ->
-      prerr_endline "++++ OR ++++" ;
-      pretty_pm x.body ;
-      pretty_matrix x.or_matrix ;
-      List.iter
-        (fun (_,i,_,pm) ->
-          eprintf "++ Handler %d ++\n" i ;
-          pretty_pm pm)
-        x.handlers
+end = struct
+#1 "js_of_lam_tuple.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let pretty_precompiled_res first nexts =
-  pretty_precompiled first ;
-  List.iter
-    (fun (e, pmh) ->
-      eprintf "** DEFAULT %d **\n" e ;
-      pretty_precompiled pmh)
-    nexts
 
 
 
-(* Identifing some semantically equivalent lambda-expressions,
-   Our goal here is also to
-   find alpha-equivalent (simple) terms *)
 
-(* However, as shown by PR#6359 such sharing may hinders the
-   lambda-code invariant that all bound idents are unique,
-   when switchs are compiled to test sequences.
-   The definitive fix is the systematic introduction of exit/catch
-   in case action sharing is present.
-*)
 
 
-module StoreExp =
-  Switch.Store
-    (struct
-      type t = lambda
-      type key = lambda
-      let make_key = Lambda.make_key
-    end)
 
+module E = Js_exp_make
 
-let make_exit i = Lstaticraise (i,[])
+let make (args : J.expression list) =
+  E.make_block E.zero_int_literal Blk_tuple args Immutable
 
-(* Introduce a catch, if worth it *)
-let make_catch d k = match d with
-| Lstaticraise (_,[]) -> k d
-| _ ->
-    let e = next_raise_count () in
-    Lstaticcatch (k (make_exit e),(e,[]),d)
 
-(* Introduce a catch, if worth it, delayed version *)
-let rec as_simple_exit = function
-  | Lstaticraise (i,[]) -> Some i
-  | Llet (Alias,_,_,e) -> as_simple_exit e
-  | _ -> None
+end
+module Lam_dispatch_primitive : sig 
+#1 "lam_dispatch_primitive.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-let make_catch_delayed handler = match as_simple_exit handler with
-| Some i -> i,(fun act -> act)
-| None ->
-    let i = next_raise_count () in
-(*
-    Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler);
-*)
-    i,
-    (fun body -> match body with
-    | Lstaticraise (j,_) ->
-        if i=j then handler else body
-    | _ -> Lstaticcatch (body,(i,[]),handler))
 
 
-let raw_action l =
-  match make_key l with | Some l -> l | None -> l
 
 
-let tr_raw act = match make_key act with
-| Some act -> act
-| None -> raise Exit
 
-let same_actions = function
-  | [] -> None
-  | [_,act] -> Some act
-  | (_,act0) :: rem ->
-      try
-        let raw_act0 = tr_raw act0 in
-        let rec s_rec = function
-          | [] -> Some act0
-          | (_,act)::rem ->
-              if raw_act0 = tr_raw act then
-                s_rec rem
-              else
-                None in
-        s_rec rem
-      with
-      | Exit -> None
 
 
-(* Test for swapping two clauses *)
+(** Compile lambda primitives (note this is different external c calls) *)
 
-let up_ok_action act1 act2 =
-  try
-    let raw1 = tr_raw act1
-    and raw2 = tr_raw act2 in
-    raw1 = raw2
-  with
-  | Exit -> false
 
-(* Nothing is kown about exception/extension patterns,
-   because of potential rebind *)
-let rec exc_inside p = match p.pat_desc with
-  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
-  | Tpat_any|Tpat_constant _|Tpat_var _
-  | Tpat_construct (_,_,[])
-  | Tpat_variant (_,None,_)
-    -> false
-  | Tpat_construct (_,_,ps)
-  | Tpat_tuple ps
-  | Tpat_array ps
-      -> exc_insides ps
-  | Tpat_variant (_, Some q,_)
-  | Tpat_alias (q,_,_)
-  | Tpat_lazy q
-    -> exc_inside q
-  | Tpat_record (lps,_) ->
-      List.exists (fun (_,_,p) -> exc_inside p) lps
-  | Tpat_or (p1,p2,_) -> exc_inside p1 || exc_inside p2
+(** 
+    @return None when the primitives are not handled in  pre-processing
+ *)
+val translate : 
+  string ->
+  J.expression list -> J.expression 
+
+end = struct
+#1 "lam_dispatch_primitive.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
 
-and exc_insides ps = List.exists exc_inside ps
 
-let up_ok (ps,act_p) l =
-  if exc_insides ps then match l with [] -> true | _::_ -> false
-  else
-    List.for_all
-      (fun (qs,act_q) ->
-        up_ok_action act_p act_q ||
-        not (Parmatch.compats ps qs))
-      l
 
 
-(*
-   Simplify fonction normalize the first column of the match
-     - records are expanded so that they posses all fields
-     - aliases are removed and replaced by bindings in actions.
-   However or-patterns are simplified differently,
-     - aliases are not removed
-     - or patterns (_|p) are changed into _
+
+
+
+
+module E = Js_exp_make  
+module S = Js_stmt_make
+
+
+(** 
+There are two things we need consider:
+1.  For some primitives we can replace caml-primitive with js primitives directly
+2.  For some standard library functions, we prefer to replace with javascript primitives
+    For example [Pervasives["^"] -> ^]
+    We can collect all mli files in OCaml and replace it with an efficient javascript runtime
+
+TODO: return type to be expression is ugly, 
+   we should allow return block    
 *)
+let translate (prim_name : string) 
+    (args : J.expression list) : J.expression  =
+  let call m = E.runtime_call m prim_name args in 
+  begin match prim_name with 
+  | "caml_gc_stat" 
+  | "caml_gc_quick_stat"  
+  | "caml_gc_counters"
+  | "caml_gc_get"
+  | "caml_gc_set"
+  | "caml_gc_minor"
+  | "caml_gc_major_slice"
+  | "caml_gc_major"
+  | "caml_gc_full_major"
+  | "caml_gc_compaction"
+  | "caml_final_register"
+  | "caml_final_release"
+    ->  call Js_config.gc
+  | "caml_abs_float" -> 
+    E.math "abs" args 
+  | "caml_acos_float" -> 
+    E.math "acos" args 
+  |  "caml_add_float" -> 
+    begin match args with 
+    | [e0;e1] -> E.float_add e0 e1 (** TODO float plus*)
+    | _ -> assert false
+    end
+  |"caml_div_float" -> 
+    begin match args with 
+    | [e0;e1] -> E.float_div e0 e1
+    | _ -> assert false 
+    end
+  |"caml_sub_float" -> 
+    begin match args with 
+    | [e0;e1] -> E.float_minus e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_eq_float" -> 
+    begin match args with 
+    | [e0;e1] -> E.float_equal e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_ge_float"  ->
+    begin match args with 
+    | [e0;e1] -> E.float_comp Cge e0 e1
+    | _ -> assert false 
+    end
+  |"caml_gt_float"  ->
+    begin match args with 
+    | [e0;e1] -> E.float_comp Cgt  e0 e1
+    | _ -> assert false 
+    end
+  | "caml_tan_float"  ->
+    E.math "tan" args 
+  | "caml_tanh_float"  ->
+    E.math "tanh" args 
+  | "caml_asin_float"  -> 
+    E.math "asin" args 
+  | "caml_atan2_float" -> 
+    E.math "atan2" args
+  | "caml_atan_float" -> 
+    E.math "atan" args 
+  | "caml_ceil_float" -> 
+    E.math "ceil" args 
+  | "caml_cos_float" -> 
+    E.math "cos" args 
+  | "caml_cosh_float" -> 
+    E.math "cosh" args
+  | "caml_exp_float" -> 
+    E.math "exp" args
+  | "caml_sin_float" -> 
+    E.math "sin" args
+  | "caml_sinh_float"-> 
+    E.math "sinh" args
+  | "caml_sqrt_float" -> 
+    E.math "sqrt" args
 
-exception Var of pattern
 
-let simplify_or p =
-  let rec simpl_rec p = match p with
-    | {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p)
-    | {pat_desc = Tpat_alias (q,id,s)} ->
-        begin try
-          {p with pat_desc = Tpat_alias (simpl_rec q,id,s)}
-        with
-        | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id,s)})
-        end
-    | {pat_desc = Tpat_or (p1,p2,o)} ->
-        let q1 = simpl_rec p1 in
-        begin try
-          let q2 = simpl_rec p2 in
-          {p with pat_desc = Tpat_or (q1, q2, o)}
-        with
-        | Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)})
-        end
-    | {pat_desc = Tpat_record (lbls,closed)} ->
-        let all_lbls = all_record_args lbls in
-        {p with pat_desc=Tpat_record (all_lbls, closed)}
-    | _ -> p in
-  try
-    simpl_rec p
-  with
-  | Var p -> p
+  | "caml_float_of_int" -> 
+    begin match args with 
+    | [e] -> e 
+    | _ -> assert false 
+    end
+  | "caml_floor_float" ->
+    E.math "floor" args 
+  | "caml_log_float" -> 
+    E.math "log" args 
+  | "caml_log10_float" -> 
+    E.math "log10" args 
+  | "caml_log1p_float" -> 
+    E.math "log1p" args 
+  | "caml_power_float"  -> 
+    E.math "pow" args
+  |  "caml_make_float_vect" -> 
+    E.new_ (E.js_global "Array") args 
 
-let simplify_cases args cls = match args with
-| [] -> assert false
-| (arg,_)::_ ->
-    let rec simplify = function
-      | [] -> []
-      | ((pat :: patl, action) as cl) :: rem ->
-          begin match pat.pat_desc with
-          | Tpat_var (id, _) ->
-              (omega :: patl, bind Alias id arg action) ::
-              simplify rem
-          | Tpat_any ->
-              cl :: simplify rem
-          | Tpat_alias(p, id,_) ->
-              simplify ((p :: patl, bind Alias id arg action) :: rem)
-          | Tpat_record ([],_) ->
-              (omega :: patl, action)::
-              simplify rem
-          | Tpat_record (lbls, closed) ->
-              let all_lbls = all_record_args lbls in
-              let full_pat =
-                {pat with pat_desc=Tpat_record (all_lbls, closed)} in
-              (full_pat::patl,action)::
-              simplify rem
-          | Tpat_or _ ->
-              let pat_simple  = simplify_or pat in
-              begin match pat_simple.pat_desc with
-              | Tpat_or _ ->
-                  (pat_simple :: patl, action) ::
-                  simplify rem
-              | _ ->
-                  simplify ((pat_simple::patl,action) :: rem)
-              end
-          | _ -> cl :: simplify rem
-          end
-      | _ -> assert false in
 
-    simplify cls
+  | "caml_array_append" -> 
+    begin match args with 
+    | [e0;e1] -> E.array_append e0 e1
+    | _ ->  assert false 
+    end
 
+  | "caml_array_get"
+  | "caml_array_get_addr"
+  | "caml_array_get_float"
+  | "caml_array_unsafe_get"
+  | "caml_array_unsafe_get_float" -> 
+    begin match args with 
+    | [e0;e1] -> Js_of_lam_array.ref_array e0 e1
+    | _ -> assert false
+    end
+  | "caml_array_set"
+  | "caml_array_set_addr"
+  | "caml_array_set_float"
+  | "caml_array_unsafe_set"
+  | "caml_array_unsafe_set_addr"
+  | "caml_array_unsafe_set_float" -> 
+    begin match args with 
+    | [e0;e1;e2] -> 
+      Js_of_lam_array.set_array e0 e1 e2
+    | _ -> assert false
+    end
 
+  | "caml_int32_add"
+    -> 
+    begin match args with 
+    | [e0;e1] -> E.int32_add e0 e1 
+    | _ -> assert false 
+    end
 
-(* Once matchings are simplified one easily finds
-   their nature *)
+  | "caml_nativeint_add" 
+    -> 
+    begin match args with 
+    | [e0;e1] -> E.unchecked_int32_add e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_int32_div" 
+    -> 
+    begin match args with 
+      | [e0;e1] -> 
+        E.int32_div  ~checked:(!Js_config.check_div_by_zero) e0 e1
+      | _ -> assert false 
+    end
 
-let rec what_is_cases cases = match cases with
-| ({pat_desc=Tpat_any} :: _, _) :: rem -> what_is_cases rem
-| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_,_))}::_),_)::_
-  -> assert false (* applies to simplified matchings only *)
-| (p::_,_)::_ -> p
-| [] -> omega
-| _ -> assert false
+  | "caml_nativeint_div" 
+    -> (* nativeint behaves exactly the same as js numbers except division *)
+    begin match args with 
+    | [e0;e1] -> E.int32_div  ~checked:false e0 e1
+    | _ -> assert false 
+    end
+
+  | "caml_int32_mul"
+    -> 
+    begin match args with 
+    | [e0;e1] -> E.int32_mul e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_nativeint_mul"  -> 
+    begin match args with 
+    | [e0;e1] -> E.unchecked_int32_mul e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_int32_of_int"
+  | "caml_nativeint_of_int" 
+  | "caml_nativeint_of_int32" -> 
+    begin match args with 
+    | [e] -> e 
+    | _ -> assert false 
+    end
+  | "caml_int32_of_float"
+  | "caml_int_of_float"
+  | "caml_nativeint_of_float" -> 
+    begin match args with 
+    | [e] -> E.to_int32 e 
+    | _ -> assert false 
+    end
+  | "caml_int32_to_float"
+  | "caml_int32_to_int"
+  | "caml_nativeint_to_int" 
+  | "caml_nativeint_to_float"
+  | "caml_nativeint_to_int32" -> 
+    begin match args with 
+    | [e] -> e (* TODO: do more checking when [to_int32]*)
+    | _ -> assert false 
+    end
+  | "caml_int32_sub" -> 
+    begin match args with 
+    | [e0;e1] -> E.int32_minus e0 e1 
+    | _ -> assert false 
+    end
 
+  | "caml_nativeint_sub" ->
+    begin match args with 
+    | [e0;e1] -> E.unchecked_int32_minus e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_int32_xor" 
+  | "caml_nativeint_xor" -> 
+    begin match args with 
+    | [e0; e1] -> E.int32_bxor e0 e1 
+    | _ -> assert false 
+    end
 
+  | "caml_int32_and"
+  | "caml_nativeint_and" -> 
+    begin match args with 
+    | [e0;e1] -> E.int32_band e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_int32_or"
+  | "caml_nativeint_or" ->
+    begin match args with
+    | [e0;e1] -> E.int32_bor e0 e1 
+    | _ -> assert false  
+    end
+  | "caml_le_float" ->
+    begin match args with 
+    | [e0;e1] -> E.float_comp Cle e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_lt_float" ->
+    begin match args with 
+    | [e0;e1] -> E.float_comp Clt e0 e1 
+    | _ -> assert false 
+    end
+  |  "caml_neg_float" -> 
+    begin match args with 
+    | [e] -> 
+      (** TODO: use float.. *)
+      E.int32_minus E.zero_int_literal e 
+    | _ -> assert false
+    end
+  | "caml_neq_float" -> 
+    begin match args with 
+    | [e0;e1] -> E.float_notequal e0 e1
+    | _ -> assert false 
+    end
+  | "caml_mul_float" -> 
+    begin match args with 
+    | [e0; e1] -> E.float_mul e0 e1 
+    | _ -> assert false  
+    end
+  | "caml_int64_to_float"
+    -> Js_long.to_float args
+  | "caml_int64_of_float"
+    -> Js_long.of_float args
+  | "caml_int64_compare"
+    -> Js_long.compare args 
+  | "js_int64_discard_sign"
+    -> Js_long.discard_sign args
+  | "js_int64_div_mod"
+    -> Js_long.div_mod args
+  | "js_int64_to_hex"
+    -> Js_long.to_hex args    
+  | "caml_int64_bits_of_float"
+    -> Js_long.bits_of_float args     
+  | "caml_int64_float_of_bits"
+    -> Js_long.float_of_bits args 
+  | "caml_int64_bswap"
+    -> Js_long.swap args    
+  | "caml_int32_float_of_bits"
+  | "caml_int32_bits_of_float"
+  | "caml_classify_float"
+  | "caml_modf_float"
+  | "caml_ldexp_float"
+  | "caml_frexp_float"
+  | "caml_float_compare"
+  | "caml_copysign_float"
+  | "caml_expm1_float"
+  | "caml_hypot_float"
 
-(* A few operation on default environments *)
-let as_matrix cases = get_mins le_pats (List.map (fun (ps,_) -> ps) cases)
+    ->
+    call Js_config.float
+  | "caml_fmod_float" 
+    (* float module like js number module *)      
+    ->      
+    begin match args with 
+    | [e0;e1] -> E.float_mod e0 e1
+    | _ -> assert false 
+    end
 
-(* For extension matching, record no imformation in matrix *)
-let as_matrix_omega cases =
-  get_mins le_pats
-    (List.map
-       (fun (ps,_) ->
-         match ps with
-         | [] -> assert false
-         | _::ps -> omega::ps)
-       cases)
+  | "caml_string_equal" 
+    -> 
+    begin match args with 
+    | [e0; e1] -> E.string_equal e0 e1 
+    | _ -> assert false 
+    end
+  | "caml_string_notequal"
+    -> 
+    begin match args with 
+    | [e0; e1] -> E.string_comp NotEqEq e0 e1
+    (** TODO: convert to ocaml ones*)
+    | _ -> assert false 
+    end
+  | "caml_string_lessequal"
+    -> 
+    begin 
+      match args with 
+      | [e0; e1] 
+        -> 
+        E.string_comp Le e0 e1
+      | _ -> assert false 
+    end
+  | "caml_string_lessthan"
+    -> 
+    begin match args with 
+    | [e0; e1] 
+      -> 
+      E.string_comp Lt e0 e1
+    | _ -> assert false 
+    end
+  | "caml_string_greaterequal"
+    -> 
+    begin match args with 
+    | [e0; e1] 
+      -> 
+      E.string_comp Ge  e0 e1
+    | _ -> assert false 
+    end
+  | "caml_string_greaterthan"
+    -> 
+    begin match args with 
+    | [e0; e1] 
+      -> 
+      E.string_comp Gt  e0 e1
+    | _ -> assert false 
+    end
+  | "caml_create_string" -> 
+    (* Note that for invalid range, JS raise an Exception RangeError, 
+       here in OCaml it's [Invalid_argument], we have to preserve this semantics.
+        Also, it's creating a [bytes] which is a js array actually.
+    *)
+    begin match args with
+    | [{expression_desc = Number (Int {i; _}); _} as v] 
+      when i >= 0l -> 
+      E.uninitialized_array v 
+    (* TODO: inline and spits out a warning when i is negative *)
+    | _ -> 
+      call Js_config.string 
+    end
 
-let cons_default matrix raise_num default =
-  match matrix with
-  | [] -> default
-  | _ -> (matrix,raise_num)::default
+  | "caml_string_get"
+  | "caml_string_compare"
+  | "string_of_bytes"
+  | "bytes_of_string"
 
-let default_compat p def =
-  List.fold_right
-    (fun (pss,i) r ->
-      let qss =
-        List.fold_right
-          (fun qs r -> match qs with
-            | q::rem when Parmatch.compat p q -> rem::r
-            | _ -> r)
-          pss [] in
-      match qss with
-      | [] -> r
-      | _  -> (qss,i)::r)
-    def []
+  | "caml_is_printable"
+  | "caml_string_of_char_array"
+  | "caml_fill_string"
+  | "caml_blit_string" 
+  | "caml_blit_bytes"
+    -> 
+    call Js_config.string
 
-(* Or-pattern expansion, variables are a complication w.r.t. the article *)
-let rec extract_vars r p = match p.pat_desc with
-| Tpat_var (id, _) -> IdentSet.add id r
-| Tpat_alias (p, id,_ ) ->
-    extract_vars (IdentSet.add id r) p
-| Tpat_tuple pats ->
-    List.fold_left extract_vars r pats
-| Tpat_record (lpats,_) ->
-    List.fold_left
-      (fun r (_, _, p) -> extract_vars r p)
-      r lpats
-| Tpat_construct (_, _, pats) ->
-    List.fold_left extract_vars r pats
-| Tpat_array pats ->
-    List.fold_left extract_vars r pats
-| Tpat_variant (_,Some p, _) -> extract_vars r p
-| Tpat_lazy p -> extract_vars r p
-| Tpat_or (p,_,_) -> extract_vars r p
-| Tpat_constant _|Tpat_any|Tpat_variant (_,None,_) -> r
+  | "caml_register_named_value" -> 
+    (**
+       callback.ml
+       {[ external register_named_value : string -> Obj.t -> unit
+         = "caml_register_named_value" ]}
 
-exception Cannot_flatten
+       See the manual chap19, Interfacing C with OCaml
+
+       {[
+         let f x = print_string "f is applied to "; print_int x; print_newline()
+         let _ = Callback.register "test function" f
+       ]}
+
+       On the C side 
+       {[
+         let f x = print_string "f is applied to "; print_int x; print_newline()
+         let _ = Callback.register "test function" f
+       ]}
+
+       [caml_named_value] is a c primitive but not belong to OCaml/runtimedef.ml,
+       so we don't needs
+       handle it 
+    *)
+    E.unit
 
-let mk_alpha_env arg aliases ids =
-  List.map
-    (fun id -> id,
-      if List.mem id aliases then
-        match arg with
-        | Some v -> v
-        | _      -> raise Cannot_flatten
-      else
-        Ident.create (Ident.name id))
-    ids
+  | "caml_backtrace_status"
 
-let rec explode_or_pat arg patl mk_action rem vars aliases = function
-  | {pat_desc = Tpat_or (p1,p2,_)} ->
-      explode_or_pat
-        arg patl mk_action
-        (explode_or_pat arg patl mk_action rem vars aliases p2)
-        vars aliases p1
-  | {pat_desc = Tpat_alias (p,id, _)} ->
-      explode_or_pat arg patl mk_action rem vars (id::aliases) p
-  | {pat_desc = Tpat_var (x, _)} ->
-      let env = mk_alpha_env arg (x::aliases) vars in
-      (omega::patl,mk_action (List.map snd env))::rem
-  | p ->
-      let env = mk_alpha_env arg aliases vars in
-      (alpha_pat env p::patl,mk_action (List.map snd env))::rem
 
-let pm_free_variables {cases=cases} =
-  List.fold_right
-    (fun (_,act) r -> IdentSet.union (free_variables act) r)
-    cases IdentSet.empty
+  | "caml_get_exception_backtrace"
+  | "caml_get_exception_raw_backtrace"
+  | "caml_record_backtrace"
+  | "caml_convert_raw_backtrace" 
+  | "caml_get_current_callstack"
+    -> E.unit
+  (* unit -> unit 
+     _ -> unit  
+     major_slice : int -> int 
+  *)
+  | "caml_set_oo_id" 
+    ->
+    (** ATT: relevant to how exception is encoded in OCaml 
+        IDea: maybe we can delay compile primitive into js?
+        benefit: 
+        less code side when serialzation, and more knowledge in jsir
+    *)
+    Js_of_lam_exception.caml_set_oo_id args 
 
+  | "caml_sys_const_big_endian" -> 
+    (** return false *)
+    E.bool Sys.big_endian
+  | "caml_sys_const_word_size" -> 
+    E.small_int  Sys.word_size
+  (** TODO: How it will affect program behavior *)
+  | "caml_sys_const_ostype_cygwin" -> E.caml_false 
+  | "caml_sys_const_ostype_win32" -> E.caml_false 
+  | "caml_sys_const_ostype_unix" -> E.caml_true
+  | "caml_is_js" -> E.caml_true
+  | "caml_sys_get_config" ->
+    (** No cross compilation *)
+    Js_of_lam_tuple.make [E.str Sys.os_type; E.small_int  Sys.word_size; 
+                          E.bool Sys.big_endian ]
+  | "caml_sys_get_argv" -> 
+    (** TODO: refine
+        Inlined here is helpful for DCE
+        {[ external get_argv: unit -> string * string array = "caml_sys_get_argv" ]}
+    *)
+    Js_of_lam_tuple.make [E.str "cmd"; 
+                          Js_of_lam_array.make_array NA Pgenarray []
+                         ]
+  | "caml_sys_time"
+  | "caml_sys_random_seed"
+  | "caml_sys_getenv"
+  | "caml_sys_system_command" 
+  | "caml_sys_getcwd" (* check browser or nodejs *)
+  | "caml_sys_is_directory"
+  | "caml_sys_file_exists"
+    -> 
+    call Js_config.sys
+  | "caml_lex_engine"
+  | "caml_new_lex_engine"
+    -> 
+    call Js_config.lexer 
+  | "caml_parse_engine"
+  | "caml_set_parser_trace" 
+    -> 
+    call Js_config.parser 
 
-(* Basic grouping predicates *)
-let pat_as_constr = function
-  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr
-  | _ -> fatal_error "Matching.pat_as_constr"
+  | "caml_array_sub"
+  | "caml_array_concat"
+  (*external concat: 'a array list -> 'a array 
+     Not good for inline *)
 
-let group_constant = function
-  | {pat_desc= Tpat_constant _} -> true
-  | _                           -> false
+  | "caml_array_blit"
+  | "caml_make_vect" -> 
+    call Js_config.array
+  | "caml_ml_flush"
+  | "caml_ml_out_channels_list"
+  | "caml_ml_open_descriptor_in" 
+  | "caml_ml_open_descriptor_out"
+  | "caml_ml_output_char"
+  | "caml_ml_output" 
+  | "caml_ml_input_char"
+    -> 
+    call Js_config.io
+  | "caml_update_dummy"
+  | "caml_obj_dup" -> 
+    (** Note currently is an Array copy function, this is tightly coupled with 
+        how record, tuple encoded in JS.
+        Here we only inline constant cases, since this semantics should be preserved 
+        no matter how we represent objects, we don't inline it just for future
+    *)
+    begin 
+      match args with 
+      | [ a ] when Js_analyzer.is_constant a ->  a 
+      | _ -> 
+        call Js_config.obj_runtime 
+    end
+  | "caml_obj_block" -> 
+    (** TODO: Optimize  for [CamlinternalOO] input 
+        external new_block : tag:int -> size:int  -> t = "caml_obj_block"
+        Note that we don't need initialize its content anyway
+        TODO: more optimizations later
+        ATTENTION: This optmization is coupled with memory layout
+    *)
+    begin match args with 
+    | [ tag; 
+        {expression_desc = Number (Int { i ;_}); _} ] ->
+      E.make_block tag Blk_na 
+        (Ext_list.init (Int32.to_int i) 
+           (fun _ -> E.zero_int_literal)) NA
 
-and group_constructor = function
-  | {pat_desc = Tpat_construct (_,_,_)} -> true
-  | _ -> false
+    | [ tag; size] -> 
+      E.uninitialized_object tag size
+    | _ -> assert false
 
-and group_variant = function
-  | {pat_desc = Tpat_variant (_, _, _)} -> true
-  | _ -> false
 
-and group_var = function
-  | {pat_desc=Tpat_any} -> true
-  | _ -> false
+    end
+  | "caml_format_float"
 
-and group_tuple = function
-  | {pat_desc = (Tpat_tuple _|Tpat_any)} -> true
-  | _ -> false
+  | "caml_nativeint_format"
+  | "caml_int32_format"
+  | "caml_float_of_string"
+  | "caml_int_of_string" (* what is the semantics?*)
+  | "caml_int32_of_string"
+  | "caml_nativeint_of_string" 
+  | "caml_int64_format"
+  | "caml_int64_of_string"
+    -> 
+    call Js_config.format 
+  | "caml_format_int" -> 
+    begin match args with 
+    | [ {expression_desc = Str (_, "%d"); _}; v] 
+      ->
+      E.int_to_string v 
+    | _ -> 
+      call Js_config.format
+    end
+    (*   "caml_alloc_dummy"; *)
+    (* TODO:   "caml_alloc_dummy_float"; *)
 
-and group_record = function
-  | {pat_desc = (Tpat_record _|Tpat_any)} -> true
-  | _ -> false
 
-and group_array = function
-  | {pat_desc=Tpat_array _} -> true
-  | _ -> false
+  | "caml_obj_is_block"
+    -> 
+    begin match args with 
+    | [e] -> E.is_caml_block e 
+    | _ -> assert false
+    end
+  | "caml_obj_truncate"
+  | "caml_lazy_make_forward"
+  | "caml_compare"
+  | "caml_int_compare"
+  | "caml_int32_compare"
+  | "caml_nativeint_compare"
+  | "caml_equal"
+  | "caml_notequal"
+  | "caml_greaterequal"
+  | "caml_greaterthan"
+  | "caml_lessequal"
+  | "caml_lessthan"
 
-and group_lazy = function
-  | {pat_desc = Tpat_lazy _} -> true
-  | _ -> false
+    -> 
+    call Js_config.obj_runtime
+  | "caml_obj_set_tag" 
+    -> begin match args with 
+      | [a;b]  -> E.set_tag a b 
+      | _ -> assert false end
+  | "caml_obj_tag" -> 
+    (* Note that in ocaml, [int] has tag [1000] and [string] has tag [252]
+       also now we need do nullary check 
+    *)      
+    begin match args with 
+    | [e] -> E.tag e 
+    | _ -> assert false end
 
-let get_group p = match p.pat_desc with
-| Tpat_any -> group_var
-| Tpat_constant _ -> group_constant
-| Tpat_construct _ -> group_constructor
-| Tpat_tuple _ -> group_tuple
-| Tpat_record _ -> group_record
-| Tpat_array _ -> group_array
-| Tpat_variant (_,_,_) -> group_variant
-| Tpat_lazy _ -> group_lazy
-|  _ -> fatal_error "Matching.get_group"
+  (* Unix support *)
+  | "unix_tcdrain"
+  | "unix_tcflush"
+  | "unix_setsid"
+  | "unix_tcflow"
+  | "unix_tcgetattr"
+  | "unix_tcsetattr"
+  | "unix_tcsendbreak"
+  | "unix_getprotobynumber"
+  | "unix_getprotobyname"
+  | "unix_getservbyport"
+  | "unix_getservbyname"
+  | "unix_getservbyaddr"
+  | "unix_gethostbyname"
+  | "unix_gethostname"
+  | "unix_getpeername"
+  | "unix_accept"
+  | "unix_bind"
+  | "unix_connect"
+  | "unix_listen"
+  | "unix_shutdown"
+  | "unix_getsockname"
+  | "unix_gethostbyaddr"
+  | "unix_getgrnam"
+  | "unix_getpwuid"
+  | "unix_getgrgid"
+  | "unix_inet_addr_of_string"
+  | "unix_string_of_inet_addr"
+  | "unix_socket"
+  | "unix_socketpair"
+  | "unix_error_message"
+  | "unix_read"
+  | "unix_write"
+  | "unix_single_write"
+  | "unix_set_close_on_exec"
+  | "unix_sigprocmask"
+  | "unix_sigsuspend"
+  | "unix_recv"
+  | "unix_recvfrom"
+  | "unix_send"
+  | "unix_sendto"
+  | "unix_getsockopt"
+  | "unix_setsockopt"
+  | "unix_getaddrinfo"
+  | "unix_getnameinfo"
+  | "unix_waitpid"
+  | "unix_wait"
+  | "unix_fork"
+  | "unix_execv"
+  | "unix_dup"
+  | "unix_close"
+  | "unix_dup2"
+  | "unix_execvp"
+  | "unix_execvpe"
+  | "unix_pipe"
+  | "unix_execve"
+  | "caml_channel_descriptor"
+  | "unix_putenv"
+  | "unix_environment"
+  | "unix_lseek"
+  | "unix_getppid"
+  | "unix_getpid"
+  | "unix_nice"
+  | "unix_open"
+  | "unix_truncate"
+  | "unix_ftruncate"
+  | "unix_stat"
+  | "unix_lstat"
+  | "unix_fstat"
+  | "unix_isatty"
+  | "unix_lseek_64"
+  | "unix_truncate_64"
+  | "unix_ftruncate_64"
+  | "unix_stat_64"
+  | "unix_lstat_64"
+  | "unix_fstat_64"
+  | "unix_unlink"
+  | "unix_rename"
+  | "unix_link"
+  | "unix_chmod"
+  | "unix_fchmod"
+  | "unix_chown"
+  | "unix_fchown"
+  | "unix_umask"
+  | "unix_access"
+  | "unix_set_nonblock"
+  | "unix_clear_nonblock"
+  | "unix_clear_close_on_exec"
+  | "unix_mkdir"
+  | "unix_rmdir"
+  | "unix_chdir"
+  | "unix_getcwd"
+  | "unix_chroot"
+  | "unix_opendir"
+  | "unix_readdir"
+  | "unix_rewinddir"
+  | "unix_closedir"
+  | "unix_mkfifo"
+  | "unix_symlink"
+  | "unix_readlink"
+  | "unix_select"
+  | "unix_lockf"
+  | "unix_kill"
+  | "unix_sigpending"
+  | "unix_time"
+  | "unix_gettimeofday"
+  | "unix_gmtime"
+  | "unix_localtime"
+  | "unix_mktime"
+  | "unix_alarm"
+  | "unix_sleep"
+  | "unix_times"
+  | "unix_utimes"
+  | "unix_getitimer"
+  | "unix_setitimer"
+  | "unix_getuid"
+  | "unix_geteuid"
+  | "unix_setuid"
+  | "unix_getgid"
+  | "unix_getegid"
+  | "unix_setgid"
+  | "unix_getgroups"
+  | "unix_setgroups"
+  | "unix_initgroups"
+  | "unix_getlogin"
+  | "unix_getpwnam"
+    ->  E.not_implemented prim_name
+  (* End of Unix support *)
+  (* bigarrary support *)
+  | "caml_ba_init"
+    -> 
+    begin match args with 
+      | [e] -> E.seq e E.unit 
+      | _ -> assert false
+    end
+  | "caml_ba_create"
+  | "caml_ba_get_generic"
+  | "caml_ba_set_generic"
+  | "caml_ba_num_dims"
+  | "caml_ba_dim"
+  | "caml_ba_kind"
+  | "caml_ba_layout"
+  | "caml_ba_sub"
+  | "caml_ba_slice"
+  | "caml_ba_blit"
+  | "caml_ba_fill"
+  | "caml_ba_reshape"
+  | "caml_ba_map_file_bytecode"
 
+    (* caml_ba_get_1,  (\* %caml_ba_ref_1 *\) *)
+    (* caml_ba_get_2, *)
+    (* caml_ba_get_3, *)
 
+    (* caml_ba_set_1,  // %caml_ba_set_1 *)
+    (* caml_ba_set_2, *)
+    (* caml_ba_set_3, *)
 
-let is_or p = match p.pat_desc with
-| Tpat_or _ -> true
-| _ -> false
+    (* caml_ba_dim_1, // %caml_ba_dim_1 *)
+    (* caml_ba_dim_2,  *)
+    (* caml_ba_dim_3,  *)
 
-(* Conditions for appending to the Or matrix *)
-let conda p q = not (compat p q)
-and condb act ps qs =  not (is_guarded act) && Parmatch.le_pats qs ps
+    -> 
+    E.not_implemented prim_name
+    (* call  Js_config.bigarray *)
+  (* End of bigarray support *)
+  | "caml_convert_raw_backtrace_slot"
+    -> call  Js_config.backtrace
 
-let or_ok p ps l =
-  List.for_all
-    (function
-      | ({pat_desc=Tpat_or _} as q::qs,act) ->
-          conda p q || condb act ps qs
-      | _ -> true)
-    l
+  | "caml_bswap16"
+  | "caml_int32_bswap"
+  | "caml_nativeint_bswap" 
+    -> call Js_config.int32
+  | "caml_get_public_method"
+    ->
+    call Js_config.oo
+  (** TODO: Primitives not implemented yet ...*)
+  | "caml_install_signal_handler"
+    -> 
+    begin match args with
+    | [num; behavior] 
+      -> E.seq num behavior (*TODO:*)
+    | _ -> assert false
+    end
+  | "caml_md5_string"
+    -> call Js_config.md5
+  | "caml_hash"
+    -> call Js_config.hash 
+  | "caml_weak_set"
+  | "caml_weak_create"
+  | "caml_weak_get"
+  | "caml_weak_check"
+  | "caml_weak_blit"
+  | "caml_weak_get_copy"
+    -> call Js_config.weak
 
-(* Insert or append a pattern in the Or matrix *)
+  | "caml_output_value_to_buffer"
+  | "caml_marshal_data_size"
+  | "caml_input_value_from_string"
+  | "caml_output_value"
+  | "caml_input_value"
+  | "caml_output_value_to_string"
+  | "caml_md5_chan"
+  | "caml_hash_univ_param"
+  | "caml_sys_close"
+  | "caml_sys_open"
+  | "caml_ml_input"
+  | "caml_ml_input_scan_line"
+  | "caml_ml_input_int"
+  | "caml_ml_close_channel"
+  | "caml_ml_output_int"
+  | "caml_sys_exit"
+  | "caml_ml_channel_size_64"
+  | "caml_ml_channel_size"
+  | "caml_ml_pos_in_64"
+  | "caml_ml_pos_in"
+  | "caml_ml_seek_in"
+  | "caml_ml_seek_in_64"
+  | "caml_ml_pos_out"
+  | "caml_ml_pos_out_64"
+  | "caml_ml_seek_out"
+  | "caml_ml_seek_out_64"
+  | "caml_ml_set_binary_mode"
+    ->  E.not_implemented prim_name
 
-let equiv_pat p q = le_pat p q && le_pat q p
+  | "js_function_length"
 
-let rec get_equiv p l = match l with
-  | (q::_,_) as cl::rem ->
-      if equiv_pat p q then
-        let others,rem = get_equiv p rem in
-        cl::others,rem
-      else
-        [],l
-  | _ -> [],l
+    -> begin
+        match args with 
+        | [f ] -> E.function_length f 
+        | _ -> assert false
+      end
+  | "js_create_array" 
+    -> 
+    begin match args with 
+    | [e] -> E.uninitialized_array e 
+    | _ -> assert false
+    end
+  | "js_array_append" 
+    -> 
+    begin match args with 
+    | [a;b] -> 
+      E.array_append a b 
+    | _ -> assert false 
+    end
+  | "js_string_append"
+    -> 
+    begin match args with 
+    | [a ; b] -> E.string_append a b 
+    | _ -> assert false
+    end
+  | "js_apply" 
+    -> 
+    begin match args with 
+    | [f ;  args] -> 
+      E.flat_call f args
+    | _ -> assert false 
+    end
+  | "js_string_of_small_int_array"
+    ->
+    begin match args with 
+    | [e] -> E.string_of_small_int_array e 
+    | _ -> assert false
+    end
+  | "js_string_of_char" 
+    ->
+      begin match args with 
+      | [{expression_desc = Number (Int {i; _})} ] 
+        -> E.str (String.make 1 (Char.chr (Int32.to_int i)))
+      | _ -> call Js_config.string
+      end
+  | "js_unsafe_lt" 
+    -> 
+    begin match args with 
+      | [l; r] -> E.bin Lt l r 
+      | _ -> assert false 
+    end
+  | "js_unsafe_le" 
+    -> begin match args with 
+    | [l; r] -> E.bin Le l r 
+    | _ -> assert false end 
+  | "js_unsafe_gt" 
+    -> begin match args with 
+    | [l;r] -> E.bin Gt l r 
+    | _ ->  assert false end 
+  | "js_unsafe_ge" -> 
+    begin match args with 
+    | [l ; r] -> E.bin Ge l r 
+    | _ -> assert false end
+  | "js_boolean_to_bool"
+    -> 
+    begin match args with 
+    | [e] -> E.to_ocaml_boolean e 
+    | _ -> assert false
+    end
+  | "js_is_instance_array" 
+    ->
+    begin match args with 
+    | [e] -> E.is_instance_array e 
+    | _ -> assert false end
+  | "js_typeof"
+    -> 
+    begin match args with 
+    | [e] -> E.typeof e         
+    | _ -> assert false
+    end
 
+  | "js_dump"
+    -> 
+    (* This primitive can accept any number of arguments 
+       {[
+         console.log(1,2,3)
+           1 2 3
+       ]}         
+    *)      
+    E.seq (E.dump Log args) E.unit
 
-let insert_or_append p ps act ors no =
-  let rec attempt seen = function
-    | (q::qs,act_q) as cl::rem ->
-        if is_or q then begin
-          if compat p q then
-            if
-              IdentSet.is_empty (extract_vars IdentSet.empty p) &&
-              IdentSet.is_empty (extract_vars IdentSet.empty q) &&
-              equiv_pat p q
-            then (* attempt insert, for equivalent orpats with no variables *)
-              let _, not_e = get_equiv q rem in
-              if
-                or_ok p ps not_e && (* check append condition for head of O *)
-                List.for_all        (* check insert condition for tail of O *)
-                  (fun cl -> match cl with
-                  | (q::_,_) -> not (compat p q)
-                  | _        -> assert false)
-                  seen
-              then (* insert *)
-                List.rev_append seen ((p::ps,act)::cl::rem), no
-              else (* fail to insert or append *)
-                ors,(p::ps,act)::no
-            else if condb act_q ps qs then (* check condition (b) for append *)
-              attempt (cl::seen) rem
-            else
-              ors,(p::ps,act)::no
-          else (* p # q, go on with append/insert *)
-            attempt (cl::seen) rem
-        end else (* q is not a or-pat, go on with append/insert *)
-          attempt (cl::seen) rem
-    | _  -> (* [] in fact *)
-        (p::ps,act)::ors,no in (* success in appending *)
-  attempt [] ors
+  | "caml_anything_to_string"
+  (* patched to compiler to support for convenience *)      
+  | "js_anything_to_string" 
+    ->
+    begin match args with 
+    | [e] -> E.anything_to_string e 
+    | _ -> assert false
+    end
+  | "js_anything_to_number" 
+    -> 
+    begin match args with 
+    | [e] -> E.to_number e 
+    | _ -> assert false
+    end
 
-(* Reconstruct default information from half_compiled  pm list *)
+  | "js_json_stringify"      
+    -> 
+    begin match args with 
+    | [e] ->        
+      E.to_json_string e
+    | _ -> 
+      assert false      
+    end
+    (* | "js_dump1" *)
+    (* | "js_dump2" *)
+    (* | "js_dump3" *)
+    (* | "js_dump4" *)
+    (* | "js_dump5" *)
+    (* | "js_dump6" *)
+    (* | "js_dump7" (\* TODO: refin api later *\) *)
+    (* | "js_dump8" -> E.dump Log args  *)
+    | "js_apply1"
+    | "js_apply2"
+    | "js_apply3"
+    | "js_apply4"
+    | "js_apply5"
+    | "js_apply6"
+    | "js_apply7"
+    | "js_apply8" -> 
+      begin match args with 
+        | fn :: rest -> 
+          E.call ~info:{arity=Full; call_info =  Call_na} fn rest 
+        | _ -> assert false
+      end
+    | "js_uninitialized_object"
+      ->
+      begin match args with 
+        | [ tag; size] -> E.uninitialized_object tag size 
+        | _ -> assert false  end
+    | "js_obj_length" 
+      -> 
+      begin match args with 
+        | [e] -> E.obj_length e 
+        | _ -> assert false 
+      end
+    | "js_pure_expr" (* TODO: conver it even earlier *)
+      -> 
+      begin match args with 
+      | [ { expression_desc = Str (_,s )}] -> 
+        E.raw_js_code Exp  s
+      | _ -> 
+        Ext_log.err __LOC__ 
+          "JS.unsafe_js_expr is applied to an non literal string in %s"
+          (Js_config.get_current_file ())
+        ;
+        assert false
+      end
+    | "js_pure_stmt" (* TODO: convert even ealier *)
+      -> 
+      begin match args with 
+      | [ { expression_desc = Str (_,s )}] -> E.raw_js_code Stmt s
+      | _ -> 
+        Ext_log.err __LOC__ 
+          "JS.unsafe_js_expr is applied to an non literal string in %s"
+          (Js_config.get_current_file ())
+        ;
+        assert false
+      end
+    | "js_is_nil" -> 
+      begin match args with
+      | [ e ] -> E.is_nil e 
+      | _ -> assert false 
+      end
+    | "js_is_undef" -> 
+      begin match args with 
+      | [e] -> E.is_undef e 
+      | _ -> assert false
+      end
+    | "js_is_nil_undef" 
+    | "js_from_nullable_def"
+      -> call Js_config.js_primitive
+    | "js_from_def" 
+      -> 
+      begin match args with 
+      | [e] -> 
+        begin match e.expression_desc with 
+        | Var _ -> 
+          E.econd (E.is_undef e) Js_of_lam_option.none (Js_of_lam_option.some e)
+        | _ -> 
+          call Js_config.js_primitive  
+        (* # GPR 974
+          let id = Ext_ident.create "v" in
+          let tmp = E.var id in
+          E.(seq (assign tmp e ) 
+               (econd (is_undef tmp) Js_of_lam_option.none (Js_of_lam_option.some tmp)) )
+        *)
+        end
 
-let rec rebuild_matrix pmh = match pmh with
-  | Pm pm -> as_matrix pm.cases
-  | PmOr {or_matrix=m} -> m
-  | PmVar x -> add_omega_column  (rebuild_matrix x.inside)
+      | _ -> assert false 
+      end
+    | "js_from_nullable" 
+      -> 
+      begin match args with 
+      | [e] -> 
+        begin match e.expression_desc with 
+        | Var _ -> 
+          E.econd (E.is_nil e) Js_of_lam_option.none (Js_of_lam_option.some e)
+        | _ ->
+          call Js_config.js_primitive
+         (* GPR #974
+          let id = Ext_ident.create "v" in
+          let tmp = E.var id in
+          E.(seq (assign tmp e ) 
+               (econd (is_nil tmp) Js_of_lam_option.none (Js_of_lam_option.some tmp)) )
+          *)
+        end
 
-let rec rebuild_default nexts def = match nexts with
-| [] -> def
-| (e, pmh)::rem ->
-    (add_omega_column (rebuild_matrix pmh), e)::
-    rebuild_default rem def
+      | _ -> assert false 
+      end
+    | "js_obj_set_length"
+      ->
+      begin match args with 
+        | [a; b] -> E.set_length a b 
+        | _ -> assert false 
+      end
 
-let rebuild_nexts arg nexts k =
-  List.fold_right
-    (fun (e, pm) k -> (e, PmVar {inside=pm ; var_arg=arg})::k)
-    nexts k
+    | _ -> 
 
+      let comment = "Missing primitive" in       
+      Ext_log.warn __LOC__  "%s: %s when compiling %s\n" comment prim_name 
+        (Js_config.get_current_file ()) ;
+      E.not_implemented prim_name
+      (*we dont use [throw] here, since [throw] is an statement 
+        so we wrap in IIFE
+      *)        
 
-(*
-  Split a matching.
-    Splitting is first directed by or-patterns, then by
-    tests (e.g. constructors)/variable transitions.
+  end 
 
-    The approach is greedy, every split function attempt to
-    raise rows as much as possible in the top matrix,
-    then splitting applies again to the remaining rows.
 
-    Some precompilation of or-patterns and
-    variable pattern occurs. Mostly this means that bindings
-    are performed now,  being replaced by let-bindings
-    in actions (cf. simplify_cases).
 
-    Additionally, if the match argument is a variable, matchings whose
-    first column is made of variables only are splitted further
-    (cf. precompile_var).
+;;
 
-*)
+end
+module Lam_compile_external_call : sig 
+#1 "lam_compile_external_call.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-let rec split_or argo cls args def =
 
-  let cls = simplify_cases args cls in
 
-  let rec do_split before ors no = function
-    | [] ->
-        cons_next
-          (List.rev before) (List.rev ors) (List.rev no)
-    | ((p::ps,act) as cl)::rem ->
-        if up_ok cl no then
-          if is_or p then
-            let ors, no = insert_or_append p ps act ors no in
-            do_split before ors no rem
-          else begin
-            if up_ok cl ors then
-              do_split (cl::before) ors no rem
-            else if or_ok p ps ors then
-              do_split before (cl::ors) no rem
-            else
-              do_split before ors (cl::no) rem
-          end
-        else
-          do_split before ors (cl::no) rem
-    | _ -> assert false
 
-  and cons_next yes yesor = function
-    | [] ->
-        precompile_or argo yes yesor args def []
-    | rem ->
-        let {me=next ; matrix=matrix ; top_default=def},nexts =
-          do_split [] [] [] rem in
-        let idef = next_raise_count () in
-        precompile_or
-          argo yes yesor args
-          (cons_default matrix idef def)
-          ((idef,next)::nexts) in
 
-  do_split [] [] [] cls
 
-(* Ultra-naive spliting, close to semantics, used for extension,
-   as potential rebind prevents any kind of optimisation *)
 
-and split_naive cls args def k =
+(** Compile ocaml external function call to JS IR. *) 
 
-  let rec split_exc cstr0 yes = function
-    | [] ->
-        let yes = List.rev yes in
-        { me = Pm {cases=yes; args=args; default=def;} ;
-          matrix = as_matrix_omega yes ;
-          top_default=def},
-        k
-    | (p::_,_ as cl)::rem ->
-        if group_constructor p then
-          let cstr = pat_as_constr p in
-          if cstr = cstr0 then split_exc cstr0 (cl::yes) rem
-          else
-            let yes = List.rev yes in
-            let {me=next ; matrix=matrix ; top_default=def}, nexts =
-              split_exc cstr [cl] rem in
-            let idef = next_raise_count () in
-            let def = cons_default matrix idef def in
-            { me = Pm {cases=yes; args=args; default=def} ;
-              matrix = as_matrix_omega yes ;
-              top_default = def; },
-            (idef,next)::nexts
-        else
-          let yes = List.rev yes in
-          let {me=next ; matrix=matrix ; top_default=def}, nexts =
-              split_noexc [cl] rem in
-            let idef = next_raise_count () in
-            let def = cons_default matrix idef def in
-            { me = Pm {cases=yes; args=args; default=def} ;
-              matrix = as_matrix_omega yes ;
-              top_default = def; },
-            (idef,next)::nexts
-    | _ -> assert false
+(** 
+    This module define how the FFI (via `external`) works with attributes. 
+    Note it will route to {!Lam_compile_global} 
+    for compiling normal functions without attributes.
+ *)
 
-  and split_noexc yes = function
-    | [] -> precompile_var args (List.rev yes) def k
-    | (p::_,_ as cl)::rem ->
-        if group_constructor p then
-          let yes= List.rev yes in
-          let {me=next; matrix=matrix; top_default=def;},nexts =
-            split_exc (pat_as_constr p) [cl] rem in
-          let idef = next_raise_count () in
-          precompile_var
-            args yes
-            (cons_default matrix idef def)
-            ((idef,next)::nexts)
-        else split_noexc (cl::yes) rem
-    | _ -> assert false in
 
-  match cls with
-  | [] -> assert false
-  | (p::_,_ as cl)::rem ->
-      if group_constructor p then
-        split_exc (pat_as_constr p) [cl] rem
-      else
-        split_noexc [cl] rem
-  | _ -> assert false
+(** TODO: document supported attributes
+    Attributes starting with `js` are reserved
+    examples: "bs.splice"
+ *)
 
-and split_constr cls args def k =
-  let ex_pat = what_is_cases cls in
-  match ex_pat.pat_desc with
-  | Tpat_any -> precompile_var args cls def k
-  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) ->
-      split_naive cls args def k
-  | _ ->
+val translate :
+  Location.t ->
+  Lam_compile_defs.cxt -> 
+  Primitive.description -> 
+  J.expression list -> 
+  J.expression
 
-      let group = get_group ex_pat in
+end = struct
+#1 "lam_compile_external_call.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-      let rec split_ex yes no = function
-        | [] ->
-            let yes = List.rev yes and no = List.rev no in
-            begin match no with
-            | [] ->
-                {me = Pm {cases=yes ; args=args ; default=def} ;
-                  matrix = as_matrix yes ;
-                  top_default = def},
-                k
-            | cl::rem ->
-                begin match yes with
-                | [] ->
-                    (* Could not success in raising up a constr matching up *)
-                    split_noex [cl] [] rem
-                | _ ->
-                    let {me=next ; matrix=matrix ; top_default=def}, nexts =
-                      split_noex [cl] [] rem in
-                    let idef = next_raise_count () in
-                    let def = cons_default matrix idef def in
-                    {me = Pm {cases=yes ; args=args ; default=def} ;
-                      matrix = as_matrix yes ;
-                      top_default = def },
-                    (idef, next)::nexts
-                end
-            end
-        | (p::_,_) as cl::rem ->
-            if group p && up_ok cl no then
-              split_ex (cl::yes) no rem
-            else
-              split_ex yes (cl::no) rem
-        | _ -> assert false
 
-      and split_noex yes no = function
-        | [] ->
-            let yes = List.rev yes and no = List.rev no in
-            begin match no with
-            | [] -> precompile_var args yes def k
-            | cl::rem ->
-                let {me=next ; matrix=matrix ; top_default=def}, nexts =
-                  split_ex [cl] [] rem in
-                let idef = next_raise_count () in
-                precompile_var
-                  args yes
-                  (cons_default matrix idef def)
-                  ((idef,next)::nexts)
-            end
-        | [ps,_ as cl]
-            when List.for_all group_var ps && yes <> [] ->
-       (* This enables an extra division in some frequent case :
-          last row is made of variables only *)
-              split_noex yes (cl::no) []
-        | (p::_,_) as cl::rem ->
-            if not (group p) && up_ok cl no then
-              split_noex (cl::yes) no rem
-            else
-              split_noex yes (cl::no) rem
-        | _ -> assert false in
 
-      match cls with
-      | ((p::_,_) as cl)::rem ->
-          if group p then split_ex [cl] [] rem
-          else split_noex [cl] [] rem
-      | _ ->  assert false
 
-and precompile_var  args cls def k = match args with
-| []  -> assert false
-| _::((Lvar v as av,_) as arg)::rargs ->
-    begin match cls with
-    | [ps,_] -> (* as splitted as it can *)
-        dont_precompile_var args cls def k
-    | _ ->
-(* Precompile *)
-        let var_cls =
-          List.map
-            (fun (ps,act) -> match ps with
-            | _::ps -> ps,act | _     -> assert false)
-            cls
-        and var_def = make_default (fun _ rem -> rem) def in
-        let {me=first ; matrix=matrix}, nexts =
-          split_or (Some v) var_cls (arg::rargs) var_def in
 
-(* Compute top information *)
-        match nexts with
-        | [] -> (* If you need *)
-            dont_precompile_var args cls def k
-        | _  ->
-            let rfirst =
-              {me = PmVar {inside=first ; var_arg = av} ;
-                matrix = add_omega_column matrix ;
-                top_default = rebuild_default nexts def ; }
-            and rnexts = rebuild_nexts av nexts k in
-            rfirst, rnexts
-    end
-|  _ ->
-    dont_precompile_var args cls def k
+module E = Js_exp_make
 
-and dont_precompile_var args cls def k =
-  {me =  Pm {cases = cls ; args = args ; default = def } ;
-    matrix=as_matrix cls ;
-    top_default=def},k
 
-and is_exc p = match p.pat_desc with
-| Tpat_or (p1,p2,_) -> is_exc p1 || is_exc p2
-| Tpat_alias (p,v,_) -> is_exc p
-| Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
-| _ -> false
 
-and precompile_or argo cls ors args def k = match ors with
-| [] -> split_constr cls args def k
-| _  ->
-    let rec do_cases = function
-      | ({pat_desc=Tpat_or _} as orp::patl, action)::rem ->
-          let do_opt = not (is_exc orp) in
-          let others,rem =
-            if do_opt then get_equiv orp rem
-            else [],rem in
-          let orpm =
-            {cases =
-              (patl, action)::
-              List.map
-                (function
-                  | (_::ps,action) -> ps,action
-                  | _ -> assert false)
-                others ;
-              args = (match args with _::r -> r | _ -> assert false) ;
-              default = default_compat (if do_opt then orp else omega) def} in
-          let vars =
-            IdentSet.elements
-              (IdentSet.inter
-                 (extract_vars IdentSet.empty orp)
-                 (pm_free_variables orpm)) in
-          let or_num = next_raise_count () in
-          let new_patl = Parmatch.omega_list patl in
+let handle_external 
+    ({bundle ; bind_name} : Ast_external_attributes.external_module_name)
+  =
+  match bind_name with 
+  | None -> 
+    Lam_compile_env.add_js_module bundle , bundle
+  | Some bind_name -> 
+    Lam_compile_env.add_js_module 
+      ~id:(Ext_ident.create_js_module bind_name) bundle,
+    bundle
 
-          let mk_new_action vs =
-            Lstaticraise
-              (or_num, List.map (fun v -> Lvar v) vs) in
+let handle_external_opt 
+    (module_name : Ast_external_attributes.external_module_name option) = 
+  match module_name with 
+  | Some module_name -> Some (handle_external module_name) 
+  | None -> None 
 
-          let do_optrec,body,handlers = do_cases rem in
-          do_opt && do_optrec,
-          explode_or_pat
-            argo new_patl mk_new_action body vars [] orp,
-          let mat = if do_opt then [[orp]] else [[omega]] in
-          ((mat, or_num, vars , orpm):: handlers)
-      | cl::rem ->
-          let b,new_ord,new_to_catch = do_cases rem in
-          b,cl::new_ord,new_to_catch
-      | [] -> true,[],[] in
+type typ = Ast_core_type.t
 
-    let do_opt,end_body, handlers = do_cases ors in
-    let matrix = (if do_opt then as_matrix else as_matrix_omega) (cls@ors)
-    and body = {cases=cls@end_body ; args=args ; default=def} in
-    {me = PmOr {body=body ; handlers=handlers ; or_matrix=matrix} ;
-      matrix=matrix ;
-      top_default=def},
-    k
 
-let split_precompile argo pm =
-  let {me=next}, nexts = split_or argo pm.cases pm.args pm.default  in
-  if dbg && (nexts <> [] || (match next with PmOr _ -> true | _ -> false))
-  then begin
-    prerr_endline "** SPLIT **" ;
-    pretty_pm pm ;
-    pretty_precompiled_res  next nexts
-  end ;
-  next, nexts
+let ocaml_to_js_eff ({ Ast_external_attributes.arg_label;  arg_type = ty })
+    (arg : J.expression) 
+  : E.t list * E.t list  =
+  match ty with
+  | Unit ->  
+    [], 
+    (if Js_analyzer.no_side_effect_expression arg then 
+       []
+     else 
+       [arg]) (* leave up later to decide *)
+  | Ignore -> 
+    [], 
+    (if Js_analyzer.no_side_effect_expression arg then 
+       []
+     else 
+       [arg])
+  | NullString dispatches -> 
+    [Js_of_lam_variant.eval arg dispatches],[]
+  | NonNullString dispatches -> 
+    Js_of_lam_variant.eval_as_event arg dispatches,[]
+  | Int dispatches -> 
+    [Js_of_lam_variant.eval_as_int arg dispatches],[]
+  | Nothing  | Array -> 
+    begin match arg_label with 
+      | Optional label -> [Js_of_lam_option.get_default_undefined arg]
+      | Label _ | Empty ->  [arg]  
+    end, []
 
 
-(* General divide functions *)
+let assemble_args arg_types args : E.t list * E.t option  = 
+  let args, eff = 
+    List.fold_right2 
+    (fun arg_type arg (accs, effs) -> 
+       match ocaml_to_js_eff arg_type arg with
+       | acc, eff  -> 
+         acc @ accs , eff @ effs 
+    ) arg_types args ([],[]) in
+  args, begin match eff with 
+    | [] -> None
+    | x::xs -> Some (List.fold_left (fun x y -> E.seq x y) x xs )
+  end
 
-let add_line patl_action pm = pm.cases <- patl_action :: pm.cases; pm
+let add_eff eff e =
+  match eff with
+  | None -> e 
+  | Some v -> E.seq v e 
 
-type cell =
-  {pm : pattern_matching ;
-  ctx : ctx list ;
-  pat : pattern}
+(* Note: can potentially be inconsistent, sometimes 
+   {[
+     { x : 3 , y : undefined}
+   ]}
+   and 
+   {[
+     {x : 3 }
+   ]}
+   But the default to be undefined  seems reasonable 
+*)
+let assemble_args_obj labels args = 
+  let map, eff  = 
+    List.fold_right2
+      (fun label ( arg : J.expression) (accs, eff ) -> 
+         match (label : Ast_core_type.arg_label) with 
+         | Empty ->  
+           accs , 
+           if Js_analyzer.no_side_effect_expression arg then eff 
+           else arg :: eff 
+         | Label label -> 
+           ( Js_op.Key label, arg) :: accs, eff  
+         | Optional label -> 
+           begin match arg.expression_desc with 
+             | Number _ -> (*Invariant: None encoding*)
+               accs, eff 
+             | _ ->  
+               ( Js_op.Key label, Js_of_lam_option.get_default_undefined arg) :: accs,
+               eff
+           end
+      ) labels args ([], []) in
+  match eff with
+  | [] -> 
+    E.obj map 
+  | x::xs -> E.seq (List.fold_left (fun x y -> E.seq x y) x xs) (E.obj map)
 
-let add make_matching_fun division eq_key key patl_action args =
-  try
-    let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in
-    cell.pm.cases <- patl_action :: cell.pm.cases;
-    division
-  with Not_found ->
-    let cell = make_matching_fun args in
-    cell.pm.cases <- [patl_action] ;
-    (key, cell) :: division
 
+(* TODO: fix splice, 
+   we need a static guarantee that it is static array construct
+   otherwise, we should provide a good error message here, 
+   no compiler failure here 
+   Invariant : Array encoding
+*)
 
-let divide make eq_key get_key get_args ctx pm =
+let ocaml_to_js ~js_splice:(js_splice : bool) call_loc ffi
+    last ({ Ast_external_attributes.arg_label;  arg_type = ty } as arg_ty)
+    (arg : J.expression) 
+  = 
+  if last && js_splice then
+    match ty with 
+    | Array -> 
+      begin match arg with 
+        | {expression_desc = Array (ls,_mutable_flag) } -> 
+          ls, [] 
+        | _ -> 
+          Location.raise_errorf ~loc:call_loc
+            "function call with %s  is a primitive with [@@bs.splice], it expects its arguments to be a syntactic array in the call site" (Ast_external_attributes.name_of_ffi ffi)
+      end
+    | _ -> assert  false
+  else 
+    ocaml_to_js_eff arg_ty arg 
 
-  let rec divide_rec = function
-    | (p::patl,action) :: rem ->
-        let this_match = divide_rec rem in
-        add
-          (make p pm.default ctx)
-          this_match eq_key (get_key p) (get_args p patl,action) pm.args
-    | _ -> [] in
+let assemble_args_splice call_loc ffi  js_splice arg_types args : E.t list * E.t option = 
+  let args, eff = 
+    Ext_list.fold_right2_last (fun last arg_ty arg (accs, effs)  -> 
+      let (acc,eff) = ocaml_to_js call_loc ffi  ~js_splice last arg_ty arg  in acc @ accs, eff @ effs
+      ) arg_types args ([], []) in
+  args,
+  begin  match eff with
+    | [] -> None 
+    | x::xs ->  Some (List.fold_left (fun x y -> E.seq x y) x xs)
+  end
 
-  divide_rec pm.cases
 
+let translate_ffi call_loc (ffi : Ast_external_attributes.ffi ) prim_name
+    (cxt  : Lam_compile_defs.cxt)
+    arg_types result_type
+    (args : J.expression list) = 
+    match ffi with 
+    | Obj_create labels -> assemble_args_obj labels args 
+    | Js_call{ external_module_name = module_name; 
+                 name = fn; splice = js_splice ; 
 
-let divide_line make_ctx make get_args pat ctx pm =
-  let rec divide_rec = function
-    | (p::patl,action) :: rem ->
-        let this_match = divide_rec rem in
-        add_line (get_args p patl, action) this_match
-    | _ -> make pm.default pm.args in
+                     } -> 
+      let fn =  
+        match handle_external_opt module_name with 
+        | Some (id,_) -> 
+          E.dot (E.var id) fn
+        | None ->  E.js_var fn
+      in
+      let args, eff  = assemble_args_splice   call_loc ffi js_splice arg_types args in 
+      add_eff eff 
+      begin match (result_type : Ast_core_type.arg_type) with 
+      | Unit -> 
+        E.seq (E.call ~info:{arity=Full; call_info = Call_na} fn args) E.unit
+      | _ -> 
+        E.call ~info:{arity=Full; call_info = Call_na} fn args
+      end
+    | Js_module_as_var module_name -> 
+      let (id, name) =  handle_external  module_name  in
+      E.external_var_dot id name None
 
-  {pm = divide_rec pm.cases ;
-  ctx=make_ctx ctx ;
-  pat=pat}
+    | Js_module_as_fn {external_module_name = module_name; splice} ->
+      let fn =
+        let (id, name) = handle_external  module_name  in
+        E.external_var_dot id name None           
+      in           
+      let args, eff = assemble_args_splice   call_loc ffi splice arg_types args in 
+        (* TODO: fix in rest calling convention *)          
+      add_eff eff 
+      begin match (result_type : Ast_core_type.arg_type) with 
+        | Unit -> 
+          E.seq (E.call ~info:{arity=Full; call_info = Call_na} fn args) E.unit
+        | _ -> 
+          E.call ~info:{arity=Full; call_info = Call_na} fn args
+      end
+    | Js_module_as_class module_name ->
+      let fn =
+        let (id,name) = handle_external  module_name in
+        E.external_var_dot id name None in           
+      let args,eff = assemble_args arg_types args in 
+        (* TODO: fix in rest calling convention *)   
+      add_eff eff        
+      begin 
+        (match cxt.st with 
+         | Declare (_, id) | Assign id  ->
+           (* Format.fprintf Format.err_formatter "%a@."Ident.print  id; *)
+           Ext_ident.make_js_object id 
+         | EffectCall | NeedValue -> ())
+        ;
+        E.new_ fn args
+      end            
 
+    | Js_new { external_module_name = module_name; 
+               name = fn;
+               splice 
+             } -> 
+      (* This has some side effect, it will 
+         mark its identifier (If it has) as an object,
+         ATTENTION: 
+         order also matters here, since we mark its jsobject property, 
+         it  will affect the code gen later
+         TODO: we should propagate this property 
+         as much as we can(in alias table)
+      *)
+      let args, eff = assemble_args_splice  call_loc  ffi splice arg_types args in
+      let fn =  
+        match handle_external_opt module_name with 
+        | Some (id,name) ->  
+          E.external_var_dot id name (Some fn)
 
+        | None -> 
+          (** TODO: check, no [@@bs.module], 
+              assume it's global *)
+          E.js_var fn
 
-(* Then come various functions,
-   There is one set of functions per matching style
-   (constants, constructors etc.)
+      in
+      add_eff eff 
+      begin 
+        (match cxt.st with 
+         | Declare (_, id) | Assign id  ->
+           (* Format.fprintf Format.err_formatter "%a@."Ident.print  id; *)
+           Ext_ident.make_js_object id 
+         | EffectCall | NeedValue -> ())
+        ;
+        E.new_ fn args
+      end            
 
-   - matcher function are arguments to make_default (for defaukt handlers)
-   They may raise NoMatch or OrPat and perform the full
-   matching (selection + arguments).
 
 
-   - get_args and get_key are for the compiled matrices, note that
-   selection and geting arguments are separed.
+    | Js_global {name; external_module_name} -> 
 
-   - make_ _matching combines the previous functions for produicing
-   new  ``pattern_matching'' records.
-*)
+      (* TODO #11
+         1. check args -- error checking 
+         2. support [@@bs.scope "window"]
+         we need know whether we should call [add_js_module] or not 
+      *)
+      begin match name, handle_external_opt external_module_name with 
+        | "true", None -> E.js_bool true
+        | "false", None -> E.js_bool false
+        | "null", None -> E.nil 
+        | "undefined", None -> E.undefined
+        | _, Some(id,mod_name)
+          -> E.external_var_dot id mod_name (Some name)
+        | _, None -> 
 
+          E.var (Ext_ident.create_js name)
+      end
+    | Js_send {splice  = js_splice ; name ; pipe = false} -> 
+      begin match args  with
+        | self :: args -> 
+          let [@warning"-8"] ( self_type::arg_types )
+            = arg_types in
+          let args, eff = assemble_args_splice  call_loc ffi  js_splice arg_types args in
+          add_eff eff @@ 
+          E.call ~info:{arity=Full; call_info = Call_na}  (E.dot self name) args
+        | _ -> 
+          assert false 
+      end
+    | Js_send { name ; pipe = true ; splice = js_splice}
+      -> (* splice should not happen *)
+      (* assert (js_splice = false) ;  *)
+      let self, args = Ext_list.exclude_tail args in
+      let self_type, arg_types = Ext_list.exclude_tail arg_types in
+      let args, eff = assemble_args_splice call_loc ffi  js_splice arg_types args in
+      add_eff eff @@
+      E.call ~info:{arity=Full; call_info = Call_na}  (E.dot self name) args
 
+    | Js_get name -> 
+      begin match args with 
+      | [obj] ->
+        E.dot obj name        
+      | _ -> assert false 
+      end  
+    | Js_set name -> 
+      begin match args with 
+      | [obj; v] -> 
+        E.assign (E.dot obj name) v         
+      | _ -> 
+        assert false 
+      end
+    | Js_get_index 
+      -> 
+      begin match args with
+        | [obj; v ] -> 
+          Js_arr.ref_array obj v
+        | _ -> assert false 
+      end
+    | Js_set_index 
+      -> 
+      begin match args with 
+      | [obj; v ; value] -> 
+        Js_arr.set_array obj v value
+      | _ -> assert false
+      end
+    
 
-let rec matcher_const cst p rem = match p.pat_desc with
-| Tpat_or (p1,p2,_) ->
-    begin try
-      matcher_const cst p1 rem with
-    | NoMatch -> matcher_const cst p2 rem
-    end
-| Tpat_constant c1 when const_compare c1 cst = 0 -> rem
-| Tpat_any    -> rem
-| _ -> raise NoMatch
 
-let get_key_constant caller = function
-  | {pat_desc= Tpat_constant cst} -> cst
-  | p ->
-      prerr_endline ("BAD: "^caller) ;
-      pretty_pat p ;
-      assert false
+let translate loc cxt 
+    ({prim_name ;  prim_native_name} 
+     : Primitive.description) args  = 
+  if Ast_external_attributes.is_bs_external_prefix prim_native_name then 
+    begin 
+      match Ast_external_attributes.unsafe_from_string prim_native_name with 
+      | Normal -> 
+        Lam_dispatch_primitive.translate prim_name args 
+      | Bs (arg_types, result_type, ffi) -> 
+        translate_ffi loc  ffi prim_name cxt arg_types result_type args 
+    end
+  else 
+    begin 
+      Lam_dispatch_primitive.translate prim_name args 
+    end
 
-let get_args_constant _ rem = rem
 
-let make_constant_matching p def ctx = function
-    [] -> fatal_error "Matching.make_constant_matching"
-  | (_ :: argl) ->
-      let def =
-        make_default
-          (matcher_const (get_key_constant "make" p)) def
-      and ctx =
-        filter_ctx p  ctx in
-      {pm = {cases = []; args = argl ; default = def} ;
-        ctx = ctx ;
-        pat = normalize_pat p}
+end
+module Lam_compile_primitive : sig 
+#1 "lam_compile_primitive.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
 
 
-let divide_constant ctx m =
-  divide
-    make_constant_matching
-    (fun c d -> const_compare c d = 0) (get_key_constant "divide")
-    get_args_constant
-    ctx m
 
-(* Matching against a constructor *)
 
 
-let make_field_args loc binding_kind arg first_pos last_pos argl =
-  let rec make_args pos =
-    if pos > last_pos
-    then argl
-    else (Lprim(Pfield (pos, Fld_na (* TODO*) ), [arg],loc), binding_kind) :: make_args (pos + 1)
-  in make_args first_pos
 
-let get_key_constr = function
-  | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag
-  | _ -> assert false
+(** Primitive compilation  *) 
 
-let get_args_constr p rem = match p with
-| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem
-| _ -> assert false
+(* The entry point of compile primitives
+   Note it will call {!Lam_compile_external_call.translate} for c stubs compilation
+ *)
 
-let matcher_constr cstr = match cstr.cstr_arity with
-| 0 ->
-    let rec matcher_rec q rem = match q.pat_desc with
-    | Tpat_or (p1,p2,_) ->
-        begin
-          try
-            matcher_rec p1 rem
-          with
-          | NoMatch -> matcher_rec p2 rem
-        end
-    | Tpat_construct (_, cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag ->
-        rem
-    | Tpat_any -> rem
-    | _ -> raise NoMatch in
-    matcher_rec
-| 1 ->
-    let rec matcher_rec q rem = match q.pat_desc with
-    | Tpat_or (p1,p2,_) ->
-        let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
-        and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
-        begin match r1,r2 with
-        | None, None -> raise NoMatch
-        | Some r1, None -> r1
-        | None, Some r2 -> r2
-        | Some (a1::rem1), Some (a2::_) ->
-            {a1 with
-             pat_loc = Location.none ;
-             pat_desc = Tpat_or (a1, a2, None)}::
-            rem
-        | _, _ -> assert false
-        end
-    | Tpat_construct (_, cstr1, [arg])
-      when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem
-    | Tpat_any -> omega::rem
-    | _ -> raise NoMatch in
-    matcher_rec
-| _ ->
-    fun q rem -> match q.pat_desc with
-    | Tpat_or (_,_,_) -> raise OrPat
-    | Tpat_construct (_, cstr1, args)
-      when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
-    | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
-    | _        -> raise NoMatch
+val translate : 
+  Location.t -> 
+  Lam_compile_defs.cxt  -> Lam.primitive -> J.expression list -> J.expression
 
-let make_constr_matching p def ctx = function
-    [] -> fatal_error "Matching.make_constr_matching"
-  | ((arg, mut) :: argl) ->
-      let cstr = pat_as_constr p in
-      let newargs =
-        match cstr.cstr_tag with
-          Cstr_constant _ | Cstr_block _ ->
-            make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl
-        | Cstr_extension _ ->
-            make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl in
-      {pm=
-        {cases = []; args = newargs;
-          default = make_default (matcher_constr cstr) def} ;
-        ctx =  filter_ctx p ctx ;
-        pat=normalize_pat p}
+end = struct
+#1 "lam_compile_primitive.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-let divide_constructor ctx pm =
-  divide
-    make_constr_matching
-    (=) get_key_constr get_args_constr
-    ctx pm
 
-(* Matching against a variant *)
 
-let rec matcher_variant_const lab p rem = match p.pat_desc with
-| Tpat_or (p1, p2, _) ->
-    begin
-      try
-        matcher_variant_const lab p1 rem
-      with
-      | NoMatch -> matcher_variant_const lab p2 rem
-    end
-| Tpat_variant (lab1,_,_) when lab1=lab -> rem
-| Tpat_any -> rem
-| _   -> raise NoMatch
 
 
-let make_variant_matching_constant p lab def ctx = function
-    [] -> fatal_error "Matching.make_variant_matching_constant"
-  | ((arg, mut) :: argl) ->
-      let def = make_default (matcher_variant_const lab) def
-      and ctx = filter_ctx p ctx in
-      {pm={ cases = []; args = argl ; default=def} ;
-        ctx=ctx ;
-        pat = normalize_pat p}
 
-let matcher_variant_nonconst lab p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_variant (lab1,Some arg,_) when lab1=lab -> arg::rem
-| Tpat_any -> omega::rem
-| _   -> raise NoMatch
 
+module E = Js_exp_make 
 
-let make_variant_matching_nonconst p lab def ctx = function
-    [] -> fatal_error "Matching.make_variant_matching_nonconst"
-  | ((arg, mut) :: argl) ->
-      let def = make_default (matcher_variant_nonconst lab) def
-      and ctx = filter_ctx p ctx in
-      {pm=
-        {cases = []; args = (Lprim(Pfield (1, Fld_na (* TODO*)), [arg], p.pat_loc), Alias) :: argl;
-          default=def} ;
-        ctx=ctx ;
-        pat = normalize_pat p}
+(* If it is the return value, since it is a side-effect call,
+   we return unit, otherwise just return it
+ *)
+let decorate_side_effect ({st; should_return;_} : Lam_compile_defs.cxt) e : E.t = 
+  match st, should_return with 
+  | _, True _ 
+  | (Assign _ | Declare _ | NeedValue), _  -> E.seq e E.unit
+  | EffectCall, False -> e 
+  (* NeedValue should return a meaningful expression*)
 
-let get_key_variant p = match p.pat_desc with
-| Tpat_variant(lab, Some _ , _) ->  Cstr_block (Btype.hash_variant lab)
-| Tpat_variant(lab, None , _) -> Cstr_constant (Btype.hash_variant lab)
-|  _ -> assert false
+let translate  loc
+    ({ meta = { env; _}; _} as cxt : Lam_compile_defs.cxt) 
+    (prim : Lam.primitive)
+    (args : J.expression list) : J.expression = 
+  match prim with
+  | Pjs_unsafe_downgrade _
+  | Pdebugger 
+  | Pjs_fn_run _ 
+  | Pjs_fn_make _
 
-let divide_variant row ctx {cases = cl; args = al; default=def} =
-  let row = Btype.row_repr row in
-  let rec divide = function
-      ({pat_desc = Tpat_variant(lab, pato, _)} as p:: patl, action) :: rem ->
-        let variants = divide rem in
-        if try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
-        with Not_found -> true
-        then
-          variants
-        else begin
-          let tag = Btype.hash_variant lab in
-          match pato with
-            None ->
-              add (make_variant_matching_constant p lab def ctx) variants
-                (=) (Cstr_constant tag) (patl, action) al
-          | Some pat ->
-              add (make_variant_matching_nonconst p lab def ctx) variants
-                (=) (Cstr_block tag) (pat :: patl, action) al
-        end
-    | cl -> []
-  in
-  divide cl
+  | Pjs_fn_runmethod _ 
+    -> assert false (* already handled by {!Lam_compile} *)
+  | Pjs_fn_method _ -> assert false
+  | Pglobal_exception id ->
+    Js_of_lam_exception.get_builtin_by_name id.name    
+  | Pstringadd ->
+    begin match args with      
+      | [a;b] ->
+        E.string_append a b
+      | _ -> assert false          
+    end          
+  | Pinit_mod -> 
+    E.runtime_call Js_config.module_ "init_mod" args
+  | Pupdate_mod ->
+    E.runtime_call Js_config.module_ "update_mod" args
+  | Pmakeblock(tag, tag_info, mutable_flag ) ->  (* RUNTIME *)
+    Js_of_lam_block.make_block 
+      (Js_op_util.of_lam_mutable_flag mutable_flag) 
+      tag_info (E.small_int tag) args 
+  | Pfield (i, fld_info) -> 
+    begin match args with 
+      | [ e ]  -> 
+        Js_of_lam_block.field fld_info e (Int32.of_int i)
+      (* Invariant depends on runtime *)
+      | _ -> assert false
+    end
 
-(*
-  Three ``no-test'' cases
-  *)
+(** Negate boxed int *)
+  | Pnegbint Pint32
+    ->
+    begin match args with
+    | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
+    | _ -> assert false
+    end
+  | Pnegbint Pnativeint
+    -> 
+    begin match args with
+    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
+    | _ -> assert false
+    end
+  | Pnegbint Pint64
+    -> 
+    Js_long.neg args 
 
-(* Matching against a variable *)
+  | Pnegint
+    -> 
+    begin match args with
+    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
+    | _ -> assert false
+    end
 
-let get_args_var _ rem = rem
+  | Pnegfloat 
+    -> 
+    begin match args with 
+    | [ e ] -> E.float_minus (E.zero_float_lit) e 
+    | _ -> assert false
+    end
+(** Negate boxed int end*)
+(* Int addition and subtraction *)
+  | Paddint 
+  | Paddbint  Pint32
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.int32_add  e1  e2
+      | _ -> assert false
+    end
+  | Paddbint Pnativeint 
+    -> 
+    begin match args with
+      | [e1;e2] ->
+        E.unchecked_int32_add  e1  e2
+      | _ -> assert false
+    end
 
+  | Paddbint Pint64
+    ->  
+    Js_long.add args 
 
-let make_var_matching def = function
-  | [] ->  fatal_error "Matching.make_var_matching"
-  | _::argl ->
-      {cases=[] ;
-        args = argl ;
-        default= make_default get_args_var def}
 
-let divide_var ctx pm =
-  divide_line ctx_lshift make_var_matching get_args_var omega ctx pm
+  | Paddfloat
+     -> 
+     begin match args with
+       | [e1;e2] ->
+         E.float_add  e1  e2
+       | _ -> assert false
+     end
+  | Psubint 
+    -> 
+    begin match args with 
+    | [e1; e2] ->     
+      E.int32_minus e1 e2 
+    | _ -> assert false
+    end
+  | Psubbint Pint32
+    -> 
+    begin match args with
+      | [e1;e2] ->
+          E.int32_minus   e1  e2
+      | _ -> assert false 
+    end
+  | Psubbint Pnativeint
+    -> 
+    begin match args with
+      | [e1;e2] ->
+          E.unchecked_int32_minus   e1  e2
+      | _ -> assert false 
+    end
+  | Psubbint Pint64
+    -> 
+    Js_long.sub args 
+  | Psubfloat
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.float_minus   e1  e2
+      | _ -> assert false 
+    end
+  | Pmulbint Lambda.Pnativeint
+    -> 
+    begin match args with
+      | [e1; e2]  ->
+        E.unchecked_int32_mul  e1  e2
+      | _ -> assert false 
+    end
+
+  | Pmulint 
+  | Pmulbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1; e2]  ->
+        E.int32_mul  e1  e2
+      | _ -> assert false 
+    end
+  | Pmulbint Pint64 
+    -> 
+    Js_long.mul args 
+  | Pmulfloat 
+    -> 
+      begin match args with
+      | [e1; e2]  ->
+          E.float_mul  e1  e2
+      | _ -> assert false 
+      end
+  | Pdivfloat -> 
+    begin match args with  
+      | [e1;e2] -> E.float_div  e1  e2
+      | _ -> assert false 
+    end
+  | Pdivbint Pnativeint
+    -> 
+    begin match args with 
+      | [e1;e2] ->
+        E.int32_div ~checked:false e1 e2
+      | _ -> assert false
+    end
+  | Pdivint 
+  | Pdivbint Pint32
+    -> 
+    begin match args with 
+      | [e1;e2] ->
+        E.int32_div ~checked:(!Js_config.check_div_by_zero) e1 e2
+      | _ -> assert false
+    end
+
+  | Pdivbint Pint64 
+    -> Js_long.div args 
+  | Pmodint 
+  | Pmodbint Pnativeint
+  | Pmodbint Pint32
+    ->
+    begin match args with
+      | [e1; e2] ->
+        E.int32_mod   ~checked:(!Js_config.check_div_by_zero) e1  e2
+      | _ -> assert false 
+    end
+  | Pmodbint Lambda.Pint64 
+    -> Js_long.mod_ args  
+  | Plslint 
+  | Plslbint Lambda.Pnativeint
+  | Plslbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.int32_lsl e1  e2
+      | _ -> assert false 
+    end
+  | Plslbint Lambda.Pint64 
+    -> Js_long.lsl_ args
+  | Plsrbint Lambda.Pnativeint
+    -> 
+    begin match args with
+      | [e1; e2] ->
+        E.int32_lsr   e1  e2
+      | _ -> assert false
+    end
+  | Plsrint 
+  | Plsrbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1; {J.expression_desc = Number (Int {i=0l; _}|Uint 0l | Nint 0n); _}]
+        -> 
+        e1
+      | [e1; e2] ->
+        E.to_int32 @@ E.int32_lsr   e1  e2
+      | _ -> assert false
+    end
+  | Plsrbint Lambda.Pint64
+    -> Js_long.lsr_ args
+  | Pasrint 
+  | Pasrbint Lambda.Pnativeint
+  | Pasrbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.int32_asr  e1  e2
+      | _ -> assert false
+    end
+  | Pasrbint Lambda.Pint64 
+    -> Js_long.asr_ args      
+  | Pandint 
+  | Pandbint Lambda.Pnativeint
+  | Pandbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.int32_band  e1  e2
+      | _ -> assert false
+    end
+  | Pandbint Lambda.Pint64
+    -> Js_long.and_ args
+  | Porint 
+  | Porbint Lambda.Pnativeint
+  | Porbint Lambda.Pint32
+    ->
+    begin match args with
+      | [e1;e2] ->
+        E.int32_bor  e1  e2
+      | _ -> assert false
+    end
+  | Porbint Lambda.Pint64 
+    -> Js_long.or_ args
+  | Pxorint 
+  | Pxorbint Lambda.Pnativeint
+  | Pxorbint Lambda.Pint32 
+    -> 
+    begin match args with
+      | [e1;e2] ->
+        E.int32_bxor  e1  e2
+      | _ -> assert false
+    end
+  | Pxorbint Lambda.Pint64 
+    ->
+    Js_long.xor args    
+  | Pbintcomp (Pnativeint ,cmp)
+  | Pfloatcomp cmp
+  | Pintcomp cmp
+  | Pbintcomp (Pint32 ,cmp)
+    ->
+    begin 
+      (* Global Builtin Exception is an int, like 
+         [Not_found] or [Invalid_argument] ?
+      *)
+      match args with 
+      | [e1;e2] -> E.int_comp cmp e1 e2
+      | _ -> assert false 
+    end
+        (* List --> stamp = 0 
+           Assert_false --> stamp = 26 
+         *)
+  | Pbintcomp (Pint64 ,cmp)
+    -> Js_long.comp cmp args
+
+  | Pcvtbint ((Pint32 | Pnativeint ), Pint64) 
+    -> Js_long.of_int32 args
+  | Pcvtbint (Pint64, Pint64)
+  | Pcvtbint ((Pnativeint|Pint32), (Pnativeint|Pint32))
+    ->   
+    begin match args with 
+      | [e0] -> e0 
+      | _ -> assert false
+    end
+  | Pcvtbint (Pint64, (Pnativeint|Pint32)) 
+    ->  
+    Js_long.to_int32 args 
+  | Pintoffloat -> 
+    begin
+      match args with 
+      | [e] -> E.to_int32 e 
+      | _ -> assert false 
+    end
+  | Pbintofint Pint64
+    -> Js_long.of_int32 args 
+  | Pbintofint (Pnativeint 
+               | Pint32 )
+  | Pintofbint Pnativeint
+  | Pintofbint Pint32
+  | Pfloatofint 
+    -> 
+    begin match args with 
+      | [e] -> e 
+      | _ -> assert false 
+    end
+  | Pintofbint Pint64
+    -> Js_long.to_int32 args
+  | Pabsfloat -> 
+    begin match args with 
+      | [e] ->
+        E.math "abs" [e]
+        (* GCC treat built-ins like Math in a dirfferent way*)
+      | _ -> assert false
+      end
+  | Pnot ->
+    begin match args with
+      | [e] ->  E.not  e 
+      | _ -> assert false
+    end
+  | Poffsetint n ->
+    begin match args with
+      | [e] ->  E.int32_add  e (E.small_int  n)
+      | _ -> assert false
+    end
+  | Poffsetref n ->
+    begin match args with
+      | [e] -> 
+        let v = (Js_of_lam_block.field Fld_na e 0l) in
+        E.assign  v (E.int32_add v (E.small_int  n))
+      | _ -> assert false
+    end
+
+  | Psequand -> (* TODO: rhs is possibly a tail call *)
+    begin match args with
+      | [e1;e2] ->
+        E.and_   e1  e2
+      | _ -> assert false
+    end
+  | Psequor -> (* TODO: rhs is possibly a tail call *)
+    begin match args with
+      | [e1;e2] ->
+        E.or_  e1  e2
+      | _ -> assert false
+    end
+  | Pisout -> 
+    begin match args with 
+      (* predicate: [x > range  or x < 0 ]
+         can be simplified if x is positive , x > range
+         if x is negative, fine, its uint is for sure larger than range,
+         the output is not readable, we might change it back.
+
+         Note that if range is small like [1], then the negative of 
+         it can be more precise (given integer)
+         a normal case of the compiler is  that it will do a shift 
+         in the first step [ (x - 1) > 1 or ( x - 1 ) < 0 ]
+      *)
+      | [range; e] -> E.is_out e range
+      | _ -> assert false
+    end
+  | Pbytes_of_string -> 
+    begin 
+      (* TODO: write a js primitive  - or is it necessary ?
+         if we have byte_get/string_get
+         still necessary, since you can set it now.
+      *)
+      match args with 
+      |[e] -> Js_of_lam_string.bytes_of_string e
+      | _ -> assert false
+    end
+  | Pbytes_to_string  -> 
+    begin 
+      match args with 
+      |[e] -> Js_of_lam_string.bytes_to_string e 
+      | _ -> assert false
+    end
+  | Pstringlength ->
+    begin match args with
+      | [e] -> E.string_length e 
+      | _ -> assert false 
+    end
+  | Pbyteslength  -> 
+    begin match args with
+      | [e] -> E.bytes_length e 
+      | _ -> assert false 
+    end
+  (* This should only be Pbyteset(u|s), which in js, is an int array 
+     Bytes is an int array in javascript
+  *)
+  | Pbytessetu
+  | Pbytessets -> 
+      begin match args with
+      | [e;e0;e1] -> decorate_side_effect cxt 
+            (Js_of_lam_string.set_byte e e0 e1)
+
+      | _ -> assert false
+      end
+  | Pbytesrefu ->
+      begin match args with
+      | [e;e1] -> Js_of_lam_string.ref_byte e e1
+      | _ -> assert false
+      end
+    
+  | Pbytesrefs ->
+    begin match args with
+      | [e ; e1] ->
+        if !Clflags.fast then
+          Js_of_lam_string.ref_byte e e1
+        else E.runtime_call Js_config.bytes "get" args            
+      | _ -> assert false         
+    end
+   (* For bytes and string, they both return [int] in ocaml 
+       we need tell Pbyteref from Pstringref
+       1. Pbyteref -> a[i]
+       2. Pstringref -> a.charCodeAt (a[i] is wrong)
+    *)
+  | Pstringrefu  ->
+      begin match args with
+      | [e;e1] -> Js_of_lam_string.ref_string e e1 
+      | _ -> assert false
+      end
 
-(* Matching and forcing a lazy value *)
+  | Pstringrefs ->
+      begin match args with
+        | [e;e1] ->
+          if !Clflags.fast then
+            Js_of_lam_string.ref_string e e1             
+          else       
+            E.runtime_call Js_config.string "get" args          
+      | _ -> assert false
+      end
+    
+  | Pgetglobal i   -> 
+    (* TODO -- check args, case by case -- 
+        1. include Array --> let include  = Array 
+        2. get exception
+    *)
+    Lam_compile_global.get_exp (i,env,true)
+  
+    (** only when Lapply -> expand = true*)
+  | Praise  -> assert false (* handled before here *)
 
-let get_arg_lazy p rem = match p with
-| {pat_desc = Tpat_any} -> omega :: rem
-| {pat_desc = Tpat_lazy arg} -> arg :: rem
-| _ ->  assert false
+(* Runtime encoding relevant *)
+  | Parraylength Pgenarray
+  | Parraylength Paddrarray
+  | Parraylength Pintarray
+  | Parraylength Pfloatarray  -> 
+      begin match args with 
+      | [e] -> E.array_length e 
+      | _ -> assert false
+      end
+  | Psetfield (i, _, field_info) -> 
+      begin match args with 
+      | [e0;e1] ->  (** RUNTIME *)
+          decorate_side_effect cxt 
+            (Js_of_lam_block.set_field field_info e0 (Int32.of_int i) e1)
+            (*TODO: get rid of [E.unit ()]*)
+      | _ -> assert false
+      end
+  | Psetfloatfield (i,field_info)
+    -> (** RUNTIME --  RETURN VALUE SHOULD BE UNIT *)
+      begin 
+        match args with 
+        | [e;e0] -> 
+          decorate_side_effect cxt 
+            (Js_of_lam_float_record.set_double_field field_info e (Int32.of_int i) e0 ) 
+        | _ -> assert false
+      end
 
-let matcher_lazy p rem = match p.pat_desc with
-| Tpat_or (_,_,_)     -> raise OrPat
-| Tpat_var _          -> get_arg_lazy omega rem
-| _                   -> get_arg_lazy p rem
 
-(* Inlining the tag tests before calling the primitive that works on
-   lazy blocks. This is alse used in translcore.ml.
-   No call other than Obj.tag when the value has been forced before.
-*)
+  | Pfloatfield (i, field_info) -> (** RUNTIME *)
+      begin 
+        match args with 
+        | [e] ->
+          Js_of_lam_float_record.get_double_feild field_info e
+            (Int32.of_int i) 
+        | _ -> assert false 
+      end
+  | Parrayrefu _kind
+  | Parrayrefs _kind ->  
+      begin match args with
+      | [e;e1] -> Js_of_lam_array.ref_array e e1 (* Todo: Constant Folding *)
+      | _ -> assert false
+      end
+  | Pmakearray kind -> 
+      Js_of_lam_array.make_array Mutable kind args 
+  | Parraysetu _kind
+  | Parraysets _kind -> 
+      begin match args with (* wrong*)
+      | [e;e0;e1] -> decorate_side_effect cxt @@ Js_of_lam_array.set_array  e e0 e1
+      | _ -> assert false
+      end
+  | Pccall prim -> 
+      Lam_compile_external_call.translate loc cxt prim args 
+     (* Test if the argument is a block or an immediate integer *)
+  | Pisint -> 
+    begin 
+      match args with 
+      | [e] ->  E.is_type_number e 
 
-let prim_obj_tag =
-  {prim_name = "caml_obj_tag";
-   prim_arity = 1; prim_alloc = false;
-   prim_native_name = "";
-   prim_native_float = false}
+      | _ ->   assert false
+    end
+  | Pctconst ct -> 
+    begin
+      match ct with 
+      | Big_endian -> 
+        if Sys.big_endian then  E.caml_true
+        else E.caml_false
+      | Word_size -> 
+        E.small_int  Sys.word_size
+      | Ostype_unix -> 
+        if Sys.unix then E.caml_true else E.caml_false
+      | Ostype_win32 -> 
+        if Sys.win32 then E.caml_true else E.caml_false
+      | Ostype_cygwin -> 
+        if Sys.cygwin then E.caml_true else E.caml_false
+    end
+  (* | Psetglobal _  ->  *)
+  (*   assert false (\* already handled *\) *)
+    (* assert false *)
+  | Pduprecord ((Record_regular 
+                | Record_float ),0)
+  | Pduprecord ((Record_regular 
+                | Record_float ),_) -> 
+    begin match args with 
+    | [e] -> Js_of_lam_record.copy e
+    | _ -> assert false       
+    end
+  | Pbigarrayref (unsafe, dimension, kind, layout)
+    -> 
+    (* can be refined to 
+       [caml_bigarray_float32_c_get_1]
+       note that kind can be [generic]
+       and layout can be [unknown],
+       dimension is always available
+    *)
+    begin match dimension, kind, layout, unsafe with 
+      | 1,  ( Pbigarray_float32 | Pbigarray_float64
+            | Pbigarray_sint8 | Pbigarray_uint8
+            | Pbigarray_sint16 | Pbigarray_uint16
+            | Pbigarray_int32 | Pbigarray_int64
+            | Pbigarray_caml_int | Pbigarray_native_int
+            | Pbigarray_complex32 | Pbigarray_complex64), Pbigarray_c_layout, _
+        -> 
+        begin match args with
+        | [x;indx] -> Js_of_lam_array.ref_array x indx
+        | _ -> assert false
+        end
+    | _, _, _ ,_ -> 
+      E.not_implemented ("caml_ba_get_" ^ string_of_int dimension )
+      (* E.runtime_call Js_config.bigarray  *)
+      (*   ("caml_ba_get_" ^ string_of_int dimension ) args  *)
+    end
+  | Pbigarrayset (unsafe, dimension, kind, layout)
+    -> 
+    begin match dimension, kind, layout, unsafe with 
+      | 1,  ( Pbigarray_float32 | Pbigarray_float64
+            | Pbigarray_sint8 | Pbigarray_uint8
+            | Pbigarray_sint16 | Pbigarray_uint16
+            | Pbigarray_int32 | Pbigarray_int64
+            | Pbigarray_caml_int | Pbigarray_native_int
+            | Pbigarray_complex32 | Pbigarray_complex64), Pbigarray_c_layout, _
+        -> 
+        begin match args with 
+        | [x; index; value] -> 
+          Js_of_lam_array.set_array x index value          
+        | _ -> assert false
+        end
+      
+      | _ , _, _,_ 
+        -> 
+        E.not_implemented
+          ("caml_ba_set_" ^ string_of_int dimension )
+        (* E.runtime_call Js_config.bigarray  *)
+        (*   ("caml_ba_set_" ^ string_of_int dimension ) args  *)
+    end
 
-let get_mod_field modname field =
-  lazy (
-    try
-      let mod_ident = Ident.create_persistent modname in
-      let env = Env.open_pers_signature modname Env.initial_safe_string in
-      let p = try
-        match Env.lookup_value (Longident.Lident field) env with
-        | (Path.Pdot(_,_,i), _) -> i
-        | _ -> fatal_error ("Primitive "^modname^"."^field^" not found.")
-      with Not_found ->
-        fatal_error ("Primitive "^modname^"."^field^" not found.")
-      in
-      Lprim(Pfield (p, Fld_na (* TODO - then we dont need query any more*)), 
-            [Lprim(Pgetglobal mod_ident, [], Location.none)], Location.none)
-    with Not_found -> fatal_error ("Module "^modname^" unavailable.")
-  )
+  | Pbigarraydim i
+    -> 
+    E.not_implemented ("caml_ba_dim_" ^ string_of_int i)
+    (* E.runtime_call Js_config.bigarray *)
+    (*   ("caml_ba_dim_" ^ string_of_int i) args        *)
+  | Pbswap16 
+    -> 
+    E.runtime_call Js_config.int32 "caml_bswap16" args
+  | Pbbswap Lambda.Pnativeint
+  | Pbbswap Lambda.Pint32
+    -> 
+    E.runtime_call Js_config.int32 "caml_int32_bswap" args
+  | Pbbswap Lambda.Pint64
+    -> Js_long.swap args 
+  | Pstring_load_16 unsafe
+    -> E.runtime_call Js_config.string "caml_string_get16" args
+  | Pstring_load_32 unsafe
+    -> E.runtime_call Js_config.string "caml_string_get32" args
+  | Pstring_load_64 unsafe
+    -> Js_long.get64 args
 
-let code_force_lazy_block =
-  get_mod_field "CamlinternalLazy" "force_lazy_block"
-;;
+  | Plazyforce
+  (* | Plazyforce -> *)
+  (*     let parm = Ident.create "prim" in *)
+  (*     Lfunction(Curried, [parm], *)
+  (*               Matching.inline_lazy_force (Lvar parm) Location.none) *)
+  (* It is inlined, this should not appear here *)    
+  | Pbittest 
+  
+  | Pstring_set_16 _
+  | Pstring_set_32 _
+  | Pstring_set_64 _
+  | Pbigstring_load_16 _
+  | Pbigstring_load_32 _
+  | Pbigstring_load_64 _
+  | Pbigstring_set_16 _
+  | Pbigstring_set_32 _
+  | Pbigstring_set_64 _
+    -> 
+      let comment = "Missing primitive" in       
+      let s = Lam_util.string_of_primitive prim in
+      let warn = Printf.sprintf  "%s: %s\n" comment s in
+      Ext_log.warn __LOC__ "%s"  warn;
+      (*we dont use [throw] here, since [throw] is an statement  *)        
+      E.dump  Error [ E.str warn]
 
-(* inline_lazy_force inlines the beginning of the code of Lazy.force. When
-   the value argument is tagged as:
-   - forward, take field 0
-   - lazy, call the primitive that forces (without testing again the tag)
-   - anything else, return it
 
-   Using Lswitch below relies on the fact that the GC does not shortcut
-   Forward(val_out_of_heap).
-*)
 
-let inline_lazy_force_cond arg loc =
-  let idarg = Ident.create "lzarg" in
-  let varg = Lvar idarg in
-  let tag = Ident.create "tag" in
-  let force_fun = Lazy.force code_force_lazy_block in
-  Llet(Strict, idarg, arg,
-       Llet(Alias, tag, Lprim(Pccall prim_obj_tag, [varg], loc),
-            Lifthenelse(
-              (* if (tag == Obj.forward_tag) then varg.(0) else ... *)
-              Lprim(Pintcomp Ceq,
-                    [Lvar tag; Lconst(Const_base(Const_int Obj.forward_tag))],
-                   loc),
-              Lprim(Pfield (0, Fld_na (* TODO: lazy *)), [varg],
-                   loc),
-              Lifthenelse(
-                (* ... if (tag == Obj.lazy_tag) then Lazy.force varg else ... *)
-                Lprim(Pintcomp Ceq,
-                      [Lvar tag; Lconst(Const_base(Const_int Obj.lazy_tag))],
-                     loc),
-                Lapply(force_fun, [varg], loc),
-                (* ... arg *)
-                  varg))))
+end
+module Lam_exit_code : sig 
+#1 "lam_exit_code.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let inline_lazy_force_switch arg loc =
-  let idarg = Ident.create "lzarg" in
-  let varg = Lvar idarg in
-  let force_fun = Lazy.force code_force_lazy_block in
-  Llet(Strict, idarg, arg,
-       Lifthenelse(
-         Lprim(Pisint, [varg],loc), varg,
-         (Lswitch
-            (varg,
-             { sw_numconsts = 0; sw_consts = [];
-               sw_numblocks = 256;  (* PR#6033 - tag ranges from 0 to 255 *)
-               sw_blocks =
-                 [ (Obj.forward_tag, Lprim(Pfield (0, Fld_na (* TODO: lazy *)), [varg],loc));
-                   (Obj.lazy_tag,
-                    Lapply(force_fun, [varg], loc)) ];
-               sw_failaction = Some varg } ))))
 
-let inline_lazy_force arg loc =
-  if !Clflags.native_code then
-    (* Lswitch generates compact and efficient native code *)
-    inline_lazy_force_switch arg loc
-  else
-    (* generating bytecode: Lswitch would generate too many rather big
-       tables (~ 250 elts); conditionals are better *)
-    inline_lazy_force_cond arg loc
 
-let make_lazy_matching def = function
-    [] -> fatal_error "Matching.make_lazy_matching"
-  | (arg,mut) :: argl ->
-      { cases = [];
-        args =
-          (inline_lazy_force arg Location.none, Strict) :: argl;
-        default = make_default matcher_lazy def }
 
-let divide_lazy p ctx pm =
-  divide_line
-    (filter_ctx p)
-    make_lazy_matching
-    get_arg_lazy
-    p ctx pm
 
-(* Matching against a tuple pattern *)
 
 
-let get_args_tuple arity p rem = match p with
-| {pat_desc = Tpat_any} -> omegas arity @ rem
-| {pat_desc = Tpat_tuple args} ->
-    args @ rem
-| _ ->  assert false
+val has_exit_code : (int -> bool ) -> Lam.t -> bool 
 
-let matcher_tuple arity p rem = match p.pat_desc with
-| Tpat_or (_,_,_)     -> raise OrPat
-| Tpat_var _          -> get_args_tuple arity omega rem
-| _                   ->  get_args_tuple arity p rem
+end = struct
+#1 "lam_exit_code.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let make_tuple_matching loc arity def = function
-    [] -> fatal_error "Matching.make_tuple_matching"
-  | (arg, mut) :: argl ->
-      let rec make_args pos =
-        if pos >= arity
-        then argl
-        else (Lprim(Pfield (pos, Fld_na (* TODO: tuple*)) , [arg], loc), Alias) :: make_args (pos + 1) in
-      {cases = []; args = make_args 0 ;
-        default=make_default (matcher_tuple arity) def}
 
 
-let divide_tuple arity p ctx pm =
-  divide_line
-    (filter_ctx p)
-    (make_tuple_matching p.pat_loc arity)
-    (get_args_tuple  arity) p ctx pm
 
-(* Matching against a record pattern *)
 
 
-let record_matching_line num_fields lbl_pat_list =
-  let patv = Array.make num_fields omega in
-  List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
-  Array.to_list patv
+let rec has_exit_code exits  (lam : Lam.t)  : bool = 
+  match lam with
+  | Lvar _
+  | Lconst _ 
+  | Lfunction _ (* static exit can not across function boundary *)
+    -> false
+  | Lapply {fn = l; args; _ } 
+    -> has_exit_code exits l || List.exists (fun x -> has_exit_code exits x ) args 
 
-let get_args_record num_fields p rem = match p with
-| {pat_desc=Tpat_any} ->
-    record_matching_line num_fields [] @ rem
-| {pat_desc=Tpat_record (lbl_pat_list,_)} ->
-    record_matching_line num_fields lbl_pat_list @ rem
-| _ -> assert false
+  | Llet (_kind,_id,v,body) 
+    -> has_exit_code exits v || has_exit_code exits body
+  | Lletrec (binding,body) ->
+    List.exists (fun (_, l) -> has_exit_code exits l ) binding ||
+    has_exit_code exits body    
+  | Lprim {args; _} 
+    -> List.exists (fun x -> has_exit_code exits x) args
+  | Lswitch (l,lam_switch) 
+    -> has_exit_code exits l || has_exit_code_lam_switch exits lam_switch
 
-let matcher_record num_fields p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_var _      -> get_args_record num_fields omega rem
-| _               -> get_args_record num_fields p rem
+  | Lstringswitch (l,ls,opt) -> 
+    has_exit_code exits l ||
+    List.exists (fun (_,l) -> has_exit_code exits l) ls ||
+    (match opt with 
+    | None -> false
+    | Some x -> has_exit_code exits l )
+  | Lstaticraise (v,ls) ->
+      exits v ||    
+    List.exists (has_exit_code exits) ls
+  | Lstaticcatch (l,_,handler) 
+    ->
+    has_exit_code exits l || has_exit_code exits handler
+  | Ltrywith (l,_, handler) 
+    ->
+    has_exit_code exits l || has_exit_code exits handler
+  | Lifthenelse (a,b,c) 
+    -> 
+    has_exit_code exits a || has_exit_code exits b || has_exit_code exits c
+  | Lsequence (a,b) 
+    ->
+    has_exit_code exits a || has_exit_code exits b
+  | Lwhile (a,b) 
+    ->
+    has_exit_code exits a || has_exit_code exits b
+  | Lfor (_,a,b,_dir,body) -> 
+    has_exit_code exits a 
+    || has_exit_code exits b
+    || has_exit_code exits body
+    
+  | Lassign (_,a) 
+    -> 
+    has_exit_code exits a
+  | Lsend (_,obj,l,ls,_loc) 
+    -> 
+    has_exit_code exits obj ||
+    has_exit_code exits l ||
+    List.exists (has_exit_code exits) ls
+  | Lifused (_,b) 
+    -> has_exit_code exits b
 
-let make_record_matching loc all_labels def = function
-    [] -> fatal_error "Matching.make_record_matching"
-  | ((arg, mut) :: argl) ->
-      let rec make_args pos =
-        if pos >= Array.length all_labels then argl else begin
-          let lbl = all_labels.(pos) in
-          let access =
-            match lbl.lbl_repres with
-              Record_regular -> Pfield (lbl.lbl_pos, Fld_record lbl.lbl_name)
-            | Record_float -> Pfloatfield (lbl.lbl_pos, Fld_record lbl.lbl_name) in
-          let str =
-            match lbl.lbl_mut with
-              Immutable -> Alias
-            | Mutable -> StrictOpt in
-          (Lprim(access, [arg], loc), str) :: make_args(pos + 1)
-        end in
-      let nfields = Array.length all_labels in
-      let def= make_default (matcher_record nfields) def in
-      {cases = []; args = make_args 0 ; default = def}
+and has_exit_code_lam_switch exits (lam_switch : Lam.switch) = 
+  match lam_switch with
+   | { sw_numconsts = _; sw_consts; sw_numblocks = _ ; sw_blocks; sw_failaction } ->
+     List.exists (fun (_,l) -> has_exit_code exits l) sw_consts ||
+     List.exists (fun (_,l) -> has_exit_code exits l)  sw_blocks ||
+     (match sw_failaction with 
+     | None -> false 
+     | Some x -> has_exit_code exits x)
 
+end
+module Lam_compile : sig 
+#1 "lam_compile.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let divide_record all_labels p ctx pm =
-  let get_args = get_args_record (Array.length all_labels) in
-  divide_line
-    (filter_ctx p)
-    (make_record_matching p.pat_loc all_labels)
-    get_args
-    p ctx pm
 
-(* Matching against an array pattern *)
 
-let get_key_array = function
-  | {pat_desc=Tpat_array patl} -> List.length patl
-  | _ -> assert false
 
-let get_args_array p rem = match p with
-| {pat_desc=Tpat_array patl} -> patl@rem
-| _ -> assert false
 
-let matcher_array len p rem = match p.pat_desc with
-| Tpat_or (_,_,_) -> raise OrPat
-| Tpat_array args when List.length args=len -> args @ rem
-| Tpat_any -> Parmatch.omegas len @ rem
-| _ -> raise NoMatch
 
-let make_array_matching kind p def ctx = function
-  | [] -> fatal_error "Matching.make_array_matching"
-  | ((arg, mut) :: argl) ->
-      let len = get_key_array p in
-      let rec make_args pos =
-        if pos >= len
-        then argl
-        else (Lprim(Parrayrefu kind, [arg; Lconst(Const_base(Const_int pos))],p.pat_loc),
-              StrictOpt) :: make_args (pos + 1) in
-      let def = make_default (matcher_array len) def
-      and ctx = filter_ctx p ctx in
-      {pm={cases = []; args = make_args 0 ; default = def} ;
-        ctx=ctx ;
-        pat = normalize_pat p}
 
-let divide_array kind ctx pm =
-  divide
-    (make_array_matching kind)
-    (=) get_key_array get_args_array ctx pm
 
+(** Compile single lambda IR to JS IR  *)
 
-(*
-   Specific string test sequence
-   Will be called by the bytecode compiler, from bytegen.ml.
-   The strategy is first dichotomic search (we perform 3-way tests
-   with compare_string), then sequence of equality tests
-   when there are less then T=strings_test_threshold static strings to match.
+val compile_let : 
+  Lambda.let_kind ->
+  Lam_compile_defs.cxt -> 
+  J.ident -> 
+  Lam.t -> 
+  Js_output.t
 
-  Increasing T entails (slightly) less code, decreasing T
-  (slightly) favors runtime speed.
-  T=8 looks a decent tradeoff.
-*)
+val compile_recursive_lets : Lam_compile_defs.cxt -> (Ident.t * Lam.t) list -> Js_output.t
 
-(* Utilities *)
+val compile_lambda : Lam_compile_defs.cxt -> Lam.t -> Js_output.t
 
-let strings_test_threshold = 8
+end = struct
+#1 "lam_compile.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let prim_string_notequal =
-  Pccall{prim_name = "caml_string_notequal";
-         prim_arity = 2; prim_alloc = false;
-         prim_native_name = ""; prim_native_float = false}
 
-let prim_string_compare =
-  Pccall{prim_name = "caml_string_compare";
-         prim_arity = 2; prim_alloc = false;
-         prim_native_name = ""; prim_native_float = false}
 
-let bind_sw arg k = match arg with
-| Lvar _ -> k arg
-| _ ->
-    let id = Ident.create "switch" in
-    Llet (Strict,id,arg,k (Lvar id))
 
 
-(* Sequential equality tests *)
 
-let make_string_test_sequence loc arg sw d =
-  let d,sw = match d with
-  | None ->
-      begin match sw with
-      | (_,d)::sw -> d,sw
-      | [] -> assert false
-      end
-  | Some d -> d,sw in
-  bind_sw arg
-    (fun arg ->
-      List.fold_right
-        (fun (s,lam) k ->
-          Lifthenelse
-            (Lprim
-               (prim_string_notequal,
-                [arg; Lconst (Const_immstring s)], loc),
-             k,lam))
-        sw d)
 
-let rec split k xs = match xs with
-| [] -> assert false
-| x0::xs ->
-    if k <= 1 then [],x0,xs
-    else
-      let xs,y0,ys = split (k-2) xs in
-      x0::xs,y0,ys
 
-let zero_lam  = Lconst (Const_base (Const_int 0))
+open Js_output.Ops 
 
-let tree_way_test loc arg lt eq gt =
-  Lifthenelse
-    (Lprim (Pintcomp Clt,[arg;zero_lam], loc),lt,
-     Lifthenelse(Lprim (Pintcomp Clt,[zero_lam;arg], loc),gt,eq))
+module E = Js_exp_make 
 
-(* Dichotomic tree *)
+module S = Js_stmt_make  
 
+let method_cache_id = ref 1 (*TODO: move to js runtime for re-entrant *)
 
-let rec do_make_string_test_tree loc arg sw delta d =
-  let len = List.length sw in
-  if len <= strings_test_threshold+delta then
-    make_string_test_sequence loc arg sw d
-  else
-    let lt,(s,act),gt = split len sw in
-    bind_sw
-      (Lprim
-         (prim_string_compare,
-          [arg; Lconst (Const_immstring s)], loc;))
-      (fun r ->
-        tree_way_test loc r
-          (do_make_string_test_tree  loc arg lt delta d)
-          act
-          (do_make_string_test_tree loc arg gt delta d))
 
-(* Entry point *)
-let expand_stringswitch loc arg sw d = match d with
-| None ->
-    bind_sw arg
-      (fun arg -> do_make_string_test_tree loc  arg sw 0 None)
-| Some e ->
-    bind_sw arg
-      (fun arg ->
-        make_catch e
-          (fun d -> do_make_string_test_tree loc arg sw 1 (Some d)))
+(* assume outer is [Lstaticcatch] *)
+let rec flat_catches acc (x : Lam.t)
+  : (int * Lam.t * Ident.t  list ) list * Lam.t = 
+  match x with 
+  | Lstaticcatch( Lstaticcatch(l, (code,bindings), handler), (code1, bindings1),handler1) 
+    when 
+      not @@ Lam_exit_code.has_exit_code 
+        (fun exit -> exit = code1 || List.exists (fun (c, _, _) -> c = exit ) acc ) handler
+    -> 
+    (* when handler does not have [exit code] which [code] belongs to collected,
+       it is okay to merge
+       *)
+    flat_catches ( (code, handler,bindings) :: (code1,handler1,bindings1)  :: acc)  l
+  | Lstaticcatch(l, (code, bindings), handler) ->
+    (code,handler,bindings)::acc, l
+    (* flat_catches ((code,handler,bindings)::acc) l  *)
+  | _ -> acc, x
 
-(**********************)
-(* Generic test trees *)
-(**********************)
+let flatten_caches  x = flat_catches [] x 
 
-(* Sharing *)
+(* exception Not_an_expression *)
 
-(* Add handler, if shared *)
-let handle_shared () =
-  let hs = ref (fun x -> x) in
-  let handle_shared act = match act with
-  | Switch.Single act -> act
-  | Switch.Shared act ->
-      let i,h = make_catch_delayed act in
-      let ohs = !hs in
-      hs := (fun act -> h (ohs act)) ;
-      make_exit i in
-  hs,handle_shared
+(* TODO:
+    for expression generation, 
+    name, should_return  is not needed,
+    only jmp_table and env needed
+*)
+let translate_dispatch = ref (fun _ -> assert false)
 
+type default_case = 
+  | Default of Lam.t
+  | Complete
+  | NonComplete
 
-let share_actions_tree sw d =
-  let store = StoreExp.mk_store () in
-(* Default action is always shared *)
-  let d =
-    match d with
-    | None -> None
-    | Some d -> Some (store.Switch.act_store_shared d) in
-(* Store all other actions *)
-  let sw =
-    List.map  (fun (cst,act) -> cst,store.Switch.act_store act) sw in
 
-(* Retrieve all actions, includint potentiel default *)
-  let acts = store.Switch.act_get_shared () in
+let rec  
+  get_exp_with_index (cxt : Lam_compile_defs.cxt) lam 
+    ((id : Ident.t), (pos : int),env) : Js_output.t = 
+  let f =   Js_output.handle_name_tail cxt.st cxt.should_return lam in    
+  Lam_compile_env.find_and_add_if_not_exist (id,pos) env 
+    ~not_found:(fun id -> 
+        f (E.str ~pure:false (Printf.sprintf "Err %s %d %d" id.name id.flags pos))
+        (* E.index m (pos + 1) *) (** shift by one *)
+        (** This can not happen since this id should be already consulted by type checker *)
+      )
+    ~found:(fun {id; name; closed_lambda } ->
+        match id, name, closed_lambda with 
+        | {name = "Sys"; _}, "os_type" , _
+          (** We drop the ability of cross-compiling
+              the compiler has to be the same running 
+          *)
+          ->  f (E.str Sys.os_type)
+        | _, _, Some lam 
+          when Lam_util.not_function lam
+          (* since it's only for alias, there is no arguments, 
+             we should not inline function definition here, even though
+             it is very small             
+             TODO: add comment here, we should try to add comment for 
+             cross module inlining             
+          
+             if we do too agressive inlining here: 
 
-(* Array of actual actions *)
-  let hs,handle_shared = handle_shared () in
-  let acts = Array.map handle_shared acts in
+             if we inline {!List.length} which will call {!A_list.length}, 
+             then we if we try inline {!A_list.length}, this means if {!A_list} 
+             is rebuilt, this module should also be rebuilt,
 
-(* Recontruct default and switch list *)
-  let d = match d with
-  | None -> None
-  | Some d -> Some (acts.(d)) in
-  let sw = List.map (fun (cst,j) -> cst,acts.(j)) sw in
-  !hs,sw,d
+             But if the build system is content-based, suppose {!A_list} 
+             is changed, cmj files in {!List} is unchnaged, however, 
+             {!List.length} call {!A_list.length} which is changed, since
+             [ocamldep] only detect that we depend on {!List}, it will not 
+             get re-built, then we are screwed.                   
 
-(* Note: dichotomic search requires sorted input with no duplicates *)
-let rec uniq_lambda_list sw = match sw with
-  | []|[_] -> sw
-  | (c1,_ as p1)::((c2,_)::sw2 as sw1) ->
-      if const_compare c1 c2 = 0 then uniq_lambda_list (p1::sw2)
-      else p1::uniq_lambda_list sw1
+             This is okay for stamp based build system.
 
-let sort_lambda_list l =
-  let l =
-    List.stable_sort (fun (x,_) (y,_) -> const_compare x y) l in
-  uniq_lambda_list l
+             Another solution is that we add dependencies in the compiler
 
-let rec cut n l =
-  if n = 0 then [],l
-  else match l with
-    [] -> raise (Invalid_argument "cut")
-  | a::l -> let l1,l2 = cut (n-1) l in a::l1, l2
+             -: we should not do functor application inlining in a 
+                non-toplevel, it will explode code very quickly              
+          *)               
+          ->  
+          compile_lambda cxt lam
+        | _ -> 
+          f (E.ml_var_dot id name)
+      ) 
+(* TODO: how nested module call would behave,
+   In the future, we should keep in track  of if 
+   it is fully applied from [Lapply]
+   Seems that the module dependency is tricky..
+   should we depend on [Pervasives] or not?
 
-let rec do_tests_fail loc fail tst arg = function
-  | [] -> fail
-  | (c, act)::rem ->
-      Lifthenelse
-        (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
-         do_tests_fail loc fail tst arg rem,
-         act)
+   we can not do this correctly for the return value, 
+   however we can inline the definition in Pervasives
+   TODO:
+   [Pervasives.print_endline]
+   [Pervasives.prerr_endline]
+   @param id external module id 
+   @param number the index of the external function 
+   @param env typing environment
+   @param args arguments 
+ *)
 
-let rec do_tests_nofail loc tst arg = function
-  | [] -> fatal_error "Matching.do_tests_nofail"
-  | [_,act] -> act
-  | (c,act)::rem ->
-      Lifthenelse
-        (Lprim (tst, [arg ; Lconst (Const_base c)], loc),
-         do_tests_nofail loc tst arg rem,
-         act)
+and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
+    (id : Ident.t) (pos : int) env : Js_output.t = 
+  Lam_compile_env.find_and_add_if_not_exist (id,pos) env ~not_found:(fun id -> 
+      (** This can not happen since this id should be already consulted by type checker 
+          Worst case 
+          {[
+            E.index m (pos + 1)
+          ]}
+          shift by one (due to module encoding)
+      *)
+      (* Js_output.handle_block_return cxt.st cxt.should_return lam args_code @@  *)
+      (* E.str ~pure:false  (Printf.sprintf "Err %s %d %d" *)
+      (*                       id.name *)
+      (*                       id.flags *)
+      (*                       pos *)
+      (*                    ) *)
+      assert false 
+    )
 
-let make_test_sequence loc fail tst lt_tst arg const_lambda_list =
-  let const_lambda_list = sort_lambda_list const_lambda_list in
-  let hs,const_lambda_list,fail =
-    share_actions_tree const_lambda_list fail in
+    ~found:(fun {id; name;arity; closed_lambda ; _} -> 
+        let args_code, args = 
+          List.fold_right 
+            (fun (x : Lam.t) (args_code, args)  ->
+               match x with 
+               | Lprim {primitive = Pgetglobal i; args =  [];_ } -> 
+                 (* when module is passed as an argument - unpack to an array
+                     for the function, generative module or functor can be a function,
+                     however it can not be global -- global can only module
+                 *)
 
-  let rec make_test_sequence const_lambda_list =
-    if List.length const_lambda_list >= 4 && lt_tst <> Pignore then
-      split_sequence const_lambda_list
-    else match fail with
-    | None -> do_tests_nofail loc tst arg const_lambda_list
-    | Some fail -> do_tests_fail loc fail tst arg const_lambda_list
+                 args_code, (Lam_compile_global.get_exp (i, env, true) :: args)
+               | _ -> 
+                 begin match compile_lambda {cxt with st = NeedValue; should_return = False} x with
+                   | {block = a; value = Some b} -> 
+                     (a @ args_code), (b :: args )
+                   | _ -> assert false
+                 end
+            ) args_lambda ([], []) in
 
-  and split_sequence const_lambda_list =
-    let list1, list2 =
-      cut (List.length const_lambda_list / 2) const_lambda_list in
-    Lifthenelse(Lprim(lt_tst,[arg; Lconst(Const_base (fst(List.hd list2)))], loc),
-                make_test_sequence list1, make_test_sequence list2)
-  in
-  hs (make_test_sequence const_lambda_list)
+        match closed_lambda with 
+        | Some (Lfunction{ params; body; _}) 
+          when Ext_list.same_length params args_lambda -> 
+          (* TODO: serialize it when exporting to save compile time *)
+          let (_, param_map)  = 
+            Lam_closure.is_closed_with_map Ident_set.empty params body in
+          compile_lambda cxt 
+            (Lam_beta_reduce.propogate_beta_reduce_with_map cxt.meta param_map
+               params body args_lambda)
+        | _ ->  
+          Js_output.handle_block_return cxt.st cxt.should_return lam args_code @@ 
+          (match id, name,  args with 
+           | {name = "Pervasives"; _}, "print_endline", ([ _ ] as args) ->  
+             E.seq (E.dump Log args) E.unit
+           | {name = "Pervasives"; _}, "prerr_endline", ([ _ ] as args) ->  
+             E.seq (E.dump Error args) E.unit
+           | _ -> 
+             let rec aux (acc : J.expression)
+                 (arity : Lam.function_arities) args (len : int)  =
+               match arity, len with
+               | _, 0 -> 
+                 acc (** All arguments consumed so far *)
+               | Determin (a, (x,_) :: rest, b), len   ->
+                 let x = 
+                   if x = 0 
+                   then 1 
+                   else x in (* Relax when x = 0 *)
+                 if  len >= x 
+                 then
+                   let first_part, continue =  (Ext_list.take x args) in
+                   aux
+                     (E.call ~info:{arity=Full; call_info = Call_ml} acc first_part)
+                     (Determin (a, rest, b))
+                     continue (len - x)
+                 else  acc 
+               (* alpha conversion now? --
+                  Since we did an alpha conversion before so it is not here
+               *)
+               | Determin (a, [], b ), _ ->
+                 (* can not happen, unless it's an exception ? *)
+                 E.call ~info:Js_call_info.dummy acc args
+               | NA, _ ->
+                 E.call ~info:Js_call_info.dummy acc args
+             in
+             aux (E.ml_var_dot id name) arity args (List.length args ))
+      )
 
+and  compile_let flag (cxt : Lam_compile_defs.cxt) id (arg : Lam.t) : Js_output.t =
 
-let rec explode_inter offset i j act k =
-  if i <= j then
-    explode_inter offset i (j-1) act ((j-offset,act)::k)
-  else
-    k
 
-let max_vals cases acts =
-  let vals = Array.make (Array.length acts) 0 in
-  for i=Array.length cases-1 downto 0 do
-    let l,h,act = cases.(i) in
-    vals.(act) <- h - l + 1 + vals.(act)
-  done ;
-  let max = ref 0 in
-  for i = Array.length vals-1 downto 0 do
-    if vals.(i) >= vals.(!max) then
-      max := i
-  done ;
-  if vals.(!max) > 1 then
-    !max
-  else
-    -1
+  match flag, arg  with 
+  |  let_kind, _  -> 
+    compile_lambda {cxt with st = Declare (let_kind, id); should_return = False } arg 
+(** 
+    The second return values are values which need to be wrapped using 
+   [caml_update_dummy] 
+   
+   Invariant:  jmp_table can not across function boundary,
+       here we share env 
 
-let as_int_list cases acts =
-  let default = max_vals cases acts in
-  let min_key,_,_ = cases.(0)
-  and _,max_key,_ = cases.(Array.length cases-1) in
+*)
+and compile_recursive_let 
+    (cxt : Lam_compile_defs.cxt)
+    (id : Ident.t)
+    (arg : Lam.t)   : Js_output.t * Ident.t list = 
+  match arg with 
+  |  Lfunction { kind; params; body; _}  -> 
 
-  let rec do_rec i k =
-    if i >= 0 then
-      let low, high, act =  cases.(i) in
-      if act = default then
-        do_rec (i-1) k
-      else
-        do_rec (i-1) (explode_inter min_key low high acts.(act) k)
-    else
-      k in
-  min_key, max_key,do_rec (Array.length cases-1) [],
-  (if default >= 0 then Some acts.(default) else None)
+    let continue_label = Lam_util.generate_label ~name:id.name () in
+    (* TODO: Think about recursive value 
+       {[
+         let rec v = ref (fun _ ... 
+                         )
+       ]}
+        [Alias] may not be exact 
+    *)
+    Js_output.handle_name_tail (Declare (Alias, id)) False arg
+      (
+        let ret : Lam_compile_defs.return_label = 
+          {id; 
+           label = continue_label; 
+           params;
+           immutable_mask = Array.make (List.length params) true;
+           new_params = Ident_map.empty;
+           triggered = false} in
+        let output = 
+          compile_lambda
+            { cxt with 
+              st = EffectCall;  
+              should_return = True (Some ret );
+              jmp_table = Lam_compile_defs.empty_handler_map}  body in
+        if ret.triggered then 
+          let body_block = Js_output.to_block output in
+          E.ocaml_fun
+            (* TODO:  save computation of length several times 
+               Here we always create [ocaml_fun], 
+               it will be renamed into [method] 
+               when it is detected by a primitive
+            *)
+            ~immutable_mask:ret.immutable_mask
+            (List.map (fun x -> 
+                  Ident_map.find_default x ret.new_params x )
+                params)
+            [
+              S.while_ (* ~label:continue_label *)
+                E.caml_true   
+                (
+                  Ident_map.fold
+                    (fun old new_param  acc ->
+                       S.define ~kind:Alias old (E.var new_param) :: acc) 
+                    ret.new_params body_block
+                )
+            ]
 
+        else            (* TODO:  save computation of length several times *)
+          E.ocaml_fun params (Js_output.to_block output )
+      ), [] 
+  | Lprim {primitive = Pmakeblock (0, _, _) ; args =  ls}
+    when List.for_all (function  | Lam.Lvar _  -> true | _ -> false) ls 
+    ->
+    (* capture cases like for {!Queue}
+       {[let rec cell = { content = x; next = cell} ]}
+    *)
+    Js_output.of_block (
+      S.define ~kind:Variable id (E.arr Mutable []) :: 
+      (List.mapi (fun i x -> 
+          match x with  
+          | Lam.Lvar lid
+            -> S.exp 
+                 (Js_arr.set_array (E.var id) (E.int (Int32.of_int i)) (E.var lid))
+          | _ -> assert false
+         ) ls)
+    ), []
 
-module SArg = struct
-  type primitive = Lambda.primitive
+  | Lprim{primitive = Pmakeblock _ ; _}   ->
+    (* FIXME: also should fill tag *)
+    (* Lconst should not appear here if we do [scc]
+       optimization, since it's faked recursive value,
+       however it would affect scope issues, we have to declare it first 
+    *)
+    (* Ext_log.err "@[recursive value %s/%d@]@." id.name id.stamp; *)
+    begin
+      match compile_lambda {cxt with st = NeedValue; should_return = False } arg with
+      | { block = b; value = Some v} -> 
+        (* TODO: check recursive value .. 
+            could be improved for simple cases
+        *)
+        Js_output.of_block  
+          (
+            b  @ 
+            [S.exp
+               (E.runtime_call Js_config.obj_runtime "caml_update_dummy" 
+                  [ E.var id;  v])]),
+        [id]
+      (* S.define ~kind:Variable id (E.arr Mutable [])::  *)
+      | _ -> assert false 
+    end
+  | Lvar _   ->
+    compile_lambda {cxt with st = Declare (Alias ,id); should_return = False } arg, []
+  | _ -> 
+    (* pathological case:
+        fail to capture taill call?
+       {[ let rec a = 
+         if  g > 30 then .. fun () -> a ()
+       ]}
 
-  let eqint = Pintcomp Ceq
-  let neint = Pintcomp Cneq
-  let leint = Pintcomp Cle
-  let ltint = Pintcomp Clt
-  let geint = Pintcomp Cge
-  let gtint = Pintcomp Cgt
+        Neither  below is not allowed in ocaml:
+       {[
+         let rec v = 
+           if sum 0 10 > 20 then 
+             1::v 
+           else 2:: v
+       ]}
+       {[
+         let rec v = 
+           if sum 0 10 > 20 then 
+             fun _ -> print_endline "hi"; v ()
+           else 
+             fun _-> print_endline "hey"; v ()
+       ]}
+    *)
+    compile_lambda {cxt with st = Declare (Alias ,id); should_return = False } arg, []
 
-  type act = Lambda.lambda
+and compile_recursive_lets cxt id_args : Js_output.t = 
+  let output_code, ids  = List.fold_right
+      (fun (ident,arg) (acc, ids) -> 
+         let code, declare_ids  = compile_recursive_let cxt ident arg in
+         (code ++ acc, declare_ids @ ids )
+      )  id_args (Js_output.dummy, [])
+  in
+  match ids with 
+  | [] -> output_code
+  | _ ->  
+    (Js_output.of_block  @@
+     List.map (fun id -> S.define ~kind:Variable id (E.dummy_obj ())) ids ) 
+    ++  output_code
 
-  let make_prim p args = Lprim (p,args, Location.none)
-  let make_offset arg n = match n with
-  | 0 -> arg
-  | _ -> Lprim (Poffsetint n,[arg], Location.none)
+and compile_general_cases : 
+  'a . 
+  ('a -> J.expression) ->
+  (J.expression -> J.expression -> J.expression) -> 
+  Lam_compile_defs.cxt -> 
+  (?default:J.block ->
+   ?declaration:Lambda.let_kind * Ident.t  -> 
+   _ -> 'a J.case_clause list ->  J.statement) -> 
+  _ -> 
+  ('a * Lam.t) list -> default_case -> J.block 
+  = fun f eq cxt switch v table default -> 
+    let wrap (cxt : Lam_compile_defs.cxt) k =
+      let cxt, define =
+        match cxt.st with 
+        | Declare (kind, did)
+          -> 
+          {cxt with st = Assign did}, Some (kind,did)
+        | _ -> cxt, None
+      in
+      k cxt  define 
+    in
+    match table, default with 
+    | [], Default lam ->  
+      Js_output.to_block  (compile_lambda cxt lam)
+    | [], (Complete | NonComplete) ->  []
+    | [(id,lam)],Complete -> 
+      (* To take advantage of such optimizations, 
+          when we generate code using switch, 
+          we should always have a default,
+          otherwise the compiler engine would think that 
+          it's also complete
+      *)
+      Js_output.to_block @@ compile_lambda cxt lam 
+    | [(id,lam)], NonComplete 
+      ->
+      wrap cxt @@ fun cxt define  ->
+      [S.if_ ?declaration:define (eq v (f id) )
+         (Js_output.to_block @@ compile_lambda cxt lam )]
 
-  let bind arg body =
-    let newvar,newarg = match arg with
-    | Lvar v -> v,arg
-    | _      ->
-        let newvar = Ident.create "switcher" in
-        newvar,Lvar newvar in
-    bind Alias newvar arg (body newarg)
-  let make_const i = Lconst (Const_base (Const_int i))
-  let make_isout h arg = Lprim (Pisout, [h ; arg], Location.none)
-  let make_isin h arg = Lprim (Pnot,[make_isout h arg], Location.none)
-  let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
-  let make_switch arg cases acts =
-    let l = ref [] in
-    for i = Array.length cases-1 downto 0 do
-      l := (i,acts.(cases.(i))) ::  !l
-    done ;
-    Lswitch(arg,
-            {sw_numconsts = Array.length cases ; sw_consts = !l ;
-             sw_numblocks = 0 ; sw_blocks =  []  ;
-             sw_failaction = None})
-  let make_catch  = make_catch_delayed
-  let make_exit = make_exit
+    | ([(id,lam)], Default x) | ([(id,lam); (_,x)], Complete)
+      ->
+      wrap cxt  @@ fun cxt define -> 
+      let else_block = Js_output.to_block (compile_lambda cxt x) in
+      let then_block = Js_output.to_block (compile_lambda cxt lam)  in
+      [ S.if_ ?declaration:define (eq v (f id) )
+          then_block
+          ~else_:else_block
+      ]
+    | _ , _ -> 
+      (* TODO: this is not relevant to switch case
+          however, in a subset of switch-case if we can analysis 
+          its branch are the same, we can propogate which 
+          might encourage better inlining strategey
+          ---
+          TODO: grouping can be delayed untile JS IR
+      *)
+      (*TOOD: disabled temporarily since it's not perfect yet *)
+      wrap cxt @@ fun cxt declaration  ->
+      let default =
+        match default with
+        | Complete -> None
+        | NonComplete -> None
+        | Default lam -> Some (Js_output.to_block  (compile_lambda cxt lam))
+      in
+      let body = 
+        table 
+        |> Ext_list.stable_group (fun (_,lam) (_,lam1) -> Lam_analysis.eq_lambda lam lam1)
+        |> Ext_list.flat_map 
+          (fun group -> 
+             group 
+             |> Ext_list.map_last 
+               (fun last (x,lam) -> 
+                  if last 
+                  then {J.case =  x; body = Js_output.to_break_block (compile_lambda cxt lam) }
+                  else { case = x; body = [],false }))
+          (* TODO: we should also group default *)
+          (* The last clause does not need [break]
+              common break through, *)
 
-end
+      in
+      [switch ?default ?declaration v body] 
 
-(* Action sharing for Lswitch argument *)
-let share_actions_sw sw =
-(* Attempt sharing on all actions *)
-  let store = StoreExp.mk_store () in
-  let fail = match sw.sw_failaction with
-  | None -> None
-  | Some fail ->
-      (* Fail is translated to exit, whatever happens *)
-      Some (store.Switch.act_store_shared fail) in
-  let consts =
-    List.map
-      (fun (i,e) -> i,store.Switch.act_store e)
-      sw.sw_consts
-  and blocks =
-    List.map
-      (fun (i,e) -> i,store.Switch.act_store e)
-      sw.sw_blocks in
-  let acts = store.Switch.act_get_shared () in
-  let hs,handle_shared = handle_shared () in
-  let acts = Array.map handle_shared acts in
-  let fail = match fail with
-  | None -> None
-  | Some fail -> Some (acts.(fail)) in
-  !hs,
-  { sw with
-    sw_consts = List.map (fun (i,j) -> i,acts.(j)) consts ;
-    sw_blocks = List.map (fun (i,j) -> i,acts.(j)) blocks ;
-    sw_failaction = fail; }
+and compile_cases cxt = compile_general_cases (fun x -> E.small_int  x) E.int_equal cxt 
+    (fun  ?default ?declaration e clauses    -> S.int_switch ?default  ?declaration e clauses)
 
-(* Reintroduce fail action in switch argument,
-   for the sake of avoiding carrying over huge switches *)
+and compile_string_cases cxt = compile_general_cases E.str E.string_equal cxt 
+    (fun  ?default ?declaration e clauses    -> S.string_switch ?default  ?declaration e clauses)
+(* TODO: optional arguments are not good 
+    for high order currying *)
+and
+  compile_lambda
+    ({st ; should_return; jmp_table; meta = {env ; _} } as cxt : Lam_compile_defs.cxt)
+    (lam : Lam.t)  : Js_output.t  =
+  begin
+    match lam with 
+    | Lfunction{ kind; params; body} ->
+      Js_output.handle_name_tail st should_return lam 
+        (E.ocaml_fun
+           params
+           (* Invariant:  jmp_table can not across function boundary,
+              here we share env
+           *)
+           (Js_output.to_block 
+              ( compile_lambda
+                  { cxt with st = EffectCall;  
+                             should_return = True None; (* Refine*)
+                             jmp_table = Lam_compile_defs.empty_handler_map}  body)))
 
-let reintroduce_fail sw = match sw.sw_failaction with
-| None ->
-    let t = Hashtbl.create 17 in
-    let seen (_,l) = match as_simple_exit l with
-    | Some i ->
-        let old = try Hashtbl.find t i with Not_found -> 0 in
-        Hashtbl.replace t i (old+1)
-    | None -> () in
-    List.iter seen sw.sw_consts ;
-    List.iter seen sw.sw_blocks ;
-    let i_max = ref (-1)
-    and max = ref (-1) in
-    Hashtbl.iter
-      (fun i c ->
-        if c > !max then begin
-          i_max := i ;
-          max := c
-        end) t ;
-    if !max >= 3 then
-      let default = !i_max in
-      let remove =
-        List.filter
-          (fun (_,lam) -> match as_simple_exit lam with
-          | Some j -> j <> default
-          | None -> true) in
-      {sw with
-       sw_consts = remove sw.sw_consts ;
-       sw_blocks = remove sw.sw_blocks ;
-       sw_failaction = Some (make_exit default)}
-    else sw
-| Some _ -> sw
 
+    | Lapply{
+        fn = Lapply{ fn = an; args =  args'; status = App_na ; };
+        args;  
+        status = App_na; loc }
+      ->    
+      (* After inlining we can generate such code, 
+         see {!Ari_regress_test}         
+      *)      
+      compile_lambda  cxt  
+        (Lam.apply an (args' @ args)  loc  App_na )
+    (* External function calll *)
+    | Lapply{ fn = 
+                Lprim{primitive = Pfield (n,_); 
+                      args = [ Lprim {primitive = Pgetglobal id; args = []}];_};
+             args = args_lambda;
+             status = App_na | App_ml_full} ->
+      (* Note we skip [App_js_full] since [get_exp_with_args] dont carry 
+         this information, we should fix [get_exp_with_args]
+      *)
+      get_exp_with_args cxt lam  args_lambda id n  env
 
-module Switcher = Switch.Make(SArg)
-open Switch
 
-let lambda_of_int i =  Lconst (Const_base (Const_int i))
+    | Lapply{ fn; args = args_lambda;   status} -> 
+      (* TODO: --- 
+         1. check arity, can be simplified for pure expression
+         2. no need create names
+      *)
+      begin 
+        let [@warning "-8" (* non-exhaustive pattern*)] (args_code, fn_code:: args) = 
+          List.fold_right (fun (x : Lam.t) (args_code, fn_code )-> 
+              match x with             
+              | Lprim {primitive = Pgetglobal ident; args =  []} -> 
+                (* when module is passed as an argument - unpack to an array
+                    for the function, generative module or functor can be a function, 
+                    however it can not be global -- global can only module 
+                *)
+                args_code, Lam_compile_global.get_exp  (ident, env,true) :: fn_code
+              | _ ->
+                begin
+                  match compile_lambda 
+                          {cxt with st = NeedValue ; should_return =  False} x with
+                  | {block = a; value =  Some b} -> a @ args_code , b:: fn_code 
+                  | _ -> assert false
+                end
+            ) (fn::args_lambda) ([],[]) in
 
-let rec last def = function
-  | [] -> def
-  | [x,_] -> x
-  | _::rem -> last def rem
 
-let get_edges low high l = match l with
-| [] -> low, high
-| (x,_)::_ -> x, last high l
+        begin
+          match fn, should_return with
+          | (Lvar id',
+             True (Some ({id;label; params; _} as ret))) when Ident.same id id' ->
 
 
-let as_interval_canfail fail low high l =
-  let store = StoreExp.mk_store () in
+            (* Ext_log.err "@[ %s : %a tailcall @]@."  cxt.meta.filename Ident.print id; *)
+            ret.triggered <- true;
+            (* Here we mark [finished] true, since the continuation 
+                does not make sense any more (due to that we have [continue])
+                TODO: [finished] is not a meaningful name, we should use [truncate] 
+                to mean the following statement should be truncated
+            *)
+            (* 
+                actually, there is no easy way to determin 
+                if the argument depends on an expresion, since 
+                it can be a function, then it may depend on anything
+                http://caml.inria.fr/pub/ml-archives/caml-list/2005/02/5727b4ecaaef6a7a350c9d98f5f68432.en.html
+                http://caml.inria.fr/pub/ml-archives/caml-list/2005/02/fe9bc4e23e6dc8c932c8ab34240ff195.en.html
 
-  let do_store tag act =
-    let i =  store.act_store act in
-(*
-    Printlambda.lambda Format.str_formatter act ;
-    eprintf "STORE [%s] %i %s\n" tag i (Format.flush_str_formatter ()) ;
-*)
-    i in
+            *)
+            (* TODO: use [fold]*)            
+            let block =  args_code @
+                        (
+                          let (_,assigned_params,new_params) = 
+                            List.fold_left2 (fun (i,assigns,new_params) param (arg : J.expression) ->
+                                match arg with
+                                | {expression_desc = Var (Id x); _} when Ident.same x param ->
+                                  (i + 1, assigns, new_params)
+                                | _ ->
+                                  let new_param, m  = 
+                                    match Ident_map.find_opt  param ret.new_params with 
+                                    | None -> 
+                                      ret.immutable_mask.(i)<- false;
+                                      let v = Ext_ident.create ("_"^param.Ident.name) in
+                                      v, (Ident_map.add param v new_params) 
+                                    | Some v -> v, new_params  in
+                                  (i+1, (new_param, arg) :: assigns, m)
+                              ) (0, [], Ident_map.empty) params args  in 
+                          let () = ret.new_params <- Ident_map.disjoint_merge new_params ret.new_params in
+                          assigned_params |> List.map (fun (param, arg) -> S.assign param arg))
+                         @
+                        [S.continue ()(* label *)]
+                         (* Note true and continue needed to be handled together*)
+            in
+            begin
+              (* Ext_log.dwarn __LOC__ "size : %d" (List.length block); *)
+              Js_output.of_block  ~finished:True block 
+            end
 
-  let rec nofail_rec cur_low cur_high cur_act = function
-    | [] ->
-        if cur_high = high then
-          [cur_low,cur_high,cur_act]
-        else
-          [(cur_low,cur_high,cur_act) ; (cur_high+1,high, 0)]
-    | ((i,act_i)::rem) as all ->
-        let act_index = do_store "NO" act_i in
-        if cur_high+1= i then
-          if act_index=cur_act then
-            nofail_rec cur_low i cur_act rem
-          else if act_index=0 then
-            (cur_low,i-1, cur_act)::fail_rec i i rem
-          else
-            (cur_low, i-1, cur_act)::nofail_rec i i act_index rem
-        else if act_index = 0 then
-          (cur_low, cur_high, cur_act)::
-          fail_rec (cur_high+1) (cur_high+1) all
-        else
-          (cur_low, cur_high, cur_act)::
-          (cur_high+1,i-1,0)::
-          nofail_rec i i act_index rem
+ 
 
-  and fail_rec cur_low cur_high = function
-    | [] -> [(cur_low, cur_high, 0)]
-    | (i,act_i)::rem ->
-        let index = do_store "YES" act_i in
-        if index=0 then fail_rec cur_low i rem
-        else
-          (cur_low,i-1,0)::
-          nofail_rec i i index rem in
+          (* match assigned_params with *)
+          (* | [] ->  [] *)
+          (* | [param,arg] -> [S.assign param arg ] *)
+          (* | _ -> *)
+          (*    let arg_map = Ident_map.of_list assigned_params in *)
+          (*    match Lam_util.sort_dag_args arg_map with *)
+          (*    | Some args -> *)
+          (*        List.map (fun a -> S.assign a (Ident_map.find a arg_map )) args *)
+          (*    | None -> *)
+          (*        let renamed_params_args = *)
+          (*          assigned_params |> *)
+          (*          List.map (fun (param, arg) -> (param, Ident.rename param, arg )) *)
+          (*        in *)
+          (*        List.map (fun (param, param2, arg) -> *)
+          (*          S.declare param2 arg *)
+          (*                 ) renamed_params_args *)
+          (*        @ *)
+          (*          List.map (fun (param, param2, _) -> *)
+          (*            S.assign param (E.var param2) *)
+          (*                   )  renamed_params_args *)
+          (*  Js_output.handle_block_return st should_return lam   *)
+          (* (E.call fn_code args)  *)
+          | _ -> 
 
-  let init_rec = function
-    | [] -> []
-    | (i,act_i)::rem ->
-        let index = do_store "INIT" act_i in
-        if index=0 then
-          fail_rec low i rem
-        else
-          if low < i then
-            (low,i-1,0)::nofail_rec i i index rem
-          else
-            nofail_rec i i index rem in
+            Js_output.handle_block_return st should_return lam args_code 
+              (E.call ~info:(match fn, status with 
+                   | _,  App_ml_full -> 
+                     {arity = Full ; call_info = Call_ml}
+                   | _,  App_js_full -> 
+                     {arity = Full ; call_info = Call_na}
+                   | _,   App_na -> 
+                     {arity = NA; call_info = Call_ml }
+                 ) fn_code args) 
+        end;
+      end
 
-  assert (do_store "FAIL" fail = 0) ; (* fail has action index 0 *)
-  let r = init_rec l in
-  Array.of_list r,  store
 
-let as_interval_nofail l =
-  let store = StoreExp.mk_store () in
+    | Llet (let_kind,id,arg, body) ->
+      (* Order matters..  see comment below in [Lletrec] *)
+      let args_code =
+        compile_let  let_kind cxt id arg  in 
+      args_code ++
+      compile_lambda  cxt  body
 
-  let rec i_rec cur_low cur_high cur_act = function
-    | [] ->
-        [cur_low, cur_high, cur_act]
-    | (i,act)::rem ->
-        let act_index = store.act_store act in
-        if act_index = cur_act then
-          i_rec cur_low i cur_act rem
-        else
-          (cur_low, cur_high, cur_act)::
-          i_rec i i act_index rem in
-  let inters = match l with
-  | (i,act)::rem ->
-      let act_index = store.act_store act in
-      i_rec i i act_index rem
-  | _ -> assert false in
+    | Lletrec (id_args, body) -> 
+      (* There is a bug in our current design, 
+         it requires compile args first (register that some objects are jsidentifiers)
+         and compile body wiht such effect.
+         So here we should compile [id_args] first, then [body] later.
+         Note it has some side effect over cache number as well, mostly the value of
+         [Caml_primitive["caml_get_public_method"](x,hash_tab, number)]
 
-  Array.of_list inters, store
+         To fix this, 
+         1. scan the lambda layer first, register js identifier before proceeding
+         2. delay the method call into javascript ast
+      *)
+      let v =  compile_recursive_lets cxt  id_args in v ++ compile_lambda cxt  body
 
+    | Lvar id -> Js_output.handle_name_tail st  should_return lam (E.var id )
+    | Lconst c -> 
+      Js_output.handle_name_tail st should_return lam (Lam_compile_const.translate c)
 
-let sort_int_lambda_list l =
-  List.sort
-    (fun (i1,_) (i2,_) ->
-      if i1 < i2 then -1
-      else if i2 < i1 then 1
-      else 0)
-    l
+    | Lprim {primitive = Pfield (n,_); 
+             args = [ Lprim {primitive = Pgetglobal id; args = [] ; _}]; _} 
+      -> (* should be before Pgetglobal *)
+        get_exp_with_index cxt lam  (id,n, env)
 
-let as_interval fail low high l =
-  let l = sort_int_lambda_list l in
-  get_edges low high l,
-  (match fail with
-  | None -> as_interval_nofail l
-  | Some act -> as_interval_canfail act low high l)
+    | Lprim {primitive = Praise ; args =  [ e ]; _} -> 
+      begin
+        match compile_lambda {
+            cxt with should_return = False; st = NeedValue} e with 
+        | {block = b; value =  Some v} -> 
 
-let call_switcher fail arg low high int_lambda_list =
-  let edges, (cases, actions) =
-    as_interval fail low high int_lambda_list in
-  Switcher.zyva edges arg cases actions
+          Js_output.make (b @ [S.throw v])
+            ~value:E.undefined ~finished:True
+        (* FIXME -- breaks invariant when NeedValue, reason is that js [throw] is statement 
+           while ocaml it's an expression, we should remove such things in lambda optimizations
+        *)
+        | {value =  None; _} -> assert false 
+      end
+    | Lprim{primitive = Psequand ; args =  [l;r] ; _}
+      ->
+      begin match cxt with 
+        | {should_return = True _ } 
+          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
+          ->
+          compile_lambda cxt (Lam.sequand  l r )
+        | _ -> 
+          let l_block,l_expr = 
+            match compile_lambda {cxt with st = NeedValue; should_return = False} l with 
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false 
+          in
+          let r_block, r_expr = 
+            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false 
+          in
+          let args_code =  l_block @ r_block  in
+          let exp =  E.and_ l_expr r_expr  in
+          Js_output.handle_block_return st should_return lam args_code exp           
+      end
 
+    | Lprim {primitive = Psequor; args =  [l;r]}
+      ->
+      begin match cxt with
+        | {should_return = True _ }
+          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
+          ->
+          compile_lambda cxt @@ Lam.sequor l r
+        | _ ->
+          let l_block,l_expr =
+            match compile_lambda {cxt with st = NeedValue; should_return = False} l with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false
+          in
+          let r_block, r_expr =
+            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false
+          in
+          let args_code =  l_block @ r_block  in
+          let exp =  E.or_ l_expr r_expr  in
+          Js_output.handle_block_return st should_return lam args_code exp
+      end
+    | Lprim {primitive = Pdebugger ; _}
+      -> 
+      (* [%bs.debugger] guarantees that the expression does not matter 
+         TODO: make it even safer      *)
+        Js_output.handle_block_return st should_return lam [S.debugger] E.unit
 
-let exists_ctx ok ctx =
-  List.exists
-    (function
-      | {right=p::_} -> ok p
-      | _ -> assert false)
-    ctx
 
-let rec list_as_pat = function
-  | [] -> fatal_error "Matching.list_as_pat"
-  | [pat] -> pat
-  | pat::rem ->
-      {pat with pat_desc = Tpat_or (pat,list_as_pat rem,None)}
 
+    (* TODO: 
+       check the arity of fn before wrapping it 
+       we need mark something that such eta-conversion can not be simplified in some cases 
+    *)
 
-let rec pat_as_list k = function
-  | {pat_desc=Tpat_or (p1,p2,_)} ->
-      pat_as_list (pat_as_list k p2) p1
-  | p -> p::k
+    | Lprim {primitive = Pjs_unsafe_downgrade (name,loc); 
+             args = [obj]}
+      when not (Ext_string.ends_with name Literals.setter_suffix) 
+      -> 
+      (**
+         either a getter {[ x #. height ]} or {[ x ## method_call ]}
+      *)
+      let property =  Lam_methname.translate ~loc name  in
+      begin 
+        match compile_lambda {cxt with st = NeedValue; should_return = False} obj
+        with 
+        | {block; value = Some b } -> 
+          let blocks, ret  = 
+            if block = [] then [],  E.dot b property
+            else 
+              (match Js_ast_util.named_expression b  with 
+               | None -> block,  E.dot b property
+               | Some (x, b) ->  
+                 (block @ [x]),  E.dot (E.var b) property
+              )
+          in 
+          Js_output.handle_block_return st should_return lam 
+            blocks ret 
+        | _ -> assert false 
+      end
+    | Lprim {primitive = Pjs_fn_run arity;  args = args_lambda}
+      ->
+      (* 1. prevent eta-conversion
+         by using [App_js_full]
+         2. invariant: `external` declaration will guarantee
+         the function application is saturated
+         3. we need a location for Pccall in the call site
+      *)
 
-(* Extracting interesting patterns *)
-exception All
+        begin match args_lambda with  
+        | [Lprim{
+            primitive = 
+              Pjs_unsafe_downgrade(method_name,loc);
+            args = [obj]} as fn;
+           arg]
+          -> 
+          begin 
+            let obj_block = 
+              compile_lambda {cxt with st = NeedValue; should_return = False} obj
+            in 
+            let value_block = 
+              compile_lambda {cxt with st = NeedValue; should_return = False} arg
+            in 
+            let cont block0 block1 obj_code = 
+              Js_output.handle_block_return st should_return lam 
+                (
+                  match obj_code with
+                  | None -> block0 @ block1
+                  | Some obj_code -> block0 @ obj_code :: block1
+                )
+            in 
+            match obj_block, value_block with 
+            | {block = block0; value = Some obj }, 
+              {block = block1; value = Some value}
+              ->
+               if  Ext_string.ends_with method_name Literals.setter_suffix then 
+                let property =
+                  Lam_methname.translate ~loc @@ 
+                  String.sub method_name 0 
+                    (String.length method_name - Literals.setter_suffix_len) in 
+                match Js_ast_util.named_expression  obj with
+                  | None ->
+                    cont block0 block1 None (E.assign (E.dot obj property) value)
+                  | Some (obj_code, obj)
+                    ->
+                    cont block0 block1 (Some obj_code)
+                      (E.assign (E.dot (E.var obj) property) value)
+              else 
+                compile_lambda cxt
+                  (Lam.apply fn [arg]  
+                     Location.none (* TODO *) App_js_full)
+            | _ -> 
+              assert false 
+          end
 
-let rec extract_pat seen k p = match p.pat_desc with
-| Tpat_or (p1,p2,_) ->
-    let k1,seen1 = extract_pat seen k p1 in
-    extract_pat seen1 k1 p2
-| Tpat_alias (p,_,_) ->
-    extract_pat  seen k p
-| Tpat_var _|Tpat_any ->
-    raise All
-| _ ->
-    let q = normalize_pat p in
-    if  List.exists (compat q) seen then
-      k, seen
-    else
-      q::k, q::seen
+        | fn :: rest -> 
+          compile_lambda cxt 
+            (Lam.apply fn rest 
+               Location.none (*TODO*)
+               App_js_full)
+        | _ -> assert false 
+        end
+    | Lprim {primitive = Pjs_fn_runmethod arity ; args }
+      -> 
+      begin match args with 
+        | (Lprim{primitive = Pjs_unsafe_downgrade (name,loc);
+                 args = [ _ ]} as fn) 
+          :: _obj
+          :: rest -> 
+        (* assert (Ident.same id2 id) ;  *)
+        (* we ignore the computation of [_obj], 
+           since our ast writer 
+           {[ obj#.f (x,y)
+           ]}
+           -->
+           {[ runmethod2 f obj#.f x y]}           
+        *)
+        compile_lambda cxt (Lam.apply fn rest loc App_js_full)
+      | _ -> assert false               
+      end
+    | Lprim {primitive = Pjs_fn_method arity;  args = args_lambda} -> 
+      begin match args_lambda with 
+        | [Lfunction{arity = len; kind; params; body} ] 
+          when len = arity -> 
+          Js_output.handle_block_return 
+            st
+            should_return             
+            lam 
+            []
+            (E.method_
+             params
+             (* Invariant:  jmp_table can not across function boundary,
+                here we share env
+             *)
+             (Js_output.to_block 
+                ( compile_lambda
+                    { cxt with st = EffectCall;  
+                               should_return = True None; 
+                               jmp_table = Lam_compile_defs.empty_handler_map} 
+                    body)))
+        | _ -> assert false 
+      end
 
-let extract_mat seen pss =
-  let r,_ =
-    List.fold_left
-      (fun (k,seen) ps -> match ps with
-      | p::_ -> extract_pat seen k p
-      | _ -> assert false)
-      ([],seen)
-      pss in
-  r
 
+    | Lprim {primitive = Pjs_fn_make arity;  args = args_lambda} -> 
 
+        begin match args_lambda with 
+          | [fn] -> 
+            if arity = 0 then 
+              (* 
+                Invariant: mk0 : (unit -> 'a0) -> 'a0 t 
+                TODO: this case should be optimized, 
+                we need check where we handle [arity=0] 
+                as a special case -- 
+                if we do an optimization before compiling
+                into lambda
 
-let complete_pats_constrs = function
-  | p::_ as pats ->
-      List.map
-        (pat_of_constr p)
-        (complete_constrs p (List.map get_key_constr pats))
-  | _ -> assert false
+                 {[Fn.mk0]} is not intended for use by normal users
 
+                 so we assume [Fn.mk0] is only used in such cases
+                 {[
+                   Fn.mk0 (fun _ -> .. )
+                 ]}
+                 when it is passed as a function directly
+              *)
+              begin match fn with 
+                | Lfunction {params =  [_]; body}
+                  ->
+                  compile_lambda cxt 
+                    (Lam.function_ 
+                       ~arity:0 
+                       ~kind:Curried
+                       ~params:[]
+                       ~body)
+                | _ -> 
 
-let mk_res get_key env last_choice idef cant_fail ctx =
+                  compile_lambda cxt  
+                    (Lam.function_ ~arity:0 
+                       ~kind:Curried ~params:[] 
+                       ~body:(
+                         Lam.apply fn
+                           [Lam.unit]
+                           Location.none App_na
+                       ))
+              end
+            else 
+              begin match fn with
+                | Lam.Lfunction{arity = len; kind; params = args; body}
+                  ->
+                  if len = arity then
+                    compile_lambda cxt fn 
+                  else if len > arity then 
+                    let params, rest  = Ext_list.take arity args  in 
+                    compile_lambda cxt 
+                      (Lam.function_ 
+                         ~arity
+                         ~kind ~params
+                         ~body:(Lam.function_ ~arity:(len - arity)
+                                  ~kind ~params:rest ~body)
+                      )
+                  else 
+                    compile_lambda cxt 
+                      (Lam_util.eta_conversion arity 
+                         Location.none App_na
+                         fn  [] )
+                (* let extra_args = Ext_list.init (arity - len) (fun _ ->   (Ident.create Literals.param)) in *)
+                (* let extra_lambdas = List.map (fun x -> Lambda.Lvar x) extra_args in *)
+                (* Lambda.Lfunction (kind, extra_args @ args , body ) *)
+                (*TODO: can be optimized ?
+                  {[\ x y -> (\u -> body x) x y]}
+                  {[\u x -> body x]}        
+                  rewrite rules 
+                  {[
+                    \x -> body 
+                          --
+                          \y (\x -> body ) y 
+                  ]}
+                  {[\ x y -> (\a b c -> g a b c) x y]}
+                  {[ \a b -> \c -> g a b c ]}
+                *)
+                | _ -> 
+                  compile_lambda cxt 
+                    (Lam_util.eta_conversion arity
+                       Location.none App_na  fn  [] )
+              end
+          | _ -> assert false 
+        end
+    | Lprim{primitive = prim; args =  args_lambda; loc} -> 
+      let args_block, args_expr =
+        Ext_list.split_map (fun (x : Lam.t) ->
+            match compile_lambda {cxt with st = NeedValue; should_return = False} x 
+            with 
+            | {block = a; value = Some b} -> a,b
+            | _ -> assert false ) args_lambda 
 
-  let env,fail,jumps_fail = match last_choice with
-  | [] ->
-      env, None, jumps_empty
-  | [p] when group_var p ->
-      env,
-      Some (Lstaticraise (idef,[])),
-      jumps_singleton idef ctx
-  | _ ->
-      (idef,cant_fail,last_choice)::env,
-      None, jumps_empty in
-  let klist,jumps =
-    List.fold_right
-      (fun (i,cant_fail,pats) (klist,jumps) ->
-        let act = Lstaticraise (i,[])
-        and pat = list_as_pat pats in
-        let klist =
-          List.fold_right
-            (fun pat klist -> (get_key pat,act)::klist)
-            pats klist
-        and ctx = if cant_fail then ctx else ctx_lub pat ctx in
-        klist,jumps_add i ctx jumps)
-      env ([],jumps_fail) in
-  fail, klist, jumps
+      in
+      let args_code  = List.concat args_block in
+      let exp  =  (* TODO: all can be done in [compile_primitive] *)
+        Lam_compile_primitive.translate loc cxt  prim args_expr in
+      Js_output.handle_block_return st should_return lam args_code exp  
 
 
-(*
-     Following two ``failaction'' function compute n, the trap handler
-    to jump to in case of failure of elementary tests
-*)
+    | Lsequence (l1,l2) ->
+      let output_l1 = 
+        compile_lambda {cxt with st = EffectCall; should_return =  False} l1 in
+      let output_l2 = 
+        compile_lambda cxt l2  in
+       output_l1 ++ output_l2
 
-let mk_failaction_neg partial ctx def = match partial with
-| Partial ->
-    begin match def with
-    | (_,idef)::_ ->
-        Some (Lstaticraise (idef,[])),[],jumps_singleton idef ctx
-    | _ ->
-       (* Act as Total, this means
-          If no appropriate default matrix exists,
-          then this switch cannot fail *)
-        None, [], jumps_empty
-    end
-| Total ->
-    None, [], jumps_empty
 
+    | Lifthenelse(p,t_br,f_br) ->
+      (*
+         This should be optimized in lambda layer 
+         (let (match/1038 = (apply g/1027 x/1028))
+         (catch
+         (stringswitch match/1038
+         case "aabb": 0
+         case "bbc": 1
+         default: (exit 1))
+         with (1) 2))
+      *)
+      begin 
+        match compile_lambda {cxt with st = NeedValue ; should_return = False } p with 
+        | {block = b; value =  Some e} ->
+          (match st, should_return, 
+                 compile_lambda {cxt with st= NeedValue}  t_br, 
+                 compile_lambda {cxt with st= NeedValue}  f_br with 
+          | NeedValue, _, 
+            {block = []; value =  Some out1}, 
+            {block = []; value =  Some out2} -> (* speical optimization *)
+            Js_output.make b ~value:(E.econd e out1 out2)
+          | NeedValue, _, _, _  -> 
+            (* we can not reuse -- here we need they have the same name, 
+                   TODO: could be optimized by inspecting assigment statement *)
+            let id = Ext_ident.gen_js () in
+            (match
+               compile_lambda  {cxt with st = Assign id} t_br,
+               compile_lambda {cxt with st = Assign id} f_br
+             with
+             | out1 , out2 -> 
+               Js_output.make 
+                 (S.declare_variable ~kind:Variable id :: b @ [
+                     S.if_ e 
+                       (Js_output.to_block out1) 
+                       ~else_:(Js_output.to_block out2 )
+                   ])
+                 ~value:(E.var id)
+            )
 
+          | Declare (kind,id), _, 
+            {block = []; value =  Some out1},
+            {block = []; value =  Some out2} ->  
+            (* Invariant: should_return is false*)
+            Js_output.make [
+              S.define ~kind id (E.econd e out1 out2) ]
+          | Declare (kind, id), _, _, _ ->
+            Js_output.make 
+              ( b @ [
+                   S.if_ ~declaration:(kind,id) e 
+                     (Js_output.to_block @@ 
+                      compile_lambda {cxt with st = Assign id}  t_br)
+                     ~else_:(Js_output.to_block @@  
+                             (compile_lambda {cxt with st = Assign id} f_br))
+                 ])
 
-(* Conforme a l'article et plus simple qu'avant *)
-and mk_failaction_pos partial seen ctx defs  =
-  if dbg then begin
-    prerr_endline "**POS**" ;
-    pretty_def defs ;
-    ()
-  end ;
-  let rec scan_def env to_test defs = match to_test,defs with
-  | ([],_)|(_,[]) ->
-      List.fold_left
-        (fun  (klist,jumps) (pats,i)->
-          let action = Lstaticraise (i,[]) in
-          let klist =
-            List.fold_right
-              (fun pat r -> (get_key_constr pat,action)::r)
-              pats klist
-          and jumps =
-            jumps_add i (ctx_lub (list_as_pat pats) ctx) jumps in
-          klist,jumps)
-        ([],jumps_empty) env
-  | _,(pss,idef)::rem ->
-      let now, later =
-        List.partition
-          (fun (p,p_ctx) -> ctx_match p_ctx pss) to_test in
-      match now with
-      | [] -> scan_def env to_test rem
-      | _  -> scan_def ((List.map fst now,idef)::env) later rem in
+          | Assign id, _ , 
+            {block = []; value =  Some out1}, 
+            {block = []; value =  Some out2} ->  
+            (* Invariant:  should_return is false *)
+            Js_output.make [S.assign id (E.econd e out1 out2)]
+          | EffectCall, True _ , 
+            {block = []; value =  Some out1}, 
+            {block = []; value =  Some out2} ->
+            Js_output.make [S.return  (E.econd e  out1 out2)] ~finished:True
+              (* see PR#83 *)
+          | EffectCall, False , {block = []; value =  Some out1}, 
+            {block = []; value =  Some out2} ->
+            begin
+              match Js_exp_make.extract_non_pure out1 ,
+                    Js_exp_make.extract_non_pure out2 with
+              | None, None -> Js_output.make b
+              | Some out1, Some out2 -> 
+                Js_output.make b  ~value:(E.econd e  out1 out2)
+              | Some out1, None -> 
+                Js_output.make (b @ [S.if_ e  [S.exp out1]])
+              | None, Some out2 -> 
+                Js_output.make @@
+                b @ [S.if_ (E.not e)
+                       [S.exp out2]
+                    ]
+            end
+          | EffectCall , False , {block = []; value = Some out1}, _ -> 
+            (* assert branch 
+                TODO: here we re-compile two branches since
+                its context is different -- could be improved
+            *)
+            if Js_analyzer.no_side_effect_expression out1 then 
+              Js_output.make
+                (b @[ S.if_ (E.not e)
+                        (Js_output.to_block @@
+                         (compile_lambda cxt f_br))])
+            else 
+              Js_output.make 
+                (b @[S.if_ e 
+                       (Js_output.to_block 
+                        @@ compile_lambda cxt t_br)
+                       ~else_:(Js_output.to_block @@  
+                               (compile_lambda cxt f_br))]
+                )
 
-  scan_def
-    []
-    (List.map
-       (fun pat -> pat, ctx_lub pat ctx)
-       (complete_pats_constrs seen))
-    defs
+          | EffectCall , False , _, {block = []; value = Some out2} -> 
+            let else_ = 
+              if  Js_analyzer.no_side_effect_expression out2 then  
+                None 
+              else 
+                Some (
+                  Js_output.to_block @@
+                  compile_lambda cxt f_br) in 
+            Js_output.make 
+              (b @[S.if_ e 
+                     (Js_output.to_block @@
+                      compile_lambda cxt t_br)
+                     ?else_])
 
 
-let combine_constant loc arg cst partial ctx def
-    (const_lambda_list, total, pats) =
-  let fail, to_add, local_jumps =
-    mk_failaction_neg partial ctx def in
-  let const_lambda_list = to_add@const_lambda_list in
-  let lambda1 =
-    match cst with
-    | Const_int _ ->
-        let int_lambda_list =
-          List.map (function Const_int n, l -> n,l | _ -> assert false)
-            const_lambda_list in
-        call_switcher fail arg min_int max_int int_lambda_list
-    | Const_char _ ->
-        let int_lambda_list =
-          List.map (function Const_char c, l -> (Char.code c, l)
-            | _ -> assert false)
-            const_lambda_list in
-        call_switcher fail arg 0 255 int_lambda_list
-    | Const_string _ ->
-(* Note as the bytecode compiler may resort to dichotmic search,
-   the clauses of strinswitch  are sorted with duplicate removed.
-   This partly applies to the native code compiler, which requires
-   no duplicates *)
-        let const_lambda_list = sort_lambda_list const_lambda_list in
-        let sw =
-          List.map
-            (fun (c,act) -> match c with
-            | Const_string (s,_) -> s,act
-            | _ -> assert false)
-            const_lambda_list in
-        let hs,sw,fail = share_actions_tree sw fail in
-        hs (Lstringswitch (arg,sw,fail,loc))
-    | Const_float _ ->
-        make_test_sequence loc 
-          fail
-          (Pfloatcomp Cneq) (Pfloatcomp Clt)
-          arg const_lambda_list
-    | Const_int32 _ ->
-        make_test_sequence loc
-          fail
-          (Pbintcomp(Pint32, Cneq)) (Pbintcomp(Pint32, Clt))
-          arg const_lambda_list
-    | Const_int64 _ ->
-        make_test_sequence loc
-          fail
-          (Pbintcomp(Pint64, Cneq)) (Pbintcomp(Pint64, Clt))
-          arg const_lambda_list
-    | Const_nativeint _ ->
-        make_test_sequence loc
-          fail
-          (Pbintcomp(Pnativeint, Cneq)) (Pbintcomp(Pnativeint, Clt))
-          arg const_lambda_list
-  in lambda1,jumps_union local_jumps total
+          | (Assign _ | EffectCall), _, _, _  ->
+            let then_output = 
+              Js_output.to_block @@ 
+              (compile_lambda cxt  t_br) in
+            let else_output = 
+              Js_output.to_block @@ 
+              (compile_lambda cxt f_br) in
+            Js_output.make (b @ [
+                S.if_ e 
+                  then_output
+                  ~else_:else_output
+              ]))
+        | _ -> assert false 
+      end
+    | Lstringswitch(l, cases, default) -> 
 
+      (* TODO might better optimization according to the number of cases  
+          Be careful: we should avoid multiple evaluation of l,
+          The [gen] can be elimiated when number of [cases] is less than 3
+      *)
+      begin
+        match compile_lambda {cxt with should_return = False ; st = NeedValue} l 
+        with
+        | {block ; value =  Some e}  -> 
+          (* when should_return is true -- it's passed down 
+             otherwise it's ok *)
+          let default = 
+            match default with 
+            | Some x -> Default x 
+            | None -> Complete in
+          begin
+            match st with 
+            (* TODO: can be avoided when cases are less than 3 *)
+            | NeedValue -> 
+              let v = Ext_ident.gen_js () in 
+              Js_output.make (block @ 
+                              compile_string_cases 
+                                {cxt with st = Declare (Variable, v)}
+                                e cases default) ~value:(E.var v)
+            | _ -> 
+              Js_output.make (block @ compile_string_cases  cxt e cases default)  end
 
+        | _ -> assert false 
+      end
+    | Lswitch(lam,
+              {sw_numconsts; 
+               sw_consts;
+               sw_numblocks;
+               sw_blocks;
+               sw_failaction = default }) 
+      -> 
+      (* TODO: if default is None, we can do some optimizations
+          Use switch vs if/then/else
 
-let split_cases tag_lambda_list =
-  let rec split_rec = function
-      [] -> ([], [])
-    | (cstr, act) :: rem ->
-        let (consts, nonconsts) = split_rec rem in
-        match cstr with
-          Cstr_constant n -> ((n, act) :: consts, nonconsts)
-        | Cstr_block n    -> (consts, (n, act) :: nonconsts)
-        | _ -> assert false in
-  let const, nonconst = split_rec tag_lambda_list in
-  sort_int_lambda_list const,
-  sort_int_lambda_list nonconst
+          TODO: switch based optimiztion - hash, group, or using array,
+                also if last statement is throw -- should we drop remaining
+                statement?
+      *)
+      let default : default_case  = 
+        match default with 
+        | None -> Complete 
+        | Some x -> Default x in
+      let compile_whole  ({st; _} as cxt  : Lam_compile_defs.cxt ) =
+        begin
+          match sw_numconsts, sw_numblocks, 
+                compile_lambda {cxt with should_return = False; st = NeedValue}
+                  lam with 
+          | 0 , _ , {block; value =  Some e}  ->
+            compile_cases cxt (E.tag e )  sw_blocks default
+          | _, 0, {block; value =  Some e} ->  
+            compile_cases cxt e  sw_consts default
+          | _, _,  { block; value =  Some e} -> (* [e] will be used twice  *)
+            let dispatch e = 
+              [
+                S.if_ 
+                  (E.is_type_number e )
+                  (compile_cases cxt e sw_consts default)
+                  (* default still needed, could simplified*)
+                  ~else_:(
+                    (compile_cases  cxt (E.tag e ) sw_blocks default ))] in 
+            begin
+              match e.expression_desc with 
+              | J.Var _  -> dispatch e  
+              | _ -> 
+                let v = Ext_ident.gen_js () in  
+                (* Necessary avoid duplicated computation*)
+                (S.define ~kind:Variable v e ) ::  dispatch (E.var v)
+            end
+          | _, _, {value =  None; _}  -> assert false 
+        end in
+      begin
+        match st with  (* Needs declare first *)
+        | NeedValue -> 
+          (* Necessary since switch is a statement, we need they return 
+             the same value for different branches -- can be optmized 
+             when branches are minimial (less than 2)
+          *)
+          let v = Ext_ident.gen_js () in
+          Js_output.make (S.declare_variable ~kind:Variable v   :: compile_whole {cxt with st = Assign v})
+            ~value:(E.var  v)
 
-let split_extension_cases tag_lambda_list =
-  let rec split_rec = function
-      [] -> ([], [])
-    | (cstr, act) :: rem ->
-        let (consts, nonconsts) = split_rec rem in
-        match cstr with
-          Cstr_extension(path, true) -> ((path, act) :: consts, nonconsts)
-        | Cstr_extension(path, false) -> (consts, (path, act) :: nonconsts)
-        | _ -> assert false in
-  split_rec tag_lambda_list
+        | Declare (kind,id) -> 
+          Js_output.make (S.declare_variable ~kind id
+                          :: compile_whole {cxt with st = Assign id} )
+        | EffectCall | Assign _  -> Js_output.make (compile_whole cxt)
+      end
 
+    | Lstaticraise(i, largs) ->  (* TODO handlding *largs*)
+      (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*)
+      begin
+        match Lam_compile_defs.HandlerMap.find i cxt.jmp_table  with 
+        | {exit_id; args ; order_id} -> 
+          let args_code  =
+            (Js_output.concat @@ List.map2 (
+                fun (x : Lam.t) (arg : Ident.t) ->
+                  match x with
+                  | Lvar id -> 
+                    Js_output.make [S.assign arg (E.var id)]
 
-let combine_constructor loc arg ex_pat cstr partial ctx def
-    (tag_lambda_list, total1, pats) =
-  if cstr.cstr_consts < 0 then begin
-    (* Special cases for extensions *)
-    let fail, to_add, local_jumps =
-      mk_failaction_neg partial ctx def in
-    let tag_lambda_list = to_add@tag_lambda_list in
-    let lambda1 =
-      let consts, nonconsts = split_extension_cases tag_lambda_list in
-      let default, consts, nonconsts =
-        match fail with
-        | None ->
-            begin match consts, nonconsts with
-            | _, (_, act)::rem -> act, consts, rem
-            | (_, act)::rem, _ -> act, rem, nonconsts
-            | _ -> assert false
-            end
-        | Some fail -> fail, consts, nonconsts in
-      let nonconst_lambda =
-        match nonconsts with
-          [] -> default
-        | _ ->
-            let tag = Ident.create "tag" in
-            let tests =
-              List.fold_right
-                (fun (path, act) rem ->
-                   Lifthenelse(Lprim(Pintcomp Ceq,
-                                     [Lvar tag;
-                                      transl_path ex_pat.pat_env path], loc),
-                               act, rem))
-                nonconsts
-                default
-            in
-              Llet(Alias, tag, Lprim(Pfield (0, Fld_na), [arg], loc), tests)
-      in
-        List.fold_right
-          (fun (path, act) rem ->
-             Lifthenelse(Lprim(Pintcomp Ceq,
-                               [arg; transl_path ex_pat.pat_env path], loc),
-                         act, rem))
-          consts
-          nonconst_lambda
-    in
-    lambda1, jumps_union local_jumps total1
-  end else begin
-    (* Regular concrete type *)
-    let ncases = List.length tag_lambda_list
-    and nconstrs =  cstr.cstr_consts + cstr.cstr_nonconsts in
-    let sig_complete = ncases = nconstrs in
-    let fails,local_jumps =
-      if sig_complete then [],jumps_empty
-      else
-        mk_failaction_pos partial pats ctx def in
+                  | _ -> (* TODO: should be Assign -- Assign is an optimization *)
+                    compile_lambda {cxt with st = Assign arg ; should_return =  False} x 
+              ) largs (args : Ident.t list)) 
+          in
+          args_code ++ (* Declared in [Lstaticraise ]*)
+          Js_output.make [S.assign exit_id (E.small_int  order_id)]
+            ~value:E.undefined
+        | exception Not_found ->
+          Js_output.make [S.unknown_lambda ~comment:"error" lam]
+          (* staticraise is always enclosed by catch  *)
+      end
+    (* Invariant: code can not be reused 
+        (catch l with (32)
+        (handler))
+        32 should not be used in another catch
+        Assumption: 
+        This is true in current ocaml compiler
+        currently exit only appears in should_return position relative to staticcatch
+        if not we should use ``javascript break`` or ``continue``
+    *)
+    | Lstaticcatch _  -> 
+      let code_table, body =  flatten_caches lam in
 
-    let tag_lambda_list = fails @ tag_lambda_list in
-    let (consts, nonconsts) = split_cases tag_lambda_list in
-    let lambda1 =
-      match same_actions tag_lambda_list with
-      | Some act -> act
-      | _ ->
-          match
-            (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
-          with
-          | (1, 1, [0, act1], [0, act2]) ->
-              Lifthenelse(arg, act2, act1)
-          | (n,_,_,[])  ->
-              call_switcher None arg 0 (n-1) consts
-          | (n, _, _, _) ->
-              match same_actions nonconsts with
-              | None ->
-(* Emit a switch, as bytecode implements this sophisticated instruction *)
-                  let sw =
-                    {sw_numconsts = cstr.cstr_consts; sw_consts = consts;
-                     sw_numblocks = cstr.cstr_nonconsts; sw_blocks = nonconsts;
-                     sw_failaction = None} in
-                  let hs,sw = share_actions_sw sw in
-                  let sw = reintroduce_fail sw in
-                  hs (Lswitch (arg,sw))
-              | Some act ->
-                  Lifthenelse
-                    (Lprim (Pisint, [arg], loc),
-                     call_switcher
-                       None arg
-                       0 (n-1) consts,
-                     act) in
-    lambda1, jumps_union local_jumps total1
-  end
+      let exit_id =   Ext_ident.gen_js ~name:"exit" () in
+      let exit_expr = E.var exit_id in
+      let bindings = Ext_list.flat_map (fun (_,_,bindings) -> bindings) code_table in
 
-let make_test_sequence_variant_constant fail arg int_lambda_list =
-  let _, (cases, actions) =
-    as_interval fail min_int max_int int_lambda_list in
-  Switcher.test_sequence arg cases actions
+      (* compile_list name l false (\*\) *)
+      (* if exit_code_id == code 
+         handler -- ids are not useful, since 
+         when compiling `largs` we will do the binding there
+         - when exit_code is undefined internally, 
+           it should PRESERVE  ``tail`` property
+         - if it uses `staticraise` only once 
+           or handler is minimal, we can inline
+         - always inline also seems to be ok, but it might bloat the code
+         - another common scenario is that we have nested catch
+           (catch (catch (catch ..))
+      *)
+      (*
+        checkout example {!Digest.file}, you can not inline handler there, 
+        we can spot such patten and use finally there?
+        {[
+        let file filename =
+           let ic = open_in_bin filename in
+           match channel ic (-1) with
+           | d -> close_in ic; d
+           | exception e -> close_in ic; raise e
 
-let call_switcher_variant_constant fail arg int_lambda_list =
-  call_switcher fail arg min_int max_int int_lambda_list
+        ]}
+       *)
+      (* TODO: handle NeedValue *)
+      let jmp_table, handlers =  Lam_compile_defs.add_jmps (exit_id, code_table) jmp_table in
 
+      (* Declaration First, body and handler have the same value *)
+      (* There is a bug in google closure compiler:
+            https://github.com/google/closure-compiler/issues/1234#issuecomment-151976340 
+            TODO: wait for a bug fix
+        *)
+      let declares = 
+        S.define ~kind:Variable exit_id
+          E.zero_int_literal :: 
+        (* we should always make it zero here, since [zero] is reserved in our mapping*)
+        List.map (fun x -> S.declare_variable ~kind:Variable x ) bindings in
 
-let call_switcher_variant_constr loc fail arg int_lambda_list =
-  let v = Ident.create "variant" in
-  Llet(Alias, v, Lprim(Pfield (0, Fld_na), [arg], loc),
-       call_switcher
-         fail (Lvar v) min_int max_int int_lambda_list)
+      begin match  st with 
+         (* could be optimized when cases are less than 3 *)
+         | NeedValue -> 
+           let v = Ext_ident.gen_js  () in 
+           let lbody = compile_lambda {cxt with 
+                                       jmp_table = jmp_table;
+                                       st = Assign v
+                                      } body in
+           Js_output.make  (S.declare_variable ~kind:Variable v  :: declares) ++ 
+           lbody ++ Js_output.make (
+             compile_cases 
+               {cxt with st = Assign v;
+                         jmp_table = jmp_table} 
+               exit_expr handlers  NonComplete)  ~value:(E.var v )
+         | Declare (kind, id)
+         (* declare first this we will do branching*) ->
+           let declares = 
+             S.declare_variable ~kind id  :: declares in   
+           let lbody = compile_lambda {cxt with jmp_table = jmp_table; st = Assign id } body in
+           Js_output.make  declares ++ 
+           lbody ++ 
+           Js_output.make (compile_cases 
+                             {cxt with jmp_table = jmp_table; st = Assign id} 
+                             exit_expr 
+                             handlers
+                             NonComplete
+                             (* place holder -- tell the compiler that 
+                                we don't know if it's complete
+                             *)
+                          )
+         | EffectCall | Assign _  -> 
+           let lbody = compile_lambda {cxt with jmp_table = jmp_table } body in
+           Js_output.make declares ++
+           lbody ++
+           Js_output.make (compile_cases
+                             {cxt with jmp_table = jmp_table}
+                             exit_expr
+                             handlers
+                             NonComplete)
+      end
+    | Lwhile(p,body) ->  
+      (* Note that ``J.While(expression * statement )``
+            idealy if ocaml expression does not need fresh variables, we can generate
+            while expression, here we generate for statement, leave optimization later. 
+            (Sine OCaml expression can be really complex..)
+      *)
+      (match compile_lambda {cxt with st = NeedValue; should_return = False } p 
+       with 
+       | {block; value =  Some e} -> 
+         (* st = NeedValue -- this should be optimized and never happen *)
+         let e = 
+           match block with
+           | [] -> e 
+           | _ -> E.of_block block ~e  in
+         let block = 
+           [
+             S.while_
+               e
+               (Js_output.to_block @@ 
+                compile_lambda 
+                  {cxt with st = EffectCall; should_return = False}
+                  body)
+           ] in
 
-let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, pats) =
-  let row = Btype.row_repr row in
-  let num_constr = ref 0 in
-  if row.row_closed then
-    List.iter
-      (fun (_, f) ->
-        match Btype.row_field_repr f with
-          Rabsent | Reither(true, _::_, _, _) -> ()
-        | _ -> incr num_constr)
-      row.row_fields
-  else
-    num_constr := max_int;
-  let test_int_or_block arg if_int if_block =
-    Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in
-  let sig_complete =  List.length tag_lambda_list = !num_constr
-  and one_action = same_actions tag_lambda_list in
-  let fail, to_add, local_jumps =
-    if
-      sig_complete  || (match partial with Total -> true | _ -> false)
-    then
-      None, [], jumps_empty
-    else
-      mk_failaction_neg partial ctx def in
-  let tag_lambda_list = to_add@tag_lambda_list in
-  let (consts, nonconsts) = split_cases tag_lambda_list in
-  let lambda1 = match fail, one_action with
-  | None, Some act -> act
-  | _,_ ->
-      match (consts, nonconsts) with
-      | ([n, act1], [m, act2]) when fail=None ->
-          test_int_or_block arg act1 act2
-      | (_, []) -> (* One can compare integers and pointers *)
-          make_test_sequence_variant_constant fail arg consts
-      | ([], _) ->
-          let lam = call_switcher_variant_constr loc
-              fail arg nonconsts in
-          (* One must not dereference integers *)
-          begin match fail with
-          | None -> lam
-          | Some fail -> test_int_or_block arg fail lam
-          end
-      | (_, _) ->
-          let lam_const =
-            call_switcher_variant_constant
-              fail arg consts
-          and lam_nonconst =
-            call_switcher_variant_constr loc
-              fail arg nonconsts in
-          test_int_or_block arg lam_const lam_nonconst
-  in
-  lambda1, jumps_union local_jumps total1
+         begin
+           match st, should_return  with 
+           | Declare (_kind, x), _  ->  (* FIXME _kind not used *)
+             Js_output.make (block @ [S.declare_unit x ])
+           | Assign x, _  ->
+             Js_output.make (block @ [S.assign_unit x ])
+           | EffectCall, True _  -> 
+             Js_output.make (block @ [S.return_unit ()]) ~finished:True
+           | EffectCall, _ -> Js_output.make block
+           | NeedValue, _ -> Js_output.make block ~value:E.unit end
+       | _ -> assert false )
+
+    | Lfor (id,start,finish,direction,body) -> 
+      (* all non-tail *)
+      (* TODO: check semantics should start, finish be executed each time in both 
+           ocaml and js?, also check evaluation order..
+           in ocaml id is not in the scope of finish, so it should be safe here
 
+           for i  = 0 to (print_int 3; 10) do print_int i done;;
+           3012345678910- : unit = ()
 
-let combine_array loc arg kind partial ctx def
-    (len_lambda_list, total1, pats)  =
-  let fail, to_add, local_jumps = mk_failaction_neg partial  ctx def in
-  let len_lambda_list = to_add @ len_lambda_list in
-  let lambda1 =
-    let newvar = Ident.create "len" in
-    let switch =
-      call_switcher
-        fail (Lvar newvar)
-        0 max_int len_lambda_list in
-    bind
-      Alias newvar (Lprim(Parraylength kind, [arg], loc)) switch in
-  lambda1, jumps_union local_jumps total1
+         for(var i =  0 ; i < (console.log(i),10); ++i){console.log('hi')}
+         print i each time, so they are different semantics...
+      *)
 
-(* Insertion of debugging events *)
+      let block =
+        begin
+          match compile_lambda {cxt with st = NeedValue; should_return = False} start,
+                compile_lambda {cxt with st = NeedValue; should_return = False} finish with 
+          | {block = b1; value =  Some e1}, {block = b2; value =  Some e2} -> 
 
-let rec event_branch repr lam =
-  begin match lam, repr with
-    (_, None) ->
-      lam
-  | (Levent(lam', ev), Some r) ->
-      incr r;
-      Levent(lam', {lev_loc = ev.lev_loc;
-                    lev_kind = ev.lev_kind;
-                    lev_repr = repr;
-                    lev_env = ev.lev_env})
-  | (Llet(str, id, lam, body), _) ->
-      Llet(str, id, lam, event_branch repr body)
-  | Lstaticraise _,_ -> lam
-  | (_, Some r) ->
-      Printlambda.lambda Format.str_formatter lam ;
-      fatal_error
-        ("Matching.event_branch: "^Format.flush_str_formatter ())
-  end
+            (* order b1 -- (e1 -- b2 -- e2) 
+                in most cases we can shift it into such scenarios
+                b1, b2, [e1, e2]
+                - b2 is Empty
+                - e1 is pure
+                we can guarantee e1 is pure, if it literally contains a side effect call,
+                put it in the beginning
 
 
-(*
-   This exception is raised when the compiler cannot produce code
-   because control cannot reach the compiled clause,
+            *)
+            begin 
+              match b1,b2 with
+              | _,[] -> 
+                b1 @  [S.for_ (Some e1) e2  id direction 
+                         (Js_output.to_block @@ 
+                          compile_lambda {cxt with should_return = False ; st = EffectCall}
+                            body) ]
+              | _, _ when Js_analyzer.no_side_effect_expression e1 
+                (* 
+                     e1 > b2 > e2
+                     re-order 
+                     b2 > e1 > e2
+                   *)
+                -> 
+                b1 @ b2 @ [S.for_ (Some e1) e2  id direction 
+                             (Js_output.to_block @@ 
+                              compile_lambda {cxt with should_return = False ; st = EffectCall}
+                                body) ]
+              | _ , _
+                -> 
+                (*       let b2, e2 =  *)
+                (*   (\* e2 is of type [int]*\) *)
+                (*   match e2.expression_desc with *)
+                (*   | Number v  -> b2, J.Const v *)
+                (*   | Var v -> b2, J.Finish v *)
 
-   Unused is raised initialy in compile_test.
+                (*   | Array_length e  *)
+                (*   | Bytes_length e  *)
+                (*   | Function_length e  *)
+                (*   | String_length e  *)
+                (*     ->  *)
+                (*       let len = Ext_ident.create "_length" in *)
+                (*       b2 @ [ S.alias_variable len ~exp:e2 ],  J.Finish (Id len ) *)
+                (*   | _ ->  *)
+                (*       (\* TODO: guess a better name when possible*\) *)
+                (*       let len = Ext_ident.create "_finish" in *)
+                (*       b2 @ [S.alias_variable len ~exp:e2],  J.Finish (Id len) *)
+                (* in  *)
 
-   compile_list (for compiling switch results) catch Unused
+                b1 @ (S.define ~kind:Variable id e1 :: b2 ) @ ([
+                    S.for_ None e2 id direction 
+                      (Js_output.to_block @@ 
+                       compile_lambda {cxt with should_return = False ; st = EffectCall}
+                         body) 
+                  ])
 
-   comp_match_handlers (for compililing splitted matches)
-   may reraise Unused
+            end
 
 
-*)
+          | _ -> assert false end in
+      begin
+        match st, should_return with 
+        | EffectCall, False  -> Js_output.make block
+        | EffectCall, True _  -> 
+          Js_output.make (block @ [S.return_unit()]) ~finished:True
+        (* unit -> 0, order does not matter *)
+        | (Declare _ | Assign _), True _ -> Js_output.make [S.unknown_lambda lam]
+        | Declare (_kind, x), False  ->   
+          (* FIXME _kind unused *)
+          Js_output.make (block @   [S.declare_unit x ])
+        | Assign x, False  -> Js_output.make (block @ [S.assign_unit x ])
+        | NeedValue, _ 
+          ->  
+          Js_output.make block ~value:E.unit
+          (* TODO: fixme, here it's ok*)
+      end
+    | Lassign(id,lambda) -> 
+      let block = 
+        match lambda with
+        | Lprim {primitive = Poffsetint  v; args =  [Lvar id']}
+          when Ident.same id id' ->
+          [ S.exp (E.assign (E.var id) 
+                     (E.int32_add (E.var id) (E.small_int  v)))
+          ]
+        | _ ->
+          begin 
+            match compile_lambda {cxt with st = NeedValue; should_return = False} lambda with 
+            | {block = b; value =  Some v}  -> 
+              (b @ [S.assign id v ])
+            | _ -> assert false  
+          end
+      in
+      begin
+        match st, should_return with 
+        | EffectCall, False -> Js_output.make block
+        | EffectCall, True _ -> 
+          Js_output.make (block @ [S.return_unit ()]) ~finished:True
+        | (Declare _ | Assign _ ) , True _ -> 
+          Js_output.make [S.unknown_lambda lam]
+        (* bound by a name, while in a tail position, this can not happen  *)
+        | Declare (_kind, x) , False ->
+          (* FIXME: unused *)
+          Js_output.make (block @ [ S.declare_unit x ])
+        | Assign x, False  -> Js_output.make (block @ [S.assign_unit x ])
+        | NeedValue, _ -> 
+          Js_output.make block ~value:E.unit
+      end
+    | (Ltrywith(
+        (Lprim {primitive = Pccall {prim_name = "caml_sys_getenv"; _};
+                args = [Lconst _]} as body),
+        id, 
+        Lifthenelse
+          (Lprim{primitive = Pintcomp(Ceq);
+                 args = [Lvar id2 ; 
+                         Lprim{primitive = Pglobal_exception {name = "Not_found"}; _}]},
+           cont, _reraise )
+      )
+      | Ltrywith(
+          (Lprim {primitive = Pccall {prim_name = "caml_sys_getenv"; _};
+                  args = [Lconst _]} as body),
+          id, 
+          Lifthenelse(Lprim{primitive = Pintcomp(Ceq);
+                            args = [ 
+                              Lprim { primitive = Pglobal_exception {name = "Not_found"; _}; _}; Lvar id2 ]},
+                      cont, _reraise )
+        )) when Ident.same id id2 
+      -> 
+      compile_lambda cxt (Lam.try_ body id cont)
+    | Ltrywith(lam,id, catch) ->  (* generate documentation *)
+      (* 
+         tail --> should be renamed to `shouldReturn`  
+          in most cases ``shouldReturn`` == ``tail``, however, here is not, 
+          should return, but it is not a tail call in js
+          (* could be optimized using javascript style exceptions *)
+         {[
+           {try
+              {var $js=g(x);}
+                catch(exn){if(exn=Not_found){var $js=0;}else{throw exn;}}
+           return h($js);
+         }
+         ]}
+      *)
+      let aux st = 
+        (* should_return is passed down *)
+        [ S.try_ 
+            (Js_output.to_block (compile_lambda {cxt with st = st} lam))
+            ~with_:(id, 
+                    Js_output.to_block @@ 
+                    compile_lambda {cxt with st = st} catch )
 
-exception Unused
+        ] in 
 
-let compile_list compile_fun division =
+      begin
+        match st with 
+        | NeedValue -> 
+          let v = Ext_ident.gen_js () in
+          Js_output.make (S.declare_variable ~kind:Variable v :: aux (Assign v))  ~value:(E.var v )
+        | Declare (kind,  id) -> 
+          Js_output.make (S.declare_variable ~kind
+                            id :: aux (Assign id))
+        | Assign _ | EffectCall -> Js_output.make (aux st)
+      end
 
-  let rec c_rec totals = function
-  | [] -> [], jumps_unions totals, []
-  | (key, cell) :: rem ->
-      begin match cell.ctx with
-      | [] -> c_rec totals rem
-      | _  ->
-          try
-            let (lambda1, total1) = compile_fun cell.ctx cell.pm in
-            let c_rem, total, new_pats =
-              c_rec
-                (jumps_map ctx_combine total1::totals) rem in
-            ((key,lambda1)::c_rem), total, (cell.pat::new_pats)
-          with
-          | Unused -> c_rec totals rem
-      end in
-  c_rec [] division
 
+    | Lsend(meth_kind,met, obj, args,loc) -> 
+      (* Note that in [Texp_apply] for [%sendcache] the cache might not be used 
+         see {!CamlinternalOO.send_meth} and {!Translcore.transl_exp0} the branch
+         [Texp_apply] when [public_send ], args are simply dropped
 
-let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
-  let rec do_rec r total_r = function
-    | [] -> r,total_r
-    | (mat,i,vars,pm)::rem ->
-        begin try
-          let ctx = select_columns mat ctx in
-          let handler_i, total_i = compile_fun ctx pm in
-          match raw_action r with
-          | Lstaticraise (j,args) ->
-              if i=j then
-                List.fold_right2 (bind Alias) vars args handler_i,
-                jumps_map (ctx_rshift_num (ncols mat)) total_i
-              else
-                do_rec r total_r rem
-          | _ ->
-              do_rec
-                (Lstaticcatch (r,(i,vars), handler_i))
-                (jumps_union
-                   (jumps_remove i total_r)
-                   (jumps_map (ctx_rshift_num (ncols mat)) total_i))
-              rem
-        with
-        | Unused ->
-            do_rec (Lstaticcatch (r, (i,vars), lambda_unit)) total_r rem
-        end in
-  do_rec lambda1 total1 to_catch
+         reference 
+         [js_of_ocaml] 
+         1. GETPUBMET
+         2. GETDYNMET
+         3. GETMETHOD
+         [ocaml]
+         Lsend (bytegen.ml)
+         For the object layout refer to [camlinternalOO/create_object]
+         {[
+           let create_object table =
+             (* XXX Appel de [obj_block] *)
+             let obj = mark_ocaml_object @@ Obj.new_block Obj.object_tag table.size in
+             (* XXX Appel de [caml_modify] *)
+             Obj.set_field obj 0 (Obj.repr table.methods);
+             Obj.obj (set_id obj)
 
+           let create_object_opt obj_0 table =
+             if (Obj.magic obj_0 : bool) then obj_0 else begin
+               (* XXX Appel de [obj_block] *)
+               let obj = mark_ocaml_object @@ Obj.new_block Obj.object_tag table.size in
+               (* XXX Appel de [caml_modify] *)
+               Obj.set_field obj 0 (Obj.repr table.methods);
+               Obj.obj (set_id obj)
+             end
+         ]}
+         it's a block with tag [248], the first field is [table.methods] which is an array 
+         {[
+           type table =
+             { mutable size: int;
+               mutable methods: closure array;
+               mutable methods_by_name: meths;
+               mutable methods_by_label: labs;
+               mutable previous_states:
+                 (meths * labs * (label * item) list * vars *
+                  label list * string list) list;
+               mutable hidden_meths: (label * item) list;
+               mutable vars: vars;
+               mutable initializers: (obj -> unit) list }
+         ]}
+      *)
 
-let compile_test compile_fun partial divide combine ctx to_match =
-  let division = divide ctx to_match in
-  let c_div = compile_list compile_fun division in
-  match c_div with
-  | [],_,_ ->
-     begin match mk_failaction_neg partial ctx to_match.default with
-     | None,_,_ -> raise Unused
-     | Some l,_,total -> l,total
-     end
-  | _ ->
-      combine ctx to_match.default c_div
 
-(* Attempt to avoid some useless bindings by lowering them *)
+      begin match 
+        (met :: obj :: args) 
+        |> Ext_list.split_map (fun (x : Lam.t) -> 
+            match x with 
+            | Lprim {primitive = Pgetglobal i; args =  []} -> 
+              [], Lam_compile_global.get_exp  (i, env, true)
+            | Lprim {primitive = Pccall {prim_name ; _}; args =  []}
+              (* nullary external call*)
+              -> 
+              [], E.var (Ext_ident.create_js prim_name)
+            | _ -> 
+              begin
+                match compile_lambda
+                        {cxt with st = NeedValue; should_return = False}
+                        x with
+                | {block = a; value = Some b} -> a, b 
+                | _ -> assert false
+              end
+          ) with  
+      | _, ([] | [_]) -> assert false
+      | (args_code, label::obj'::args) 
+        -> 
+        let cont3 obj' k = 
+          match Js_ast_util.named_expression obj' with 
+          | None -> 
+            let cont =
+              Js_output.handle_block_return 
+                st should_return lam (List.concat args_code)
+            in
+            cont (k obj')
+          | Some (obj_code, v) -> 
+            let cont2 obj_code v = 
+              Js_output.handle_block_return 
+                st should_return lam 
+                (obj_code :: List.concat args_code) v in 
+            let obj' = E.var v in 
+            cont2 obj_code (k obj') 
+        in
+        begin
+          match meth_kind with 
+          | Self -> 
+            (* TODO: horrible hack -- fixed later *)
+            cont3 obj' (fun obj' -> E.call ~info:Js_call_info.dummy 
+                   (Js_of_lam_array.ref_array 
+                    (Js_of_lam_record.field Fld_na obj' 0l) label )
+                 (obj' :: args))
+          (* [E.small_int 1] is because we use array, 
+              when we change the runtime represenation, it needs to be adapted 
+          *)
 
-(* Approximation of v present in lam *)
-let rec approx_present v = function
-  | Lconst _ -> false
-  | Lstaticraise (_,args) ->
-      List.exists (fun lam -> approx_present v lam) args
-  | Lprim (_,args,_) ->
-      List.exists (fun lam -> approx_present v lam) args
-  | Llet (Alias, _, l1, l2) ->
-      approx_present v l1 || approx_present v l2
-  | Lvar vv -> Ident.same v vv
-  | _ -> true
+          | Cached | Public None
+            (* TODO: check -- 1. js object propagate 2. js object create  *)
+            -> 
+            let get = E.runtime_ref  Js_config.oo "caml_get_public_method" in
+            let cache = !method_cache_id in
+            let () = incr method_cache_id  in
+            cont3 obj' (fun obj' -> 
+              E.call ~info:Js_call_info.dummy 
+                 (E.call ~info:Js_call_info.dummy get 
+                    [obj'; label; E.small_int cache]) (obj'::args)
+              ) (* avoid duplicated compuattion *)
 
-let rec lower_bind v arg lam = match lam with
-| Lifthenelse (cond, ifso, ifnot) ->
-    let pcond = approx_present v cond
-    and pso = approx_present v ifso
-    and pnot = approx_present v ifnot in
-    begin match pcond, pso, pnot with
-    | false, false, false -> lam
-    | false, true, false ->
-        Lifthenelse (cond, lower_bind v arg ifso, ifnot)
-    | false, false, true ->
-        Lifthenelse (cond, ifso, lower_bind v arg ifnot)
-    | _,_,_ -> bind Alias v arg lam
-    end
-| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as sw))
-    when not (approx_present v ls) ->
-      Lswitch (ls, {sw with sw_consts = [i,lower_bind v arg act]})
-| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as sw))
-    when not (approx_present v ls) ->
-      Lswitch (ls, {sw with sw_blocks = [i,lower_bind v arg act]})
-| Llet (Alias, vv, lv, l) ->
-    if approx_present v lv then
-      bind Alias v arg lam
-    else
-      Llet (Alias, vv, lv, lower_bind v arg l)
-| _ ->
-    bind Alias v arg lam
 
-let bind_check str v arg lam = match str,arg with
-| _, Lvar _ ->bind str v arg lam
-| Alias,_ -> lower_bind v arg lam
-| _,_     -> bind str v arg lam
+          | Public (Some name) -> 
+            let cache = !method_cache_id in
+            incr method_cache_id ;
+            cont3 obj' 
+              (fun obj' -> E.public_method_call name obj' label 
+                  (Int32.of_int cache) args )
 
-let comp_exit ctx m = match m.default with
-| (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx
-| _        -> fatal_error "Matching.comp_exit"
+        end
+      end
+
+    (* [J.Empty,J.N] *)  (* TODO debugging, sourcemap, ignore lambda_event currently *)
+    (* 
+        seems to be an optimization trick for [translclass]
+        | Lifused(v, l) ->
+        if count_var v > 0 then simplif l else lambda_unit
+    *)
+    | Lifused(_,lam) -> compile_lambda cxt lam
+  end
+
+end
+module Lam_group : sig 
+#1 "lam_group.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
 
-let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs =
-  match next_matchs with
-  | [] -> comp_fun partial ctx arg first_match
-  | rem ->
-      let rec c_rec body total_body = function
-        | [] -> body, total_body
-        (* Hum, -1 meant never taken
-        | (-1,pm)::rem -> c_rec body total_body rem *)
-        | (i,pm)::rem ->
-            let ctx_i,total_rem = jumps_extract i total_body in
-            begin match ctx_i with
-            | [] -> c_rec body total_body rem
-            | _ ->
-                try
-                  let li,total_i =
-                    comp_fun
-                      (match rem with [] -> partial | _ -> Partial)
-                      ctx_i arg pm in
-                  c_rec
-                    (Lstaticcatch (body,(i,[]),li))
-                    (jumps_union total_i total_rem)
-                    rem
-                with
-                | Unused ->
-                    c_rec (Lstaticcatch (body,(i,[]),lambda_unit))
-                      total_rem  rem
-            end in
-   try
-      let first_lam,total = comp_fun Partial ctx arg first_match in
-      c_rec first_lam total rem
-   with Unused -> match next_matchs with
-   | [] -> raise Unused
-   | (_,x)::xs ->  comp_match_handlers comp_fun partial ctx arg x xs
 
-(* To find reasonable names for variables *)
 
-let rec name_pattern default = function
-    (pat :: patl, action) :: rem ->
-      begin match pat.pat_desc with
-        Tpat_var (id, _) -> id
-      | Tpat_alias(p, id, _) -> id
-      | _ -> name_pattern default rem
-      end
-  | _ -> Ident.create default
 
-let arg_to_var arg cls = match arg with
-| Lvar v -> v,arg
-| _ ->
-    let v = name_pattern "match" cls in
-    v,Lvar v
+type t = 
+  | Single of Lambda.let_kind  * Ident.t * Lam.t
+  | Recursive of (Ident.t * Lam.t) list
+  | Nop of Lam.t 
 
 
-(*
-  The main compilation function.
-   Input:
-      repr=used for inserting debug events
-      partial=exhaustiveness information from Parmatch
-      ctx=a context
-      m=a pattern matching
+val flatten : t list -> Lam.t -> Lam.t * t list
+
+val lambda_of_groups : Lam.t -> t list -> Lam.t
 
-   Output: a lambda term, a jump summary {..., exit number -> context, .. }
-*)
+val deep_flatten : Lam.t -> Lam.t
+(** Tricky to be complete *)
 
-let rec compile_match repr partial ctx m = match m with
-| { cases = [] } -> comp_exit ctx m
-| { cases = ([], action) :: rem } ->
-    if is_guarded action then begin
-      let (lambda, total) =
-        compile_match None partial ctx { m with cases = rem } in
-      event_branch repr (patch_guarded lambda action), total
-    end else
-      (event_branch repr action, jumps_empty)
-| { args = (arg, str)::argl } ->
-    let v,newarg = arg_to_var arg m.cases in
-    let first_match,rem =
-      split_precompile (Some v)
-        { m with args = (newarg, Alias) :: argl } in
-    let (lam, total) =
-      comp_match_handlers
-        ((if dbg then do_compile_matching_pr else do_compile_matching) repr)
-        partial ctx newarg first_match rem in
-    bind_check str v arg lam, total
-| _ -> assert false
+val pp_group : Env.t -> Format.formatter -> t -> unit
 
+end = struct
+#1 "lam_group.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* verbose version of do_compile_matching, for debug *)
 
-and do_compile_matching_pr repr partial ctx arg x =
-  prerr_string "COMPILE: " ;
-  prerr_endline (match partial with Partial -> "Partial" | Total -> "Total") ;
-  prerr_endline "MATCH" ;
-  pretty_precompiled x ;
-  prerr_endline "CTX" ;
-  pretty_ctx ctx ;
-  let (_, jumps) as r =  do_compile_matching repr partial ctx arg x in
-  prerr_endline "JUMPS" ;
-  pretty_jumps jumps ;
-  r
 
-and do_compile_matching repr partial ctx arg pmh = match pmh with
-| Pm pm ->
-  let pat = what_is_cases pm.cases in
-  begin match pat.pat_desc with
-  | Tpat_any ->
-      compile_no_test
-        divide_var ctx_rshift repr partial ctx pm
-  | Tpat_tuple patl ->
-      compile_no_test
-        (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine
-        repr partial ctx pm
-  | Tpat_record ((_, lbl,_)::_,_) ->
-      compile_no_test
-        (divide_record lbl.lbl_all (normalize_pat pat))
-        ctx_combine repr partial ctx pm
-  | Tpat_constant cst ->
-      compile_test
-        (compile_match repr partial) partial
-        divide_constant
-        (combine_constant pat.pat_loc arg cst partial)
-        ctx pm
-  | Tpat_construct (_, cstr, _) ->
-      compile_test
-        (compile_match repr partial) partial
-        divide_constructor (combine_constructor pat.pat_loc arg pat cstr partial)
-        ctx pm
-  | Tpat_array _ ->
-      let kind = Typeopt.array_pattern_kind pat in
-      compile_test (compile_match repr partial) partial
-        (divide_array kind) (combine_array pat.pat_loc arg kind partial)
-        ctx pm
-  | Tpat_lazy _ ->
-      compile_no_test
-        (divide_lazy (normalize_pat pat))
-        ctx_combine repr partial ctx pm
-  | Tpat_variant(lab, _, row) ->
-      compile_test (compile_match repr partial) partial
-        (divide_variant !row)
-        (combine_variant pat.pat_loc !row arg partial)
-        ctx pm
-  | _ -> assert false
-  end
-| PmVar {inside=pmh ; var_arg=arg} ->
-    let lam, total =
-      do_compile_matching repr partial (ctx_lshift ctx) arg pmh in
-    lam, jumps_map ctx_rshift total
-| PmOr {body=body ; handlers=handlers} ->
-    let lam, total = compile_match repr partial ctx body in
-    compile_orhandlers (compile_match repr partial) lam total ctx handlers
 
-and compile_no_test divide up_ctx repr partial ctx to_match =
-  let {pm=this_match ; ctx=this_ctx } = divide ctx to_match in
-  let lambda,total = compile_match repr partial this_ctx this_match in
-  lambda, jumps_map up_ctx total
 
+(** This is not a recursive type definition *)
+type t = 
+  | Single of Lambda.let_kind  * Ident.t * Lam.t
+  | Recursive of (Ident.t * Lam.t) list
+  | Nop of Lam.t 
 
 
+let pp = Format.fprintf 
 
-(* The entry points *)
+let str_of_kind (kind : Lambda.let_kind) = 
+  match kind with 
+  | Alias -> "a"
+  | Strict -> ""
+  | StrictOpt -> "o"
+  | Variable -> "v" 
 
-(*
-   If there is a guard in a matching or a lazy pattern,
-   then set exhaustiveness info to Partial.
-   (because of side effects, assume the worst).
+let pp_group env fmt ( x : t) =
+  match x with
+  | Single (kind, id, lam) ->
+    Format.fprintf fmt "@[let@ %a@ =%s@ @[<hv>%a@]@ @]" Ident.print id (str_of_kind kind) 
+      (Lam_print.env_lambda env) lam
+  | Recursive lst -> 
+    List.iter (fun (id,lam) -> 
+        Format.fprintf fmt
+          "@[let %a@ =r@ %a@ @]" Ident.print id (Lam_print.env_lambda env) lam
+      ) lst
+  | Nop lam -> Lam_print.env_lambda env fmt lam
 
-   Notice that exhaustiveness information is trusted by the compiler,
-   that is, a match flagged as Total should not fail at runtime.
-   More specifically, for instance if match y with x::_ -> x uis flagged
-   total (as it happens during JoCaml compilation) then y cannot be []
-   at runtime. As a consequence, the static Total exhaustiveness information
-   have to to be downgraded to Partial, in the dubious cases where guards
-   or lazy pattern execute arbitrary code that may perform side effects
-   and change the subject values.
-LM:
-   Lazy pattern was PR #5992, initial patch by lwp25.
-   I have  generalized teh patch, so as to also find mutable fields.
-*)
 
-let find_in_pat pred =
-  let rec find_rec p =
-    pred p.pat_desc ||
-    begin match p.pat_desc with
-    | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p ->
-        find_rec p
-    | Tpat_tuple ps|Tpat_construct (_,_,ps) | Tpat_array ps ->
-        List.exists find_rec ps
-    | Tpat_record (lpats,_) ->
-        List.exists
-          (fun (_, _, p) -> find_rec p)
-          lpats
-    | Tpat_or (p,q,_) ->
-        find_rec p || find_rec q
-    | Tpat_constant _ | Tpat_var _
-    | Tpat_any | Tpat_variant (_,None,_) -> false
-  end in
-  find_rec
+let rec flatten 
+    (acc :  t list ) 
+    (lam : Lam.t) :  Lam.t *  t list = 
+  match lam with 
+  | Llet (str,id,arg,body) -> 
+    let (res,l) = flatten acc arg  in
+    flatten (Single(str, id, res ) :: l) body
+  (* begin *)
+  (*   match res with *)
+  (*   | Llet _ -> assert false *)
+  (*   | Lletrec _-> assert false *)
+  (*   | _ ->  *)
+  (*       Format.fprintf  Format.err_formatter "%a@." Printlambda.lambda res ; *)
+  (*       Format.pp_print_flush Format.err_formatter (); *)
+  (*       flatten (Single(str, id, res ) :: l) body *)
+  (* end *)
+  | Lletrec (bind_args, body) -> 
+    (** TODO: more flattening, 
+        - also for function compilation, flattening should be done first
+        - [compile_group] and [compile] become mutually recursive function
+    *)
+    (* Printlambda.lambda Format.err_formatter lam ; assert false  *)
+    flatten
+      (
+        Recursive
+          (List.map (fun (id, arg ) -> (id, arg)) bind_args)
+        :: acc
+      )
+      body
+  | Lsequence (l,r) -> 
+    let (res, l)  = flatten acc l in
+    flatten (Nop res :: l)  r
 
-let is_lazy_pat = function
-  | Tpat_lazy _ -> true
-  | Tpat_alias _ | Tpat_variant _ | Tpat_record _
-  | Tpat_tuple _|Tpat_construct _ | Tpat_array _
-  | Tpat_or _ | Tpat_constant _ | Tpat_var _ | Tpat_any
-      -> false
+  | x ->  
+    (*   x = Llet _ -> assert false (* sane check *)*)
+    x, acc
 
-let is_lazy p = find_in_pat is_lazy_pat p
 
-let have_mutable_field p = match p with
-| Tpat_record (lps,_) ->
-    List.exists
-      (fun (_,lbl,_) ->
-        match lbl.Types.lbl_mut with
-        | Mutable -> true
-        | Immutable -> false)
-      lps
-| Tpat_alias _ | Tpat_variant _ | Tpat_lazy _
-| Tpat_tuple _|Tpat_construct _ | Tpat_array _
-| Tpat_or _
-| Tpat_constant _ | Tpat_var _ | Tpat_any
-  -> false
+(* [groups] are in reverse order *)
 
-let is_mutable p = find_in_pat have_mutable_field p
+let lambda_of_groups result groups = 
+  List.fold_left (fun acc x -> 
+      match x with 
+      | Nop l -> Lam.seq l acc
+      | Single(kind,ident,lam) -> Lam_util.refine_let ~kind ident lam acc
+      | Recursive bindings -> Lam.letrec bindings acc) 
+    result groups
 
-(* Downgrade Total when
-   1. Matching accesses some mutable fields;
-   2. And there are  guards or lazy patterns.
+
+(* TODO: 
+    refine effectful [ket_kind] to be pure or not
+    Be careful of how [Lifused(v,l)] work 
+    since its semantics depend on whether v is used or not
+    return value are in reverse order, but handled by [lambda_of_groups]
 *)
+let deep_flatten
+    (lam : Lam.t) :  Lam.t  = 
+  let rec
+    flatten 
+      (acc :  t list ) 
+      (lam : Lam.t) :  Lam.t *  t list = 
+    match lam with 
+    | Llet (str, id, 
+            (Lprim {primitive = Pccall 
+                      {prim_name = 
+                         ("js_from_nullable" 
+                         | "js_from_def"
+                         |"js_from_nullable_def"); _ }
+                   ; args  =  [Lvar _]} as arg), body)
+      -> 
+      flatten (Single(str, id, (aux arg) ) :: acc) body
+    | Llet (str, id, 
+            Lprim {primitive = Pccall 
+                     ({prim_name = 
+                         ("js_from_nullable"
+                         | "js_from_def"
+                         | "js_from_nullable_def"); _ } as p );
+                   args = [arg]}, body)
+      -> 
+      let id' = Ident.rename id in 
+      flatten acc 
+        (Lam.let_ str id' arg 
+               (Lam.let_ Alias id 
+                  (Lam.prim 
+                     ~primitive:(Pccall p)
+                     ~args: [Lam.var id'] Location.none (* FIXME*))
+                  body)
+              )
+    | Llet (str,id,arg,body) -> 
+      let (res,l) = flatten acc arg  in
+      flatten (Single(str, id, res ) :: l) body
+    | Lletrec (bind_args, body) -> 
+      (** TODO: more flattening, 
+          - also for function compilation, flattening should be done first
+          - [compile_group] and [compile] become mutually recursive function
+      *)
+      (* Printlambda.lambda Format.err_formatter lam ; assert false  *)
+      flatten
+        (
+          (* let rec iter bind_args acc =  *)
+          (*   match bind_args with *)
+          (*   | [] ->  acc  *)
+          (*   | (id,arg) :: rest ->  *)
+          (*       flatten acc  *)
+          Recursive
+            (List.map (fun (id, arg ) -> (id, aux arg)) bind_args)
+          :: acc
+        )
+        body
+    | Lsequence (l,r) -> 
+      let (res, l)  = flatten acc l in
+      flatten (Nop res :: l)  r
+    | x ->  
+      aux x, acc      
 
-let check_partial is_mutable is_lazy pat_act_list = function
-  | Partial -> Partial
-  | Total ->
-      if
-        List.exists
-          (fun (pats, lam) ->
-            is_mutable pats && (is_guarded lam || is_lazy pats))
-          pat_act_list
-      then Partial
-      else Total
+  and aux  (lam : Lam.t) : Lam.t= 
+    match lam with 
+    | Llet _ -> 
+      let res, groups = flatten [] lam  
+      in lambda_of_groups res groups
+    | Lletrec (bind_args, body) ->  
+      (** be careful to flatten letrec 
+          like below : 
+          {[
+            let rec even = 
+              let odd n =  if n ==1 then true else even (n - 1) in
+              fun n -> if n ==0  then true else odd (n - 1)
+          ]}
+          odd and even are recursive values, since all definitions inside 
+          e.g, [odd] can see [even] now, however, it should be fine
+          in our case? since ocaml's recursive value does not allow immediate 
+          access its value direclty?, seems no
+          {[
+            let rec even2 = 
+              let odd = even2 in
+              fun n -> if n ==0  then true else odd (n - 1)
+          ]}
+      *)
+      (* let module Ident_set = Lambda.IdentSet in *)
+      let rec iter bind_args acc =
+        match bind_args with
+        | [] ->   acc
+        | (id,arg) :: rest ->
+          let groups, set = acc in
+          let res, groups = flatten groups (aux arg)
+          in
+          iter rest (Recursive [(id,res)] :: groups, Ident_set.add id set) 
+      in
+      let groups, collections = iter bind_args ([], Ident_set.empty) in
+      (* FIXME:
+          here we try to move inner definitions of [recurisve value] upwards
+          for example:
+         {[
+           let rec x = 
+             let y = 32 in
+             y :: x
+           and z = ..
+             ---
+             le ty = 32 in
+           let rec x = y::x
+           and z = ..
+         ]}
+          however, the inner definitions can see [z] and [x], so we
+          can not blindly move it in the beginning, however, for 
+          recursive value, ocaml does not allow immediate access to 
+          recursive value, so what's the best strategy?
+          ---
+          the motivation is to capture real tail call
+      *)
+      let (result, _, wrap) = 
+        List.fold_left (fun  (acc, set, wrap)  g -> 
+            match g with 
+            | Recursive [ id, (Lconst _)]
+            | Single (Alias, id, ( Lconst _   ))
+            | Single ((Alias | Strict | StrictOpt), id, ( Lfunction _ )) -> 
+              (** FIXME: 
+                   It should be alias and alias will be optimized away
+                   in later optmizations, however, 
+                   this means if we don't optimize 
+                  {[ let u/a = v in ..]}
+                   the output would be wrong, we should *optimize 
+                   this away right now* instead of delaying it to the 
+                   later passes
+              *)
+              (acc, set, g :: wrap)
 
-let check_partial_list =
-  check_partial (List.exists is_mutable) (List.exists is_lazy)
-let check_partial = check_partial is_mutable is_lazy
+            | Single (_, id, ( Lvar bid)) -> 
+              (acc, (if Ident_set.mem bid set then Ident_set.add id set else set ), g:: wrap)
+            | Single (_, id, lam) ->
+              let variables = Lam.free_variables  lam in
+              if Ident_set.(is_empty (inter variables collections)) 
+              then 
+                (acc, set, g :: wrap )
+              else 
+                ((id, lam ) :: acc , Ident_set.add id set, wrap)
+            | Recursive us -> 
+              (* could also be from nested [let rec] 
+                 like 
+                 {[
+                   let rec x = 
+                     let rec y = 1 :: y in
+                     2:: List.hd y:: x 
+                 ]}
+                 TODO: seems like we should update depenency graph, 
 
-(* have toplevel handler when appropriate *)
+              *)
+              (us @ acc , 
+               List.fold_left (fun acc (id,_) -> Ident_set.add id acc) set us , 
+               wrap)
+            | Nop _ -> assert false 
+          ) ([], collections, []) groups in
+      lambda_of_groups 
+        (Lam.letrec 
+            result 
+            (* List.map (fun (id,lam) -> (id, aux lam )) bind_args *)
+            (aux body)) (List.rev wrap)
+    | Lsequence (l,r) -> Lam.seq (aux l) (aux r)
+    | Lconst _ -> lam
+    | Lvar _ -> lam 
+    (* | Lapply(Lfunction(Curried, params, body), args, _) *)
+    (*   when  List.length params = List.length args -> *)
+    (*     aux (beta_reduce  params body args) *)
+    (* | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) *)
+    (*     (\** TODO: keep track of this parameter in ocaml trunk, *)
+    (*           can we switch to the tupled backend? *\) *)
+    (*   when  List.length params = List.length args -> *)
+    (*       aux (beta_reduce params body args) *)
 
-let start_ctx n = [{left=[] ; right = omegas n}]
+    | Lapply{fn = l1; args  = ll; loc; status} -> 
+      Lam.apply (aux l1) (List.map aux ll) loc status
 
-let check_total total lambda i handler_fun =
-  if jumps_is_empty total then
-    lambda
-  else begin
-    Lstaticcatch(lambda, (i,[]), handler_fun())
-  end
+    (* This kind of simple optimizations should be done each time
+       and as early as possible *) 
 
-let compile_matching loc repr handler_fun arg pat_act_list partial =
-  let partial = check_partial pat_act_list partial in
-  match partial with
-  | Partial ->
-      let raise_num = next_raise_count () in
-      let pm =
-        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
-          args = [arg, Strict] ;
-          default = [[[omega]],raise_num]} in
-      begin try
-        let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
-        check_total total lambda raise_num handler_fun
-      with
-      | Unused -> assert false (* ; handler_fun() *)
-      end
-  | Total ->
-      let pm =
-        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
-          args = [arg, Strict] ;
-          default = []} in
-      let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
-      assert (jumps_is_empty total) ;
-      lambda
+    | Lprim {primitive = Pccall{prim_name = "caml_int64_float_of_bits"; _};
+            args = [ Lconst (Const_base (Const_int64 i))]; _} 
+      ->  
+      Lam.const 
+        (Const_base (Const_float (Js_number.to_string (Int64.float_of_bits i) )))
+    | Lprim {primitive = Pccall{prim_name = "caml_int64_to_float"; _}; 
+             args = [ Lconst (Const_base (Const_int64 i))]; _} 
+      -> 
+      (* TODO: note when int is too big, [caml_int64_to_float] is unsafe *)
+      Lam.const 
+        (Const_base (Const_float (Js_number.to_string (Int64.to_float i) )))
+    | Lprim {primitive ; args; loc }
+      -> 
+      let args = List.map aux args in
+      Lam.prim ~primitive ~args loc
+
+    | Lfunction{arity; kind; params;  body = l} -> 
+      Lam.function_ ~arity ~kind ~params  ~body:(aux  l)
+    | Lswitch(l, {sw_failaction; 
+                  sw_consts; 
+                  sw_blocks;
+                  sw_numblocks;
+                  sw_numconsts;
+                 }) ->
+      Lam.switch (aux  l)
+              {sw_consts = 
+                 List.map (fun (v, l) -> v, aux  l) sw_consts;
+               sw_blocks = List.map (fun (v, l) -> v, aux  l) sw_blocks;
+               sw_numconsts = sw_numconsts;
+               sw_numblocks = sw_numblocks;
+               sw_failaction = 
+                 begin 
+                   match sw_failaction with 
+                   | None -> None
+                   | Some x -> Some (aux x)
+                 end}
+    | Lstringswitch(l, sw, d) ->
+      Lam.stringswitch (aux  l) 
+                    (List.map (fun (i, l) -> i,aux  l) sw)
+                    (match d with
+                     | Some d -> Some (aux d )
+                     | None -> None)
+
+    | Lstaticraise (i,ls) 
+      -> Lam.staticraise i (List.map aux  ls)
+    | Lstaticcatch(l1, ids, l2) 
+      -> 
+      Lam.staticcatch (aux  l1) ids (aux  l2)
+    | Ltrywith(l1, v, l2) ->
+      Lam.try_ (aux  l1) v (aux  l2)
+    | Lifthenelse(l1, l2, l3) 
+      -> 
+      Lam.if_ (aux  l1) (aux l2) (aux l3)
+    | Lwhile(l1, l2) 
+      -> 
+      Lam.while_ (aux  l1) (aux l2)
+    | Lfor(flag, l1, l2, dir, l3) 
+      -> 
+      Lam.for_ flag (aux  l1) (aux  l2) dir (aux  l3)
+    | Lassign(v, l) ->
+      (* Lalias-bound variables are never assigned, so don't increase
+         v's refaux *)
+      Lam.assign v (aux  l)
+    | Lsend(u, m, o, ll, v) -> 
+      Lam.send u (aux m) (aux o) (List.map aux ll) v
 
+    | Lifused(v, l) -> Lam.ifused v (aux  l)
+  in aux lam
 
-let partial_function loc () =
-  (* [Location.get_pos_info] is too expensive *)
-  let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
-  Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-          [transl_normal_path Predef.path_match_failure;
-           Lconst(Const_block(0, Lambda.default_tag_info,
-              [Const_base(Const_string (fname, None));
-               Const_base(Const_int line);
-               Const_base(Const_int char)]))], loc)], loc)
+end
+module Lam_dce : sig 
+#1 "lam_dce.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let for_function loc repr param pat_act_list partial =
-  compile_matching loc repr (partial_function loc) param pat_act_list partial
 
-(* In the following two cases, exhaustiveness info is not available! *)
-let for_trywith param pat_act_list =
-  compile_matching Location.none None
-    (fun () -> Lprim(Praise Raise_reraise, [param], Location.none))
-    param pat_act_list Partial
 
-let for_let loc param pat body =
-  compile_matching loc None (partial_function loc) param [pat, body] Partial
 
-(* Handling of tupled functions and matchings *)
 
-(* Easy case since variables are available *)
-let for_tupled_function loc paraml pats_act_list partial =
-  let partial = check_partial_list pats_act_list partial in
-  let raise_num = next_raise_count () in
-  let omegas = [List.map (fun _ -> omega) paraml] in
-  let pm =
-    { cases = pats_act_list;
-      args = List.map (fun id -> (Lvar id, Strict)) paraml ;
-      default = [omegas,raise_num]
-    } in
-  try
-    let (lambda, total) = compile_match None partial
-        (start_ctx (List.length paraml)) pm in
-    check_total total lambda raise_num (partial_function loc)
-  with
-  | Unused -> partial_function loc ()
 
 
 
-let flatten_pattern size p = match p.pat_desc with
-| Tpat_tuple args -> args
-| Tpat_any -> omegas size
-| _ -> raise Cannot_flatten
 
-let rec flatten_pat_line size p k = match p.pat_desc with
-| Tpat_any ->  omegas size::k
-| Tpat_tuple args -> args::k
-| Tpat_or (p1,p2,_) ->  flatten_pat_line size p1 (flatten_pat_line size p2 k)
-| Tpat_alias (p,_,_) -> (* Note: if this 'as' pat is here, then this is a
-                           useless binding, solves PR #3780 *)
-    flatten_pat_line size p k
-| _ -> fatal_error "Matching.flatten_pat_line"
+(** Dead code eliminatiion on the lambda layer 
+*)
 
-let flatten_cases size cases =
-  List.map
-    (fun (ps,action) -> match ps with
-    | [p] -> flatten_pattern size p,action
-    | _ -> fatal_error "Matching.flatten_case")
-    cases
+val remove : Ident.t list -> Lam_group.t list -> Lam_group.t list
 
-let flatten_matrix size pss =
-  List.fold_right
-    (fun ps r -> match ps with
-    | [p] -> flatten_pat_line size p r
-    | _   -> fatal_error "Matching.flatten_matrix")
-    pss []
+end = struct
+#1 "lam_dce.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let flatten_def size def =
-  List.map
-    (fun (pss,i) -> flatten_matrix size pss,i)
-    def
 
-let flatten_pm size args pm =
-    {args = args ; cases = flatten_cases size pm.cases ;
-     default = flatten_def size pm.default}
 
 
-let flatten_precompiled size args  pmh = match pmh with
-| Pm pm -> Pm (flatten_pm size args pm)
-| PmOr {body=b ; handlers=hs ; or_matrix=m} ->
-    PmOr
-      {body=flatten_pm size args b ;
-       handlers=
-         List.map
-          (fun (mat,i,vars,pm) -> flatten_matrix size mat,i,vars,pm)
-          hs ;
-       or_matrix=flatten_matrix size m ;}
-| PmVar _ -> assert false
 
-(*
-   compiled_flattened is a ``comp_fun'' argument to comp_match_handlers.
-   Hence it needs a fourth argument, which it ignores
-*)
 
-let compile_flattened repr partial ctx _ pmh = match pmh with
-| Pm pm -> compile_match repr partial ctx pm
-| PmOr {body=b ; handlers=hs} ->
-    let lam, total = compile_match repr partial ctx b in
-    compile_orhandlers (compile_match repr partial) lam total ctx hs
-| PmVar _ -> assert false
 
-let do_for_multiple_match loc paraml pat_act_list partial =
-  let repr = None in
-  let partial = check_partial pat_act_list partial in
-  let raise_num,pm1 =
-    match partial with
-    | Partial ->
-        let raise_num = next_raise_count () in
-        raise_num,
-        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
-          args = [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), paraml, loc), Strict] ;
-          default = [[[omega]],raise_num] }
-    | _ ->
-        -1,
-        { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
-          args = [Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), paraml, loc), Strict] ;
-          default = [] } in
 
-  try
-    try
-(* Once for checking that compilation is possible *)
-      let next, nexts = split_precompile None pm1 in
 
-      let size = List.length paraml
-      and idl = List.map (fun _ -> Ident.create "match") paraml in
-      let args =  List.map (fun id -> Lvar id, Alias) idl in
 
-      let flat_next = flatten_precompiled size args next
-      and flat_nexts =
-        List.map
-          (fun (e,pm) ->  e,flatten_precompiled size args pm)
-          nexts in
 
-      let lam, total =
-        comp_match_handlers
-          (compile_flattened repr)
-          partial (start_ctx size) () flat_next flat_nexts in
-      List.fold_right2 (bind Strict) idl paraml
-        (match partial with
-        | Partial ->
-            check_total total lam raise_num (partial_function loc)
-        | Total ->
-            assert (jumps_is_empty total) ;
-            lam)
-    with Cannot_flatten ->
-      let (lambda, total) = compile_match None partial (start_ctx 1) pm1 in
-      begin match partial with
-      | Partial ->
-          check_total total lambda raise_num (partial_function loc)
-      | Total ->
-          assert (jumps_is_empty total) ;
-          lambda
-      end
-  with Unused ->
-    assert false (* ; partial_function loc () *)
+let transitive_closure 
+    (initial_idents : Ident.t list) 
+    (ident_freevars : Ident_set.t Ident_hashtbl.t) 
+  =
+  let visited  = Ident_hash_set.create 31 in 
+  let rec dfs (id : Ident.t) =
+    if Ident_hash_set.mem visited id || Ext_ident.is_js_or_global id  
+    then ()
+    else 
+      begin 
+        Ident_hash_set.add visited id;
+        match Ident_hashtbl.find_opt ident_freevars id with 
+        | None -> 
+          Ext_pervasives.failwithf ~loc:__LOC__ "%s/%d not found"  (Ident.name id) (id.Ident.stamp)  
+        | Some e -> Ident_set.iter (fun id -> dfs id) e
+      end  in 
+  List.iter dfs initial_idents;
+  visited
 
-(* #PR4828: Believe it or not, the 'paraml' argument below
-   may not be side effect free. *)
+let remove export_idents (rest : Lam_group.t list) : Lam_group.t list  = 
+  let ident_free_vars :  _ Ident_hashtbl.t = Ident_hashtbl.create 17 in
+  (* calculate initial required idents, 
+     at the same time, populate dependency set [ident_free_vars]
+  *)
+  let initial_idents =
+    List.fold_left (fun acc (x : Lam_group.t) -> 
+        match x with
+        | Single(kind, id,lam) ->                   
+          begin
+            Ident_hashtbl.add ident_free_vars id 
+              (Lam.free_variables  lam);
+            match kind with
+            | Alias | StrictOpt -> acc
+            | Strict | Variable -> id :: acc 
+          end
+        | Recursive bindings -> 
+          List.fold_left (fun acc (id,lam) -> 
+              Ident_hashtbl.add ident_free_vars id (Lam.free_variables lam);
+              match (lam : Lam.t) with
+              | Lfunction _ -> acc 
+              | _ -> id :: acc
+            ) acc bindings 
+        | Nop lam ->
+          if Lam_analysis.no_side_effects lam then acc
+          else 
+            (** its free varaibles here will be defined above *)
+            Ident_set.fold (fun x acc -> x :: acc )  ( Lam.free_variables lam) acc                
+      )  export_idents rest in 
+  let visited = transitive_closure initial_idents ident_free_vars in 
+  List.fold_left (fun (acc : _ list) (x : Lam_group.t) ->
+      match x with 
+      | Single(_,id,_) -> 
+        if Ident_hash_set.mem visited id  then 
+          x :: acc 
+        else acc 
+      | Nop _ -> x :: acc  
+      | Recursive bindings ->
+        let b = 
+          List.fold_right (fun ((id,_) as v) acc ->
+              if Ident_hash_set.mem visited id then 
+                v :: acc 
+              else
+                acc  
+            ) bindings [] in            
+        match b with 
+        | [] -> acc  
+        | _ -> (Recursive b) :: acc
+    ) [] rest |> List.rev   
 
-let arg_to_var arg cls = match arg with
-| Lvar v -> v,arg
-| _ ->
-    let v = name_pattern "match" cls in
-    v,Lvar v
+  
 
+end
+module Lam_stats_util : sig 
+#1 "lam_stats_util.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let param_to_var param = match param with
-| Lvar v -> v,None
-| _ -> Ident.create "match",Some param
 
-let bind_opt (v,eo) k = match eo with
-| None -> k
-| Some e ->  Lambda.bind Strict v e k
 
-let for_multiple_match loc paraml pat_act_list partial =
-  let v_paraml = List.map param_to_var paraml in
-  let paraml = List.map (fun (v,_) -> Lvar v) v_paraml in
-  List.fold_right bind_opt v_paraml
-    (do_for_multiple_match loc paraml pat_act_list partial)
 
-end
-module Translobj : sig 
-#1 "translobj.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
 
-open Lambda
 
-val oo_prim: string -> lambda
 
-val share: structured_constant -> lambda
-val meth: lambda -> string -> lambda * lambda list
 
-val reset_labels: unit -> unit
-val transl_label_init: lambda -> lambda
-val transl_store_label_init:
-    Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
+(** Utilities for lambda analysis *)
 
-val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
+val pp_alias_tbl : Format.formatter -> Lam_stats.alias_tbl  -> unit
 
-val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
-val oo_add_class: Ident.t -> Env.t * bool
+val pp_arities : Format.formatter -> Lam.function_arities -> unit
 
-val reset: unit -> unit
+val get_arity : Lam_stats.meta -> Lam.t -> Lam.function_arities
 
-end = struct
-#1 "translobj.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+(* val dump_exports_arities : Lam_stats.meta -> unit *)
 
-open Misc
-open Primitive
-open Asttypes
-open Longident
-open Lambda
 
-(* Get oo primitives identifiers *)
 
-let oo_prim name =
-  try
-    transl_normal_path
-      (fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
-  with Not_found ->
-    fatal_error ("Primitive " ^ name ^ " not found.")
+end = struct
+#1 "lam_stats_util.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* Share blocks *)
 
-let consts : (structured_constant, Ident.t) Hashtbl.t = Hashtbl.create 17
 
-let share c =
-  match c with
-    Const_block (n, _,  l) when l <> [] ->
-      begin try
-        Lvar (Hashtbl.find consts c)
-      with Not_found ->
-        let id = Ident.create "shared" in
-        Hashtbl.add consts c id;
-        Lvar id
-      end
-  | _ -> Lconst c
 
-(* Collect labels *)
 
-let cache_required = ref false
-let method_cache = ref lambda_unit
-let method_count = ref 0
-let method_table = ref []
 
-let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
 
-let next_cache tag =
-  let n = !method_count in
-  incr method_count;
-  (tag, [!method_cache; Lconst(Const_base(Const_int n))])
 
-let rec is_path = function
-    Lvar _ | Lprim (Pgetglobal _, [], _) | Lconst _ -> true
-  | Lprim (Pfield _, [lam], _) -> is_path lam
-  | Lprim ((Parrayrefu _ | Parrayrefs _), [lam1; lam2], _) ->
-      is_path lam1 && is_path lam2
-  | _ -> false
+let pp = Format.fprintf
 
-let meth obj lab =
-  let tag = meth_tag lab in
-  if not (!cache_required && !Clflags.native_code) then (tag, []) else
-  if not (is_path obj) then next_cache tag else
-  try
-    let r = List.assoc obj !method_table in
-    try
-      (tag, List.assoc tag !r)
-    with Not_found ->
-      let p = next_cache tag in
-      r := p :: !r;
-      p
-  with Not_found ->
-    let p = next_cache tag in
-    method_table := (obj, ref [p]) :: !method_table;
-    p
+let pp_arities (fmt : Format.formatter) (x : Lam.function_arities) = 
+  match x with 
+  | NA -> pp fmt "?"
+  | Determin (b,ls,tail) -> 
+    begin 
+      pp fmt "@[";
+      (if not b 
+       then 
+         pp fmt "~");
+      pp fmt "[";
+      Format.pp_print_list ~pp_sep:(fun fmt () -> pp fmt ",")
+        (fun fmt  (x,_) -> Format.pp_print_int fmt x)
+        fmt ls ;
+      if tail 
+      then pp fmt "@ *";
+      pp fmt "]@]";
+    end
 
-let reset_labels () =
-  Hashtbl.clear consts;
-  method_count := 0;
-  method_table := []
+let pp_arities_tbl 
+    (fmt : Format.formatter) 
+    (arities_tbl : (Ident.t, Lam.function_arities ref) Hashtbl.t) = 
+  Hashtbl.fold (fun (i:Ident.t) (v : Lam.function_arities ref) _ -> 
+      pp Format.err_formatter "@[%s -> %a@]@."i.name pp_arities !v ) arities_tbl ()
 
-(* Insert labels *)
+let pp_alias_tbl fmt (tbl : Lam_stats.alias_tbl) = 
+  Ident_hashtbl.iter (fun k v -> pp fmt "@[%a -> %a@]@." Ident.print k Ident.print v)
+    tbl
 
-let string s = Lconst (Const_base (Const_string (s, None)))
-let int n = Lconst (Const_base (Const_int n))
+let merge 
+    ((n : int ), params as y)
+    (x : Lam.function_arities) : Lam.function_arities = 
+  match x with 
+  | NA -> Determin(false, [y], false)
+  | Determin (b,xs,tail) -> Determin (b, y :: xs, tail)
 
-let prim_makearray =
-  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
-    prim_native_name = ""; prim_native_float = false}
+(* we need record all aliases -- since not all aliases are eliminated, 
+   mostly are toplevel bindings
+   We will keep iterating such environment
+   If not found, we will return [NA]
+*)
+let rec get_arity 
+    (meta : Lam_stats.meta) 
+    (lam : Lam.t) : 
+  Lam.function_arities = 
+  match lam with 
+  | Lconst _ -> Determin (true,[], false)
+  | Lvar v -> 
+    (** for functional parameter, if it is a high order function,
+        if it's not from function parameter, we should warn
+    *)
+    begin 
+      match Ident_hashtbl.find_opt meta.ident_tbl v with 
+      | Some (Function {arity;_}) -> arity
+      | Some _
+      | None ->
+        (* Format.fprintf Format.err_formatter *)
+        (*   "@[%s %a is not function/functor@]@." meta.filename Ident.print v ; *)
+        (NA : Lam.function_arities)
 
-(* Also use it for required globals *)
-let transl_label_init expr =
-  let expr =
-    Hashtbl.fold
-      (fun c id expr -> Llet(Alias, id, Lconst c, expr))
-      consts expr
-  in
-  let expr =
-    List.fold_right
-      (fun id expr -> Lsequence(Lprim(Pgetglobal id, [], Location.none), expr))
-      (Env.get_required_globals ()) expr
-  in
-  Env.reset_required_globals ();
-  reset_labels ();
-  expr
+    end
+  | Llet(_,_,_, l ) -> get_arity meta l 
+  (* | Lprim (Pccall {prim_name = "js_pure_expr"; prim_attributes},  *)
+  (*          [Lconst (Const_base (Const_string (_str,_)))]) *)
+  (*   -> *)
+  (*   (\* Ext_log.dwarn __LOC__ "called %s %d" str (List.length prim_attributes ); *\) *)
+  (*   begin match Parsetree_util.has_arity prim_attributes with *)
+  (*     | Some arity ->  *)
+  (*       (\* Ext_log.dwarn __LOC__ "arity %d" arity; *\) *)
+  (*       Determin(false, [arity, None], false) *)
+  (*     | None -> NA *)
+  (*   end *)
+  | Lprim {primitive = Pfield (n,_); 
+           args =  [Lprim {primitive = Pgetglobal id; args = []; _}]; _} ->
+    Lam_compile_env.find_and_add_if_not_exist (id, n) meta.env
+      ~not_found:(fun _ -> assert false)
+      ~found:(fun x -> x.arity )
+  | Lprim {primitive = Pfield _; _} -> NA (** TODO *)
+  | Lprim {primitive = Praise ;  _} -> Determin(true,[], true)
+  | Lprim {primitive = Pccall _; _} -> Determin(false, [], false)
+  | Lprim _  -> Determin(true,[] ,false)
+  (* shall we handle primitive in a direct way, 
+      since we know all the information
+      Invariant: all primitive application is fully applied, 
+      since this information  is already available
 
-let transl_store_label_init glob size f arg =
-  method_cache := Lprim(Pfield (size, Fld_na), [Lprim(Pgetglobal glob, [], Location.none)], Location.none);
-  let expr = f arg in
-  let (size, expr) =
-    if !method_count = 0 then (size, expr) else
-    (size+1,
-     Lsequence(
-     Lprim(Psetfield(size, false, Fld_set_na),
-           [Lprim(Pgetglobal glob, [], Location.none);
-            Lprim (Pccall prim_makearray, [int !method_count; int 0], Location.none)], Location.none),
-     expr))
-  in
-  (size, transl_label_init expr)
+      -- Check external c functions ?
+      -- it's not true for primitives 
+      like caml_set_oo_id  or  Lprim (Pmakeblock , [])
 
-(* Share classes *)
+      it seems true that primitive is always fully applied, however,
+      it can return a function
+  *)
+  | Lletrec(_, body) ->
+    get_arity meta body
+  (* | Lapply(Lprim( p, _), _args, _info) -> *)
+  (*     Determin(true, [], false) (\** Invariant : primtive application is always complete.. *\) *)
 
-let wrapping = ref false
-let top_env = ref Env.empty
-let classes = ref []
-let method_ids = ref IdentSet.empty
+  | Lapply{fn = app;  args; _ } -> (* detect functor application *)
+    let fn = get_arity meta app in 
+    begin match fn with 
+      | NA -> NA 
+      | Determin (b, xs, tail ) -> 
+        let rec take (xs : _ list) arg_length = 
+          match xs with 
+          | (x,y) :: xs ->
+            if arg_length = x then Lam.Determin (b, xs, tail) 
+            else if arg_length > x then
+              take xs (arg_length - x)
+            else Determin (b, 
+                           ((x -  arg_length ), 
+                            (match y with
+                            | Some y -> Some (Ext_list.drop arg_length y) 
+                            | None -> None)) :: xs ,
+                           tail)
+          | [] -> 
+            if tail then Determin(b, [], tail)
+            else if not b then 
+              NA
+            else NA
+            (* Actually, you can not have truly deministic arities
+               for example [fun x -> x ]
+            *)
+              (* Ext_pervasives.failwithf ~loc:__LOC__ "%s %s" *)
+              (*   (Format.asprintf "%a" pp_arities fn)  *)
+              (*   (Lam_util.string_of_lambda lam) *)
+        in
+        take xs (List.length args) 
+    end
+  | Lfunction {arity; kind; params; body = l} -> 
+    merge (arity, Some params)  (get_arity meta l)
+  | Lswitch(l, {sw_failaction; 
+                sw_consts; 
+                sw_blocks;
+                sw_numblocks = _;
+                sw_numconsts = _;
+               }) -> 
+    all_lambdas meta (
+      let rest = (sw_consts |> List.map snd) @ (sw_blocks |> List.map snd ) in
+      match sw_failaction with None -> rest | Some x -> x::rest )
+  | Lstringswitch(l, sw, d) -> 
+    begin match d with 
+      | None -> all_lambdas meta (List.map snd  sw )
+      | Some v -> all_lambdas meta (v:: List.map snd  sw)
+    end
+  | Lstaticraise _ -> NA (* since it will not be in tail position *)
+  | Lstaticcatch(_, _, handler) -> get_arity meta handler
+  | Ltrywith(l1, _, l2) -> 
+    all_lambdas meta [l1;l2]
+  | Lifthenelse(l1, l2, l3) ->
+    all_lambdas meta [l2;l3]
+  | Lsequence(_, l2) -> get_arity meta l2 
+  | Lsend(u, m, o, ll, v) -> NA
+  | Lifused(v, l) -> NA 
+  | Lwhile _ 
+  | Lfor _  
+  | Lassign _ -> Determin(true,[], false)
 
-let oo_add_class id =
-  classes := id :: !classes;
-  (!top_env, !cache_required)
+and all_lambdas meta (xs : Lam.t list) = 
+  match xs with 
+  | y :: ys -> 
+    let arity =  get_arity meta y in 
+    List.fold_left (fun exist (v : Lam.t) -> 
+        match (exist : Lam.function_arities) with 
+        | NA -> NA 
+        | Determin (b, xs, tail) -> 
+          begin 
+            match get_arity meta v with 
+            | NA -> NA 
+            | Determin (u,ys,tail2) -> 
+              let rec aux (b,acc) xs ys = 
+                match xs,ys with
+                | [], [] -> (b, List.rev acc, tail && tail2) 
+                | [], y::ys when tail  -> 
+                  aux (b,y::acc) [] ys 
+                | x::xs, [] when tail2 -> 
+                  aux (b,x::acc) [] xs
+                | x::xs, y::ys when x = y -> aux (b, (y :: acc)) xs ys 
+                | _, _  -> (false, List.rev acc, false) in 
+              let (b,acc, tail3)  = aux ( u &&b, []) xs ys in 
+              Determin (b,acc, tail3)
+          end
+      ) arity ys 
+  | _ -> assert false 
 
-let oo_wrap env req f x =
-  if !wrapping then
-    if !cache_required then f x else
-    try cache_required := true; let lam = f x in cache_required := false; lam
-    with exn -> cache_required := false; raise exn
-  else try
-    wrapping := true;
-    cache_required := req;
-    top_env := env;
-    classes := [];
-    method_ids := IdentSet.empty;
-    let lambda = f x in
-    let lambda =
-      List.fold_left
-        (fun lambda id ->
-          Llet(StrictOpt, id,
-               Lprim(Pmakeblock(0, Lambda.default_tag_info, Mutable),
-                     [lambda_unit; lambda_unit; lambda_unit], Location.none),
-               lambda))
-        lambda !classes
-    in
-    wrapping := false;
-    top_env := Env.empty;
-    lambda
-  with exn ->
-    wrapping := false;
-    top_env := Env.empty;
-    raise exn
+(*
+let dump_exports_arities (meta : Lam_stats.meta ) = 
+  let fmt = 
+    if meta.filename != "" then 
+      let cmj_file = Ext_filename.chop_extension meta.filename ^ Js_config.cmj_ext in
+      let out = open_out cmj_file in   
+      Format.formatter_of_out_channel out
+    else 
+      Format.err_formatter in 
+  begin 
+    List.iter (fun (i : Ident.t) ->  
+      pp fmt "@[%s: %s -> %a@]@." meta.filename i.name 
+        pp_arities  (get_arity meta (Lvar i))
+              ) meta.exports
+  end
+*)
 
-let reset () =
-  Hashtbl.clear consts;
-  cache_required := false;
-  method_cache := lambda_unit;
-  method_count := 0;
-  method_table := [];
-  wrapping := false;
-  top_env := Env.empty;
-  classes := [];
-  method_ids := IdentSet.empty
 
 end
-module Translcore : sig 
-#1 "translcore.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+module Lam_pass_alpha_conversion : sig 
+#1 "lam_pass_alpha_conversion.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* Translation from typed abstract syntax to lambda terms,
-   for the core language *)
 
-open Asttypes
-open Typedtree
-open Lambda
 
-val transl_exp: expression -> lambda
-val transl_apply: lambda -> (label * expression option * optional) list
-                  -> Location.t -> lambda
-val transl_let: rec_flag -> value_binding list -> lambda -> lambda
-val transl_primitive: Location.t -> Primitive.description -> lambda
 
-val check_recursive_lambda: Ident.t list -> lambda -> bool
 
-type error =
-    Illegal_letrec_pat
-  | Illegal_letrec_expr
-  | Free_super_var
-  | Unknown_builtin_primitive of string
 
-exception Error of Location.t * error
 
-open Format
 
-val report_error: formatter -> error -> unit
+(** alpha conversion based on arity *)
 
-(* Forward declaration -- to be filled in by Translmod.transl_module *)
-val transl_module :
-      (module_coercion -> Path.t option -> module_expr -> lambda) ref
-val transl_object :
-      (Ident.t -> string list -> class_expr -> lambda) ref
+val alpha_conversion : Lam_stats.meta -> Lam.t  -> Lam.t
 
 end = struct
-#1 "translcore.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
+#1 "lam_pass_alpha_conversion.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* Translation from typed abstract syntax to lambda terms,
-   for the core language *)
 
-open Misc
-open Asttypes
-open Primitive
-open Types
-open Typedtree
-open Typeopt
-open Lambda
 
-type error =
-    Illegal_letrec_pat
-  | Illegal_letrec_expr
-  | Free_super_var
-  | Unknown_builtin_primitive of string
 
-exception Error of Location.t * error
 
-(* Forward declaration -- to be filled in by Translmod.transl_module *)
-let transl_module =
-  ref((fun cc rootpath modl -> assert false) :
-      module_coercion -> Path.t option -> module_expr -> lambda)
 
-let transl_object =
-  ref (fun id s cl -> assert false :
-       Ident.t -> string list -> class_expr -> lambda)
 
-(* Translation of primitives *)
 
-let comparisons_table = create_hashtable 11 [
-  "%equal",
-      (Pccall{prim_name = "caml_equal"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Ceq,
-       Pfloatcomp Ceq,
-       Pccall{prim_name = "caml_string_equal"; prim_arity = 2;
-              prim_alloc = false;
-              prim_native_name = ""; prim_native_float = false},
-       Pbintcomp(Pnativeint, Ceq),
-       Pbintcomp(Pint32, Ceq),
-       Pbintcomp(Pint64, Ceq),
-       true);
-  "%notequal",
-      (Pccall{prim_name = "caml_notequal"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Cneq,
-       Pfloatcomp Cneq,
-       Pccall{prim_name = "caml_string_notequal"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pbintcomp(Pnativeint, Cneq),
-       Pbintcomp(Pint32, Cneq),
-       Pbintcomp(Pint64, Cneq),
-       true);
-  "%lessthan",
-      (Pccall{prim_name = "caml_lessthan"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Clt,
-       Pfloatcomp Clt,
-       Pccall{prim_name = "caml_string_lessthan"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pbintcomp(Pnativeint, Clt),
-       Pbintcomp(Pint32, Clt),
-       Pbintcomp(Pint64, Clt),
-       false);
-  "%greaterthan",
-      (Pccall{prim_name = "caml_greaterthan"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Cgt,
-       Pfloatcomp Cgt,
-       Pccall{prim_name = "caml_string_greaterthan"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pbintcomp(Pnativeint, Cgt),
-       Pbintcomp(Pint32, Cgt),
-       Pbintcomp(Pint64, Cgt),
-       false);
-  "%lessequal",
-      (Pccall{prim_name = "caml_lessequal"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Cle,
-       Pfloatcomp Cle,
-       Pccall{prim_name = "caml_string_lessequal"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pbintcomp(Pnativeint, Cle),
-       Pbintcomp(Pint32, Cle),
-       Pbintcomp(Pint64, Cle),
-       false);
-  "%greaterequal",
-      (Pccall{prim_name = "caml_greaterequal"; prim_arity = 2;
-              prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pintcomp Cge,
-       Pfloatcomp Cge,
-       Pccall{prim_name = "caml_string_greaterequal"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pbintcomp(Pnativeint, Cge),
-       Pbintcomp(Pint32, Cge),
-       Pbintcomp(Pint64, Cge),
-       false);
-  "%compare",
-      (Pccall{prim_name = "caml_compare"; prim_arity = 2; prim_alloc = true;
-              prim_native_name = ""; prim_native_float = false},
-       Pccall{prim_name = "caml_int_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pccall{prim_name = "caml_float_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pccall{prim_name = "caml_string_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pccall{prim_name = "caml_nativeint_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pccall{prim_name = "caml_int32_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       Pccall{prim_name = "caml_int64_compare"; prim_arity = 2;
-              prim_alloc = false; prim_native_name = "";
-              prim_native_float = false},
-       false)
-]
+let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t = 
+  let rec simpl  (lam : Lam.t) = 
+    match lam with 
+    | Lconst _ -> lam
+    | Lvar _ -> lam 
+    | Lapply {fn = l1; args =  ll;  loc ; status} 
+      -> (* detect functor application *)
+      begin 
+        match Lam_stats_util.get_arity meta l1 with 
+        | NA -> 
+          Lam.apply (simpl  l1) (List.map simpl  ll) loc status
+        | Determin (b, args, tail) -> 
+          let len = List.length ll in 
+          let rec take args = 
+            match args with 
+            | (x,_) :: xs -> 
+              if x = len 
+              then 
+                Lam.apply (simpl l1)
+                  (List.map simpl ll) loc App_ml_full
+              else if x > len  
+              then 
+                let fn = simpl l1 in
+                let args = List.map simpl ll in
+                Lam_util.eta_conversion (x - len) loc App_ml_full
+                  fn args 
+              else 
+                let first,rest = Ext_list.take x ll in 
+                Lam.apply (
+                  Lam.apply (simpl l1) 
+                         (List.map simpl first) 
+                         loc App_ml_full
+                )
+                  (List.map simpl rest) loc status (* TODO refien *)
+            | _ -> Lam.apply (simpl l1) (List.map simpl ll)  loc status
+          in take args
+      end
+
+    | Llet (str, v, l1, l2) ->
+      Lam.let_ str v (simpl l1) (simpl l2 )
+    | Lletrec (bindings, body) ->
+      let bindings = List.map (fun (k,l) -> (k, simpl l)) bindings in 
+      Lam.letrec bindings (simpl body) 
+    | Lprim {primitive; args ; loc} -> 
+      Lam.prim ~primitive ~args:(List.map simpl  args) loc
+    | Lfunction {arity; kind; params; body = l} ->
+      (* Lam_mk.lfunction kind params (simpl l) *)
+      Lam.function_ ~arity ~kind ~params  ~body:(simpl  l)
+    | Lswitch (l, {sw_failaction; 
+                  sw_consts; 
+                  sw_blocks;
+                  sw_numblocks;
+                  sw_numconsts;
+                 }) ->
+      Lam.switch (simpl  l)
+              {sw_consts = 
+                 List.map (fun (v, l) -> v, simpl  l) sw_consts;
+               sw_blocks = List.map (fun (v, l) -> v, simpl  l) sw_blocks;
+               sw_numconsts = sw_numconsts;
+               sw_numblocks = sw_numblocks;
+               sw_failaction = 
+                 begin 
+                   match sw_failaction with 
+                   | None -> None
+                   | Some x -> Some (simpl x)
+                 end}
+    | Lstringswitch (l, sw, d) ->
+      Lam.stringswitch (simpl  l)
+                    (List.map (fun (i, l) -> i,simpl  l) sw)
+                    (match d with
+                      | Some d -> Some (simpl d )
+                      | None -> None)
+                    
+    | Lstaticraise (i,ls) ->
+      Lam.staticraise i (List.map simpl  ls)
+    | Lstaticcatch (l1, ids, l2) 
+      -> 
+      Lam.staticcatch (simpl  l1) ids (simpl  l2)
+    | Ltrywith (l1, v, l2) 
+      -> 
+      Lam.try_ (simpl  l1) v (simpl  l2)
+    | Lifthenelse (l1, l2, l3) -> 
+      Lam.if_ (simpl  l1) (simpl  l2) (simpl  l3)
+    | Lsequence (l1, l2) 
+      -> Lam.seq (simpl  l1) (simpl  l2)
+    | Lwhile (l1, l2)
+      -> Lam.while_ (simpl  l1) (simpl l2)
+    | Lfor (flag, l1, l2, dir, l3)
+      -> Lam.for_ flag (simpl  l1) (simpl  l2) dir (simpl  l3)
+    | Lassign (v, l) ->
+      (* Lalias-bound variables are never assigned, so don't increase
+         v's refsimpl *)
+      Lam.assign v (simpl  l)
+    | Lsend (u, m, o, ll, v) -> 
+      Lam.send u (simpl m) (simpl o) (List.map simpl ll) v
+    | Lifused (v, l) -> Lam.ifused v (simpl  l)
+  in 
 
-let primitives_table = create_hashtable 57 [
-  "%bytes_to_string", Pbytes_to_string;
-  "%bytes_of_string", Pbytes_of_string;
-  "%identity", Pidentity;
-  "%ignore", Pignore;
-  "%field0", Pfield (0, Fld_na);
-  "%field1", Pfield (1, Fld_na);
-  "%setfield0", Psetfield(0, true, Fld_set_na);
-  "%makeblock", Pmakeblock(0, Lambda.default_tag_info, Immutable);
-  "%makemutable", Pmakeblock(0,Lambda.default_tag_info,  Mutable);
-  "%raise", Praise Raise_regular;
-  "%reraise", Praise Raise_reraise;
-  "%raise_notrace", Praise Raise_notrace;
-  "%sequand", Psequand;
-  "%sequor", Psequor;
-  "%boolnot", Pnot;
-  "%big_endian", Pctconst Big_endian;
-  "%word_size", Pctconst Word_size;
-  "%ostype_unix", Pctconst Ostype_unix;
-  "%ostype_win32", Pctconst Ostype_win32;
-  "%ostype_cygwin", Pctconst Ostype_cygwin;
-  "%negint", Pnegint;
-  "%succint", Poffsetint 1;
-  "%predint", Poffsetint(-1);
-  "%addint", Paddint;
-  "%subint", Psubint;
-  "%mulint", Pmulint;
-  "%divint", Pdivint;
-  "%modint", Pmodint;
-  "%andint", Pandint;
-  "%orint", Porint;
-  "%xorint", Pxorint;
-  "%lslint", Plslint;
-  "%lsrint", Plsrint;
-  "%asrint", Pasrint;
-  "%eq", Pintcomp Ceq;
-  "%noteq", Pintcomp Cneq;
-  "%ltint", Pintcomp Clt;
-  "%leint", Pintcomp Cle;
-  "%gtint", Pintcomp Cgt;
-  "%geint", Pintcomp Cge;
-  "%incr", Poffsetref(1);
-  "%decr", Poffsetref(-1);
-  "%intoffloat", Pintoffloat;
-  "%floatofint", Pfloatofint;
-  "%negfloat", Pnegfloat;
-  "%absfloat", Pabsfloat;
-  "%addfloat", Paddfloat;
-  "%subfloat", Psubfloat;
-  "%mulfloat", Pmulfloat;
-  "%divfloat", Pdivfloat;
-  "%eqfloat", Pfloatcomp Ceq;
-  "%noteqfloat", Pfloatcomp Cneq;
-  "%ltfloat", Pfloatcomp Clt;
-  "%lefloat", Pfloatcomp Cle;
-  "%gtfloat", Pfloatcomp Cgt;
-  "%gefloat", Pfloatcomp Cge;
-  "%string_length", Pstringlength;
-  "%string_safe_get", Pstringrefs;
-  "%string_safe_set", Pstringsets;
-  "%string_unsafe_get", Pstringrefu;
-  "%string_unsafe_set", Pstringsetu;
+  simpl lam
 
-  "%bytes_length", Pbyteslength;
-  "%bytes_safe_get", Pbytesrefs;
-  "%bytes_safe_set", Pbytessets;
-  "%bytes_unsafe_get", Pbytesrefu;
-  "%bytes_unsafe_set", Pbytessetu;
+end
+module Lam_pass_collect : sig 
+#1 "lam_pass_collect.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  "%array_length", Parraylength Pgenarray;
-  "%array_safe_get", Parrayrefs Pgenarray;
-  "%array_safe_set", Parraysets Pgenarray;
-  "%array_unsafe_get", Parrayrefu Pgenarray;
-  "%array_unsafe_set", Parraysetu Pgenarray;
-  "%obj_size", Parraylength Pgenarray;
-  "%obj_field", Parrayrefu Pgenarray;
-  "%obj_set_field", Parraysetu Pgenarray;
-  "%obj_is_int", Pisint;
-  "%lazy_force", Plazyforce;
-  "%nativeint_of_int", Pbintofint Pnativeint;
-  "%nativeint_to_int", Pintofbint Pnativeint;
-  "%nativeint_neg", Pnegbint Pnativeint;
-  "%nativeint_add", Paddbint Pnativeint;
-  "%nativeint_sub", Psubbint Pnativeint;
-  "%nativeint_mul", Pmulbint Pnativeint;
-  "%nativeint_div", Pdivbint Pnativeint;
-  "%nativeint_mod", Pmodbint Pnativeint;
-  "%nativeint_and", Pandbint Pnativeint;
-  "%nativeint_or",  Porbint Pnativeint;
-  "%nativeint_xor", Pxorbint Pnativeint;
-  "%nativeint_lsl", Plslbint Pnativeint;
-  "%nativeint_lsr", Plsrbint Pnativeint;
-  "%nativeint_asr", Pasrbint Pnativeint;
-  "%int32_of_int", Pbintofint Pint32;
-  "%int32_to_int", Pintofbint Pint32;
-  "%int32_neg", Pnegbint Pint32;
-  "%int32_add", Paddbint Pint32;
-  "%int32_sub", Psubbint Pint32;
-  "%int32_mul", Pmulbint Pint32;
-  "%int32_div", Pdivbint Pint32;
-  "%int32_mod", Pmodbint Pint32;
-  "%int32_and", Pandbint Pint32;
-  "%int32_or",  Porbint Pint32;
-  "%int32_xor", Pxorbint Pint32;
-  "%int32_lsl", Plslbint Pint32;
-  "%int32_lsr", Plsrbint Pint32;
-  "%int32_asr", Pasrbint Pint32;
-  "%int64_of_int", Pbintofint Pint64;
-  "%int64_to_int", Pintofbint Pint64;
-  "%int64_neg", Pnegbint Pint64;
-  "%int64_add", Paddbint Pint64;
-  "%int64_sub", Psubbint Pint64;
-  "%int64_mul", Pmulbint Pint64;
-  "%int64_div", Pdivbint Pint64;
-  "%int64_mod", Pmodbint Pint64;
-  "%int64_and", Pandbint Pint64;
-  "%int64_or",  Porbint Pint64;
-  "%int64_xor", Pxorbint Pint64;
-  "%int64_lsl", Plslbint Pint64;
-  "%int64_lsr", Plsrbint Pint64;
-  "%int64_asr", Pasrbint Pint64;
-  "%nativeint_of_int32", Pcvtbint(Pint32, Pnativeint);
-  "%nativeint_to_int32", Pcvtbint(Pnativeint, Pint32);
-  "%int64_of_int32", Pcvtbint(Pint32, Pint64);
-  "%int64_to_int32", Pcvtbint(Pint64, Pint32);
-  "%int64_of_nativeint", Pcvtbint(Pnativeint, Pint64);
-  "%int64_to_nativeint", Pcvtbint(Pint64, Pnativeint);
-  "%caml_ba_ref_1",
-    Pbigarrayref(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_ref_2",
-    Pbigarrayref(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_ref_3",
-    Pbigarrayref(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_set_1",
-    Pbigarrayset(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_set_2",
-    Pbigarrayset(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_set_3",
-    Pbigarrayset(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_ref_1",
-    Pbigarrayref(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_ref_2",
-    Pbigarrayref(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_ref_3",
-    Pbigarrayref(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_set_1",
-    Pbigarrayset(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_set_2",
-    Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_unsafe_set_3",
-    Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
-  "%caml_ba_dim_1", Pbigarraydim(1);
-  "%caml_ba_dim_2", Pbigarraydim(2);
-  "%caml_ba_dim_3", Pbigarraydim(3);
-  "%caml_string_get16", Pstring_load_16(false);
-  "%caml_string_get16u", Pstring_load_16(true);
-  "%caml_string_get32", Pstring_load_32(false);
-  "%caml_string_get32u", Pstring_load_32(true);
-  "%caml_string_get64", Pstring_load_64(false);
-  "%caml_string_get64u", Pstring_load_64(true);
-  "%caml_string_set16", Pstring_set_16(false);
-  "%caml_string_set16u", Pstring_set_16(true);
-  "%caml_string_set32", Pstring_set_32(false);
-  "%caml_string_set32u", Pstring_set_32(true);
-  "%caml_string_set64", Pstring_set_64(false);
-  "%caml_string_set64u", Pstring_set_64(true);
-  "%caml_bigstring_get16", Pbigstring_load_16(false);
-  "%caml_bigstring_get16u", Pbigstring_load_16(true);
-  "%caml_bigstring_get32", Pbigstring_load_32(false);
-  "%caml_bigstring_get32u", Pbigstring_load_32(true);
-  "%caml_bigstring_get64", Pbigstring_load_64(false);
-  "%caml_bigstring_get64u", Pbigstring_load_64(true);
-  "%caml_bigstring_set16", Pbigstring_set_16(false);
-  "%caml_bigstring_set16u", Pbigstring_set_16(true);
-  "%caml_bigstring_set32", Pbigstring_set_32(false);
-  "%caml_bigstring_set32u", Pbigstring_set_32(true);
-  "%caml_bigstring_set64", Pbigstring_set_64(false);
-  "%caml_bigstring_set64u", Pbigstring_set_64(true);
-  "%bswap16", Pbswap16;
-  "%bswap_int32", Pbbswap(Pint32);
-  "%bswap_int64", Pbbswap(Pint64);
-  "%bswap_native", Pbbswap(Pnativeint);
-  "%int_as_pointer", Pint_as_pointer;
-]
 
-let prim_makearray =
-  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
-    prim_native_name = ""; prim_native_float = false }
 
-let prim_obj_dup =
-  { prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true;
-    prim_native_name = ""; prim_native_float = false }
 
-let find_primitive loc prim_name =
-  match prim_name with
-      "%revapply" -> Prevapply 
-    | "%apply" -> Pdirapply 
-    | "%loc_LOC" -> Ploc Loc_LOC
-    | "%loc_FILE" -> Ploc Loc_FILE
-    | "%loc_LINE" -> Ploc Loc_LINE
-    | "%loc_POS" -> Ploc Loc_POS
-    | "%loc_MODULE" -> Ploc Loc_MODULE
-    | name -> Hashtbl.find primitives_table name
 
-let transl_prim loc prim args =
-  let prim_name = prim.prim_name in
-  try
-    let (gencomp, intcomp, floatcomp, stringcomp,
-         nativeintcomp, int32comp, int64comp,
-         simplify_constant_constructor) =
-      Hashtbl.find comparisons_table prim_name in
-    begin match args with
-      [arg1; {exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}]
-      when simplify_constant_constructor ->
-        intcomp
-    | [{exp_desc = Texp_construct(_, {cstr_tag = Cstr_constant _}, _)}; arg2]
-      when simplify_constant_constructor ->
-        intcomp
-    | [arg1; {exp_desc = Texp_variant(_, None)}]
-      when simplify_constant_constructor ->
-        intcomp
-    | [{exp_desc = Texp_variant(_, None)}; exp2]
-      when simplify_constant_constructor ->
-        intcomp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_int
-                     || has_base_type arg1 Predef.path_char ->
-        intcomp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_float ->
-        floatcomp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_string ->
-        stringcomp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_nativeint ->
-        nativeintcomp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_int32 ->
-        int32comp
-    | [arg1; arg2] when has_base_type arg1 Predef.path_int64 ->
-        int64comp
-    | _ ->
-        gencomp
-    end
-  with Not_found ->
-  try
-    let p = find_primitive loc prim_name in
-    (* Try strength reduction based on the type of the argument *)
-    begin match (p, args) with
-        (Psetfield(n, _, dbg_info), [arg1; arg2]) -> Psetfield(n, maybe_pointer arg2, dbg_info)
-      | (Parraylength Pgenarray, [arg])   -> Parraylength(array_kind arg)
-      | (Parrayrefu Pgenarray, arg1 :: _) -> Parrayrefu(array_kind arg1)
-      | (Parraysetu Pgenarray, arg1 :: _) -> Parraysetu(array_kind arg1)
-      | (Parrayrefs Pgenarray, arg1 :: _) -> Parrayrefs(array_kind arg1)
-      | (Parraysets Pgenarray, arg1 :: _) -> Parraysets(array_kind arg1)
-      | (Pbigarrayref(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
-                      arg1 :: _) ->
-            let (k, l) = bigarray_kind_and_layout arg1 in
-            Pbigarrayref(unsafe, n, k, l)
-      | (Pbigarrayset(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
-                      arg1 :: _) ->
-            let (k, l) = bigarray_kind_and_layout arg1 in
-            Pbigarrayset(unsafe, n, k, l)
-      | _ -> p
-    end
-  with Not_found ->
-    if String.length prim_name > 0 && prim_name.[0] = '%' then
-      raise(Error(loc, Unknown_builtin_primitive prim_name));
-    Pccall prim
 
 
-(* Eta-expand a primitive without knowing the types of its arguments *)
 
-let transl_primitive loc p =
-  let prim =
-    try
-      let (gencomp, _, _, _, _, _, _, _) =
-        Hashtbl.find comparisons_table p.prim_name in
-      gencomp
-    with Not_found ->
-    try
-      find_primitive loc p.prim_name
-    with Not_found ->
-      Pccall p in
-  match prim with
-  | Plazyforce ->
-      let parm = Ident.create "prim" in
-      Lfunction(Curried, [parm],
-                Matching.inline_lazy_force (Lvar parm) Location.none)
-  | Ploc kind ->
-    let lam = lam_of_loc kind loc in
-    begin match p.prim_arity with
-      | 0 -> lam
-      | 1 -> (* TODO: we should issue a warning ? *)
-        let param = Ident.create "prim" in
-        Lfunction(Curried, [param],
-          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), [lam; Lvar param], loc))
-      | _ -> assert false
-    end
-  | _ ->
-      let rec make_params n =
-        if n <= 0 then [] else Ident.create "prim" :: make_params (n-1) in
-      let params = make_params p.prim_arity in
-      if params = [] then  Lprim(prim,[], loc) (* arity = 0 in Buckle? TODO: unneeded *)
-      else Lfunction(Curried, params,
-                Lprim(prim, List.map (fun id -> Lvar id) params, loc))
 
-(* To check the well-formedness of r.h.s. of "let rec" definitions *)
+(** This pass is used to collect meta data information.
 
-let check_recursive_lambda idlist lam =
-  let rec check_top idlist = function
-    | Lvar v -> not (List.mem v idlist)
-    | Llet (_, _, _, _) as lam when check_recursive_recordwith idlist lam ->
-        true
-    | Llet(str, id, arg, body) ->
-        check idlist arg && check_top (add_let id arg idlist) body
-    | Lletrec(bindings, body) ->
-        let idlist' = add_letrec bindings idlist in
-        List.for_all (fun (id, arg) -> check idlist' arg) bindings &&
-        check_top idlist' body
-    | Lprim (Pmakearray (Pgenarray), args, _) -> false
-    | Lsequence (lam1, lam2) -> check idlist lam1 && check_top idlist lam2
-    | Levent (lam, _) -> check_top idlist lam
-    | lam -> check idlist lam
+    It includes:
+    alias table, arity for identifiers and might more information,
+    
+    ATTENTION:
+    For later pass to keep its information complete and up to date,
+    we  need update its table accordingly
 
-  and check idlist = function
-    | Lvar _ -> true
-    | Lfunction(kind, params, body) -> true
-    | Llet (_, _, _, _) as lam when check_recursive_recordwith idlist lam ->
-        true
-    | Llet(str, id, arg, body) ->
-        check idlist arg && check (add_let id arg idlist) body
-    | Lletrec(bindings, body) ->
-        let idlist' = add_letrec bindings idlist in
-        List.for_all (fun (id, arg) -> check idlist' arg) bindings &&
-        check idlist' body
-    | Lprim(Pmakeblock(tag, _,  mut), args, _) ->
-        List.for_all (check idlist) args
-    | Lprim(Pmakearray(_), args, _) ->
-        List.for_all (check idlist) args
-    | Lsequence (lam1, lam2) -> check idlist lam1 && check idlist lam2
-    | Levent (lam, _) -> check idlist lam
-    | lam ->
-        let fv = free_variables lam in
-        not (List.exists (fun id -> IdentSet.mem id fv) idlist)
+    - Alias inference is not for substitution, it is for analyze which module is 
+      actually a global module or an exception, so it can be relaxed a bit
+      (without relying on strict analysis)
 
-  and add_let id arg idlist =
-    let fv = free_variables arg in
-    if List.exists (fun id -> IdentSet.mem id fv) idlist
-    then id :: idlist
-    else idlist
+    - Js object (local) analysis 
 
-  and add_letrec bindings idlist =
-    List.fold_right (fun (id, arg) idl -> add_let id arg idl)
-                    bindings idlist
+    Design choice:
 
-  (* reverse-engineering the code generated by transl_record case 2 *)
-  (* If you change this, you probably need to change Bytegen.size_of_lambda. *)
-  and check_recursive_recordwith idlist = function
-    | Llet (Strict, id1, Lprim (Pduprecord _, [e1], _), body) ->
-       check_top idlist e1
-       && check_recordwith_updates idlist id1 body
-    | _ -> false
+    Side effectful operations:
+       - Lassign 
+       - Psetfield
 
-  and check_recordwith_updates idlist id1 = function
-    | Lsequence (Lprim ((Psetfield _ | Psetfloatfield _), [Lvar id2; e1], _), cont)
-        -> id2 = id1 && check idlist e1
-           && check_recordwith_updates idlist id1 cont
-    | Lvar id2 -> id2 = id1
-    | _ -> false
+    1. What information should be collected:
 
-  in check_top idlist lam
+    2. What's the key
+       If it's identifier, 
+       
+    Information that is always sound, not subject to change 
 
-(* To propagate structured constants *)
+    - shall we collect that if an identifier is passed as a parameter, (useful for escape analysis), 
+    however, since it's going to change after inlning (for local function)
 
-exception Not_constant
+    - function arity, subject to change when you make it a mutable ref and change it later
+    
+    - Immutable blocks of identifiers
+     
+      if identifier itself is function/non block then the access can be inlined 
+      if identifier itself is immutable block can be inlined
+      if identifier is mutable block can be inlined (without Lassign) since
 
-let extract_constant = function
-    Lconst sc -> sc
-  | _ -> raise Not_constant
+    - When collect some information, shall we propogate this information to 
+      all alias table immeidately
 
-let extract_float = function
-    Const_base(Const_float f) -> f
-  | _ -> fatal_error "Translcore.extract_float"
+      - annotation identifiers (at first time)
+      -
+ *)
 
-(* To find reasonable names for let-bound and lambda-bound idents *)
+(** Modify existing [meta] *)
+val collect_helper : Lam_stats.meta -> Lam.t -> unit
 
-let rec name_pattern default = function
-    [] -> Ident.create default
-  | {c_lhs=p; _} :: rem ->
-      match p.pat_desc with
-        Tpat_var (id, _) -> id
-      | Tpat_alias(p, id, _) -> id
-      | _ -> name_pattern default rem
+(** return a new [meta] *)
+val count_alias_globals : 
+    Env.t -> string -> Ident.t list -> Lam.t -> Lam_stats.meta
 
-(* Push the default values under the functional abstractions *)
 
-let rec push_defaults loc bindings cases partial =
-  match cases with
-    [{c_lhs=pat; c_guard=None;
-      c_rhs={exp_desc = Texp_function(l, pl,partial)} as exp}] ->
-      let pl = push_defaults exp.exp_loc bindings pl partial in
-      [{c_lhs=pat; c_guard=None;
-        c_rhs={exp with exp_desc = Texp_function(l, pl, partial)}}]
-  | [{c_lhs=pat; c_guard=None;
-      c_rhs={exp_attributes=[{txt="#default"},_];
-             exp_desc = Texp_let
-               (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}] ->
-      push_defaults loc (binds :: bindings) [{c_lhs=pat;c_guard=None;c_rhs=e2}]
-                    partial
-  | [case] ->
-      let exp =
-        List.fold_left
-          (fun exp binds ->
-            {exp with exp_desc = Texp_let(Nonrecursive, binds, exp)})
-          case.c_rhs bindings
-      in
-      [{case with c_rhs=exp}]
-  | {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
-      let param = name_pattern "param" cases in
-      let name = Ident.name param in
-      let exp =
-        { exp with exp_loc = loc; exp_desc =
-          Texp_match
-            ({exp with exp_type = pat.pat_type; exp_desc =
-              Texp_ident (Path.Pident param, mknoloc (Longident.Lident name),
-                          {val_type = pat.pat_type; val_kind = Val_reg;
-                           val_attributes = [];
-                           Types.val_loc = Location.none;
-                          })},
-             cases, [], partial) }
-      in
-      push_defaults loc bindings
-        [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)};
-          c_guard=None; c_rhs=exp}]
-        Total
-  | _ ->
-      cases
 
-(* Insertion of debugging events *)
+end = struct
+#1 "lam_pass_collect.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
+
 
-let event_before exp lam = match lam with
-| Lstaticraise (_,_) -> lam
-| _ ->
-  if !Clflags.debug
-  then Levent(lam, {lev_loc = exp.exp_loc;
-                    lev_kind = Lev_before;
-                    lev_repr = None;
-                    lev_env = Env.summary exp.exp_env})
-  else lam
 
-let event_after exp lam =
-  if !Clflags.debug
-  then Levent(lam, {lev_loc = exp.exp_loc;
-                    lev_kind = Lev_after exp.exp_type;
-                    lev_repr = None;
-                    lev_env = Env.summary exp.exp_env})
-  else lam
 
-let event_function exp lam =
-  if !Clflags.debug then
-    let repr = Some (ref 0) in
-    let (info, body) = lam repr in
-    (info,
-     Levent(body, {lev_loc = exp.exp_loc;
-                   lev_kind = Lev_function;
-                   lev_repr = repr;
-                   lev_env = Env.summary exp.exp_env}))
-  else
-    lam None
 
-let primitive_is_ccall = function
-  (* Determine if a primitive is a Pccall or will be turned later into
-     a C function call that may raise an exception *)
-  | Pccall _ | Pstringrefs | Pstringsets | Parrayrefs _ | Parraysets _ |
-    Pbigarrayref _ | Pbigarrayset _ | Pduprecord _ -> true
-  | _ -> false
 
-(* Assertions *)
 
-let assert_failed exp =
-  let (fname, line, char) =
-    Location.get_pos_info exp.exp_loc.Location.loc_start in
-  Lprim(Praise Raise_regular, [event_after exp
-    (Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-          [transl_normal_path Predef.path_assert_failure;
-           Lconst(Const_block(0, Lambda.default_tag_info,
-              [Const_base(Const_string (fname, None));
-               Const_base(Const_int line);
-               Const_base(Const_int char)]))], exp.exp_loc))], exp.exp_loc)
-;;
 
-let rec cut n l =
-  if n = 0 then ([],l) else
-  match l with [] -> failwith "Translcore.cut"
-  | a::l -> let (l1,l2) = cut (n-1) l in (a::l1,l2)
 
-(* Translation of expressions *)
+let annotate (meta : Lam_stats.meta)
+    rec_flag    
+    (k:Ident.t) (v : Lam.function_arities) lambda = 
+  (* Ext_log.dwarn  __LOC__ "%s/%d" k.name k.stamp;     *)
+  match Ident_hashtbl.find_opt  meta.ident_tbl k  with 
+  | None -> 
+      Ident_hashtbl.add meta.ident_tbl k (Function {kind = NA; arity = v; lambda; rec_flag})
+  |  Some (Function old)  ->  
+      (** Check, it is shared across ident_tbl, 
+          Only [Lassign] will break such invariant,
+          how about guarantee that [Lassign] only check the local ref 
+          and we track which ids are [Lassign]ed
+       *)
+      (**
+         might not be the same due to refinement
+         assert (old.arity = v) 
+       *)
+      old.arity <- v
+      
 
-let try_ids = Hashtbl.create 8
+  | _ -> assert false (* TODO -- avoid exception *)
 
-let rec transl_exp e =
-  let eval_once =
-    (* Whether classes for immediate objects must be cached *)
-    match e.exp_desc with
-      Texp_function _ | Texp_for _ | Texp_while _ -> false
-    | _ -> true
-  in
-  if eval_once then transl_exp0 e else
-  Translobj.oo_wrap e.exp_env true transl_exp0 e
 
-and transl_exp0 e =
-  match e.exp_desc with
-    Texp_ident(path, _, {val_kind = Val_prim p}) ->
-      let public_send = p.prim_name = "%send" in
-      if public_send || p.prim_name = "%sendself" then
-        let kind = if public_send then Public None else Self in
-        let obj = Ident.create "obj" and meth = Ident.create "meth" in
-        Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [],
-                                              e.exp_loc))
-      else if p.prim_name = "%sendcache" then
-        let obj = Ident.create "obj" and meth = Ident.create "meth" in
-        let cache = Ident.create "cache" and pos = Ident.create "pos" in
-        Lfunction(Curried, [obj; meth; cache; pos],
-                  Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos],
-                        e.exp_loc))
-      else
-        transl_primitive e.exp_loc p
-  | Texp_ident(path, _, {val_kind = Val_anc _}) ->
-      raise(Error(e.exp_loc, Free_super_var))
-  | Texp_ident(path, _, {val_kind = Val_reg | Val_self _}) ->
-      transl_path ~loc:e.exp_loc e.exp_env path
-  | Texp_ident _ -> fatal_error "Translcore.transl_exp: bad Texp_ident"
-  | Texp_constant cst ->
-      Lconst(Const_base cst)
-  | Texp_let(rec_flag, pat_expr_list, body) ->
-      transl_let rec_flag pat_expr_list (event_before body (transl_exp body))
-  | Texp_function (_, pat_expr_list, partial) ->
-      let ((kind, params), body) =
-        event_function e
-          (function repr ->
-            let pl = push_defaults e.exp_loc [] pat_expr_list partial in
-            transl_function e.exp_loc !Clflags.native_code repr partial pl)
-      in
-      Lfunction(kind, params, body)
-  | Texp_apply({exp_desc = Texp_ident(path, _, {val_kind = Val_prim p})},
-               oargs)
-    when List.length oargs >= p.prim_arity
-    && List.for_all (fun (_, arg,_) -> arg <> None) oargs ->
-      let args, args' = cut p.prim_arity oargs in
-      let wrap f =
-        if args' = []
-        then event_after e f
-        else event_after e (transl_apply f args' e.exp_loc)
-      in
-      let wrap0 f =
-        if args' = [] then f else wrap f in
-      let args =
-         List.map (function _, Some x, _ -> x | _ -> assert false) args in
-      let argl = transl_list args in
-      let public_send = p.prim_name = "%send"
-        || not !Clflags.native_code && p.prim_name = "%sendcache"in
-      if public_send || p.prim_name = "%sendself" then
-        let kind = if public_send then Public None else Self in
-        let obj = List.hd argl in
-        wrap (Lsend (kind, List.nth argl 1, obj, [], e.exp_loc))
-      else if p.prim_name = "%sendcache" then
-        match argl with [obj; meth; cache; pos] ->
-          wrap (Lsend(Cached, meth, obj, [cache; pos], e.exp_loc))
-        | _ -> assert false
-      else begin
-        let prim = transl_prim e.exp_loc p args in
-        match (prim, args) with
-          (Praise k, [arg1]) ->
-            let targ = List.hd argl in
-            let k =
-              match k, targ with
-              | Raise_regular, Lvar id
-                when Hashtbl.mem try_ids id ->
-                  Raise_reraise
-              | _ ->
-                  k
-            in
-            wrap0 (Lprim(Praise k, [event_after arg1 targ], e.exp_loc))
-        | (Ploc kind, []) ->
-          lam_of_loc kind e.exp_loc
-        | (Ploc kind, [arg1]) ->
-          let lam = lam_of_loc kind arg1.exp_loc in
-          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), lam :: argl, e.exp_loc)
-        | (Ploc _, _) -> assert false
-        | (_, _) ->
-            begin match (prim, argl) with
-            | (Plazyforce, [a]) ->
-                wrap (Matching.inline_lazy_force a e.exp_loc)
-            | (Plazyforce, _) -> assert false
-            |_ -> let p = Lprim(prim, argl, e.exp_loc) in
-               if primitive_is_ccall prim then wrap p else wrap0 p
-            end
-      end
-  | Texp_apply(funct, oargs) ->
-      event_after e (transl_apply (transl_exp funct) oargs e.exp_loc)
-  | Texp_match(arg, pat_expr_list, exn_pat_expr_list, partial) ->
-    transl_match e arg pat_expr_list exn_pat_expr_list partial
-  | Texp_try(body, pat_expr_list) ->
-      let id = name_pattern "exn" pat_expr_list in
-      Ltrywith(transl_exp body, id,
-               Matching.for_trywith (Lvar id) (transl_cases_try pat_expr_list))
-  | Texp_tuple el ->
-      let ll = transl_list el in
-      let tag_info = Lambda.Blk_tuple in 
-      begin try
-        Lconst(Const_block(0, tag_info, List.map extract_constant ll))
-      with Not_constant ->
-        Lprim(Pmakeblock(0,  tag_info, Immutable), ll, e.exp_loc)
-      end
-  | Texp_construct(_, cstr, args) ->
-      let ll = transl_list args in
-      begin match cstr.cstr_tag with
-        Cstr_constant n ->
-          Lconst(Const_pointer (n, Lambda.Pt_constructor cstr.cstr_name))
-      | Cstr_block n ->
-          let tag_info = (Lambda.Blk_constructor (cstr.cstr_name, cstr.cstr_nonconsts)) in
-          begin try
-            Lconst(Const_block(n,tag_info, List.map extract_constant ll))
-          with Not_constant ->
-            Lprim(Pmakeblock(n, tag_info, Immutable), ll, e.exp_loc)
-          end
-      | Cstr_extension(path, is_const) ->
-          if is_const then
-            transl_path e.exp_env path
-          else
-            Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-                  transl_path e.exp_env path :: ll, e.exp_loc)
-      end
-  | Texp_variant(l, arg) ->
-      let tag = Btype.hash_variant l in
-      begin match arg with
-        None -> Lconst(Const_pointer (tag, Lambda.Pt_variant l))
-      | Some arg ->
-          let lam = transl_exp arg in
-          let tag_info = Lambda.Blk_variant l in
-          try
-            Lconst(Const_block(0, tag_info, [Const_base(Const_int tag);
-                                   extract_constant lam]))
-          with Not_constant ->
-            Lprim(Pmakeblock(0, tag_info, Immutable),
-                  [Lconst(Const_base(Const_int tag)); lam], e.exp_loc)
-      end
-  | Texp_record ((_, lbl1, _) :: _ as lbl_expr_list, opt_init_expr) ->
-      transl_record e.exp_loc lbl1.lbl_all lbl1.lbl_repres lbl_expr_list opt_init_expr
-  | Texp_record ([], _) ->
-      fatal_error "Translcore.transl_exp: bad Texp_record"
-  | Texp_field(arg, _, lbl) ->
-      let access =
-        match lbl.lbl_repres with
-          Record_regular -> Pfield (lbl.lbl_pos, Fld_record lbl.lbl_name)
-        | Record_float -> Pfloatfield (lbl.lbl_pos, Fld_record lbl.lbl_name) in
-      Lprim(access, [transl_exp arg], e.exp_loc)
-  | Texp_setfield(arg, _, lbl, newval) ->
-      let access =
-        match lbl.lbl_repres with
-          Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer newval, Fld_record_set lbl.lbl_name)
-        | Record_float -> Psetfloatfield (lbl.lbl_pos, Fld_record_set lbl.lbl_name) in
-      Lprim(access, [transl_exp arg; transl_exp newval], e.exp_loc)
-  | Texp_array expr_list ->
-      let kind = array_kind e in
-      let ll = transl_list expr_list in
-      begin try
-        (* Deactivate constant optimization if array is small enough *)
-        if List.length ll <= 4 then raise Not_constant;
-        let cl = List.map extract_constant ll in
-        let master =
-          match kind with
-          | Paddrarray | Pintarray ->
-              Lconst(Const_block(0, Lambda.Blk_array, cl)) (* ATTENTION: ? [|1;2;3;4|]*)
-          | Pfloatarray ->
-              Lconst(Const_float_array(List.map extract_float cl))
-          | Pgenarray ->
-              raise Not_constant in             (* can this really happen? *)
-        Lprim(Pccall prim_obj_dup, [master], e.exp_loc)
-      with Not_constant ->
-        Lprim(Pmakearray kind, ll, e.exp_loc)
-      end
-  | Texp_ifthenelse(cond, ifso, Some ifnot) ->
-      Lifthenelse(transl_exp cond,
-                  event_before ifso (transl_exp ifso),
-                  event_before ifnot (transl_exp ifnot))
-  | Texp_ifthenelse(cond, ifso, None) ->
-      Lifthenelse(transl_exp cond,
-                  event_before ifso (transl_exp ifso),
-                  lambda_unit)
-  | Texp_sequence(expr1, expr2) ->
-      Lsequence(transl_exp expr1, event_before expr2 (transl_exp expr2))
-  | Texp_while(cond, body) ->
-      Lwhile(transl_exp cond, event_before body (transl_exp body))
-  | Texp_for(param, _, low, high, dir, body) ->
-      Lfor(param, transl_exp low, transl_exp high, dir,
-           event_before body (transl_exp body))
-  | Texp_send(_, _, Some exp) -> transl_exp exp
-  | Texp_send(expr, met, None) ->
-      let obj = transl_exp expr in
-      let lam =
-        match met with
-          Tmeth_val id -> Lsend (Self, Lvar id, obj, [], e.exp_loc)
-        | Tmeth_name nm ->
-            let (tag, cache) = Translobj.meth obj nm in
-            let kind = if cache = [] then Public (Some nm) else Cached in
-            Lsend (kind, tag, obj, cache, e.exp_loc)
-      in
-      event_after e lam
-  | Texp_new (cl, {Location.loc=loc}, _) ->
-      Lapply(Lprim(Pfield (0, Fld_na), [transl_path ~loc e.exp_env cl], loc),
-             [lambda_unit], Location.none)
-  | Texp_instvar(path_self, path, _) ->
-      Lprim(Parrayrefu Paddrarray,
-            [transl_normal_path path_self; transl_normal_path path], e.exp_loc)
-  | Texp_setinstvar(path_self, path, _, expr) ->
-      transl_setinstvar e.exp_loc (transl_normal_path path_self) path expr
-  | Texp_override(path_self, modifs) ->
-      let cpy = Ident.create "copy" in
-      Llet(Strict, cpy,
-           Lapply(Translobj.oo_prim "copy", [transl_normal_path path_self],
-                  Location.none),
-           List.fold_right
-             (fun (path, _, expr) rem ->
-                Lsequence(transl_setinstvar Location.none (Lvar cpy) path expr, rem))
-             modifs
-             (Lvar cpy))
-  | Texp_letmodule(id, _, modl, body) ->
-      Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body)
-  | Texp_pack modl ->
-      !transl_module Tcoerce_none None modl
-  | Texp_assert {exp_desc=Texp_construct(_, {cstr_name="false"}, _)} ->
-      assert_failed e
-  | Texp_assert (cond) ->
-      if !Clflags.noassert
-      then lambda_unit
-      else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e)
-  | Texp_lazy e ->
-      (* when e needs no computation (constants, identifiers, ...), we
-         optimize the translation just as Lazy.lazy_from_val would
-         do *)
-      begin match e.exp_desc with
-        (* a constant expr of type <> float gets compiled as itself *)
-      | Texp_constant
-          ( Const_int _ | Const_char _ | Const_string _
-          | Const_int32 _ | Const_int64 _ | Const_nativeint _ )
-      | Texp_function(_, _, _)
-      | Texp_construct (_, {cstr_arity = 0}, _)
-        -> transl_exp e
-      | Texp_constant(Const_float _) ->
-          Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
-      | Texp_ident(_, _, _) -> (* according to the type *)
-          begin match e.exp_type.desc with
-          (* the following may represent a float/forward/lazy: need a
-             forward_tag *)
-          | Tvar _ | Tlink _ | Tsubst _ | Tunivar _
-          | Tpoly(_,_) | Tfield(_,_,_,_) ->
-              Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
-          (* the following cannot be represented as float/forward/lazy:
-             optimize *)
-          | Tarrow(_,_,_,_) | Ttuple _ | Tpackage _ | Tobject(_,_) | Tnil
-          | Tvariant _
-              -> transl_exp e
-          (* optimize predefined types (excepted float) *)
-          | Tconstr(_,_,_) ->
-              if has_base_type e Predef.path_int
-                || has_base_type e Predef.path_char
-                || has_base_type e Predef.path_string
-                || has_base_type e Predef.path_bool
-                || has_base_type e Predef.path_unit
-                || has_base_type e Predef.path_exn
-                || has_base_type e Predef.path_array
-                || has_base_type e Predef.path_list
-                || has_base_type e Predef.path_option
-                || has_base_type e Predef.path_nativeint
-                || has_base_type e Predef.path_int32
-                || has_base_type e Predef.path_int64
-              then transl_exp e
-              else
-                Lprim(Pmakeblock(Obj.forward_tag, Lambda.default_tag_info, Immutable), [transl_exp e], e.exp_loc)
-          end
-      (* other cases compile to a lazy block holding a function *)
-      | _ ->
-          let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in
-          Lprim(Pmakeblock(Config.lazy_tag, Lambda.default_tag_info, Mutable), [fn], e.exp_loc)
+(** it only make senses recording arities for 
+    function definition,
+    alias propgation - and toplevel identifiers, this needs to be exported
+ *)
+let collect_helper  (meta : Lam_stats.meta) (lam : Lam.t)  = 
+  let rec collect_bind rec_flag
+      (kind : Lambda.let_kind) 
+      (ident : Ident.t)
+      (lam : Lam.t) = 
+    match lam with 
+    | Lconst v 
+      -> 
+      Ident_hashtbl.replace meta.ident_tbl ident (Constant v); (** *)
+    | Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args=  ls}
+      -> 
+      Ident_hashtbl.replace meta.ident_tbl ident 
+        (Lam_util.kind_of_lambda_block Normal ls);
+      List.iter collect ls 
+
+    | Lprim {primitive = Pccall {prim_name = "js_from_nullable"; _}; 
+             args = ([ Lvar _] as ls) ; _}
+      ->
+      Ident_hashtbl.replace meta.ident_tbl ident 
+        (Lam_util.kind_of_lambda_block Null ls )
+    | Lprim {primitive = Pccall {prim_name = "js_from_def"; _}; 
+             args = ([ Lvar _] as ls); _}
+      ->
+      Ident_hashtbl.replace meta.ident_tbl ident 
+        (Lam_util.kind_of_lambda_block Undefined ls )
+    | Lprim {primitive = Pccall {prim_name = "js_from_nullable_def"; _};
+             args = ([ Lvar _] as ls);}
+      ->
+      Ident_hashtbl.replace meta.ident_tbl ident 
+        (Lam_util.kind_of_lambda_block Null_undefined ls )
+      
+    | Lprim {primitive = Pgetglobal v; args = []; _} 
+      -> 
+      begin 
+        Lam_util.alias meta  ident v (Module  v) kind; 
+        begin match kind with 
+          | Alias -> ()
+          | Strict | StrictOpt | Variable -> 
+            Lam_util.add_required_module v meta
+        end;
       end
-  | Texp_object (cs, meths) ->
-      let cty = cs.cstr_type in
-      let cl = Ident.create "class" in
-      !transl_object cl meths
-        { cl_desc = Tcl_structure cs;
-          cl_loc = e.exp_loc;
-          cl_type = Cty_signature cty;
-          cl_env = e.exp_env;
-          cl_attributes = [];
-         }
+    | Lvar v 
+      -> 
+        (
+         (* if Ident.global v then  *)
+         Lam_util.alias meta  ident v NA kind
+           (* enven for not subsitution, it still propogate some properties *)
+           (* else () *)
+        )
+    | Lfunction{ params; body = l}
+        (** TODO record parameters ident ?, but it will be broken after inlining *)  
+      -> 
+        (** TODO could be optimized in one pass? 
+            -- since collect would iter everywhere,
+            so -- it would still iterate internally
+         *)
+
+      List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
+      let arity = Lam_stats_util.get_arity meta lam in       
+      (* Ext_log.dwarn __LOC__ "%s/%d : %a : %a function collected"  *)
+      (*   ident.name ident.stamp  *)
+      (*   Printlambda.lambda lam *)
+      (*   Lam_stats_util.pp_arities arity *)
+      (* ; *)
+      annotate meta rec_flag ident  arity lam;
+      collect l
+    | x -> 
+        collect x ;
+        if Ident_set.mem ident meta.export_idents then 
+          annotate meta rec_flag ident (Lam_stats_util.get_arity meta x ) lam
+
+
+  and collect  (lam : Lam.t)  =
+    match lam with 
+
+        (** TODO: 
+            how about module aliases..
+            record dependency
+            --- tricky -- if we inlining, 
+            is it safe to remove it? probably not...
+         *)
+    | Lconst _ -> ()
+    | Lvar _ -> ()
+    | Lapply{fn = l1; args =  ll; _} ->
+        collect  l1; List.iter collect  ll
+    | Lfunction { params; body =  l} -> (* functor ? *)
+        List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
+        collect  l
+    | Llet (kind,ident,arg,body) -> 
+        collect_bind Non_rec kind ident arg ; collect body
+    | Lletrec (bindings, body) -> 
+        List.iter (fun (ident,arg) -> collect_bind Rec  Strict ident arg ) bindings;
+        collect body
+    | Lprim {args; _} -> List.iter collect  args
+    | Lswitch(l, {sw_failaction; sw_consts; sw_blocks}) ->
+        collect  l;
+        List.iter (fun (_, l) -> collect  l) sw_consts;
+        List.iter (fun (_, l) -> collect  l) sw_blocks;
+        begin match sw_failaction with 
+        | None -> ()
+        | Some x -> collect x
+        end
+    | Lstringswitch(l, sw, d) ->
+        collect  l ;
+        List.iter (fun (_, l) -> collect  l) sw ;
+        begin match d with
+        | Some d -> collect d 
+        | None -> ()
+        end
+    | Lstaticraise (code,ls) -> 
+        Int_hash_set.add meta.exit_codes code;
+        List.iter collect  ls
+    | Lstaticcatch(l1, (_,_), l2) -> collect  l1; collect  l2
+    | Ltrywith(l1, _, l2) -> collect  l1; collect  l2
+    | Lifthenelse(l1, l2, l3) -> collect  l1; collect  l2; collect  l3
+    | Lsequence(l1, l2) -> collect  l1; collect  l2
+    | Lwhile(l1, l2) -> collect  l1; collect l2
+    | Lfor(_, l1, l2, dir, l3) -> collect  l1; collect  l2; collect  l3
+    | Lassign(v, l) ->
+        (* Lalias-bound variables are never assigned, so don't increase
+           v's refcollect *)
+        collect  l
+    | Lsend(_, m, o, ll, _) -> List.iter collect  (m::o::ll)
+    | Lifused(_, l) -> collect  l in collect lam 
+
+
+
+let count_alias_globals 
+    env 
+    filename
+    export_idents
+    (lam : Lam.t) : Lam_stats.meta =
+  let meta : Lam_stats.meta = 
+    {alias_tbl = Ident_hashtbl.create 31 ; 
+     ident_tbl = Ident_hashtbl.create 31;
+     exit_codes = Int_hash_set.create 31 ;
+     exports =  export_idents;
+     required_modules = [] ;
+     filename;
+     env;
+     export_idents = Lam_util.ident_set_of_list export_idents; 
+   } in 
+  collect_helper  meta lam ; 
+  meta
 
-and transl_list expr_list =
-  List.map transl_exp expr_list
+end
+module Int_hashtbl : sig 
+#1 "int_hashtbl.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-and transl_guard guard rhs =
-  let expr = event_before rhs (transl_exp rhs) in
-  match guard with
-  | None -> expr
-  | Some cond ->
-      event_before cond (Lifthenelse(transl_exp cond, expr, staticfail))
 
-and transl_case {c_lhs; c_guard; c_rhs} =
-  c_lhs, transl_guard c_guard c_rhs
 
-and transl_cases cases =
-  List.map transl_case cases
+include Hashtbl_gen.S with type key = int
 
-and transl_case_try {c_lhs; c_guard; c_rhs} =
-  match c_lhs.pat_desc with
-  | Tpat_var (id, _)
-  | Tpat_alias (_, id, _) ->
-      Hashtbl.replace try_ids id ();
-      Misc.try_finally
-        (fun () -> c_lhs, transl_guard c_guard c_rhs)
-        (fun () -> Hashtbl.remove try_ids id)
-  | _ ->
-      c_lhs, transl_guard c_guard c_rhs
 
-and transl_cases_try cases =
-  List.map transl_case_try cases
 
-and transl_tupled_cases patl_expr_list =
-  List.map (fun (patl, guard, expr) -> (patl, transl_guard guard expr))
-    patl_expr_list
 
-and transl_apply lam sargs loc =
-  let lapply funct args =
-    match funct with
-      Lsend(k, lmet, lobj, largs, loc) ->
-        Lsend(k, lmet, lobj, largs @ args, loc)
-    | Levent(Lsend(k, lmet, lobj, largs, loc), _) ->
-        Lsend(k, lmet, lobj, largs @ args, loc)
-    | Lapply(lexp, largs, _) ->
-        Lapply(lexp, largs @ args, loc)
-    | lexp ->
-        Lapply(lexp, args, loc)
-  in
-  let rec build_apply lam args = function
-      (None, optional) :: l ->
-        let defs = ref [] in
-        let protect name lam =
-          match lam with
-            Lvar _ | Lconst _ -> lam
-          | _ ->
-              let id = Ident.create name in
-              defs := (id, lam) :: !defs;
-              Lvar id
-        in
-        let args, args' =
-          if List.for_all (fun (_,opt) -> opt = Optional) args then [], args
-          else args, [] in
-        let lam =
-          if args = [] then lam else lapply lam (List.rev_map fst args) in
-        let handle = protect "func" lam
-        and l = List.map (fun (arg, opt) -> may_map (protect "arg") arg, opt) l
-        and id_arg = Ident.create "param" in
-        let body =
-          match build_apply handle ((Lvar id_arg, optional)::args') l with
-            Lfunction(Curried, ids, lam) ->
-              Lfunction(Curried, id_arg::ids, lam)
-          | Levent(Lfunction(Curried, ids, lam), _) ->
-              Lfunction(Curried, id_arg::ids, lam)
-          | lam ->
-              Lfunction(Curried, [id_arg], lam)
-        in
-        List.fold_left
-          (fun body (id, lam) -> Llet(Strict, id, lam, body))
-          body !defs
-    | (Some arg, optional) :: l ->
-        build_apply lam ((arg, optional) :: args) l
-    | [] ->
-        lapply lam (List.rev_map fst args)
-  in
-  build_apply lam [] (List.map (fun (l, x,o) -> may_map transl_exp x, o) sargs)
+end = struct
+#1 "int_hashtbl.ml"
+# 15 "ext/hashtbl.cppo.ml"
+type key = int 
+type 'a t = (key, 'a)  Hashtbl_gen.t 
+let key_index (h : _ t ) (key : key) =
+  (Bs_hash_stubs.hash_int  key ) land (Array.length h.data - 1)
+let eq_key = Ext_int.equal   
 
-and transl_function loc untuplify_fn repr partial cases =
-  match cases with
-    [{c_lhs=pat; c_guard=None;
-      c_rhs={exp_desc = Texp_function(_, pl,partial')} as exp}]
-    when Parmatch.fluid pat ->
-      let param = name_pattern "param" cases in
-      let ((_, params), body) =
-        transl_function exp.exp_loc false repr partial' pl in
-      ((Curried, param :: params),
-       Matching.for_function loc None (Lvar param) [pat, body] partial)
-  | {c_lhs={pat_desc = Tpat_tuple pl}} :: _ when untuplify_fn ->
-      begin try
-        let size = List.length pl in
-        let pats_expr_list =
-          List.map
-            (fun {c_lhs; c_guard; c_rhs} ->
-              (Matching.flatten_pattern size c_lhs, c_guard, c_rhs))
-            cases in
-        let params = List.map (fun p -> Ident.create "param") pl in
-        ((Tupled, params),
-         Matching.for_tupled_function loc params
-           (transl_tupled_cases pats_expr_list) partial)
-      with Matching.Cannot_flatten ->
-        let param = name_pattern "param" cases in
-        ((Curried, [param]),
-         Matching.for_function loc repr (Lvar param)
-           (transl_cases cases) partial)
-      end
-  | _ ->
-      let param = name_pattern "param" cases in
-      ((Curried, [param]),
-       Matching.for_function loc repr (Lvar param)
-         (transl_cases cases) partial)
 
-and transl_let rec_flag pat_expr_list body =
-  match rec_flag with
-    Nonrecursive ->
-      let rec transl = function
-        [] ->
-          body
-      | {vb_pat=pat; vb_expr=expr} :: rem ->
-          Matching.for_let pat.pat_loc (transl_exp expr) pat (transl rem)
-      in transl pat_expr_list
-  | Recursive ->
-      let idlist =
-        List.map
-          (fun {vb_pat=pat} -> match pat.pat_desc with
-              Tpat_var (id,_) -> id
-            | Tpat_alias ({pat_desc=Tpat_any}, id,_) -> id
-            | _ -> raise(Error(pat.pat_loc, Illegal_letrec_pat)))
-        pat_expr_list in
-      let transl_case {vb_pat=pat; vb_expr=expr} id =
-        let lam = transl_exp expr in
-        if not (check_recursive_lambda idlist lam) then
-          raise(Error(expr.exp_loc, Illegal_letrec_expr));
-        (id, lam) in
-      Lletrec(List.map2 transl_case pat_expr_list idlist, body)
+# 33
+type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist
+let create = Hashtbl_gen.create
+let clear = Hashtbl_gen.clear
+let reset = Hashtbl_gen.reset
+let copy = Hashtbl_gen.copy
+let iter = Hashtbl_gen.iter
+let fold = Hashtbl_gen.fold
+let length = Hashtbl_gen.length
+let stats = Hashtbl_gen.stats
 
-and transl_setinstvar loc self var expr =
-  Lprim(Parraysetu (if maybe_pointer expr then Paddrarray else Pintarray),
-                    [self; transl_normal_path var; transl_exp expr], loc)
 
-and transl_record loc all_labels repres lbl_expr_list opt_init_expr =
-  let size = Array.length all_labels in
-  (* Determine if there are "enough" new fields *)
-  if 3 + 2 * List.length lbl_expr_list >= size
-  then begin
-    (* Allocate new record with given fields (and remaining fields
-       taken from init_expr if any *)
-    let lv = Array.make (Array.length all_labels) staticfail in
-    let init_id = Ident.create "init" in
-    begin match opt_init_expr with
-      None -> ()
-    | Some init_expr ->
-        for i = 0 to Array.length all_labels - 1 do
-          let access =
-            let lbl = all_labels.(i) in
-            match lbl.lbl_repres with
-              Record_regular -> Pfield (i, Fld_record lbl.lbl_name)
-            | Record_float -> Pfloatfield (i, Fld_record lbl.lbl_name)  in
-          lv.(i) <- Lprim(access, [Lvar init_id], loc)
-        done
-    end;
-    List.iter
-      (fun (_, lbl, expr) -> lv.(lbl.lbl_pos) <- transl_exp expr)
-      lbl_expr_list;
-    let ll = Array.to_list lv in
-    let mut =
-      if List.exists (fun (_, lbl, expr) -> lbl.lbl_mut = Mutable) lbl_expr_list
-      then Mutable
-      else Immutable in
-    let all_labels_info = all_labels |> Array.map (fun x -> x.Types.lbl_name) in
-    let lam =
-      try
-        if mut = Mutable then raise Not_constant;
-        let cl = List.map extract_constant ll in
-        match repres with
-          Record_regular -> Lconst(Const_block(0, Lambda.Blk_record all_labels_info, cl))
-        | Record_float ->
-            Lconst(Const_float_array(List.map extract_float cl))
-      with Not_constant ->
-        match repres with
-          Record_regular -> Lprim(Pmakeblock(0, Lambda.Blk_record all_labels_info, mut), ll,loc)
-        | Record_float -> Lprim(Pmakearray Pfloatarray, ll, loc) in
-    begin match opt_init_expr with
-      None -> lam
-    | Some init_expr -> Llet(Strict, init_id, transl_exp init_expr, lam)
-    end
-  end else begin
-    (* Take a shallow copy of the init record, then mutate the fields
-       of the copy *)
-    (* If you change anything here, you will likely have to change
-       [check_recursive_recordwith] in this file. *)
-    let copy_id = Ident.create "newrecord" in
-    let update_field (_, lbl, expr) cont =
-      let upd =
-        match lbl.lbl_repres with
-          Record_regular -> Psetfield(lbl.lbl_pos, maybe_pointer expr, Fld_record_set lbl.lbl_name)
-        | Record_float -> Psetfloatfield (lbl.lbl_pos, Fld_record_set lbl.lbl_name) in
-      Lsequence(Lprim(upd, [Lvar copy_id; transl_exp expr], loc), cont) in
-    begin match opt_init_expr with
-      None -> assert false
-    | Some init_expr ->
-        Llet(Strict, copy_id,
-             Lprim(Pduprecord (repres, size), [transl_exp init_expr], loc),
-             List.fold_right update_field lbl_expr_list (Lvar copy_id))
+
+let add (h : _ t) key info =
+  let i = key_index h key in
+  let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in
+  h.data.(i) <- bucket;
+  h.size <- h.size + 1;
+  if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h
+
+(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *)
+let modify_or_init (h : _ t) key modf default =
+  let rec find_bucket (bucketlist : _ bucketlist)  =
+    match bucketlist with
+    | Cons(k,i,next) ->
+      if eq_key k key then begin modf i; false end
+      else find_bucket next 
+    | Empty -> true in
+  let i = key_index h key in 
+  if find_bucket h.data.(i) then
+    begin 
+      h.data.(i) <- Cons(key,default (),h.data.(i));
+      h.size <- h.size + 1 ;
+      if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h 
     end
-  end
 
-and transl_match e arg pat_expr_list exn_pat_expr_list partial =
-  let id = name_pattern "exn" exn_pat_expr_list
-  and cases = transl_cases pat_expr_list
-  and exn_cases = transl_cases exn_pat_expr_list in
-  let static_catch body val_ids handler =
-    let static_exception_id = next_negative_raise_count () in
-    Lstaticcatch
-      (Ltrywith (Lstaticraise (static_exception_id, body), id,
-                 Matching.for_trywith (Lvar id) exn_cases),
-       (static_exception_id, val_ids),
-       handler)
-  in
-  match arg, exn_cases with
-  | {exp_desc = Texp_tuple argl}, [] ->
-    Matching.for_multiple_match e.exp_loc (transl_list argl) cases partial
-  | {exp_desc = Texp_tuple argl}, _ :: _ ->
-    let val_ids = List.map (fun _ -> name_pattern "val" []) argl in
-    let lvars = List.map (fun id -> Lvar id) val_ids in
-    static_catch (transl_list argl) val_ids
-      (Matching.for_multiple_match e.exp_loc lvars cases partial)
-  | arg, [] ->
-    Matching.for_function e.exp_loc None (transl_exp arg) cases partial
-  | arg, _ :: _ ->
-    let val_id = name_pattern "val" pat_expr_list in
-    static_catch [transl_exp arg] [val_id]
-      (Matching.for_function e.exp_loc None (Lvar val_id) cases partial)
+let remove (h : _ t ) key =
+  let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with  
+    | Empty ->
+        Empty
+    | Cons(k, i, next) ->
+        if eq_key k key 
+        then begin h.size <- h.size - 1; next end
+        else Cons(k, i, remove_bucket next) in
+  let i = key_index h key in
+  h.data.(i) <- remove_bucket h.data.(i)
+
+let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with  
+  | Empty ->
+      raise Not_found
+  | Cons(k, d, rest) ->
+      if eq_key key k then d else find_rec key rest
+
+let find_exn (h : _ t) key =
+  match h.data.(key_index h key) with
+  | Empty -> raise Not_found
+  | Cons(k1, d1, rest1) ->
+      if eq_key key k1 then d1 else
+      match rest1 with
+      | Empty -> raise Not_found
+      | Cons(k2, d2, rest2) ->
+          if eq_key key k2 then d2 else
+          match rest2 with
+          | Empty -> raise Not_found
+          | Cons(k3, d3, rest3) ->
+              if eq_key key k3  then d3 else find_rec key rest3
+
+let find_opt (h : _ t) key =
+  Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key))
+let find_default (h : _ t) key default = 
+  Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key))
+let find_all (h : _ t) key =
+  let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with 
+  | Empty ->
+      []
+  | Cons(k, d, rest) ->
+      if eq_key k key 
+      then d :: find_in_bucket rest
+      else find_in_bucket rest in
+  find_in_bucket h.data.(key_index h key)
+
+let replace h key info =
+  let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with 
+    | Empty ->
+        raise_notrace Not_found
+    | Cons(k, i, next) ->
+        if eq_key k key
+        then Cons(key, info, next)
+        else Cons(k, i, replace_bucket next) in
+  let i = key_index h key in
+  let l = h.data.(i) in
+  try
+    h.data.(i) <- replace_bucket l
+  with Not_found ->
+    h.data.(i) <- Cons(key, info, l);
+    h.size <- h.size + 1;
+    if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h
+
+let mem (h : _ t) key =
+  let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with 
+  | Empty ->
+      false
+  | Cons(k, d, rest) ->
+      eq_key k key  || mem_in_bucket rest in
+  mem_in_bucket h.data.(key_index h key)
+
+
+let of_list2 ks vs = 
+  let map = create 51 in 
+  List.iter2 (fun k v -> add map k v) ks vs ; 
+  map
+
+
+end
+module Lam_pass_exits : sig 
+#1 "lam_pass_exits.mli"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+(* Adapted for Javascript backend: Hongbo Zhang,                       *)
+
+
+(** A pass used to optimize the exit code compilation, adaped from the compiler's
+    [simplif] module
+ *)
+
+val count_helper : Lam.t -> int ref Int_hashtbl.t
+
+type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
+
+val subst_helper : subst_tbl -> (int -> int) -> Lam.t -> Lam.t
+
+val simplify_exits : Lam.t -> Lam.t
+
+end = struct
+#1 "lam_pass_exits.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+(* Adapted for Javascript backend: Hongbo Zhang                        *)
+
+(*
+   TODO: 
+   we should have a pass called, always inlinable
+   as long as its length is smaller than [exit=exit_id], for example
+   
+   {[
+      switch(box_name)
+       {case "":exit=178;break;
+        case "b":exit=178;break;
+        case "h":box_type=/* Pp_hbox */0;break;
+        case "hov":box_type=/* Pp_hovbox */3;break;
+        case "hv":box_type=/* Pp_hvbox */2;break;
+        case "v":box_type=/* Pp_vbox */1;break;
+        default:box_type=invalid_box(/* () */0);}
+      
+      switch(exit){case 178:box_type=/* Pp_box */4;break}
+   ]}
+*)
+
+(* Count occurrences of (exit n ...) statements *)
+let count_exit exits i =
+  match 
+    (Int_hashtbl.find_opt exits i)
+  with
+  | None -> 0
+  | Some v -> !v 
+
+and incr_exit exits i =
+  Int_hashtbl.modify_or_init exits i incr (fun _ -> ref 1)
+
+
+let count_helper  (lam : Lam.t) : int ref Int_hashtbl.t  = 
+  let exits  = Int_hashtbl.create 17 in
+  let rec count (lam : Lam.t) = 
+    match lam with 
+    | Lstaticraise (i,ls) -> incr_exit exits i ; List.iter count ls
+    | Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
+      (* i will be replaced by j in l1, so each occurence of i in l1
+         increases j's ref count *)
+      count l1 ;
+      let ic = count_exit exits i in
+      Int_hashtbl.modify_or_init exits j (fun x -> x := !x + ic) (fun _ -> ref ic)
+    | Lstaticcatch(l1, (i,_), l2) ->
+      count l1;
+      (* If l1 does not contain (exit i),
+         l2 will be removed, so don't count its exits *)
+      if count_exit exits i > 0 
+      then
+        count l2
+    | Lstringswitch(l, sw, d) ->
+      count l;
+      List.iter (fun (_, l) -> count l) sw;
+      begin 
+        match  d with
+        | None -> ()
+        | Some d -> 
+          (* See https://github.com/ocaml/ocaml/commit/fcf3571123e2c914768e34f1bd17e4cbaaa7d212#diff-704f66c0fa0fc9339230b39ce7d90919 
+             might only necessary for native backend
+          *)
+          count d
+          (* begin match sw with *)
+          (* | []|[_] -> count d *)
+          (* | _ -> count d; count d (\** ASK: default will get replicated *\) *)
+          (* end *)
+      end
+    | Lvar _| Lconst _ -> ()
+    | Lapply{fn = l1; args =  ll; _} -> count l1; List.iter count ll
+    | Lfunction {body = l} -> count l
+    | Llet(_, _, l1, l2) ->
+      count l2; count l1
+    | Lletrec(bindings, body) ->
+      List.iter (fun (_, l) -> count l) bindings;
+      count body
+    | Lprim {args;  _} -> List.iter count args
+    | Lswitch(l, sw) ->
+      count_default sw ;
+      count l;
+      List.iter (fun (_, l) -> count l) sw.sw_consts;
+      List.iter (fun (_, l) -> count l) sw.sw_blocks
+    | Ltrywith(l1, v, l2) -> count l1; count l2
+    | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
+    | Lsequence(l1, l2) -> count l1; count l2
+    | Lwhile(l1, l2) -> count l1; count l2
+    | Lfor(_, l1, l2, dir, l3) -> count l1; count l2; count l3
+    | Lassign(_, l) -> count l
+    | Lsend(_, m, o, ll, _) -> count m; count o; List.iter count ll
+    | Lifused(_, l) -> count l 
+
+  and count_default sw =
+    match sw.sw_failaction with
+    | None -> ()
+    | Some al ->
+      let nconsts = List.length sw.sw_consts
+      and nblocks = List.length sw.sw_blocks in
+      if
+        nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
+      then 
+        begin (* default action will occur twice in native code *)
+          count al ; count al
+          (** 
+              Reason: for pattern match, 
+              we will  test whether it is 
+              an integer or block, both have default cases
+              predicate: [sw_numconsts] vs nconsts
+          *)
+        end 
+      else 
+        begin (* default action will occur once *)
+          assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
+          count al
+        end in 
+  count lam ; 
+  exits
+;;
+
+type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
+
+(*
+   Second pass simplify  ``catch body with (i ...) handler''
+      - if (exit i ...) does not occur in body, suppress catch
+      - if (exit i ...) occurs exactly once in body,
+        substitute it with handler
+      - If handler is a single variable, replace (exit i ..) with it
+*)
+(*
+  Note:
+    In ``catch body with (i x1 .. xn) handler''
+     Substituted expression is
+      let y1 = x1 and ... yn = xn in
+      handler[x1 <- y1 ; ... ; xn <- yn]
+     For the sake of preserving the uniqueness  of bound variables.
+   ASKS: This documentation seems outdated
+     (No alpha conversion of ``handler'' is presently needed, since
+     substitution of several ``(exit i ...)''
+     occurs only when ``handler'' is a variable.)
+*)
+
 
+let subst_helper (subst : subst_tbl) query lam = 
+  let rec simplif (lam : Lam.t) = 
+    match lam with 
+    | Lstaticraise (i,[])  ->
+      begin match Int_hashtbl.find_opt subst i with
+        | Some (_, handler) -> handler
+        | None -> lam
+      end
+    | Lstaticraise (i,ls) ->
+      let ls = List.map simplif ls in
+      begin 
+        match Int_hashtbl.find_opt subst i with
+        | Some (xs,handler) -> 
+          let ys = List.map Ident.rename xs in
+          let env =
+            List.fold_right2
+              (fun x y t -> Ident_map.add x (Lam.var y) t)
+              xs ys Ident_map.empty in
+          List.fold_right2
+            (fun y l r -> Lam.let_ Alias y l r)
+            ys ls 
+               (Lam_util.subst_lambda  env  handler)
+        | None -> Lam.staticraise i ls
+      end
+    | Lstaticcatch (l1,(i,[]),(Lstaticraise (j,[]) as l2)) ->
+      Int_hashtbl.add subst i ([],simplif l2) ;
+      simplif l1 (** l1 will inline the exit handler *)
+    | Lstaticcatch (l1,(i,xs),l2) ->
+      begin 
+        match query i, l2 with
+        | 0,_ -> simplif l1
 
-(* Wrapper for class compilation *)
+        (* Note that 
+           for [query] result = 2, 
+           the non-inline cost is 
+           {[
+             var exit ;
 
-(*
-let transl_exp = transl_exp_wrap
+             exit = 11;
+             exit = 11;
 
-let transl_let rec_flag pat_expr_list body =
-  match pat_expr_list with
-    [] -> body
-  | (_, expr) :: _ ->
-      Translobj.oo_wrap expr.exp_env false
-        (transl_let rec_flag pat_expr_list) body
-*)
+             switch(exit){
+               case exit = 11 : body ; break
+             }
 
-(* Error report *)
+           ]}
+           the inline cost is 
 
-open Format
+           {[
+             body;
+             body;
+           ]}
 
-let report_error ppf = function
-  | Illegal_letrec_pat ->
-      fprintf ppf
-        "Only variables are allowed as left-hand side of `let rec'"
-  | Illegal_letrec_expr ->
-      fprintf ppf
-        "This kind of expression is not allowed as right-hand side of `let rec'"
-  | Free_super_var ->
-      fprintf ppf
-        "Ancestor names can only be used to select inherited methods"
-  | Unknown_builtin_primitive prim_name ->
-    fprintf ppf  "Unknown builtin primitive \"%s\"" prim_name
+           when [i] is negative, we can not inline in general, 
+           since the outer is a traditional [try .. catch] body, 
+           if it is guaranteed to be non throw, then we can inline
+        *)
+        | ( _ , Lvar _
+          | _, Lconst _) ->  
+          Int_hashtbl.add subst i (xs,simplif l2) ;
+          simplif l1 (** l1 will inline *)
+        | 1,_ when i >= 0 -> (** Ask: Note that we have predicate i >=0 *)
+          Int_hashtbl.add subst i (xs,simplif l2) ;
+          simplif l1 (** l1 will inline *)
+        | j,_ ->
 
-let () =
-  Location.register_error_of_exn
-    (function
-      | Error (loc, err) ->
-          Some (Location.error_of_printer loc report_error err)
-      | _ ->
-        None
-    )
+          (** TODO: better heuristics, also if we can group same exit code [j] 
+              in a very early stage -- maybe we can define our enhanced [Lambda] 
+              representation and counter can be more precise, for example [apply] 
+              does not need patch from the compiler
+
+              FIXME:   when inlining, need refresh local bound identifiers
+          *)
+          let lam_size = Lam_analysis.size l2 in
+          let ok_to_inline = 
+             i >=0 && 
+             ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
+               || lam_size < 5)
+             (*TODO: when we do the case merging on the js side, 
+               the j is not very indicative                
+             *)             
+          in 
+          if ok_to_inline (* && false *) 
+          then 
+            begin 
+              Int_hashtbl.add subst i (xs, Lam_beta_reduce.refresh @@ simplif l2) ;
+              simplif l1 (** l1 will inline *)
+            end
+          else Lam.staticcatch (simplif l1) (i,xs) (simplif l2)
+      end
+
+    | Lvar _|Lconst _  -> lam
+    | Lapply {fn = l1; args =  ll;  loc; status } -> 
+      Lam.apply (simplif l1) (List.map simplif ll) loc status
+    | Lfunction {arity; kind; params; body =  l} -> 
+      Lam.function_ ~arity ~kind ~params ~body:(simplif l)
+    | Llet (kind, v, l1, l2) -> 
+      Lam.let_ kind v (simplif l1) (simplif l2)
+    | Lletrec (bindings, body) ->
+      Lam.letrec
+        ( List.map (fun (v, l) -> (v, simplif l)) bindings) 
+        (simplif body)
+    | Lprim {primitive; args; loc} -> 
+      let args = List.map simplif args in
+      Lam.prim ~primitive ~args loc
+    | Lswitch(l, sw) ->
+      let new_l = simplif l
+      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
+      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
+      and new_fail = Misc.may_map simplif sw.sw_failaction in
+      Lam.switch
+        new_l
+         { 
+           sw with 
+           sw_consts = new_consts ;
+           sw_blocks = new_blocks; 
+           sw_failaction = new_fail}
+    | Lstringswitch(l,sw,d) ->
+      Lam.stringswitch
+        (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
+         (Misc.may_map simplif d)
+    | Ltrywith (l1, v, l2) -> 
+      Lam.try_ (simplif l1) v (simplif l2)
+    | Lifthenelse (l1, l2, l3) -> 
+      Lam.if_ (simplif l1) (simplif l2) (simplif l3)
+    | Lsequence (l1, l2) -> Lam.seq (simplif l1) (simplif l2)
+    | Lwhile (l1, l2) -> Lam.while_ (simplif l1) (simplif l2)
+    | Lfor (v, l1, l2, dir, l3) ->
+      Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
+    | Lassign (v, l) -> 
+      Lam.assign v (simplif l)
+    | Lsend (k, m, o, ll, loc) ->
+      Lam.send k (simplif m) (simplif o) (List.map simplif ll) loc
+    | Lifused (v, l) -> 
+      Lam.ifused v (simplif l)
+  in 
+  simplif lam 
+ 
+let simplify_exits (lam : Lam.t) =
+  let exits = count_helper lam in
+  subst_helper (Int_hashtbl.create 17 ) (count_exit exits) lam
+
+(* Compile-time beta-reduction of functions immediately applied:
+      Lapply(Lfunction(Curried, params, body), args, loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+      Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) ->
+        let paramN = argN in ... let param1 = arg1 in body
+   Assumes |args| = |params|.
+*)
 
 end
-module Translclass : sig 
-#1 "translclass.mli"
+module Lam_pass_lets_dce : sig 
+#1 "lam_pass_lets_dce.mli"
 (***********************************************************************)
 (*                                                                     *)
 (*                                OCaml                                *)
 (*                                                                     *)
-(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
 (*  under the terms of the Q Public License version 1.0.               *)
 (*                                                                     *)
 (***********************************************************************)
+(* Adapted for Javascript backend: Hongbo Zhang                        *)
 
-open Typedtree
-open Lambda
+(**
+   This pass would do beta reduction, and dead code elimination (adapted from compiler's built-in [Simplif] module )
 
-val transl_class :
-  Ident.t list -> Ident.t ->
-  string list -> class_expr -> Asttypes.virtual_flag -> lambda;;
+   1. beta reduction -> Llet (Strict )
+  
+   2. The global table [occ] associates to each let-bound identifier
+   the number of its uses (as a reference):
+     - 0 if never used
+     - 1 if used exactly once in and *not under a lambda or within a loop
+     - > 1 if used several times or under a lambda or within a loop.
 
-type error = Illegal_class_expr | Tags of string * string
+   The local table [bv] associates to each locally-let-bound variable
+   its reference count, as above.  [bv] is enriched at let bindings
+   but emptied when crossing lambdas and loops. 
 
-exception Error of Location.t * error
+   For this pass, when it' used under a lambda or within a loop, we don't do anything,
+   in theory, we can still do something if it's pure but we are conservative here.
 
-open Format
+   [bv] is used to help caculate [occ] it is not useful outside
 
-val report_error: formatter -> error -> unit
+ *)
+val simplify_lets :  Lam.t -> Lam.t
 
 end = struct
-#1 "translclass.ml"
+#1 "lam_pass_lets_dce.ml"
 (***********************************************************************)
 (*                                                                     *)
 (*                                OCaml                                *)
 (*                                                                     *)
-(*         Jerome Vouillon, projet Cristal, INRIA Rocquencourt         *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
 (*  under the terms of the Q Public License version 1.0.               *)
 (*                                                                     *)
 (***********************************************************************)
+(* Adapted for Javascript backend : Hongbo Zhang,  *)
 
-open Asttypes
-open Types
-open Typedtree
-open Lambda
-open Translobj
-open Translcore
-
-(* XXX Rajouter des evenements... *)
-
-type error = Illegal_class_expr | Tags of label * label
-
-exception Error of Location.t * error
-
-let lfunction params body =
-  if params = [] then body else
-  match body with
-    Lfunction (Curried, params', body') ->
-      Lfunction (Curried, params @ params', body')
-  |  _ ->
-      Lfunction (Curried, params, body)
-
-let lapply func args loc =
-  match func with
-    Lapply(func', args', _) ->
-      Lapply(func', args' @ args, loc)
-  | _ ->
-      Lapply(func, args, loc)
-
-let mkappl (func, args) = Lapply (func, args, Location.none);;
-
-let lsequence l1 l2 =
-  if l2 = lambda_unit then l1 else Lsequence(l1, l2)
-
-let lfield v i = Lprim(Pfield (i, Fld_na), [Lvar v], Location.none)
-
-let transl_label l = share (Const_immstring l)
-
-let transl_meth_list lst =
-  if lst = [] then Lconst (Const_pointer (0, Lambda.Pt_na)) else
-  share (Const_block
-            (0, Lambda.Blk_na, List.map (fun lab -> Const_immstring lab) lst))
-
-let set_inst_var obj id expr =
-  let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
-  Lprim(Parraysetu kind, [Lvar obj; Lvar id; transl_exp expr],Location.none)
-
-let copy_inst_var obj id expr templ offset =
-  let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
-  let id' = Ident.create (Ident.name id) in
-  Llet(Strict, id', Lprim (Pidentity, [Lvar id], Location.none),
-  Lprim(Parraysetu kind,
-        [Lvar obj; Lvar id';
-         Lprim(Parrayrefu kind, [Lvar templ; Lprim(Paddint,
-                                                   [Lvar id';
-                                                    Lvar offset], Location.none)], Location.none)], Location.none))
-
-let transl_val tbl create name =
-  mkappl (oo_prim (if create then "new_variable" else "get_variable"),
-          [Lvar tbl; transl_label name])
-
-let transl_vals tbl create strict vals rem =
-  List.fold_right
-    (fun (name, id) rem ->
-      Llet(strict, id, transl_val tbl create name, rem))
-    vals rem
-
-let meths_super tbl meths inh_meths =
-  List.fold_right
-    (fun (nm, id) rem ->
-       try
-         (nm, id,
-          mkappl(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
-         :: rem
-       with Not_found -> rem)
-    inh_meths []
-
-let bind_super tbl (vals, meths) cl_init =
-  transl_vals tbl false StrictOpt vals
-    (List.fold_right (fun (nm, id, def) rem -> Llet(StrictOpt, id, def, rem))
-       meths cl_init)
-
-let create_object cl obj init =
-  let obj' = Ident.create "self" in
-  let (inh_init, obj_init, has_init) = init obj' in
-  if obj_init = lambda_unit then
-    (inh_init,
-     mkappl (oo_prim (if has_init then "create_object_and_run_initializers"
-                      else"create_object_opt"),
-             [obj; Lvar cl]))
-  else begin
-   (inh_init,
-    Llet(Strict, obj',
-            mkappl (oo_prim "create_object_opt", [obj; Lvar cl]),
-         Lsequence(obj_init,
-                   if not has_init then Lvar obj' else
-                   mkappl (oo_prim "run_initializers_opt",
-                           [obj; Lvar obj'; Lvar cl]))))
-  end
-
-let name_pattern default p =
-  match p.pat_desc with
-  | Tpat_var (id, _) -> id
-  | Tpat_alias(p, id, _) -> id
-  | _ -> Ident.create default
-
-let normalize_cl_path cl path =
-  Env.normalize_path (Some cl.cl_loc) cl.cl_env path
-
-let rec build_object_init cl_table obj params inh_init obj_init cl =
-  match cl.cl_desc with
-    Tcl_ident ( path, _, _) ->
-      let obj_init = Ident.create "obj_init" in
-      let envs, inh_init = inh_init in
-      let env =
-        match envs with None -> []
-        | Some envs -> [Lprim(Pfield (List.length inh_init + 1, Fld_na), [Lvar envs], Location.none)]
-      in
-      ((envs, (obj_init, normalize_cl_path cl path)
-        ::inh_init),
-       mkappl(Lvar obj_init, env @ [obj]))
-  | Tcl_structure str ->
-      create_object cl_table obj (fun obj ->
-        let (inh_init, obj_init, has_init) =
-          List.fold_right
-            (fun field (inh_init, obj_init, has_init) ->
-               match field.cf_desc with
-                 Tcf_inherit (_, cl, _, _, _) ->
-                   let (inh_init, obj_init') =
-                     build_object_init cl_table (Lvar obj) [] inh_init
-                       (fun _ -> lambda_unit) cl
-                   in
-                   (inh_init, lsequence obj_init' obj_init, true)
-               | Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
-                   (inh_init, lsequence (set_inst_var obj id exp) obj_init,
-                    has_init)
-               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _->
-                   (inh_init, obj_init, has_init)
-               | Tcf_initializer _ ->
-                   (inh_init, obj_init, true)
-            )
-            str.cstr_fields
-            (inh_init, obj_init obj, false)
-        in
-        (inh_init,
-         List.fold_right
-           (fun (id, expr) rem ->
-              lsequence (Lifused (id, set_inst_var obj id expr)) rem)
-           params obj_init,
-         has_init))
-  | Tcl_fun (_, pat, vals, cl, partial) ->
-      let vals = List.map (fun (id, _, e) -> id,e) vals in
-      let (inh_init, obj_init) =
-        build_object_init cl_table obj (vals @ params) inh_init obj_init cl
-      in
-      (inh_init,
-       let build params rem =
-         let param = name_pattern "param" pat in
-         Lfunction (Curried, param::params,
-                    Matching.for_function
-                      pat.pat_loc None (Lvar param) [pat, rem] partial)
-       in
-       begin match obj_init with
-         Lfunction (Curried, params, rem) -> build params rem
-       | rem                              -> build [] rem
-       end)
-  | Tcl_apply (cl, oexprs) ->
-      let (inh_init, obj_init) =
-        build_object_init cl_table obj params inh_init obj_init cl
-      in
-      (inh_init, transl_apply obj_init oexprs Location.none)
-  | Tcl_let (rec_flag, defs, vals, cl) ->
-      let vals = List.map (fun (id, _, e) -> id,e) vals in
-      let (inh_init, obj_init) =
-        build_object_init cl_table obj (vals @ params) inh_init obj_init cl
-      in
-      (inh_init, Translcore.transl_let rec_flag defs obj_init)
-  | Tcl_constraint (cl, _, vals, pub_meths, concr_meths) ->
-      build_object_init cl_table obj params inh_init obj_init cl
-
-let rec build_object_init_0 cl_table params cl copy_env subst_env top ids =
-  match cl.cl_desc with
-    Tcl_let (rec_flag, defs, vals, cl) ->
-      let vals = List.map (fun (id, _, e) -> id,e) vals in
-      build_object_init_0 cl_table (vals@params) cl copy_env subst_env top ids
-  | _ ->
-      let self = Ident.create "self" in
-      let env = Ident.create "env" in
-      let obj = if ids = [] then lambda_unit else Lvar self in
-      let envs = if top then None else Some env in
-      let ((_,inh_init), obj_init) =
-        build_object_init cl_table obj params (envs,[]) (copy_env env) cl in
-      let obj_init =
-        if ids = [] then obj_init else lfunction [self] obj_init in
-      (inh_init, lfunction [env] (subst_env env inh_init obj_init))
-
-
-let bind_method tbl lab id cl_init =
-  Llet(Strict, id, mkappl (oo_prim "get_method_label",
-                           [Lvar tbl; transl_label lab]),
-       cl_init)
-
-let bind_methods tbl meths vals cl_init =
-  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
-  let len = List.length methl and nvals = List.length vals in
-  if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
-  if len = 0 && nvals < 2 then transl_vals tbl true Strict vals cl_init else
-  let ids = Ident.create "ids" in
-  let i = ref (len + nvals) in
-  let getter, names =
-    if nvals = 0 then "get_method_labels", [] else
-    "new_methods_variables", [transl_meth_list (List.map fst vals)]
-  in
-  Llet(Strict, ids,
-       mkappl (oo_prim getter,
-               [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
-       List.fold_right
-         (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
-         (methl @ vals) cl_init)
-
-let output_methods tbl methods lam =
-  match methods with
-    [] -> lam
-  | [lab; code] ->
-      lsequence (mkappl(oo_prim "set_method", [Lvar tbl; lab; code])) lam
-  | _ ->
-      lsequence (mkappl(oo_prim "set_methods",
-                        [Lvar tbl; Lprim(Pmakeblock(0, Lambda.Blk_array, Immutable), methods, Location.none)]))
-        lam
 
-let rec ignore_cstrs cl =
-  match cl.cl_desc with
-    Tcl_constraint (cl, _, _, _, _) -> ignore_cstrs cl
-  | Tcl_apply (cl, _) -> ignore_cstrs cl
-  | _ -> cl
+open Asttypes
 
-let rec index a = function
-    [] -> raise Not_found
-  | b :: l ->
-      if b = a then 0 else 1 + index a l
+exception Real_reference
 
-let bind_id_as_val (id, _, _) = ("", id)
+let rec eliminate_ref id (lam : Lam.t) = 
+  match lam with  (** we can do better escape analysis in Javascript backend *)
+  | Lvar v ->
+    if Ident.same v id then raise Real_reference else lam
+  | Lprim {primitive = Pfield (0,_); args =  [Lvar v]} when Ident.same v id ->
+    Lam.var id
+  | Lfunction{ kind; params; body} as lam ->
+    if Ident_set.mem id (Lam.free_variables  lam)
+    then raise Real_reference
+    else lam
+  (* In Javascript backend, its okay, we can reify it later
+     a failed case 
+     {[
+       for i = .. 
+           let v = ref 0 
+               for j = .. 
+                   incr v 
+                     a[j] = ()=>{!v}
 
-let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
-  match cl.cl_desc with
-    Tcl_ident ( path, _, _) ->
-      begin match inh_init with
-        (obj_init, path')::inh_init ->
-          let lpath = transl_path ~loc:cl.cl_loc cl.cl_env path in
-          (inh_init,
-           Llet (Strict, obj_init,
-                 mkappl(Lprim(Pfield (1, Fld_na), [lpath], Location.none), Lvar cla ::
-                        if top then [Lprim(Pfield (3, Fld_na), [lpath], Location.none)] else []),
-                 bind_super cla super cl_init))
-      | _ ->
-          assert false
-      end
-  | Tcl_structure str ->
-      let cl_init = bind_super cla super cl_init in
-      let (inh_init, cl_init, methods, values) =
-        List.fold_right
-          (fun field (inh_init, cl_init, methods, values) ->
-            match field.cf_desc with
-              Tcf_inherit (_, cl, _, vals, meths) ->
-                let cl_init = output_methods cla methods cl_init in
-                let inh_init, cl_init =
-                  build_class_init cla false
-                    (vals, meths_super cla str.cstr_meths meths)
-                    inh_init cl_init msubst top cl in
-                (inh_init, cl_init, [], values)
-            | Tcf_val (name, _, id, _, over) ->
-                let values =
-                  if over then values else (name.txt, id) :: values
-                in
-                (inh_init, cl_init, methods, values)
-            | Tcf_method (_, _, Tcfk_virtual _)
-            | Tcf_constraint _
-              ->
-                (inh_init, cl_init, methods, values)
-            | Tcf_method (name, _, Tcfk_concrete (_, exp)) ->
-                let met_code = msubst true (transl_exp exp) in
-                let met_code =
-                  if !Clflags.native_code && List.length met_code = 1 then
-                    (* Force correct naming of method for profiles *)
-                    let met = Ident.create ("method_" ^ name.txt) in
-                    [Llet(Strict, met, List.hd met_code, Lvar met)]
-                  else met_code
-                in
-                (inh_init, cl_init,
-                 Lvar(Meths.find name.txt str.cstr_meths) :: met_code @ methods,
-                 values)
-            | Tcf_initializer exp ->
-                (inh_init,
-                 Lsequence(mkappl (oo_prim "add_initializer",
-                                   Lvar cla :: msubst false (transl_exp exp)),
-                           cl_init),
-                 methods, values)
-            | Tcf_attribute _ ->
-                (inh_init, cl_init, methods, values))
-          str.cstr_fields
-          (inh_init, cl_init, [], [])
-      in
-      let cl_init = output_methods cla methods cl_init in
-      (inh_init, bind_methods cla str.cstr_meths values cl_init)
-  | Tcl_fun (_, pat, vals, cl, _) ->
-      let (inh_init, cl_init) =
-        build_class_init cla cstr super inh_init cl_init msubst top cl
-      in
-      let vals = List.map bind_id_as_val vals in
-      (inh_init, transl_vals cla true StrictOpt vals cl_init)
-  | Tcl_apply (cl, exprs) ->
-      build_class_init cla cstr super inh_init cl_init msubst top cl
-  | Tcl_let (rec_flag, defs, vals, cl) ->
-      let (inh_init, cl_init) =
-        build_class_init cla cstr super inh_init cl_init msubst top cl
-      in
-      let vals = List.map bind_id_as_val vals in
-      (inh_init, transl_vals cla true StrictOpt vals cl_init)
-  | Tcl_constraint (cl, _, vals, meths, concr_meths) ->
-      let virt_meths =
-        List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
-      let concr_meths = Concr.elements concr_meths in
-      let narrow_args =
-        [Lvar cla;
-         transl_meth_list vals;
-         transl_meth_list virt_meths;
-         transl_meth_list concr_meths] in
-      let cl = ignore_cstrs cl in
-      begin match cl.cl_desc, inh_init with
-        Tcl_ident (path, _, _), (obj_init, path')::inh_init ->
-          assert (Path.same (normalize_cl_path cl path) path');
-          let lpath = transl_normal_path path' in
-          let inh = Ident.create "inh"
-          and ofs = List.length vals + 1
-          and valids, methids = super in
-          let cl_init =
-            List.fold_left
-              (fun init (nm, id, _) ->
-                Llet(StrictOpt, id, lfield inh (index nm concr_meths + ofs),
-                     init))
-              cl_init methids in
-          let cl_init =
-            List.fold_left
-              (fun init (nm, id) ->
-                Llet(StrictOpt, id, lfield inh (index nm vals + 1), init))
-              cl_init valids in
-          (inh_init,
-           Llet (Strict, inh,
-                 mkappl(oo_prim "inherits", narrow_args @
-                        [lpath; Lconst(Const_pointer ((if top then 1 else 0), Lambda.Pt_na))]),
-                 Llet(StrictOpt, obj_init, lfield inh 0, cl_init)))
-      | _ ->
-          let core cl_init =
-            build_class_init cla true super inh_init cl_init msubst top cl
-          in
-          if cstr then core cl_init else
-          let (inh_init, cl_init) =
-            core (Lsequence (mkappl (oo_prim "widen", [Lvar cla]), cl_init))
-          in
-          (inh_init,
-           Lsequence(mkappl (oo_prim "narrow", narrow_args),
-                     cl_init))
-      end
+     ]}
+     here v is captured by a block, and it's a loop mutable value,
+     we have to generate 
+     {[
+       for i = .. 
+           let v = ref 0 
+               (function (v){for j = .. 
+                                   a[j] = ()=>{!v}}(v)
 
-let rec build_class_lets cl ids =
-  match cl.cl_desc with
-    Tcl_let (rec_flag, defs, vals, cl') ->
-      let env, wrap = build_class_lets cl' [] in
-      (env, fun x ->
-        let lam = Translcore.transl_let rec_flag defs (wrap x) in
-        (* Check recursion in toplevel let-definitions *)
-        if ids = [] || Translcore.check_recursive_lambda ids lam then lam
-        else raise(Error(cl.cl_loc, Illegal_class_expr)))
-  | _ ->
-      (cl.cl_env, fun x -> x)
+     ]}
+     now, v is a real reference 
+     TODO: we can refine analysis in later
+  *)
+  (* Lfunction(kind, params, eliminate_ref id body) *)
+  | Lprim {primitive = Psetfield(0, _,_); 
+           args =  [Lvar v; e]} when Ident.same v id ->
+    Lam.assign id (eliminate_ref id e)
+  | Lprim {primitive = Poffsetref delta ; 
+           args =  [Lvar v]; loc } when Ident.same v id ->
+    Lam.assign id (Lam.prim ~primitive:(Poffsetint delta) ~args:[Lam.var id] loc)
+  | Lconst _  -> lam
+  | Lapply{fn = e1; args =  el;  loc; status} ->
+    Lam.apply 
+      (eliminate_ref id e1)
+      (List.map (eliminate_ref id) el)
+      loc status
+  | Llet(str, v, e1, e2) ->
+    Lam.let_ str v (eliminate_ref id e1) (eliminate_ref id e2)
+  | Lletrec(idel, e2) ->
+    Lam.letrec
+      (List.map (fun (v, e) -> (v, eliminate_ref id e)) idel)
+      (eliminate_ref id e2)
+  | Lprim {primitive ; args ; loc} ->
+    Lam.prim  ~primitive ~args:(List.map (eliminate_ref id) args) loc
+  | Lswitch(e, sw) ->
+    Lam.switch(eliminate_ref id e)
+            {sw_numconsts = sw.sw_numconsts;
+             sw_consts =
+               List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_consts;
+             sw_numblocks = sw.sw_numblocks;
+             sw_blocks =
+               List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
+             sw_failaction =
+               Misc.may_map (eliminate_ref id) sw.sw_failaction; }
+  | Lstringswitch(e, sw, default) ->
+    Lam.stringswitch
+      (eliminate_ref id e)
+      (List.map (fun (s, e) -> (s, eliminate_ref id e)) sw)
+      (Misc.may_map (eliminate_ref id) default)
+  | Lstaticraise (i,args) ->
+    Lam.staticraise i (List.map (eliminate_ref id) args)
+  | Lstaticcatch(e1, i, e2) ->
+    Lam.staticcatch (eliminate_ref id e1) i (eliminate_ref id e2)
+  | Ltrywith(e1, v, e2) ->
+    Lam.try_ (eliminate_ref id e1) v (eliminate_ref id e2)
+  | Lifthenelse(e1, e2, e3) ->
+    Lam.if_ (eliminate_ref id e1) (eliminate_ref id e2) (eliminate_ref id e3)
+  | Lsequence(e1, e2) ->
+    Lam.seq (eliminate_ref id e1) (eliminate_ref id e2)
+  | Lwhile(e1, e2) ->
+    Lam.while_ (eliminate_ref id e1) (eliminate_ref id e2)
+  | Lfor(v, e1, e2, dir, e3) ->
+    Lam.for_ v
+      (eliminate_ref id e1) 
+      (eliminate_ref id e2)
+      dir
+      (eliminate_ref id e3)
+  | Lassign(v, e) ->
+    Lam.assign v (eliminate_ref id e)
+  | Lsend(k, m, o, el, loc) ->
+    Lam.send k 
+      (eliminate_ref id m) (eliminate_ref id o)
+      (List.map (eliminate_ref id) el) loc
+  | Lifused(v, e) ->
+    Lam.ifused v (eliminate_ref id e)
 
-let rec get_class_meths cl =
-  match cl.cl_desc with
-    Tcl_structure cl ->
-      Meths.fold (fun _ -> IdentSet.add) cl.cstr_meths IdentSet.empty
-  | Tcl_ident _ -> IdentSet.empty
-  | Tcl_fun (_, _, _, cl, _)
-  | Tcl_let (_, _, _, cl)
-  | Tcl_apply (cl, _)
-  | Tcl_constraint (cl, _, _, _, _) -> get_class_meths cl
+(*A naive dead code elimination *)
+type used_info = { 
+  mutable times : int ; 
+  mutable captured : bool;
+    (* captured in functon or loop, 
+       inline in such cases should be careful
+       1. can not inline mutable values
+       2. avoid re-computation 
+    *)
+}
 
-(*
-   XXX Il devrait etre peu couteux d'ecrire des classes :
-     class c x y = d e f
-*)
-let rec transl_class_rebind obj_init cl vf =
-  match cl.cl_desc with
-    Tcl_ident (path, _, _) ->
-      if vf = Concrete then begin
-        try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit
-        with Not_found -> raise Exit
-      end;
-      (normalize_cl_path cl path, obj_init)
-  | Tcl_fun (_, pat, _, cl, partial) ->
-      let path, obj_init = transl_class_rebind obj_init cl vf in
-      let build params rem =
-        let param = name_pattern "param" pat in
-        Lfunction (Curried, param::params,
-                   Matching.for_function
-                     pat.pat_loc None (Lvar param) [pat, rem] partial)
-      in
-      (path,
-       match obj_init with
-         Lfunction (Curried, params, rem) -> build params rem
-       | rem                              -> build [] rem)
-  | Tcl_apply (cl, oexprs) ->
-      let path, obj_init = transl_class_rebind obj_init cl vf in
-      (path, transl_apply obj_init oexprs Location.none)
-  | Tcl_let (rec_flag, defs, vals, cl) ->
-      let path, obj_init = transl_class_rebind obj_init cl vf in
-      (path, Translcore.transl_let rec_flag defs obj_init)
-  | Tcl_structure _ -> raise Exit
-  | Tcl_constraint (cl', _, _, _, _) ->
-      let path, obj_init = transl_class_rebind obj_init cl' vf in
-      let rec check_constraint = function
-          Cty_constr(path', _, _) when Path.same path path' -> ()
-        | Cty_arrow (_, _, cty) -> check_constraint cty
-        | _ -> raise Exit
-      in
-      check_constraint cl.cl_type;
-      (path, obj_init)
+type occ_tbl  = used_info Ident_hashtbl.t
+(* First pass: count the occurrences of all let-bound identifiers *)
 
-let rec transl_class_rebind_0 self obj_init cl vf =
-  match cl.cl_desc with
-    Tcl_let (rec_flag, defs, vals, cl) ->
-      let path, obj_init = transl_class_rebind_0 self obj_init cl vf in
-      (path, Translcore.transl_let rec_flag defs obj_init)
-  | _ ->
-      let path, obj_init = transl_class_rebind obj_init cl vf in
-      (path, lfunction [self] obj_init)
+type local_tbl = used_info  Ident_map.t
 
-let transl_class_rebind ids cl vf =
-  try
-    let obj_init = Ident.create "obj_init"
-    and self = Ident.create "self" in
-    let obj_init0 = lapply (Lvar obj_init) [Lvar self] Location.none in
-    let path, obj_init' = transl_class_rebind_0 self obj_init0 cl vf in
-    if not (Translcore.check_recursive_lambda ids obj_init') then
-      raise(Error(cl.cl_loc, Illegal_class_expr));
-    let id = (obj_init' = lfunction [self] obj_init0) in
-    if id then transl_normal_path path else
+let dummy_info () = {times =  0 ; captured = false }
+(* y is untouched *)
 
-    let cla = Ident.create "class"
-    and new_init = Ident.create "new_init"
-    and env_init = Ident.create "env_init"
-    and table = Ident.create "table"
-    and envs = Ident.create "envs" in
-    Llet(
-    Strict, new_init, lfunction [obj_init] obj_init',
-    Llet(
-    Alias, cla, transl_normal_path path,
-    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-          [mkappl(Lvar new_init, [lfield cla 0]);
-           lfunction [table]
-             (Llet(Strict, env_init,
-                   mkappl(lfield cla 1, [Lvar table]),
-                   lfunction [envs]
-                     (mkappl(Lvar new_init,
-                             [mkappl(Lvar env_init, [Lvar envs])]))));
-           lfield cla 2;
-           lfield cla 3], Location.none)))
-  with Exit ->
-    lambda_unit
+let absorb_info (x : used_info) (y : used_info) = 
+  match x, y with
+  | {times = x0} , {times = y0; captured } -> 
+    x.times <- x0 + y0;
+    if captured then x.captured <- true
 
-(* Rewrite a closure using builtins. Improves native code size. *)
+let lets_helper (count_var : Ident.t -> used_info) lam = 
+  let subst : Lam.t Ident_hashtbl.t = Ident_hashtbl.create 31 in
+  let used v = (count_var v ).times > 0 in
+  let rec simplif (lam : Lam.t) = 
+    match lam with 
+    | Lvar v  -> Ident_hashtbl.find_default subst v lam 
+    | Llet( (Strict | Alias | StrictOpt) , v, Lvar w, l2) 
+      ->
+      Ident_hashtbl.add subst v (simplif (Lam.var w));
+      simplif l2
+    | Llet((Strict | StrictOpt as kind) ,
+           v, (Lprim {primitive = (Pmakeblock(0, tag_info, Mutable) 
+                                   as primitive); 
+                      args = [linit] ; loc}), lbody)
+      ->
+      let slinit = simplif linit in
+      let slbody = simplif lbody in
+      begin 
+        try (** TODO: record all references variables *)
+          Lam_util.refine_let
+            ~kind:Variable v slinit (eliminate_ref v slbody)
+        with Real_reference ->
+          Lam_util.refine_let 
+            ~kind v (Lam.prim ~primitive ~args:[slinit] loc)
+            slbody
+      end
+    | Llet(Alias, v, l1, l2) ->
+      (** For alias, [l1] is pure, we can always inline,
+          when captured, we should avoid recomputation
+      *)
+      begin 
+        match count_var v, l1  with
+        | {times = 0; _}, _  -> simplif l2 
+        | {times = 1; captured = false }, _ 
+        | {times = 1; captured = true }, (Lconst _ | Lvar _)
+        |  _, (Lconst 
+                 (Const_base (
+                     Const_int _ | Const_char _ | Const_float _ | Const_int32 _ 
+                     | Const_nativeint _ )
+                 | Const_pointer _ ) (* could be poly-variant [`A] -> [65a]*)
+              | Lprim {primitive = Pfield (_);
+                       args = [Lprim {primitive = Pgetglobal _;  _}]}
+            ) 
+          (* Const_int64 is no longer primitive
+             Note for some constant which is not 
+             inlined, we can still record it and
+             do constant folding independently              
+          *)
+          ->
+          Ident_hashtbl.add subst v (simplif l1); simplif l2
+        | _ -> Lam.let_ Alias v (simplif l1) (simplif l2)
+      end
+    | Llet(StrictOpt as kind, v, l1, l2) ->
+      (** can not be inlined since [l1] depend on the store
+          {[
+            let v = [|1;2;3|]
+          ]}
+          get [StrictOpt] here,  we can not inline v, 
+          since the value of [v] can be changed
+      *)
+      if not @@ used v 
+      then simplif l2
+      else Lam_util.refine_let ~kind v (simplif l1 ) (simplif l2)
+    (* TODO: check if it is correct rollback to [StrictOpt]? *)
 
-let rec module_path = function
-    Lvar id ->
-      let s = Ident.name id in s <> "" && s.[0] >= 'A' && s.[0] <= 'Z'
-  | Lprim(Pfield _, [p], _)    -> module_path p
-  | Lprim(Pgetglobal _, [], _) -> true
-  | _                       -> false
+    | Llet((Strict | Variable as kind), v, l1, l2) -> 
+      if not @@ used v 
+      then
+        let l1 = simplif l1 in
+        let l2 = simplif l2 in
+        if Lam_analysis.no_side_effects l1 
+        then l2 
+        else Lam.seq l1 l2
+      else Lam_util.refine_let ~kind v (simplif l1) (simplif l2)
 
-let const_path local = function
-    Lvar id -> not (List.mem id local)
-  | Lconst _ -> true
-  | Lfunction (Curried, _, body) ->
-      let fv = free_variables body in
-      List.for_all (fun x -> not (IdentSet.mem x fv)) local
-  | p -> module_path p
+    | Lifused(v, l) ->
+      if used  v then
+        simplif l
+      else Lam.unit
+    | Lsequence(Lifused(v, l1), l2) ->
+      if used v 
+      then Lam.seq (simplif l1) (simplif l2)
+      else simplif l2
+    | Lsequence(l1, l2) -> Lam.seq (simplif l1) (simplif l2)
 
-let rec builtin_meths self env env2 body =
-  let const_path = const_path (env::self) in
-  let conv = function
-    (* Lvar s when List.mem s self ->  "_self", [] *)
-    | p when const_path p -> "const", [p]
-    | Lprim(Parrayrefu _, [Lvar s; Lvar n], _) when List.mem s self ->
-        "var", [Lvar n]
-    | Lprim(Pfield (n,_), [Lvar e], _) when Ident.same e env ->
-        "env", [Lvar env2; Lconst(Const_pointer (n, Lambda.Pt_na))]
-    | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
-        "meth", [met]
-    | _ -> raise Not_found
-  in
-  match body with
-  | Llet(_, s', Lvar s, body) when List.mem s self ->
-      builtin_meths (s'::self) env env2 body
-  | Lapply(f, [arg], _) when const_path f ->
-      let s, args = conv arg in ("app_"^s, f :: args)
-  | Lapply(f, [arg; p], _) when const_path f && const_path p ->
-      let s, args = conv arg in
-      ("app_"^s^"_const", f :: args @ [p])
-  | Lapply(f, [p; arg], _) when const_path f && const_path p ->
-      let s, args = conv arg in
-      ("app_const_"^s, f :: p :: args)
-  | Lsend(Self, Lvar n, Lvar s, [arg], _) when List.mem s self ->
-      let s, args = conv arg in
-      ("meth_app_"^s, Lvar n :: args)
-  | Lsend(Self, met, Lvar s, [], _) when List.mem s self ->
-      ("get_meth", [met])
-  | Lsend(Public _, met, arg, [], _) ->
-      let s, args = conv arg in
-      ("send_"^s, met :: args)
-  | Lsend(Cached, met, arg, [_;_], _) ->
-      let s, args = conv arg in
-      ("send_"^s, met :: args)
-  | Lfunction (Curried, [x], body) ->
-      let rec enter self = function
-        | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'], _)
-          when Ident.same x x' && List.mem s self ->
-            ("set_var", [Lvar n])
-        | Llet(_, s', Lvar s, body) when List.mem s self ->
-            enter (s'::self) body
-        | _ -> raise Not_found
-      in enter self body
-  | Lfunction _ -> raise Not_found
-  | _ ->
-      let s, args = conv body in ("get_"^s, args)
+    | Lapply{fn = Lfunction{kind =  Curried; params; body};  args; _}
+      when  Ext_list.same_length params args ->
+      simplif (Lam_beta_reduce.beta_reduce  params body args)
+    | Lapply{ fn = Lfunction{kind = Tupled; params; body};
+             args = [Lprim {primitive = Pmakeblock _;  args; _}]; _}
+      (** TODO: keep track of this parameter in ocaml trunk,
+          can we switch to the tupled backend?
+      *)
+      when  Ext_list.same_length params  args ->
+      simplif (Lam_beta_reduce.beta_reduce params body args)
 
-module M = struct
-  open CamlinternalOO
-  let builtin_meths self env env2 body =
-    let builtin, args = builtin_meths self env env2 body in
-    (* if not arr then [mkappl(oo_prim builtin, args)] else *)
-    let tag = match builtin with
-      "get_const" -> GetConst
-    | "get_var"   -> GetVar
-    | "get_env"   -> GetEnv
-    | "get_meth"  -> GetMeth
-    | "set_var"   -> SetVar
-    | "app_const" -> AppConst
-    | "app_var"   -> AppVar
-    | "app_env"   -> AppEnv
-    | "app_meth"  -> AppMeth
-    | "app_const_const" -> AppConstConst
-    | "app_const_var"   -> AppConstVar
-    | "app_const_env"   -> AppConstEnv
-    | "app_const_meth"  -> AppConstMeth
-    | "app_var_const"   -> AppVarConst
-    | "app_env_const"   -> AppEnvConst
-    | "app_meth_const"  -> AppMethConst
-    | "meth_app_const"  -> MethAppConst
-    | "meth_app_var"    -> MethAppVar
-    | "meth_app_env"    -> MethAppEnv
-    | "meth_app_meth"   -> MethAppMeth
-    | "send_const" -> SendConst
-    | "send_var"   -> SendVar
-    | "send_env"   -> SendEnv
-    | "send_meth"  -> SendMeth
-    | _ -> assert false
-    in Lconst(Const_pointer(Obj.magic tag, Lambda.Pt_na)) :: args
-end
-open M
+    | Lapply{fn = l1;args =  ll; loc; status} -> 
+      Lam.apply (simplif l1) (List.map simplif ll) loc status
+    | Lfunction{arity; kind; params; body = l} ->
+      Lam.function_ ~arity ~kind ~params ~body:(simplif l)
+    | Lconst _ -> lam
+    | Lletrec(bindings, body) ->
+      Lam.letrec 
+        (List.map (fun (v, l) -> (v, simplif l)) bindings) 
+        (simplif body)
+    | Lprim {primitive; args; loc} 
+      -> Lam.prim ~primitive ~args:(List.map simplif args) loc
+    | Lswitch(l, sw) ->
+      let new_l = simplif l
+      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
+      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
+      and new_fail = Misc.may_map simplif sw.sw_failaction in
+      Lam.switch
+        new_l
+        {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
+                 sw_failaction = new_fail}
+    | Lstringswitch (l,sw,d) ->
+      Lam.stringswitch
+        (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
+         (Misc.may_map simplif d)
+    | Lstaticraise (i,ls) ->
+      Lam.staticraise i (List.map simplif ls)
+    | Lstaticcatch(l1, (i,args), l2) ->
+      Lam.staticcatch (simplif l1) (i,args) (simplif l2)
+    | Ltrywith(l1, v, l2) -> Lam.try_ (simplif l1) v (simplif l2)
+    | Lifthenelse(l1, l2, l3) -> 
+      Lam.if_ (simplif l1) (simplif l2) (simplif l3)
+    | Lwhile(l1, l2) 
+      -> 
+      Lam.while_ (simplif l1) (simplif l2)
+    | Lfor(v, l1, l2, dir, l3) ->
+      Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
+    | Lassign(v, l) -> Lam.assign v (simplif l)
+    | Lsend(k, m, o, ll, loc) ->
+      Lam.send k (simplif m) (simplif o) (List.map simplif ll) loc
+  in simplif lam ;;
 
 
-(*
-   Traduction d'une classe.
-   Plusieurs cas:
-    * reapplication d'une classe connue -> transl_class_rebind
-    * classe sans dependances locales -> traduction directe
-    * avec dependances locale -> creation d'un arbre de stubs,
-      avec un noeud pour chaque classe locale heritee
-   Une classe est un 4-uplet:
-    (obj_init, class_init, env_init, env)
-    obj_init: fonction de creation d'objet (unit -> obj)
-    class_init: fonction d'heritage (table -> env_init)
-      (une seule par code source)
-    env_init: parametrage par l'environnement local (env -> params -> obj_init)
-      (une par combinaison de class_init herites)
-    env: environnement local
-   Si ids=0 (objet immediat), alors on ne conserve que env_init.
-*)
+(* To transform let-bound references into variables *)
+let apply_lets  occ lambda = 
+  let count_var v =
+    match
+      Ident_hashtbl.find_opt occ v 
+    with
+    | None -> dummy_info ()
+    | Some  v -> v in
+  lets_helper count_var lambda      
 
-let prerr_ids msg ids =
-  let names = List.map Ident.unique_toplevel_name ids in
-  prerr_endline (String.concat " " (msg :: names))
+let collect_occurs  lam : occ_tbl =
+  let occ : occ_tbl = Ident_hashtbl.create 83 in
+  (* The global table [occ] associates to each let-bound identifier
+     the number of its uses (as a reference):
+     - 0 if never used
+     - 1 if used exactly once in and not under a lambda or within a loop
+         - when under a lambda, 
+         - it's probably a closure
+         - within a loop
+         - update reference,
+         niether is good for inlining
+     - > 1 if used several times or under a lambda or within a loop.
+     The local table [bv] associates to each locally-let-bound variable
+     its reference count, as above.  [bv] is enriched at let bindings
+     but emptied when crossing lambdas and loops. *)
 
-let transl_class ids cl_id pub_meths cl vflag =
-  (* First check if it is not only a rebind *)
-  let rebind = transl_class_rebind ids cl vflag in
-  if rebind <> lambda_unit then rebind else
+  (* Current use count of a variable. *)
+  let used v = 
+    match Ident_hashtbl.find_opt occ v with 
+    | None -> false 
+    | Some {times ; _} -> times > 0  in
 
-  (* Prepare for heavy environment handling *)
-  let tables = Ident.create (Ident.name cl_id ^ "_tables") in
-  let (top_env, req) = oo_add_class tables in
-  let top = not req in
-  let cl_env, llets = build_class_lets cl ids in
-  let new_ids = if top then [] else Env.diff top_env cl_env in
-  let env2 = Ident.create "env" in
-  let meth_ids = get_class_meths cl in
-  let subst env lam i0 new_ids' =
-    let fv = free_variables lam in
-    (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (IdentSet.elements fv); *)
-    let fv = List.fold_right IdentSet.remove !new_ids' fv in
-    (* We need to handle method ids specially, as they do not appear
-       in the typing environment (PR#3576, PR#4560) *)
-    (* very hacky: we add and remove free method ids on the fly,
-       depending on the visit order... *)
-    method_ids :=
-      IdentSet.diff (IdentSet.union (free_methods lam) !method_ids) meth_ids;
-    (* prerr_ids "meth_ids =" (IdentSet.elements meth_ids);
-       prerr_ids "method_ids =" (IdentSet.elements !method_ids); *)
-    let new_ids = List.fold_right IdentSet.add new_ids !method_ids in
-    let fv = IdentSet.inter fv new_ids in
-    new_ids' := !new_ids' @ IdentSet.elements fv;
-    (* prerr_ids "new_ids' =" !new_ids'; *)
-    let i = ref (i0-1) in
-    List.fold_left
-      (fun subst id ->
-        incr i; Ident.add id (lfield env !i)  subst)
-      Ident.empty !new_ids'
-  in
-  let new_ids_meths = ref [] in
-  let msubst arr = function
-      Lfunction (Curried, self :: args, body) ->
-        let env = Ident.create "env" in
-        let body' =
-          if new_ids = [] then body else
-          subst_lambda (subst env body 0 new_ids_meths) body in
-        begin try
-          (* Doesn't seem to improve size for bytecode *)
-          (* if not !Clflags.native_code then raise Not_found; *)
-          if not arr || !Clflags.debug then raise Not_found;
-          builtin_meths [self] env env2 (lfunction args body')
-        with Not_found ->
-          [lfunction (self :: args)
-             (if not (IdentSet.mem env (free_variables body')) then body' else
-              Llet(Alias, env,
-                   Lprim(Parrayrefu Paddrarray,
-                         [Lvar self; Lvar env2], Location.none), body'))]
-        end
-      | _ -> assert false
-  in
-  let new_ids_init = ref [] in
-  let env1 = Ident.create "env" and env1' = Ident.create "env'" in
-  let copy_env envs self =
-    if top then lambda_unit else
-    Lifused(env2, Lprim(Parraysetu Paddrarray,
-                        [Lvar self; Lvar env2; Lvar env1'], Location.none))
-  and subst_env envs l lam =
-    if top then lam else
-    (* must be called only once! *)
-    let lam = subst_lambda (subst env1 lam 1 new_ids_init) lam in
-    Llet(Alias, env1, (if l = [] then Lvar envs else lfield envs 0),
-    Llet(Alias, env1',
-         (if !new_ids_init = [] then Lvar env1 else lfield env1 0),
-         lam))
-  in
+  (* Entering a [let].  Returns updated [bv]. *)
+  let bind_var bv ident =
+    let r = dummy_info () in
+    Ident_hashtbl.add occ ident r;
+    Ident_map.add ident r bv in
 
-  (* Now we start compiling the class *)
-  let cla = Ident.create "class" in
-  let (inh_init, obj_init) =
-    build_object_init_0 cla [] cl copy_env subst_env top ids in
-  let inh_init' = List.rev inh_init in
-  let (inh_init', cl_init) =
-    build_class_init cla true ([],[]) inh_init' obj_init msubst top cl
-  in
-  assert (inh_init' = []);
-  let table = Ident.create "table"
-  and class_init = Ident.create (Ident.name cl_id ^ "_init")
-  and env_init = Ident.create "env_init"
-  and obj_init = Ident.create "obj_init" in
-  let pub_meths =
-    List.sort
-      (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
-      pub_meths in
-  let tags = List.map Btype.hash_variant pub_meths in
-  let rev_map = List.combine tags pub_meths in
-  List.iter2
-    (fun tag name ->
-      let name' = List.assoc tag rev_map in
-      if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
-    tags pub_meths;
-  let ltable table lam =
-    Llet(Strict, table,
-         mkappl (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
-  and ldirect obj_init =
-    Llet(Strict, obj_init, cl_init,
-         Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
-                   mkappl (Lvar obj_init, [lambda_unit])))
-  in
-  (* Simplest case: an object defined at toplevel (ids=[]) *)
-  if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
+  (* Record a use of a variable *)
+  let add_one_use bv ident  =
+    match Ident_map.find_opt ident bv with 
+    | Some r  -> r.times <- r.times + 1 
+    | None ->
+      (* ident is not locally bound, therefore this is a use under a lambda
+         or within a loop.  Increase use count by 2 -- enough so
+         that single-use optimizations will not apply. *)
+      match Ident_hashtbl.find_opt occ ident with 
+      | Some r -> absorb_info r {times = 1; captured =  true}
+      | None ->
+        (* Not a let-bound variable, ignore *)
+        () in
 
-  let concrete = (vflag = Concrete)
-  and lclass lam =
-    let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in
-    Llet(Strict, class_init, cl_init, lam (free_variables cl_init))
-  and lbody fv =
-    if List.for_all (fun id -> not (IdentSet.mem id fv)) ids then
-      mkappl (oo_prim "make_class",[transl_meth_list pub_meths;
-                                    Lvar class_init])
-    else
-      ltable table (
-      Llet(
-      Strict, env_init, mkappl (Lvar class_init, [Lvar table]),
-      Lsequence(
-      mkappl (oo_prim "init_class", [Lvar table]),
-      Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-            [mkappl (Lvar env_init, [lambda_unit]);
-             Lvar class_init; Lvar env_init; lambda_unit], Location.none))))
-  and lbody_virt lenvs =
-    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-          [lambda_unit; Lfunction(Curried,[cla], cl_init); lambda_unit; lenvs], Location.none)
-  in
-  (* Still easy: a class defined at toplevel *)
-  if top && concrete then lclass lbody else
-  if top then llets (lbody_virt lambda_unit) else
+  let inherit_use bv ident bid =
+    let n =
+      match Ident_hashtbl.find_opt occ bid with
+      | None -> dummy_info ()
+      | Some v -> v in
+    match Ident_map.find_opt ident bv with 
+    | Some r  -> absorb_info r n
+    | None ->
+      (* ident is not locally bound, therefore this is a use under a lambda
+         or within a loop.  Increase use count by 2 -- enough so
+         that single-use optimizations will not apply. *)
+      match Ident_hashtbl.find_opt occ ident with 
+      | Some r -> absorb_info r {n with captured = true} 
+      | None ->
+        (* Not a let-bound variable, ignore *)
+        () in
 
-  (* Now for the hard stuff: prepare for table cacheing *)
-  let envs = Ident.create "envs"
-  and cached = Ident.create "cached" in
-  let lenvs =
-    if !new_ids_meths = [] && !new_ids_init = [] && inh_init = []
-    then lambda_unit
-    else Lvar envs in
-  let lenv =
-    let menv =
-      if !new_ids_meths = [] then lambda_unit else
-      Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-            List.map (fun id -> Lvar id) !new_ids_meths, Location.none) in
-    if !new_ids_init = [] then menv else
-    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-          menv :: List.map (fun id -> Lvar id) !new_ids_init, Location.none)
-  and linh_envs =
-    List.map (fun (_, p) -> Lprim(Pfield (3, Fld_na), [transl_normal_path p], Location.none))
-      (List.rev inh_init)
-  in
-  let make_envs lam =
-    Llet(StrictOpt, envs,
-         (if linh_envs = [] then lenv else
-         Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), lenv :: linh_envs, Location.none)),
-         lam)
-  and def_ids cla lam =
-    Llet(StrictOpt, env2,
-         mkappl (oo_prim "new_variable", [Lvar cla; transl_label ""]),
-         lam)
-  in
-  let inh_paths =
-    List.filter
-      (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in
-  let inh_keys =
-    List.map (fun (_,p) -> Lprim(Pfield (1, Fld_na), [transl_normal_path p], Location.none)) inh_paths in
-  let lclass lam =
-    Llet(Strict, class_init,
-         Lfunction(Curried, [cla], def_ids cla cl_init), lam)
-  and lcache lam =
-    if inh_keys = [] then Llet(Alias, cached, Lvar tables, lam) else
-    Llet(Strict, cached,
-         mkappl (oo_prim "lookup_tables",
-                [Lvar tables; Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), inh_keys, Location.none)]),
-         lam)
-  and lset cached i lam =
-    Lprim(Psetfield(i, true, Fld_set_na), [Lvar cached; lam], Location.none)
-  in
-  let ldirect () =
-    ltable cla
-      (Llet(Strict, env_init, def_ids cla cl_init,
-            Lsequence(mkappl (oo_prim "init_class", [Lvar cla]),
-                      lset cached 0 (Lvar env_init))))
-  and lclass_virt () =
-    lset cached 0 (Lfunction(Curried, [cla], def_ids cla cl_init))
-  in
-  llets (
-  lcache (
-  Lsequence(
-  Lifthenelse(lfield cached 0, lambda_unit,
-              if ids = [] then ldirect () else
-              if not concrete then lclass_virt () else
-              lclass (
-              mkappl (oo_prim "make_class_store",
-                      [transl_meth_list pub_meths;
-                       Lvar class_init; Lvar cached]))),
-  make_envs (
-  if ids = [] then mkappl (lfield cached 0, [lenvs]) else
-  Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-        (if concrete then
-          [mkappl (lfield cached 0, [lenvs]);
-           lfield cached 1;
-           lfield cached 0;
-           lenvs]
-        else [lambda_unit; lfield cached 0; lambda_unit; lenvs])
-       , Location.none)))))
+  let rec count (bv : local_tbl) (lam : Lam.t) = 
+    match lam with 
+    | Lfunction{body = l} ->
+      count Ident_map.empty l
+    (** when entering a function local [bv] 
+        is cleaned up, so that all closure variables will not be
+        carried over, since the parameters are never rebound, 
+        so it is fine to kep it empty
+    *)
+    | Lvar v ->
+      add_one_use bv v 
+    | Llet(_, v, Lvar w, l2)  ->
+      (* v will be replaced by w in l2, so each occurrence of v in l2
+         increases w's refcount *)
+      count (bind_var bv v) l2;
+      inherit_use bv w v 
+    (* | Lprim(Pmakeblock _, ll)  *)
+    (*     ->  *)
+    (*       List.iter (fun x -> count bv x ; count bv x) ll *)
+    (* | Llet(kind, v, (Lprim(Pmakeblock _, _) as l1),l2) -> *)
+    (*     count (bind_var bv v) l2; *)
+    (*     (\* If v is unused, l1 will be removed, so don't count its variables *\) *)
+    (*     if kind = Strict || count_var v > 0 then *)
+    (*       count bv l1; count bv l1 *)
 
-(* Wrapper for class compilation *)
-(*
-    let cl_id = ci.ci_id_class in
-(* TODO: cl_id is used somewhere else as typesharp ? *)
-  let _arity = List.length ci.ci_params in
-  let pub_meths = m in
-  let cl = ci.ci_expr in
-  let vflag = vf in
-*)
+    | Llet(kind, v, l1, l2) ->
+      count (bind_var bv v) l2;
+      (* If v is unused, l1 will be removed, so don't count its variables *)
+      if kind = Strict || used v then count bv l1
 
-let transl_class ids id pub_meths cl vf =
-  oo_wrap cl.cl_env false (transl_class ids id pub_meths cl) vf
+    | Lprim {args; _} -> List.iter (count bv ) args
 
-let () =
-  transl_object := (fun id meths cl -> transl_class [] id meths cl Concrete)
+    | Lletrec(bindings, body) ->
+      List.iter (fun (v, l) -> count bv l) bindings;
+      count bv body
+    | Lapply{fn = Lfunction{kind= Curried; params; body};  args; _}
+      when  Ext_list.same_length params args ->
+      count bv (Lam_beta_reduce.beta_reduce  params body args)
+    | Lapply{fn = Lfunction{kind = Tupled; params; body};
+             args = [Lprim {primitive = Pmakeblock _;  args; _}]; _}
+      when  Ext_list.same_length params  args ->
+      count bv (Lam_beta_reduce.beta_reduce   params body args)
+    | Lapply{fn = l1; args= ll; _} ->
+      count bv l1; List.iter (count bv) ll
+    | Lassign(_, l) ->
+      (* Lalias-bound variables are never assigned, so don't increase
+         this ident's refcount *)
+      count bv l
+    | Lconst cst -> ()
+    | Lswitch(l, sw) ->
+      count_default bv sw ;
+      count bv l;
+      List.iter (fun (_, l) -> count bv l) sw.sw_consts;
+      List.iter (fun (_, l) -> count bv l) sw.sw_blocks
+    | Lstringswitch(l, sw, d) ->
+      count bv l ;
+      List.iter (fun (_, l) -> count bv l) sw ;
+      begin 
+        match d with
+        | Some d -> count bv d 
+        (* begin match sw with *)
+        (* | []|[_] -> count bv d *)
+        (* | _ -> count bv d ; count bv d *)
+        (* end *)
+        | None -> ()
+      end
+    | Lstaticraise (i,ls) -> List.iter (count bv) ls
+    | Lstaticcatch(l1, (i,_), l2) -> count bv l1; count bv l2
+    | Ltrywith(l1, v, l2) -> count bv l1; count bv l2
+    | Lifthenelse(l1, l2, l3) -> count bv l1; count bv l2; count bv l3
+    | Lsequence(l1, l2) -> count bv l1; count bv l2
+    | Lwhile(l1, l2) -> count Ident_map.empty l1; count Ident_map.empty l2
+    | Lfor(_, l1, l2, dir, l3) -> 
+      count bv l1;
+      count bv l2; 
+      count Ident_map.empty l3
+    | Lsend(_, m, o, ll, _) -> List.iter (count bv) (m::o::ll)
+    | Lifused(v, l) ->
+      if used v then count bv l
 
-(* Error report *)
+  and count_default bv sw = 
+    match sw.sw_failaction with
+    | None -> ()
+    | Some al ->
+      let nconsts = List.length sw.sw_consts
+      and nblocks = List.length sw.sw_blocks in
+      if nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
+      then 
+        begin (* default action will occur twice in native code *)
+          count bv al ; count bv al
+        end 
+      else 
+        begin (* default action will occur once *)
+          assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
+          count bv al
+        end
+  in
+  count Ident_map.empty  lam;
+  occ
 
-open Format
+let simplify_lets  (lam : Lam.t) = 
+  let occ =  collect_occurs  lam in 
+  apply_lets  occ   lam
 
-let report_error ppf = function
-  | Illegal_class_expr ->
-      fprintf ppf "This kind of recursive class expression is not allowed"
-  | Tags (lab1, lab2) ->
-      fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s"
-        lab1 lab2 "Change one of them."
+end
+module Lam_inline_util : sig 
+#1 "lam_inline_util.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let () =
-  Location.register_error_of_exn
-    (function
-      | Error (loc, err) ->
-        Some (Location.error_of_printer loc report_error err)
-      | _ ->
-        None
-    )
 
-end
-module Translmod : sig 
-#1 "translmod.mli"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
 
-(* Translation from typed abstract syntax to lambda terms,
-   for the module language *)
 
-open Typedtree
-open Lambda
 
-val transl_implementation: string -> structure * module_coercion -> lambda
-val transl_store_phrases: string -> structure -> int * lambda
-val transl_store_implementation:
-      string -> structure * module_coercion -> int * lambda
-val transl_toplevel_definition: structure -> lambda
-val transl_package:
-      Ident.t option list -> Ident.t -> module_coercion -> lambda
-val transl_store_package:
-      Ident.t option list -> Ident.t -> module_coercion -> int * lambda
 
-val toplevel_name: Ident.t -> string
-val nat_toplevel_name: Ident.t -> Ident.t * int
 
-val primitive_declarations: Primitive.description list ref
 
-type error =
-  Circular_dependency of Ident.t
+(** Utilities for lambda inlining *)
 
-exception Error of Location.t * error
+val maybe_functor : string -> bool
+
+val should_be_functor : string -> Lam.t -> bool 
+
+end = struct
+#1 "lam_inline_util.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-val report_error: Format.formatter -> error -> unit
 
-val reset: unit -> unit
 
 
-(** make it an array for better performance*)
-val get_export_identifiers : unit -> Ident.t list 
 
-end = struct
-#1 "translmod.ml"
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
 
-(* Translation from typed abstract syntax to lambda terms,
-   for the module language *)
 
-open Misc
-open Asttypes
-open Longident
-open Path
-open Types
-open Typedtree
-open Lambda
-open Translobj
-open Translcore
-open Translclass
+(* TODO: add a context, like 
+    [args]
+    [Lfunction(params,body)]
+ *)
 
-type error =
-  Circular_dependency of Ident.t
 
+let maybe_functor (name : string) = 
+  name.[0] >= 'A' && name.[0] <= 'Z'
 
-exception Error of Location.t * error
 
-(* Keep track of the root path (from the root of the namespace to the
-   currently compiled module expression).  Useful for naming extensions. *)
+let should_be_functor (name : string) (lam : Lam.t) = 
+  maybe_functor name  &&
+  (match lam with Lfunction _ -> true | _ -> false)
 
-let global_path glob = Some(Pident glob)
-let is_top rootpath = 
-  match rootpath with 
-  | Some (Pident _ ) -> true
-  | _ -> false 
 
-let functor_path path param =
-  match path with
-    None -> None
-  | Some p -> Some(Papply(p, Pident param))
-let field_path path field =
-  match path with
-    None -> None
-  | Some p -> Some(Pdot(p, Ident.name field, Path.nopos))
 
-(* Compile type extensions *)
+end
+module Lam_pass_remove_alias : sig 
+#1 "lam_pass_remove_alias.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let prim_set_oo_id =
-  Pccall {Primitive.prim_name = "caml_set_oo_id"; prim_arity = 1;
-          prim_alloc = false; prim_native_name = "";
-          prim_native_float = false}
 
-let transl_extension_constructor env path ext =
-  let name =
-    match path with
-      None -> Ident.name ext.ext_id
-    | Some p -> Path.name p
-  in
-  let loc = ext.ext_loc in
-  match ext.ext_kind with
-    Text_decl(args, ret) ->
-      Lprim(prim_set_oo_id,
-            [Lprim(Pmakeblock(Obj.object_tag, Lambda.default_tag_info, Mutable),
-                   [Lconst(Const_base(Const_string (name,None)));
-                    Lconst(Const_base(Const_int 0))], loc)], loc)
-  | Text_rebind(path, lid) ->
-      transl_path ~loc env path
 
-let transl_type_extension env rootpath tyext body =
-  List.fold_right
-    (fun ext body ->
-      let lam =
-        transl_extension_constructor env (field_path rootpath ext.ext_id) ext
-      in
-      Llet(Strict, ext.ext_id, lam, body))
-    tyext.tyext_constructors
-    body
 
-(* Compile a coercion *)
 
-let rec apply_coercion loc strict restr arg =
-  match restr with
-    Tcoerce_none ->
-      arg
-  | Tcoerce_structure(pos_cc_list, id_pos_list) ->
-      name_lambda strict arg (fun id ->
-        let get_field pos = Lprim(Pfield (pos, Fld_na (*TODO*)),[Lvar id], loc) in
-        let lam =
-          Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-                List.map (apply_coercion_field loc get_field) pos_cc_list, loc)
-        in
-        wrap_id_pos_list loc id_pos_list get_field lam)
-  | Tcoerce_functor(cc_arg, cc_res) ->
-      let param = Ident.create "funarg" in
-      name_lambda strict arg (fun id ->
-        Lfunction(Curried, [param],
-          apply_coercion loc Strict cc_res
-            (Lapply(Lvar id, [apply_coercion loc Alias cc_arg (Lvar param)],
-                   Location.none))))
-  | Tcoerce_primitive (_,p) ->
-      transl_primitive Location.none p
-  | Tcoerce_alias (path, cc) ->
-      name_lambda strict arg
-        (fun id -> apply_coercion loc Alias cc (transl_normal_path path))
 
-and apply_coercion_field loc get_field (pos, cc) =
-  apply_coercion loc Alias cc (get_field pos)
 
-and wrap_id_pos_list loc id_pos_list get_field lam =
-  let fv = free_variables lam in
-  (*Format.eprintf "%a@." Printlambda.lambda lam;
-  IdentSet.iter (fun id -> Format.eprintf "%a " Ident.print id) fv;
-  Format.eprintf "@.";*)
-  let (lam,s) =
-    List.fold_left (fun (lam,s) (id',pos,c) ->
-      if IdentSet.mem id' fv then
-        let id'' = Ident.create (Ident.name id') in
-        (Llet(Alias,id'',
-              apply_coercion loc Alias c (get_field pos),lam),
-         Ident.add id' (Lvar id'') s)
-      else (lam,s))
-      (lam, Ident.empty) id_pos_list
-  in
-  if s == Ident.empty then lam else subst_lambda s lam
 
+(** Keep track of the global module Aliases *) 
 
-(* Compose two coercions
-   apply_coercion c1 (apply_coercion c2 e) behaves like
-   apply_coercion (compose_coercions c1 c2) e. *)
+(**
+    One way:  guarantee that all global aliases *would be removed* ,
+    it will not be aliased 
+    
+    So the only remaining place for globals is either 
+    just  Pgetglobal in functor application or 
+    `Lprim (Pfield( i ), [Pgetglobal])`
 
-let rec compose_coercions c1 c2 =
-  match (c1, c2) with
-    (Tcoerce_none, c2) -> c2
-  | (c1, Tcoerce_none) -> c1
-  | (Tcoerce_structure (pc1, ids1), Tcoerce_structure (pc2, ids2)) ->
-      let v2 = Array.of_list pc2 in
-      let ids1 =
-        List.map (fun (id,pos1,c1) ->
-          let (pos2,c2) = v2.(pos1) in (id, pos2, compose_coercions c1 c2))
-          ids1
-      in
-      Tcoerce_structure
-        (List.map
-          (function (p1, Tcoerce_primitive _) as x ->
-                      x (* (p1, Tcoerce_primitive p) *)
-                  | (p1, c1) ->
-                      let (p2, c2) = v2.(p1) in (p2, compose_coercions c1 c2))
-             pc1,
-         ids1 @ ids2)
-  | (Tcoerce_functor(arg1, res1), Tcoerce_functor(arg2, res2)) ->
-      Tcoerce_functor(compose_coercions arg2 arg1,
-                      compose_coercions res1 res2)
-  | (c1, Tcoerce_alias (path, c2)) ->
-      Tcoerce_alias (path, compose_coercions c1 c2)
-  | (_, _) ->
-      fatal_error "Translmod.compose_coercions"
+    This pass does not change meta  data
+*)
 
-(*
-let apply_coercion a b c =
-  Format.eprintf "@[<2>apply_coercion@ %a@]@." Includemod.print_coercion b;
-  apply_coercion a b c
+val simplify_alias : 
+  Lam_stats.meta -> 
+  Lam.t ->
+  Lam.t
 
-let compose_coercions c1 c2 =
-  let c3 = compose_coercions c1 c2 in
-  let open Includemod in
-  Format.eprintf "@[<2>compose_coercions@ (%a)@ (%a) =@ %a@]@."
-    print_coercion c1 print_coercion c2 print_coercion c3;
-  c3
-*)
+end = struct
+#1 "lam_pass_remove_alias.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-(* Record the primitive declarations occuring in the module compiled *)
 
-let primitive_declarations = ref ([] :  Primitive.description list)
-let record_primitive = function
-  | {val_kind=Val_prim p} ->
-      primitive_declarations := p :: !primitive_declarations
-  | _ -> ()
 
-(* Utilities for compiling "module rec" definitions *)
 
-let mod_prim name =
-  try
-    transl_normal_path
-      (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
-                             Env.empty))
-  with Not_found ->
-    fatal_error ("Primitive " ^ name ^ " not found.")
 
-let undefined_location loc =
-  let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
-  Lconst(Const_block(0, Lambda.default_tag_info,
-                     [Const_base(Const_string (fname, None));
-                      Const_base(Const_int line);
-                      Const_base(Const_int char)]))
 
-let init_shape modl =
-  let rec init_shape_mod env mty =
-    match Mtype.scrape env mty with
-      Mty_ident _ ->
-        raise Not_found
-    | Mty_alias _ ->
-        Const_block (1, Lambda.default_tag_info, [Const_pointer (0, Lambda.Pt_module_alias)])
-    | Mty_signature sg ->
-        Const_block(0,  Lambda.default_tag_info, [Const_block(0, Lambda.default_tag_info, init_shape_struct env sg)])
-    | Mty_functor(id, arg, res) ->
-        raise Not_found (* can we do better? *)
-  and init_shape_struct env sg =
-    match sg with
-      [] -> []
-    | Sig_value(id, vdesc) :: rem ->
-        let init_v =
-          match Ctype.expand_head env vdesc.val_type with
-            {desc = Tarrow(_,_,_,_)} ->
-              Const_pointer (0,Lambda.default_pointer_info) (* camlinternalMod.Function *)
-          | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
-              Const_pointer (1, Lambda.default_pointer_info) (* camlinternalMod.Lazy *)
-          | _ -> raise Not_found in
-        init_v :: init_shape_struct env rem
-    | Sig_type(id, tdecl, _) :: rem ->
-        init_shape_struct (Env.add_type ~check:false id tdecl env) rem
-    | Sig_typext(id, ext, _) :: rem ->
-        raise Not_found
-    | Sig_module(id, md, _) :: rem ->
-        init_shape_mod env md.md_type ::
-        init_shape_struct (Env.add_module_declaration id md env) rem
-    | Sig_modtype(id, minfo) :: rem ->
-        init_shape_struct (Env.add_modtype id minfo env) rem
-    | Sig_class(id, cdecl, _) :: rem ->
-        Const_pointer (2, Lambda.default_pointer_info) (* camlinternalMod.Class *)
-        :: init_shape_struct env rem
-    | Sig_class_type(id, ctyp, _) :: rem ->
-        init_shape_struct env rem
-  in
-  try
-    Some(undefined_location modl.mod_loc,
-         Lconst(init_shape_mod modl.mod_env modl.mod_type))
-  with Not_found ->
-    None
 
-(* Reorder bindings to honor dependencies.  *)
 
-type binding_status = Undefined | Inprogress | Defined
+let simplify_alias 
+    (meta : Lam_stats.meta)
+    (lam : Lam.t) 
+  :  Lam.t  = 
 
-let reorder_rec_bindings bindings =
-  let id = Array.of_list (List.map (fun (id,_,_,_) -> id) bindings)
-  and loc = Array.of_list (List.map (fun (_,loc,_,_) -> loc) bindings)
-  and init = Array.of_list (List.map (fun (_,_,init,_) -> init) bindings)
-  and rhs = Array.of_list (List.map (fun (_,_,_,rhs) -> rhs) bindings) in
-  let fv = Array.map Lambda.free_variables rhs in
-  let num_bindings = Array.length id in
-  let status = Array.make num_bindings Undefined in
-  let res = ref [] in
-  let rec emit_binding i =
-    match status.(i) with
-      Defined -> ()
-    | Inprogress -> raise(Error(loc.(i), Circular_dependency id.(i)))
-    | Undefined ->
-        if init.(i) = None then begin
-          status.(i) <- Inprogress;
-          for j = 0 to num_bindings - 1 do
-            if IdentSet.mem id.(j) fv.(i) then emit_binding j
-          done
-        end;
-        res := (id.(i), init.(i), rhs.(i)) :: !res;
-        status.(i) <- Defined in
-  for i = 0 to num_bindings - 1 do
-    match status.(i) with
-      Undefined -> emit_binding i
-    | Inprogress -> assert false
-    | Defined -> ()
-  done;
-  List.rev !res
+  let rec simpl  (lam : Lam.t) : Lam.t = 
+    match lam with 
+    | Lvar v ->
+      begin match (Ident_hashtbl.find_opt meta.alias_tbl v) with
+      | None -> lam
+      | Some v -> Lam.var v
+      end
+      (* GLOBAL module needs to be propogated *)
+    | Llet(kind, k, (Lprim {primitive = Pgetglobal i; args = [] ; _} as g),
+           l ) -> 
+      (* This is detection of MODULE ALIAS 
+          we need track all global module aliases, when it's
+          passed as a parameter(escaped), we need do the expansion
+          since global module access is not the same as local module
+          TODO: 
+          since we aliased k, so it's safe to remove it?
+      *)
+      let v = simpl l in
+      if Ident_set.mem k meta.export_idents 
+      then 
+        Lam.let_ kind k g v
+        (* in this case it is preserved, but will still be simplified 
+            for the inner expression
+        *)
+      else v
+    | Lprim {primitive = Pfield (i,_); args =  [Lvar v]; _} -> 
+      (* ATTENTION: 
+         Main use case, we should detect inline all immutable block .. *)
+      Lam_util.get lam v  i meta.ident_tbl 
+    | Lifthenelse(Lvar id as l1, l2, l3) 
+      -> 
+      begin match Ident_hashtbl.find_opt meta.ident_tbl id with 
+      | Some (ImmutableBlock ( _, Normal))
+      | Some (MutableBlock _  )
+        -> simpl l2 
+      | Some (ImmutableBlock ( [| SimpleForm l |]  , x) )
+        -> 
+        let l1 = 
+          match x with 
+          | Null 
+            -> Lam.not_ (Location.none) ( Lam.prim ~primitive:Lam.Prim.js_is_nil ~args:[l] Location.none) 
+          | Undefined 
+            -> 
+            Lam.not_  Location.none (Lam.prim ~primitive:Lam.Prim.js_is_undef ~args:[l] Location.none)
+          | Null_undefined
+            -> 
+            Lam.not_ Location.none
+              ( Lam.prim ~primitive:Lam.Prim.js_is_nil_undef  ~args:[l] Location.none) 
+          | Normal ->  l1 
+        in 
+        Lam.if_ l1 (simpl l2) (simpl l3)
+      | Some _
+      | None -> Lam.if_ l1 (simpl l2) (simpl l3)
+      end
+    | Lifthenelse (l1, l2, l3) -> 
+        Lam.if_ (simpl  l1) (simpl  l2) (simpl  l3)
 
-(* Generate lambda-code for a reordered list of bindings *)
+    | Lconst _ -> lam
+    | Llet(str, v, l1, l2) ->
+      Lam.let_ str v (simpl l1) (simpl l2 )
+    | Lletrec(bindings, body) ->
+      let bindings = List.map (fun (k,l) ->  (k, simpl l) ) bindings in 
+      Lam.letrec bindings (simpl body) 
+    | Lprim {primitive; args; loc } 
+      -> Lam.prim ~primitive ~args:(List.map simpl  args) loc
 
-let eval_rec_bindings bindings cont =
-  let rec bind_inits = function
-    [] ->
-      bind_strict bindings
-  | (id, None, rhs) :: rem ->
-      bind_inits rem
-  | (id, Some(loc, shape), rhs) :: rem ->
-      Llet(Strict, id, Lapply(mod_prim "init_mod", [loc; shape], Location.none),
-           bind_inits rem)
-  and bind_strict = function
-    [] ->
-      patch_forwards bindings
-  | (id, None, rhs) :: rem ->
-      Llet(Strict, id, rhs, bind_strict rem)
-  | (id, Some(loc, shape), rhs) :: rem ->
-      bind_strict rem
-  and patch_forwards = function
-    [] ->
-      cont
-  | (id, None, rhs) :: rem ->
-      patch_forwards rem
-  | (id, Some(loc, shape), rhs) :: rem ->
-      Lsequence(Lapply(mod_prim "update_mod", [shape; Lvar id; rhs],
-                       Location.none),
-                patch_forwards rem)
-  in
-    bind_inits bindings
+    (* complicated 
+        1. inline this function
+        2. ...
+        exports.Make=
+        function(funarg)
+      {var $$let=Make(funarg);
+        return [0, $$let[5],... $$let[16]]}
+    *)      
+    | Lapply{fn = 
+               Lprim {primitive = Pfield (index, _) ;
+                      args = [Lprim {primitive = Pgetglobal ident; args =  []}];
+                      _} as l1;
+             args; loc ; status} ->
+      begin
+        Lam_compile_env.find_and_add_if_not_exist (ident,index) meta.env
+          ~not_found:(fun _ -> assert false)
+          ~found:(fun i ->
+              match i with
+              | {closed_lambda=Some Lfunction{params; body; _} } 
+                (** be more cautious when do cross module inlining *)
+                when
+                  ( Ext_list.same_length params args &&
+                    List.for_all (fun (arg : Lam.t) ->
+                        match arg with 
+                        | Lvar p -> 
+                          begin 
+                            match Ident_hashtbl.find_opt meta.ident_tbl p with
+                            | Some v  -> v <> Parameter
+                            | None -> true 
+                          end
+                        |  _ -> true 
+                      ) args) -> 
+                simpl @@
+                Lam_beta_reduce.propogate_beta_reduce
+                  meta params body args
+              | _ -> 
+                Lam.apply (simpl l1) (List.map simpl args) loc status
+            )
 
-let compile_recmodule compile_rhs bindings cont =
-  eval_rec_bindings
-    (reorder_rec_bindings
-       (List.map
-          (fun {mb_id=id; mb_expr=modl; _} ->
-            (id, modl.mod_loc, init_shape modl, compile_rhs id modl))
-          bindings))
-    cont
+      end
+    (* Function inlining interact with other optimizations...
 
-(* Extract the list of "value" identifiers bound by a signature.
-   "Value" identifiers are identifiers for signature components that
-   correspond to a run-time value: values, extensions, modules, classes.
-   Note: manifest primitives do not correspond to a run-time value! *)
+        - parameter attributes
+        - scope issues 
+        - code bloat 
+    *)      
+    | Lapply{fn = (Lvar v as fn);  args; loc ; status} ->
+      (* Check info for always inlining *)
 
-let rec bound_value_identifiers = function
-    [] -> []
-  | Sig_value(id, {val_kind = Val_reg}) :: rem ->
-      id :: bound_value_identifiers rem
-  | Sig_typext(id, ext, _) :: rem -> id :: bound_value_identifiers rem
-  | Sig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem
-  | Sig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem
-  | _ :: rem -> bound_value_identifiers rem
+      (* Ext_log.dwarn __LOC__ "%s/%d" v.name v.stamp;     *)
+      let normal () = Lam.apply ( simpl fn) (List.map simpl args) loc status in
+      begin 
+        match Ident_hashtbl.find_opt meta.ident_tbl v with
+        | Some (Function {lambda = Lfunction {params; body} as _m;
+                    rec_flag;                     
+                    _ })
+          -> 
+        
+          if Ext_list.same_length args params (* && false *)
+          then               
+            if Lam_inline_util.maybe_functor v.name  
+              (* && (Ident_set.mem v meta.export_idents) && false *)
+            then 
+              (* TODO: check l1 if it is exported, 
+                 if so, maybe not since in that case, 
+                 we are going to have two copy?
+              *)
 
-(* Compile a module expression *)
- 
-let export_identifiers  : Ident.t list ref = ref []
-let get_export_identifiers () = 
-  !export_identifiers
+              (* Check: recursive applying may result in non-termination *)
+              begin
+                (* Ext_log.dwarn __LOC__ "beta .. %s/%d" v.name v.stamp ; *)
+                simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args) 
+              end
+            else 
+            if (* Lam_analysis.size body < Lam_analysis.small_inline_size *)
+              Lam_analysis.ok_to_inline ~body params args 
+            then 
 
-let rec transl_module cc rootpath mexp =
-  let loc = mexp.mod_loc in
-  match mexp.mod_type with
-    Mty_alias _ -> apply_coercion loc Alias cc lambda_unit
-  | _ ->
-  match mexp.mod_desc with
-    Tmod_ident (path,_) ->
-      apply_coercion loc Strict cc
-        (transl_path ~loc mexp.mod_env path)
-  | Tmod_structure str ->
-      transl_struct loc [] cc rootpath str
-  | Tmod_functor( param, _, mty, body) ->
-      let bodypath = functor_path rootpath param in
-      oo_wrap mexp.mod_env true
-        (function
-        | Tcoerce_none ->
-            Lfunction(Curried, [param],
-                      transl_module Tcoerce_none bodypath body)
-        | Tcoerce_functor(ccarg, ccres) ->
-            let param' = Ident.create "funarg" in
-            Lfunction(Curried, [param'],
-                      Llet(Alias, param,
-                           apply_coercion loc Alias ccarg (Lvar param'),
-                           transl_module ccres bodypath body))
-        | _ ->
-            fatal_error "Translmod.transl_module")
-        cc
-  | Tmod_apply(funct, arg, ccarg) ->
-      oo_wrap mexp.mod_env true
-        (apply_coercion loc Strict cc)
-        (Lapply(transl_module Tcoerce_none None funct,
-                [transl_module ccarg None arg], loc))
-  | Tmod_constraint(arg, mty, _, ccarg) ->
-      transl_module (compose_coercions cc ccarg) rootpath arg
-  | Tmod_unpack(arg, _) ->
-      apply_coercion loc  Strict cc (Translcore.transl_exp arg)
+                (* let param_map =  *)
+                (*   Lam_analysis.free_variables meta.export_idents  *)
+                (*     (Lam_analysis.param_map_of_list params) body in *)
+                (* let old_count = List.length params in *)
+                (* let new_count = Ident_map.cardinal param_map in *)
+                let param_map = 
+                  Lam_closure.is_closed_with_map 
+                    meta.export_idents params body in
+                let is_export_id = Ident_set.mem v meta.export_idents in
+                match is_export_id, param_map with 
+                | false, (_, param_map)
+                | true, (true, param_map) -> 
+                  if rec_flag = Rec then               
+                    begin
+                      (* Ext_log.dwarn __LOC__ "beta rec.. %s/%d" v.name v.stamp ; *)
+                      (* Lam_beta_reduce.propogate_beta_reduce meta params body args *)
+                      Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args
+                    end
+                  else 
+                    begin
+                      (* Ext_log.dwarn __LOC__ "beta  nonrec..[%d] [%a]  %s/%d"  *)
+                      (*   (List.length args)  *)
+                      (*   Printlambda.lambda body                      *)
+                      (*   v.name v.stamp ; *)
+                      simpl (Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args)
 
-and transl_struct loc fields cc rootpath str =
-  transl_structure loc fields cc rootpath str.str_items
+                    end
+                | _ -> normal ()
+              else 
+                normal ()
+          else
+            normal ()
+        | Some _
+        | None -> normal ()
 
-and transl_structure loc fields cc rootpath = function
-    [] ->
-      begin match cc with
-        Tcoerce_none ->
-          let fields =  List.rev fields in
-          let field_names = List.map (fun id -> id.Ident.name) fields in
-          Lprim(Pmakeblock(0, Lambda.Blk_module (Some field_names) , Immutable),
-                List.fold_right (fun id acc -> begin
-                      (if is_top rootpath then 
-                         export_identifiers :=  id :: !export_identifiers);
-                      (Lvar id :: acc) end) fields [] , loc
-                 )
-      | Tcoerce_structure(pos_cc_list, id_pos_list) ->
-              (* Do not ignore id_pos_list ! *)
-          (*Format.eprintf "%a@.@[" Includemod.print_coercion cc;
-          List.iter (fun l -> Format.eprintf "%a@ " Ident.print l)
-            fields;
-          Format.eprintf "@]@.";*)
-          let v = Array.of_list (List.rev fields) in
-          let get_field pos = Lvar v.(pos)
-          and ids = List.fold_right IdentSet.add fields IdentSet.empty in
-          let (result, names) = List.fold_right
-              (fun  (pos, cc) (code, name) ->
-                 begin match cc with
-                 | Tcoerce_primitive (id,p) -> 
-                     (if is_top rootpath then 
-                        export_identifiers := id:: !export_identifiers);
-                     (transl_primitive Location.none p :: code, p.Primitive.prim_name ::name)
-                 | _ -> 
-                     (if is_top rootpath then 
-                        export_identifiers :=  v.(pos) :: !export_identifiers);
-                     (apply_coercion loc Strict cc (get_field pos) :: code, v.(pos).Ident.name :: name)
-                 end)
-              pos_cc_list ([], [])in 
-          let lam =
-            (Lprim(Pmakeblock(0, Blk_module (Some names), Immutable),
-                   result, loc))
-          and id_pos_list =
-            List.filter (fun (id,_,_) -> not (IdentSet.mem id ids)) id_pos_list
-          in
-          wrap_id_pos_list loc id_pos_list get_field lam
-      | _ ->
-          fatal_error "Translmod.transl_structure"
       end
-  | item :: rem ->
-      match item.str_desc with
-      | Tstr_eval (expr, _) ->
-      Lsequence(transl_exp expr, transl_structure loc fields cc rootpath rem)
-  | Tstr_value(rec_flag, pat_expr_list) ->
-      let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
-      transl_let rec_flag pat_expr_list
-                 (transl_structure loc ext_fields cc rootpath rem)
-  | Tstr_primitive descr ->
-      record_primitive descr.val_val;
-      transl_structure loc fields cc rootpath rem
-  | Tstr_type decls ->
-      transl_structure loc  fields cc rootpath rem
-  | Tstr_typext(tyext) ->
-      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
-      transl_type_extension item.str_env rootpath tyext
-        (transl_structure loc (List.rev_append ids fields) cc rootpath rem)
-  | Tstr_exception ext ->
-      let id = ext.ext_id in
-      let path = field_path rootpath id in
-      Llet(Strict, id, transl_extension_constructor item.str_env path ext,
-           transl_structure loc (id :: fields) cc rootpath rem)
-  | Tstr_module mb ->
-      let id = mb.mb_id in
-      Llet(pure_module mb.mb_expr, id,
-           transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr,
-           transl_structure loc (id :: fields) cc rootpath rem)
-  | Tstr_recmodule bindings ->
-      let ext_fields =
-        List.rev_append (List.map (fun mb -> mb.mb_id) bindings) fields
-      in
-      compile_recmodule
-        (fun id modl ->
-          transl_module Tcoerce_none (field_path rootpath id) modl)
-        bindings
-        (transl_structure loc ext_fields cc rootpath rem)
-  | Tstr_class cl_list ->
-      let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in
-      Lletrec(List.map
-              (fun (ci, meths, vf) ->
-                let id = ci.ci_id_class in
-                let cl = ci.ci_expr in
-                  (id, transl_class ids id meths cl vf ))
-                cl_list,
-              transl_structure loc (List.rev_append ids fields) cc rootpath rem)
-  | Tstr_include incl ->
-      let ids = bound_value_identifiers incl.incl_type in
-      let modl = incl.incl_mod in
-      let mid = Ident.create "include" in
-      let rec rebind_idents pos newfields = function
-        [] ->
-          transl_structure loc newfields cc rootpath rem
-      | id :: ids ->
-          Llet(Alias, id, Lprim(Pfield (pos, Fld_na), [Lvar mid], incl.incl_loc),
-               rebind_idents (pos + 1) (id :: newfields) ids) in
-      Llet(pure_module modl, mid, transl_module Tcoerce_none None modl,
-           rebind_idents 0 fields ids)
-
-  | Tstr_modtype _
-  | Tstr_open _
-  | Tstr_class_type _
-  | Tstr_attribute _ ->
-      transl_structure loc fields cc rootpath rem
 
-and pure_module m =
-  match m.mod_desc with
-    Tmod_ident _ -> Alias
-  | Tmod_constraint (m,_,_,_) -> pure_module m
-  | _ -> Strict
+    | Lapply{ fn = Lfunction{ kind = Curried ; params; body}; args; _}
+      when  Ext_list.same_length params args ->
+      simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
+    | Lapply{ fn = Lfunction{kind =  Tupled;  params; body}; 
+             args = [Lprim {primitive = Pmakeblock _; args; _}]; _}
+      (** TODO: keep track of this parameter in ocaml trunk,
+          can we switch to the tupled backend?
+      *)
+      when  Ext_list.same_length params args ->
+      simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
 
-(* Update forward declaration in Translcore *)
-let _ =
-  Translcore.transl_module := transl_module
+    | Lapply {fn = l1; args =  ll;  loc ; status} ->
+      Lam.apply (simpl  l1) (List.map simpl  ll) loc status
+    | Lfunction {arity; kind; params; body = l}
+      -> Lam.function_ ~arity ~kind ~params  ~body:(simpl  l)
+    | Lswitch (l, {sw_failaction; 
+                   sw_consts; 
+                   sw_blocks;
+                   sw_numblocks;
+                   sw_numconsts;
+                  }) ->
+      Lam.switch (simpl  l)
+               {sw_consts = 
+                  List.map (fun (v, l) -> v, simpl  l) sw_consts;
+                sw_blocks = List.map (fun (v, l) -> v, simpl  l) sw_blocks;
+                sw_numconsts = sw_numconsts;
+                sw_numblocks = sw_numblocks;
+                sw_failaction = 
+                  begin 
+                    match sw_failaction with 
+                    | None -> None
+                    | Some x -> Some (simpl x)
+                  end}
+    | Lstringswitch(l, sw, d) ->
+      Lam.stringswitch (simpl  l )
+                    (List.map (fun (i, l) -> i,simpl  l) sw)
+                    (match d with
+                     | Some d -> Some (simpl d )
+                     | None -> None)
+    | Lstaticraise (i,ls) -> 
+      Lam.staticraise i (List.map simpl  ls)
+    | Lstaticcatch (l1, ids, l2) -> 
+      Lam.staticcatch (simpl  l1) ids (simpl  l2)
+    | Ltrywith (l1, v, l2) -> Lam.try_ (simpl  l1) v (simpl  l2)
 
-(* Compile an implementation *)
+    | Lsequence (Lprim {primitive = Pgetglobal (id); args = []}, l2)
+      when Lam_compile_env.is_pure (Lam_module_ident.of_ml id) 
+      -> simpl l2
+    | Lsequence(l1, l2)
+      -> Lam.seq (simpl  l1) (simpl  l2)
+    | Lwhile(l1, l2)
+      -> Lam.while_ (simpl  l1) (simpl l2)
+    | Lfor(flag, l1, l2, dir, l3)
+      -> 
+      Lam.for_ flag (simpl  l1) (simpl  l2) dir (simpl  l3)
+    | Lassign(v, l) ->
+      (* Lalias-bound variables are never assigned, so don't increase
+         v's refsimpl *)
+      Lam.assign v (simpl  l)
+    | Lsend (u, m, o, ll, v) 
+      -> 
+      Lam.send u (simpl m) (simpl o) (List.map simpl ll) v
+    | Lifused (v, l) -> Lam.ifused v (simpl  l)
+  in 
+  simpl lam
 
-let transl_implementation module_name (str, cc) =
-  reset_labels ();
-  primitive_declarations := [];
-  let module_id = Ident.create_persistent module_name in
-  Lprim(Psetglobal module_id,
-        [transl_label_init
-            (transl_struct Location.none [] cc (global_path module_id) str)], Location.none)
+end
+module Ext_option : sig 
+#1 "ext_option.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
 
-(* Build the list of value identifiers defined by a toplevel structure
-   (excluding primitive declarations). *)
 
-let rec defined_idents = function
-    [] -> []
-  | item :: rem ->
-    match item.str_desc with
-    | Tstr_eval (expr, _) -> defined_idents rem
-    | Tstr_value(rec_flag, pat_expr_list) ->
-      let_bound_idents pat_expr_list @ defined_idents rem
-    | Tstr_primitive desc -> defined_idents rem
-    | Tstr_type decls -> defined_idents rem
-    | Tstr_typext tyext ->
-      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
-      @ defined_idents rem
-    | Tstr_exception ext -> ext.ext_id :: defined_idents rem
-    | Tstr_module mb -> mb.mb_id :: defined_idents rem
-    | Tstr_recmodule decls ->
-      List.map (fun mb -> mb.mb_id) decls @ defined_idents rem
-    | Tstr_modtype _ -> defined_idents rem
-    | Tstr_open _ -> defined_idents rem
-    | Tstr_class cl_list ->
-      List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem
-    | Tstr_class_type cl_list -> defined_idents rem
-    | Tstr_include incl ->
-      bound_value_identifiers incl.incl_type @ defined_idents rem
-    | Tstr_attribute _ -> defined_idents rem
 
-(* second level idents (module M = struct ... let id = ... end),
-   and all sub-levels idents *)
-let rec more_idents = function
-    [] -> []
-  | item :: rem ->
-    match item.str_desc with
-    | Tstr_eval (expr, _attrs) -> more_idents rem
-    | Tstr_value(rec_flag, pat_expr_list) -> more_idents rem
-    | Tstr_primitive _ -> more_idents rem
-    | Tstr_type decls -> more_idents rem
-    | Tstr_typext tyext -> more_idents rem
-    | Tstr_exception _ -> more_idents rem
-    | Tstr_recmodule decls -> more_idents rem
-    | Tstr_modtype _ -> more_idents rem
-    | Tstr_open _ -> more_idents rem
-    | Tstr_class cl_list -> more_idents rem
-    | Tstr_class_type cl_list -> more_idents rem
-    | Tstr_include _ -> more_idents rem
-    | Tstr_module {mb_expr={mod_desc = Tmod_structure str}} ->
-        all_idents str.str_items @ more_idents rem
-    | Tstr_module _ -> more_idents rem
-    | Tstr_attribute _ -> more_idents rem
 
-and all_idents = function
-    [] -> []
-  | item :: rem ->
-    match item.str_desc with
-    | Tstr_eval (expr, _attrs) -> all_idents rem
-    | Tstr_value(rec_flag, pat_expr_list) ->
-      let_bound_idents pat_expr_list @ all_idents rem
-    | Tstr_primitive _ -> all_idents rem
-    | Tstr_type decls -> all_idents rem
-    | Tstr_typext tyext ->
-      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
-      @ all_idents rem
-    | Tstr_exception ext -> ext.ext_id :: all_idents rem
-    | Tstr_recmodule decls ->
-      List.map (fun mb -> mb.mb_id) decls @ all_idents rem
-    | Tstr_modtype _ -> all_idents rem
-    | Tstr_open _ -> all_idents rem
-    | Tstr_class cl_list ->
-      List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem
-    | Tstr_class_type cl_list -> all_idents rem
-    | Tstr_include incl ->
-      bound_value_identifiers incl.incl_type @ all_idents rem
-    | Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}} ->
-        mb_id :: all_idents str.str_items @ all_idents rem
-    | Tstr_module mb -> mb.mb_id :: all_idents rem
-    | Tstr_attribute _ -> all_idents rem
 
 
-(* A variant of transl_structure used to compile toplevel structure definitions
-   for the native-code compiler. Store the defined values in the fields
-   of the global as soon as they are defined, in order to reduce register
-   pressure.  Also rewrites the defining expressions so that they
-   refer to earlier fields of the structure through the fields of
-   the global, not by their names.
-   "map" is a table from defined idents to (pos in global block, coercion).
-   "prim" is a list of (pos in global block, primitive declaration). *)
 
-let transl_store_subst = ref Ident.empty
-  (** In the native toplevel, this reference is threaded through successive
-      calls of transl_store_structure *)
+(** Utilities for [option] type *)
 
-let nat_toplevel_name id =
-  try match Ident.find_same id !transl_store_subst with
-    | Lprim(Pfield (pos, _), [Lprim(Pgetglobal glob, [], _)] ,_) -> (glob,pos)
-    | _ -> raise Not_found
-  with Not_found ->
-    fatal_error("Translmod.nat_toplevel_name: " ^ Ident.unique_name id)
+val bind : 'a option -> ('a -> 'b) -> 'b option
 
-let transl_store_structure glob map prims str =
-  let rec transl_store rootpath subst = function
-    [] ->
-      transl_store_subst := subst;
-        lambda_unit
-    | item :: rem ->
-        match item.str_desc with
-  | Tstr_eval (expr, _attrs) ->
-      Lsequence(subst_lambda subst (transl_exp expr),
-                transl_store rootpath subst rem)
-  | Tstr_value(rec_flag, pat_expr_list) ->
-      let ids = let_bound_idents pat_expr_list in
-      let lam = transl_let rec_flag pat_expr_list (store_idents Location.none ids) in
-      Lsequence(subst_lambda subst lam,
-                transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_primitive descr ->
-      record_primitive descr.val_val;
-      transl_store rootpath subst rem
-  | Tstr_type decls ->
-      transl_store rootpath subst rem
-  | Tstr_typext(tyext) ->
-      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
-      let lam =
-        transl_type_extension item.str_env rootpath tyext (store_idents Location.none ids)
-      in
-        Lsequence(subst_lambda subst lam,
-                  transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_exception ext ->
-      let id = ext.ext_id in
-      let path = field_path rootpath id in
-      let lam = transl_extension_constructor item.str_env path ext in
-      Lsequence(Llet(Strict, id, subst_lambda subst lam, store_ident ext.ext_loc id),
-                transl_store rootpath (add_ident false id subst) rem)
-  | Tstr_module{mb_id=id; mb_expr={mod_desc = Tmod_structure str}; mb_loc = loc} ->
-    let lam = transl_store (field_path rootpath id) subst str.str_items in
-      (* Careful: see next case *)
-    let subst = !transl_store_subst in
-    Lsequence(lam,
-              Llet(Strict, id,
-                   subst_lambda subst
-                   (Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable),
-                          List.map (fun id -> Lvar id)
-                                   (defined_idents str.str_items),loc)),
-                   Lsequence(store_ident loc id,
-                             transl_store rootpath (add_ident true id subst)
-                                          rem)))
-  | Tstr_module{mb_id=id; mb_expr=modl; mb_loc = loc} ->
-      let lam = transl_module Tcoerce_none (field_path rootpath id) modl in
-      (* Careful: the module value stored in the global may be different
-         from the local module value, in case a coercion is applied.
-         If so, keep using the local module value (id) in the remainder of
-         the compilation unit (add_ident true returns subst unchanged).
-         If not, we can use the value from the global
-         (add_ident true adds id -> Pgetglobal... to subst). *)
-      Llet(Strict, id, subst_lambda subst lam,
-        Lsequence(store_ident loc id,
-                  transl_store rootpath (add_ident true id subst) rem))
-  | Tstr_recmodule bindings ->
-      let ids = List.map (fun mb -> mb.mb_id) bindings in
-      compile_recmodule
-        (fun id modl ->
-          subst_lambda subst
-            (transl_module Tcoerce_none
-                           (field_path rootpath id) modl))
-        bindings
-        (Lsequence(store_idents Location.none ids,
-                   transl_store rootpath (add_idents true ids subst) rem))
-  | Tstr_class cl_list ->
-      let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
-      let lam =
-        Lletrec(List.map
-              (fun (ci, meths, vf) ->
-                let id = ci.ci_id_class in
-                let cl = ci.ci_expr in
-                     (id, transl_class ids id meths cl vf))
-                  cl_list,
-                store_idents Location.none ids) in
-      Lsequence(subst_lambda subst lam,
-                transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_include incl ->
-      let ids = bound_value_identifiers incl.incl_type in
-      let modl = incl.incl_mod in
-      let mid = Ident.create "include" in
-      let loc = incl.incl_loc in
-      let rec store_idents pos = function
-        [] -> transl_store rootpath (add_idents true ids subst) rem
-      | id :: idl ->
-          Llet(Alias, id, Lprim(Pfield (pos, Fld_na), [Lvar mid],loc),
-               Lsequence(store_ident loc id, store_idents (pos + 1) idl)) in
-      Llet(Strict, mid,
-           subst_lambda subst (transl_module Tcoerce_none None modl),
-           store_idents 0 ids)
-  | Tstr_modtype _
-  | Tstr_open _
-  | Tstr_class_type _
-  | Tstr_attribute _ ->
-      transl_store rootpath subst rem
+end = struct
+#1 "ext_option.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-  and store_ident loc id =
-    try
-      let (pos, cc) = Ident.find_same id map in
-      let init_val = apply_coercion loc Alias cc (Lvar id) in
-      Lprim(Psetfield(pos, false, Fld_set_na), [Lprim(Pgetglobal glob, [], loc); init_val], loc)
-    with Not_found ->
-      fatal_error("Translmod.store_ident: " ^ Ident.unique_name id)
 
-  and store_idents loc idlist =
-    make_sequence (store_ident loc) idlist
 
-  and add_ident may_coerce id subst =
-    try
-      let (pos, cc) = Ident.find_same id map in
-      match cc with
-        Tcoerce_none ->
-          Ident.add id (Lprim(Pfield (pos, Fld_na), [Lprim(Pgetglobal glob, [], Location.none)], Location.none)) subst
-      | _ ->
-          if may_coerce then subst else assert false
-    with Not_found ->
-      assert false
 
-  and add_idents may_coerce idlist subst =
-    List.fold_right (add_ident may_coerce) idlist subst
 
-  and store_primitive (pos, prim) cont =
-    Lsequence(Lprim(Psetfield(pos, false, Fld_set_na),
-                    [Lprim(Pgetglobal glob, [], Location.none);
-                     transl_primitive Location.none prim], Location.none),
-              cont)
 
-  in List.fold_right store_primitive prims
-                     (transl_store (global_path glob) !transl_store_subst str)
 
-(* Transform a coercion and the list of value identifiers defined by
-   a toplevel structure into a table [id -> (pos, coercion)],
-   with [pos] being the position in the global block where the value of
-   [id] must be stored, and [coercion] the coercion to be applied to it.
-   A given identifier may appear several times
-   in the coercion (if it occurs several times in the signature); remember
-   to assign it the position of its last occurrence.
-   Identifiers that are not exported are assigned positions at the
-   end of the block (beyond the positions of all exported idents).
-   Also compute the total size of the global block,
-   and the list of all primitives exported as values. *)
 
-let build_ident_map restr idlist more_ids =
-  let rec natural_map pos map prims = function
-    [] ->
-      (map, prims, pos)
-  | id :: rem ->
-      natural_map (pos+1) (Ident.add id (pos, Tcoerce_none) map) prims rem in
-  let (map, prims, pos) =
-    match restr with
-        Tcoerce_none ->
-          natural_map 0 Ident.empty [] idlist
-      | Tcoerce_structure (pos_cc_list, _id_pos_list) ->
-              (* ignore _id_pos_list as the ids are already bound *)
-        let idarray = Array.of_list idlist in
-        let rec export_map pos map prims undef = function
-        [] ->
-          natural_map pos map prims undef
-          | (source_pos, Tcoerce_primitive (_,p)) :: rem ->
-            export_map (pos + 1) map ((pos, p) :: prims) undef rem
-          | (source_pos, cc) :: rem ->
-            let id = idarray.(source_pos) in
-            export_map (pos + 1) (Ident.add id (pos, cc) map)
-              prims (list_remove id undef) rem
-        in export_map 0 Ident.empty [] idlist pos_cc_list
-      | _ ->
-        fatal_error "Translmod.build_ident_map"
-  in
-  natural_map pos map prims more_ids
+let bind v f = 
+  match v with 
+  | None -> None
+  | Some x -> Some (f x )
 
-(* Compile an implementation using transl_store_structure
-   (for the native-code compiler). *)
+end
+module Lam_stats_export : sig 
+#1 "lam_stats_export.mli"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let transl_store_gen module_name ({ str_items = str }, restr) topl =
-  reset_labels ();
-  primitive_declarations := [];
-  let module_id = Ident.create_persistent module_name in
-  let (map, prims, size) =
-    build_ident_map restr (defined_idents str) (more_idents str) in
-  let f = function
-    | [ { str_desc = Tstr_eval (expr, _attrs) } ] when topl ->
-        assert (size = 0);
-        subst_lambda !transl_store_subst (transl_exp expr)
-    | str -> transl_store_structure module_id map prims str in
-  transl_store_label_init module_id size f str
-  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
 
-let transl_store_phrases module_name str =
-  transl_store_gen module_name (str,Tcoerce_none) true
 
-let transl_store_implementation module_name (str, restr) =
-  let s = !transl_store_subst in
-  transl_store_subst := Ident.empty;
-  let r = transl_store_gen module_name (str, restr) false in
-  transl_store_subst := s;
-  r
 
-(* Compile a toplevel phrase *)
 
-let toploop_ident = Ident.create_persistent "Toploop"
-let toploop_getvalue_pos = 0 (* position of getvalue in module Toploop *)
-let toploop_setvalue_pos = 1 (* position of setvalue in module Toploop *)
 
-let aliased_idents = ref Ident.empty
+val export_to_cmj : 
+  Lam_stats.meta ->
+  Js_cmj_format.effect ->
+  Lam_module_ident.t list ->
+  Lam.t Ident_map.t -> Js_cmj_format.t
 
-let set_toplevel_unique_name id =
-  aliased_idents :=
-    Ident.add id (Ident.unique_toplevel_name id) !aliased_idents
 
-let toplevel_name id =
-  try Ident.find_same id !aliased_idents
-  with Not_found -> Ident.name id
+end = struct
+#1 "lam_stats_export.ml"
+(* 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
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * 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. *)
 
-let toploop_getvalue id =
-  Lapply(Lprim(Pfield (toploop_getvalue_pos, Fld_na),
-                 [Lprim(Pgetglobal toploop_ident, [], Location.none)], Location.none),
-         [Lconst(Const_base(Const_string (toplevel_name id, None)))],
-         Location.none)
 
-let toploop_setvalue id lam =
-  Lapply(Lprim(Pfield (toploop_setvalue_pos, Fld_na),
-                 [Lprim(Pgetglobal toploop_ident, [], Location.none)], Location.none),
-         [Lconst(Const_base(Const_string (toplevel_name id, None))); lam],
-         Location.none)
 
-let toploop_setvalue_id id = toploop_setvalue id (Lvar id)
 
-let close_toplevel_term lam =
-  IdentSet.fold (fun id l -> Llet(Strict, id, toploop_getvalue id, l))
-                (free_variables lam) lam
 
-let transl_toplevel_item item =
-  match item.str_desc with
-    Tstr_eval (expr, _attrs) ->
-      transl_exp expr
-  | Tstr_value(rec_flag, pat_expr_list) ->
-      let idents = let_bound_idents pat_expr_list in
-      transl_let rec_flag pat_expr_list
-                 (make_sequence toploop_setvalue_id idents)
-  | Tstr_typext(tyext) ->
-      let idents =
-        List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
-      in
-        transl_type_extension item.str_env None tyext
-          (make_sequence toploop_setvalue_id idents)
-  | Tstr_exception ext ->
-      toploop_setvalue ext.ext_id
-        (transl_extension_constructor item.str_env None ext)
-  | Tstr_module {mb_id=id; mb_expr=modl} ->
-      (* we need to use the unique name for the module because of issues
-         with "open" (PR#1672) *)
-      set_toplevel_unique_name id;
-      let lam = transl_module Tcoerce_none (Some(Pident id)) modl in
-      toploop_setvalue id lam
-  | Tstr_recmodule bindings ->
-      let idents = List.map (fun mb -> mb.mb_id) bindings in
-      compile_recmodule
-        (fun id modl -> transl_module Tcoerce_none (Some(Pident id)) modl)
-        bindings
-        (make_sequence toploop_setvalue_id idents)
-  | Tstr_class cl_list ->
-      (* we need to use unique names for the classes because there might
-         be a value named identically *)
-      let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
-      List.iter set_toplevel_unique_name ids;
-      Lletrec(List.map
-          (fun (ci, meths, vf) ->
-            let id = ci.ci_id_class in
-            let cl = ci.ci_expr in
-                   (id, transl_class ids id meths cl vf))
-                cl_list,
-              make_sequence
-                (fun (ci, _, _) -> toploop_setvalue_id ci.ci_id_class)
-                cl_list)
-  | Tstr_include incl ->
-      let ids = bound_value_identifiers incl.incl_type in
-      let modl = incl.incl_mod in
-      let mid = Ident.create "include" in
-      let rec set_idents pos = function
-        [] ->
-          lambda_unit
-      | id :: ids ->
-          Lsequence(toploop_setvalue id (Lprim(Pfield (pos, Fld_na), [Lvar mid], Location.none)),
-                    set_idents (pos + 1) ids) in
-      Llet(Strict, mid, transl_module Tcoerce_none None modl, set_idents 0 ids)
-  | Tstr_modtype _
-  | Tstr_open _
-  | Tstr_primitive _
-  | Tstr_type _
-  | Tstr_class_type _
-  | Tstr_attribute _ ->
-      lambda_unit
 
-let transl_toplevel_item_and_close itm =
-  close_toplevel_term (transl_label_init (transl_toplevel_item itm))
+let pp = Format.fprintf 
+(* we should exclude meaninglist names and do the convert as well *)
 
-let transl_toplevel_definition str =
-  reset_labels ();
-  make_sequence transl_toplevel_item_and_close str.str_items
+let meaningless_names  = ["*opt*"; "param";]
 
-(* Compile the initialization code for a packed library *)
+let rec dump_ident fmt (id : Ident.t) (arity : Lam.function_arities)  = 
+  pp fmt  "@[<2>export var %s:@ %a@ ;@]" (Ext_ident.convert true id.name ) dump_arity arity
 
-let get_component = function
-    None -> Lconst const_unit
-  | Some id -> Lprim(Pgetglobal id, [], Location.none)
+and dump_arity fmt (arity : Lam.function_arities) = 
+  match arity with 
+  | NA -> pp fmt "any"
+  | Determin (_, [], _) -> pp fmt "any"
+  | Determin (_, (n,args)::xs, _) -> 
+    let args = match args with 
+    | Some args -> args 
+    | None -> Ext_list.init n (fun _ -> Ident.create "param") in
+    pp fmt "@[(%a)@ =>@ any@]" 
+      (Format.pp_print_list  
+         ~pp_sep:(fun fmt _ -> 
+             Format.pp_print_string fmt ",";
+             Format.pp_print_space fmt ();
+           )
+         (fun fmt ident -> pp fmt "@[%s@ :@ any@]" 
+             (Ext_ident.convert true  @@ Ident.name ident))
+      ) args 
 
-let transl_package component_names target_name coercion =
-  let components =
-    Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), List.map get_component component_names, Location.none) in
-  Lprim(Psetglobal target_name, [apply_coercion Location.none Strict coercion components], Location.none)
-  (*
-  let components =
-    match coercion with
-      Tcoerce_none ->
-        List.map get_component component_names
-    | Tcoerce_structure (pos_cc_list, id_pos_list) ->
-              (* ignore id_pos_list as the ids are already bound *)
-        let g = Array.of_list component_names in
-        List.map
-          (fun (pos, cc) -> apply_coercion Strict cc (get_component g.(pos)))
-          pos_cc_list
-    | _ ->
-        assert false in
-  Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
-   *)
 
-let transl_store_package component_names target_name coercion =
-  let rec make_sequence fn pos arg =
-    match arg with
-      [] -> lambda_unit
-    | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in
-  match coercion with
-    Tcoerce_none ->
-      (List.length component_names,
-       make_sequence
-         (fun pos id ->
-           Lprim(Psetfield(pos, false, Fld_set_na),
-                 [Lprim(Pgetglobal target_name, [], Location.none);
-                  get_component id], Location.none))
-         0 component_names)
-  | Tcoerce_structure (pos_cc_list, id_pos_list) ->
-      let components =
-        Lprim(Pmakeblock(0, Lambda.default_tag_info, Immutable), List.map get_component component_names, Location.none)
-      in
-      let blk = Ident.create "block" in
-      (List.length pos_cc_list,
-       Llet (Strict, blk, apply_coercion Location.none Strict coercion components,
-             make_sequence
-               (fun pos id ->
-                 Lprim(Psetfield(pos, false, Fld_set_na),
-                       [Lprim(Pgetglobal target_name, [], Location.none);
-                        Lprim(Pfield (pos, Fld_na), [Lvar blk], Location.none)], Location.none))
-               0 pos_cc_list))
-  (*
-              (* ignore id_pos_list as the ids are already bound *)
-      let id = Array.of_list component_names in
-      (List.length pos_cc_list,
-       make_sequence
-         (fun dst (src, cc) ->
-           Lprim(Psetfield(dst, false),
-                 [Lprim(Pgetglobal target_name, []);
-                  apply_coercion Strict cc (get_component id.(src))]))
-         0 pos_cc_list)
-  *)
-  | _ -> assert false
+(* Note that 
+   [lambda_exports] is 
+   lambda expression to be exported
+   for the js backend, we compile to js 
+   for the inliner, we try to seriaize it -- 
+   relies on other optimizations to make this happen
+   {[
+     exports.Make = function () {.....}
+   ]}
+   TODO: check that we don't do this in browser environment
+*)
+let export_to_cmj 
+    (meta : Lam_stats.meta ) 
+    maybe_pure
+    external_ids 
+    export_map
 
-(* Error report *)
+  : Js_cmj_format.t = 
+  let values = 
 
-open Format
+    List.fold_left
+      (fun   acc (x : Ident.t)  ->
+         let arity =  Lam_stats_util.get_arity meta (Lam.var x) in
+         match Ident_map.find_opt x export_map with 
+         | Some lambda  -> 
+           if Lam_analysis.safe_to_inline lambda
+           (* when inlning a non function, we have to be very careful,
+              only truly immutable values can be inlined
+           *)
+           then
+             let closed_lambda = 
+               if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *)
+               then
+                 if Lam_closure.is_closed lambda (* TODO: seriealize more*)
+                 then Some lambda
+                 else None
+               else 
+                 let lam_size = Lam_analysis.size lambda in
+                 (* TODO:
+                    1. global need re-assocate when do the beta reduction 
+                    2. [lambda_exports] is not precise
+                 *)
+                 let free_variables =
+                   Lam_closure.free_variables Ident_set.empty
+                   (* meta.export_idents *)  Ident_map.empty 
+                     lambda in
+                 if  lam_size < Lam_analysis.small_inline_size  && 
+                     Ident_map.is_empty free_variables
+                 then 
+                   begin
+                     Ext_log.dwarn __LOC__ "%s recorded for inlining @." x.name ;
+                     Some lambda
+                   end
+                 else 
+                   begin
+                     (* Ext_log.dwarn __LOC__ "%s : %d : {%s} not inlined @."  *)
+                     (*   x.name lam_size   *)
+                     (*   (String.concat ", " @@  *)
+                     (*    List.map (fun x -> x.Ident.name) @@ Ident_map.keys free_variables) ; *)
+                     None 
+                   end
+             in 
+             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda } acc 
+           else
+             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None } acc 
+         | None
+           -> String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None} acc  
+      )
+      String_map.empty
+      meta.exports 
 
-let report_error ppf = function
-    Circular_dependency id ->
-      fprintf ppf
-        "@[Cannot safely evaluate the definition@ \
-         of the recursively-defined module %a@]"
-        Printtyp.ident id
 
-let () =
-  Location.register_error_of_exn
-    (function
-      | Error (loc, err) ->
-        Some (Location.error_of_printer loc report_error err)
-      | _ ->
-        None
-    )
+  in
+
+  let rec dump fmt ids = 
+    (* TODO: also use {[Ext_pp]} module instead *)
+    match ids with 
+    | [] -> ()
+    | x::xs -> 
+      dump_ident fmt x (Lam_stats_util.get_arity meta (Lam.var x)) ; 
+      Format.pp_print_space fmt ();
+      dump fmt xs in
+
+  let () =
+    if !Js_config.default_gen_tds && not ( Ext_string.is_empty meta.filename) then
+      Ext_pervasives.with_file_as_pp
+        (Ext_filename.chop_extension ~loc:__LOC__ meta.filename ^ ".d.ts")
+      @@ fun fmt ->
+        pp fmt "@[<v>%a@]@." dump meta.exports
+  in
+  let effect = 
+    match maybe_pure with
+    | None ->  
+      Ext_option.bind ( Ext_list.for_all_ret 
+                          (fun (id : Lam_module_ident.t) -> 
+                             Lam_compile_env.query_and_add_if_not_exist id 
+                               (Has_env meta.env )
+                               ~not_found:(fun _ -> false ) ~found:(fun i -> 
+                                   i.pure)
+                          ) external_ids) (fun x -> Lam_module_ident.name x)
+    | Some _ -> maybe_pure
+
+  in
+  {values; 
+   effect ; 
+   npm_package_path = Js_config.get_packages_info ();
+  }
 
-let reset () =
-  export_identifiers := [];
-  primitive_declarations := [];
-  transl_store_subst := Ident.empty;
-  toploop_ident.Ident.flags <- 0;
-  aliased_idents := Ident.empty
 
 end
 module Lam_compile_group : sig 
@@ -96018,7 +96027,6 @@ module Lam_compile_group : sig
 val compile :  
   filename : string -> 
   string -> 
-  bool -> 
   Env.t -> 
   Types.signature -> 
   Lambda.lambda -> 
@@ -96206,24 +96214,81 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
 
 ;;
 
+
+
+
+(* Invariant: The last one is always [exports]
+           Compile definitions
+           Compile exports
+           Assume Pmakeblock(_,_),
+           lambda_exports are pure
+           compile each binding with a return value
+           This might be wrong in toplevel
+           TODO: add this check as early as possible in the beginning
+*)
+let handle_exports 
+    (original_exports : Ident.t list)
+    (lambda_exports : Lam.t list)  (rest : Lam_group.t list) : 
+  Lam.ident list * Ident_set.t * Lam.t Ident_map.t * Lam_group.t list=
+  let coercion_groups, new_exports, new_export_set,  export_map = 
+    List.fold_right2 
+        (fun  eid lam (coercions, new_exports, new_export_set,  export_map) ->
+           match (lam : Lam.t) with 
+           | Lvar id 
+             when Ident.name id = Ident.name eid -> 
+             (* {[ Ident.same id eid]} is more  correct, 
+                however, it will introduce a coercion, which is not necessary, 
+                as long as its name is the same, we want to avoid 
+                another coercion                        
+             *)
+             (coercions, 
+              id :: new_exports, 
+              Ident_set.add id new_export_set,
+              export_map)
+           | _ -> (** TODO : bug 
+                      check [map.ml] here coercion, we introduced 
+                      rebound which is not corrrect 
+                      {[
+                        let Make/identifier = function (funarg){
+                            var $$let = Make/identifier(funarg);
+                                    return [0, ..... ]
+                          }
+                      ]}
+                      Possible fix ? 
+                      change export identifier, we should do this in the very 
+                      beginning since lots of optimizations depend on this
+                      however
+                  *)
+             (Lam_group.Single(Strict ,eid,  lam) :: coercions, 
+              eid :: new_exports,
+              Ident_set.add eid new_export_set, 
+              Ident_map.add eid lam export_map))
+        original_exports lambda_exports 
+        ([],[], Ident_set.empty, Ident_map.empty)
+  in
+  let (export_map, rest) = 
+    List.fold_left 
+      (fun (export_map, acc) x ->
+         (match (x : Lam_group.t)  with 
+          | Single (_,id,lam) when Ident_set.mem id new_export_set 
+            -> Ident_map.add id lam export_map
+          | _ -> export_map), x :: acc ) (export_map, coercion_groups) rest in
+  let rest = Lam_dce.remove new_exports rest in
+  new_exports, new_export_set, export_map , rest 
+
+
 (** Actually simplify_lets is kind of global optimization since it requires you to know whether 
     it's used or not 
-    [no_export] is only used in playground
 *)
-let compile  ~filename output_prefix no_export env _sigs 
+let compile  ~filename output_prefix env _sigs 
     (lam : Lambda.lambda)   = 
-  let export_idents = 
-    if no_export then
-      []    
-    else  Translmod.get_export_identifiers()  
-  in
+  let export_idents = Translmod.get_export_identifiers() in
   let () = 
     export_idents |> List.iter 
       (fun (id : Ident.t) -> Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp) 
   in
   (* To make toplevel happy - reentrant for js-demo *)
   let ()   = 
-    Translmod.reset () ; 
     Lam_compile_env.reset () ;
   in 
   let lam = Lam.convert  lam in 
@@ -96275,9 +96340,7 @@ let compile  ~filename output_prefix no_export env _sigs
     |> Lam_pass_exits.simplify_exits
     |> _d "simplify_lets"
     (* |> Lam.check (Js_config.get_current_file () ) *)
-
   in
-
   (* Debug identifier table *)
   (* Lam_stats_util.pp_alias_tbl Format.err_formatter meta.alias_tbl; *)
   (* Lam_stats_util.dump_exports_arities meta ; *)
@@ -96286,181 +96349,117 @@ let compile  ~filename output_prefix no_export env _sigs
   (* Dump for debugger *)
 
   begin 
-    match (lam : Lam.t) with
-    | Lprim{primitive = Psetglobal id; args =  [biglambda]; _}
-      -> 
-      (* Invariant: The last one is always [exports]
-         Compile definitions
-         Compile exports
-         Assume Pmakeblock(_,_),
-         lambda_exports are pure
-         compile each binding with a return value
-         This might be wrong in toplevel
-         TODO: add this check as early as possible in the beginning
-      *)
+    match Lam_group.flatten [] lam with 
+    | Lprim {primitive = Pmakeblock (_,_,_); args =  lambda_exports},
+      rest ->
+      let new_exports, new_export_set, export_map, rest = 
+        handle_exports  meta.exports lambda_exports rest in 
+      let meta = { meta with 
+                   export_idents = new_export_set;
+                   exports = new_exports
+                 } in 
+      (* TODO: turn in on debug mode later*)
+      let () =
+        let len = List.length new_exports in 
+        let tbl = String_hash_set.create len in 
+        new_exports |> List.iter 
+          (fun (id : Ident.t) -> 
+             if not @@ String_hash_set.check_add tbl id.name then 
+               Bs_exception.error (Bs_duplicate_exports id.name);
+             Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp
+          );
+        if Js_config.is_same_file () then
+          let f =
+            Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".lambda" in
+          Ext_pervasives.with_file_as_pp f begin fun fmt ->
+            Format.pp_print_list ~pp_sep:Format.pp_print_newline
+              (Lam_group.pp_group env) fmt rest 
+          end;
+      in
 
-      begin 
-        match Lam_group.flatten [] biglambda with 
-        | Lprim {primitive = Pmakeblock (_,_,_); args =  lambda_exports},
-          rest ->
-          let coercion_groups, new_exports, new_export_set,  export_map = 
-            if no_export then 
-              [], [], Ident_set.empty, Ident_map.empty
-            else
-              List.fold_right2 
-                (fun  eid lam (coercions, new_exports, new_export_set,  export_map) ->
-                   match (lam : Lam.t) with 
-                   | Lvar id 
-                     when Ident.name id = Ident.name eid -> 
-                     (* {[ Ident.same id eid]} is more  correct, 
-                        however, it will introduce 
-                        a coercion, which is not necessary, 
-                        as long as its name is the same, we want to avoid 
-                        another coercion                        
-                     *)
-                     (coercions, 
-                      id :: new_exports, 
-                      Ident_set.add id new_export_set,
-                      export_map)
-                   | _ -> (** TODO : bug 
-                              check [map.ml] here coercion, we introduced 
-                              rebound which is not corrrect 
-                              {[
-                                let Make/identifier = function (funarg){
-                                    var $$let = Make/identifier(funarg);
-                                            return [0, ..... ]
-                                  }
-                              ]}
-                              Possible fix ? 
-                              change export identifier, we should do this in the very 
-                              beginning since lots of optimizations depend on this
-                              however
-                          *)
-                     (Lam_group.Single(Strict ,eid,  lam) :: coercions, 
-                      eid :: new_exports,
-                      Ident_set.add eid new_export_set, 
-                      Ident_map.add eid lam export_map))
-                meta.exports lambda_exports 
-                ([],[], Ident_set.empty, Ident_map.empty)
-          in
-          let () = 
-            let len = List.length new_exports in 
-            let tbl = String_hash_set.create len in 
-            new_exports |> List.iter 
-              (fun (id : Ident.t) -> 
-                 if not @@ String_hash_set.check_add tbl id.name then 
-                   Bs_exception.error (Bs_duplicate_exports id.name);
-                 Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp
-              ) 
-          in
-          let meta = { meta with 
-                       export_idents = new_export_set;
-                       exports = new_exports
-                     } in 
-          let (export_map, rest) = 
-            List.fold_left 
-              (fun (export_map, acc) x ->
-                 (match (x : Lam_group.t)  with 
-                 | Single (_,id,lam) when Ident_set.mem id new_export_set 
-                   -> Ident_map.add id lam export_map
-                 | _ -> export_map), x :: acc ) (export_map, coercion_groups) rest in
-
-          (* TODO: turn in on debug mode later*)
-          let () =
-            if Js_config.is_same_file () then
-              let f =
-                Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".lambda" in
-              Ext_pervasives.with_file_as_pp f @@ fun fmt ->
-              Format.pp_print_list ~pp_sep:Format.pp_print_newline
-                (Lam_group.pp_group env) fmt rest ;
-          in
-          let rest = Lam_dce.remove meta.exports rest 
-          in
-          let module  E = struct exception  Not_pure of string end in
-          (** Also need analyze its depenency is pure or not *)
-          let no_side_effects rest = 
-            Ext_list.for_all_opt (fun (x : Lam_group.t) -> 
-                match x with 
-                | Single(kind,id,body) -> 
-                  begin 
-                    match kind with 
-                    | Strict | Variable -> 
-                      if not @@ Lam_analysis.no_side_effects body 
-                      then Some  (Printf.sprintf "%s" id.name)
-                      else None
-                    | _ -> None
-                  end
-                | Recursive bindings -> 
-                  Ext_list.for_all_opt (fun (id,lam) -> 
-                      if not @@ Lam_analysis.no_side_effects lam 
-                      then Some (Printf.sprintf "%s" id.Ident.name )
-                      else None
-                    ) bindings
-                | Nop lam -> 
+      let module  E = struct exception  Not_pure of string end in
+      (** Also need analyze its depenency is pure or not *)
+      let no_side_effects rest = 
+        Ext_list.for_all_opt (fun (x : Lam_group.t) -> 
+            match x with 
+            | Single(kind,id,body) -> 
+              begin 
+                match kind with 
+                | Strict | Variable -> 
+                  if not @@ Lam_analysis.no_side_effects body 
+                  then Some  (Printf.sprintf "%s" id.name)
+                  else None
+                | _ -> None
+              end
+            | Recursive bindings -> 
+              Ext_list.for_all_opt (fun (id,lam) -> 
                   if not @@ Lam_analysis.no_side_effects lam 
-                  then 
-                    (*  (Lam_util.string_of_lambda lam) *)
-                    Some ""
-                  else None (* TODO :*))
-              rest
-          in
-          let maybe_pure = no_side_effects rest
-          in
-          let body  = 
-            rest
-            |> List.map (fun group -> compile_group meta group)
-            |> Js_output.concat
-            |> Js_output.to_block
-          in
-          (* The file is not big at all compared with [cmo] *)
-          (* Ext_marshal.to_file (Ext_filename.chop_extension filename ^ ".mj")  js; *)
-          let js = 
-            Js_program_loader.make_program filename meta.exports
-              body 
+                  then Some (Printf.sprintf "%s" id.Ident.name )
+                  else None
+                ) bindings
+            | Nop lam -> 
+              if not @@ Lam_analysis.no_side_effects lam 
+              then 
+                (*  (Lam_util.string_of_lambda lam) *)
+                Some ""
+              else None (* TODO :*))
+          rest
+      in
+      let maybe_pure = no_side_effects rest
+      in
+      let body  = 
+        rest
+        |> List.map (fun group -> compile_group meta group)
+        |> Js_output.concat
+        |> Js_output.to_block
+      in
+      (* The file is not big at all compared with [cmo] *)
+      (* Ext_marshal.to_file (Ext_filename.chop_extension filename ^ ".mj")  js; *)
+      let js = 
+        Js_program_loader.make_program filename meta.exports
+          body 
+      in
+      js 
+      |> _j "initial"
+      |> Js_pass_flatten.program
+      |> _j "flattern"
+      |> Js_pass_tailcall_inline.tailcall_inline
+      |> _j "inline_and_shake"
+      |> Js_pass_flatten_and_mark_dead.program
+      |> _j "flatten_and_mark_dead"
+      (* |> Js_inline_and_eliminate.inline_and_shake *)
+      (* |> _j "inline_and_shake" *)
+      |> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
+      |> Js_shake.shake_program
+      |> _j "shake"
+      |> ( fun (js:  J.program) -> 
+          let external_module_ids = 
+            Lam_compile_env.get_requried_modules  
+              meta.env
+              meta.required_modules  
+              (Js_fold_basic.calculate_hard_dependencies js.block)
+            |>
+            (fun x ->
+               if !Js_config.sort_imports then
+                 Ext_list.sort_via_array
+                   (fun (id1 : Lam_module_ident.t) (id2 : Lam_module_ident.t) ->
+                      String.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
+                   ) x
+               else
+                 x
+            )
           in
-          js 
-          |> _j "initial"
-          |> Js_pass_flatten.program
-          |> _j "flattern"
-          |> Js_pass_tailcall_inline.tailcall_inline
-          |> _j "inline_and_shake"
-          |> Js_pass_flatten_and_mark_dead.program
-          |> _j "flatten_and_mark_dead"
-          (* |> Js_inline_and_eliminate.inline_and_shake *)
-          (* |> _j "inline_and_shake" *)
-          |> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
-          |> Js_shake.shake_program
-          |> _j "shake"
-          |> ( fun (js:  J.program) -> 
-            let external_module_ids = 
-              Lam_compile_env.get_requried_modules  
-                meta.env
-                meta.required_modules  
-                (Js_fold_basic.calculate_hard_dependencies js.block)
-              |>
-              (fun x ->
-                 if !Js_config.sort_imports then
-                   Ext_list.sort_via_array
-                     (fun (id1 : Lam_module_ident.t) (id2 : Lam_module_ident.t) ->
-                       String.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
-                     ) x
-                 else
-                   x
-              )
-            in
 
-            let v = 
-              Lam_stats_export.export_to_cmj meta  maybe_pure external_module_ids
-                (if no_export then Ident_map.empty else export_map) 
-            in
-            (if not @@ !Clflags.dont_write_files then
-               Js_cmj_format.to_file 
-                  (output_prefix ^ Js_config.cmj_ext) v);
-            Js_program_loader.decorate_deps external_module_ids v.effect js
-          )
-        | _ -> raise Not_a_module
-      end
-    | _ -> raise Not_a_module end
+          let v = 
+            Lam_stats_export.export_to_cmj meta  maybe_pure external_module_ids export_map
+          in
+          (if not @@ !Clflags.dont_write_files then
+             Js_cmj_format.to_file 
+               (output_prefix ^ Js_config.cmj_ext) v);
+          Js_program_loader.decorate_deps external_module_ids v.effect js
+        )
+    | _ -> raise Not_a_module
+  end
 ;;
 
 
@@ -96474,7 +96473,7 @@ let lambda_as_module
   begin 
     Js_config.set_current_file filename ;  
     Js_config.iset_debug_file "camlinternalFormat.ml";
-    let lambda_output = compile ~filename output_prefix false env sigs lam in
+    let lambda_output = compile ~filename output_prefix env sigs lam in
     let (//) = Filename.concat in 
     let basename =  
       (* #758, output_prefix is already chopped *)
@@ -96501,8 +96500,6 @@ let lambda_as_module
                 only generate little-case js file
              *)
           ) output_chan
-
-
     | NonBrowser (_package_name, module_systems) ->
       module_systems |> List.iter begin fun (module_system, _path) -> 
         let output_chan chan  = 
@@ -103298,6 +103295,7 @@ let after_parsing_sig ppf sourcefile outputprefix ast  =
       if Js_config.get_diagnose () then
         Format.fprintf Format.err_formatter "Building %s@." sourcefile;    
       let modulename = module_of_filename ppf sourcefile outputprefix in
+      Lam_compile_env.reset () ;
       let initial_env = Compmisc.initial_env () in
       Env.set_unit_name modulename;
       let tsg = Typemod.type_interface initial_env ast in
@@ -103343,6 +103341,7 @@ let after_parsing_impl ppf sourcefile outputprefix ast =
       if Js_config.get_diagnose () then
         Format.fprintf Format.err_formatter "Building %s@." sourcefile;      
       let modulename = Compenv.module_of_filename ppf sourcefile outputprefix in
+      Lam_compile_env.reset () ;
       let env = Compmisc.initial_env() in
       Env.set_unit_name modulename;
       try
diff --git a/jscomp/core/global_exports.adoc b/jscomp/core/global_exports.adoc
new file mode 100644
index 0000000000..b271c29eb7
--- /dev/null
+++ b/jscomp/core/global_exports.adoc
@@ -0,0 +1,7 @@
+
+
+Global exports identifiers are extracted from {!Translmod.get_export_identifiers} 
+instead of inferred from lambda expression or cmi file.
+
+1. We need be careful about externals.
+2. Reading from fresh generated cmi is expensive.
diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml
index d9a66e681f..1592e23dde 100644
--- a/jscomp/core/js_implementation.ml
+++ b/jscomp/core/js_implementation.ml
@@ -46,6 +46,7 @@ let after_parsing_sig ppf sourcefile outputprefix ast  =
       if Js_config.get_diagnose () then
         Format.fprintf Format.err_formatter "Building %s@." sourcefile;    
       let modulename = module_of_filename ppf sourcefile outputprefix in
+      Lam_compile_env.reset () ;
       let initial_env = Compmisc.initial_env () in
       Env.set_unit_name modulename;
       let tsg = Typemod.type_interface initial_env ast in
@@ -91,6 +92,7 @@ let after_parsing_impl ppf sourcefile outputprefix ast =
       if Js_config.get_diagnose () then
         Format.fprintf Format.err_formatter "Building %s@." sourcefile;      
       let modulename = Compenv.module_of_filename ppf sourcefile outputprefix in
+      Lam_compile_env.reset () ;
       let env = Compmisc.initial_env() in
       Env.set_unit_name modulename;
       try
diff --git a/jscomp/core/jsoo_main.ml b/jscomp/core/jsoo_main.ml
index 30c154bc4b..e3dc365941 100644
--- a/jscomp/core/jsoo_main.ml
+++ b/jscomp/core/jsoo_main.ml
@@ -44,12 +44,13 @@ let () =
   Clflags.dont_write_files := true;
   Clflags.unsafe_string := false
 
-let implementation impl no_export ppf  str  =
+let implementation impl ppf  str  =
   let modulename = "Test" in
   (* let env = !Toploop.toplevel_env in *)
   (* Compmisc.init_path false; *)
   (* let modulename = module_of_filename ppf sourcefile outputprefix in *)
   (* Env.set_unit_name modulename; *)
+  Lam_compile_env.reset () ;
   let env = Compmisc.initial_env() in (* Question ?? *)
   let finalenv = ref Env.empty in
   let types_signature = ref [] in
@@ -68,7 +69,7 @@ let implementation impl no_export ppf  str  =
       let () = Js_dump.(pp_deps_program
                           ~output_prefix:"" (* does not matter here *)
                           `NodeJS
-                          (Lam_compile_group.compile ~filename:"" "" no_export
+                          (Lam_compile_group.compile ~filename:"" "" 
                              !finalenv !types_signature lam)
                           (Ext_pp.from_buffer buffer)) in
       let v = Buffer.contents buffer in 
@@ -105,8 +106,9 @@ let string_of_fmt (f : Format.formatter -> 'a -> unit) v =
     Format.pp_print_flush fmt () in
   Buffer.contents buf 
 
-let compile  impl : string -> string = string_of_fmt (implementation  impl false)
-let shake_compile impl : string -> string = string_of_fmt (implementation impl true)
+let compile  impl : string -> string = string_of_fmt (implementation  impl )
+(** TODO: add `[@@bs.config{no_export}]\n# 1 "repl.ml"`*)
+let shake_compile impl : string -> string = string_of_fmt (implementation impl )
 
 
 (** *)
diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml
index e0143574f4..da40dfadf8 100644
--- a/jscomp/core/lam.ml
+++ b/jscomp/core/lam.ml
@@ -45,7 +45,7 @@ type primitive =
   | Pbytes_of_string
   (* Globals *)
   | Pgetglobal of ident
-  | Psetglobal of ident
+  (* | Psetglobal of ident *)
   | Pglobal_exception of ident       
   (* Operations on heap blocks *)
   | Pmakeblock of int * tag_info * mutable_flag
@@ -996,7 +996,13 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc  : t =
       prim ~primitive:(Pglobal_exception id) ~args loc       
     else       
       prim ~primitive:(Pgetglobal id) ~args loc
-  | Psetglobal id -> prim ~primitive:(Psetglobal id) ~args loc
+  | Psetglobal id -> 
+    (* we discard [Psetglobal] in the beginning*)
+    begin match args with 
+    | [biglambda] -> biglambda
+    | _ -> assert false 
+    end
+    (* prim ~primitive:(Psetglobal id) ~args loc *)
   | Pmakeblock (tag,info, mutable_flag) 
     -> prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
   | Pfield (id,info) 
diff --git a/jscomp/core/lam.mli b/jscomp/core/lam.mli
index ab2377285f..b7dd8c67b3 100644
--- a/jscomp/core/lam.mli
+++ b/jscomp/core/lam.mli
@@ -50,7 +50,7 @@ type primitive =
   | Pbytes_to_string
   | Pbytes_of_string
   | Pgetglobal of ident
-  | Psetglobal of ident
+  (* | Psetglobal of ident *)
   | Pglobal_exception of ident             
   | Pmakeblock of int * Lambda.tag_info * Asttypes.mutable_flag
   | Pfield of int * Lambda.field_dbg_info
diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml
index 8d8decfbe7..7b4d09173e 100644
--- a/jscomp/core/lam_analysis.ml
+++ b/jscomp/core/lam_analysis.ml
@@ -171,7 +171,8 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Plazyforce 
       | Psetfield _ 
       | Psetfloatfield _
-      | Psetglobal _ -> false 
+      (* | Psetglobal _  *)
+        -> false 
     )
   | Llet (_,_, arg,body) -> no_side_effects arg && no_side_effects body 
   | Lswitch (_,_) -> false 
diff --git a/jscomp/core/lam_compile_env.ml b/jscomp/core/lam_compile_env.ml
index 797c8935dd..9278d1cf19 100644
--- a/jscomp/core/lam_compile_env.ml
+++ b/jscomp/core/lam_compile_env.ml
@@ -79,6 +79,7 @@ let cached_tbl  = Lam_module_ident.Hash.create 31
 
 (* For each compilation we need reset to make it re-entrant *)
 let reset () = 
+  Translmod.reset ();
   Lam_module_ident.Hash.clear cached_tbl 
 
 (* FIXME: JS external instead *)
diff --git a/jscomp/core/lam_compile_group.ml b/jscomp/core/lam_compile_group.ml
index 12cab8a47f..6aa06815f2 100644
--- a/jscomp/core/lam_compile_group.ml
+++ b/jscomp/core/lam_compile_group.ml
@@ -173,24 +173,81 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
 
 ;;
 
+
+
+
+(* Invariant: The last one is always [exports]
+           Compile definitions
+           Compile exports
+           Assume Pmakeblock(_,_),
+           lambda_exports are pure
+           compile each binding with a return value
+           This might be wrong in toplevel
+           TODO: add this check as early as possible in the beginning
+*)
+let handle_exports 
+    (original_exports : Ident.t list)
+    (lambda_exports : Lam.t list)  (rest : Lam_group.t list) : 
+  Lam.ident list * Ident_set.t * Lam.t Ident_map.t * Lam_group.t list=
+  let coercion_groups, new_exports, new_export_set,  export_map = 
+    List.fold_right2 
+        (fun  eid lam (coercions, new_exports, new_export_set,  export_map) ->
+           match (lam : Lam.t) with 
+           | Lvar id 
+             when Ident.name id = Ident.name eid -> 
+             (* {[ Ident.same id eid]} is more  correct, 
+                however, it will introduce a coercion, which is not necessary, 
+                as long as its name is the same, we want to avoid 
+                another coercion                        
+             *)
+             (coercions, 
+              id :: new_exports, 
+              Ident_set.add id new_export_set,
+              export_map)
+           | _ -> (** TODO : bug 
+                      check [map.ml] here coercion, we introduced 
+                      rebound which is not corrrect 
+                      {[
+                        let Make/identifier = function (funarg){
+                            var $$let = Make/identifier(funarg);
+                                    return [0, ..... ]
+                          }
+                      ]}
+                      Possible fix ? 
+                      change export identifier, we should do this in the very 
+                      beginning since lots of optimizations depend on this
+                      however
+                  *)
+             (Lam_group.Single(Strict ,eid,  lam) :: coercions, 
+              eid :: new_exports,
+              Ident_set.add eid new_export_set, 
+              Ident_map.add eid lam export_map))
+        original_exports lambda_exports 
+        ([],[], Ident_set.empty, Ident_map.empty)
+  in
+  let (export_map, rest) = 
+    List.fold_left 
+      (fun (export_map, acc) x ->
+         (match (x : Lam_group.t)  with 
+          | Single (_,id,lam) when Ident_set.mem id new_export_set 
+            -> Ident_map.add id lam export_map
+          | _ -> export_map), x :: acc ) (export_map, coercion_groups) rest in
+  let rest = Lam_dce.remove new_exports rest in
+  new_exports, new_export_set, export_map , rest 
+
+
 (** Actually simplify_lets is kind of global optimization since it requires you to know whether 
     it's used or not 
-    [no_export] is only used in playground
 *)
-let compile  ~filename output_prefix no_export env _sigs 
+let compile  ~filename output_prefix env _sigs 
     (lam : Lambda.lambda)   = 
-  let export_idents = 
-    if no_export then
-      []    
-    else  Translmod.get_export_identifiers()  
-  in
+  let export_idents = Translmod.get_export_identifiers() in
   let () = 
     export_idents |> List.iter 
       (fun (id : Ident.t) -> Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp) 
   in
   (* To make toplevel happy - reentrant for js-demo *)
   let ()   = 
-    Translmod.reset () ; 
     Lam_compile_env.reset () ;
   in 
   let lam = Lam.convert  lam in 
@@ -242,9 +299,7 @@ let compile  ~filename output_prefix no_export env _sigs
     |> Lam_pass_exits.simplify_exits
     |> _d "simplify_lets"
     (* |> Lam.check (Js_config.get_current_file () ) *)
-
   in
-
   (* Debug identifier table *)
   (* Lam_stats_util.pp_alias_tbl Format.err_formatter meta.alias_tbl; *)
   (* Lam_stats_util.dump_exports_arities meta ; *)
@@ -253,181 +308,117 @@ let compile  ~filename output_prefix no_export env _sigs
   (* Dump for debugger *)
 
   begin 
-    match (lam : Lam.t) with
-    | Lprim{primitive = Psetglobal id; args =  [biglambda]; _}
-      -> 
-      (* Invariant: The last one is always [exports]
-         Compile definitions
-         Compile exports
-         Assume Pmakeblock(_,_),
-         lambda_exports are pure
-         compile each binding with a return value
-         This might be wrong in toplevel
-         TODO: add this check as early as possible in the beginning
-      *)
-
-      begin 
-        match Lam_group.flatten [] biglambda with 
-        | Lprim {primitive = Pmakeblock (_,_,_); args =  lambda_exports},
-          rest ->
-          let coercion_groups, new_exports, new_export_set,  export_map = 
-            if no_export then 
-              [], [], Ident_set.empty, Ident_map.empty
-            else
-              List.fold_right2 
-                (fun  eid lam (coercions, new_exports, new_export_set,  export_map) ->
-                   match (lam : Lam.t) with 
-                   | Lvar id 
-                     when Ident.name id = Ident.name eid -> 
-                     (* {[ Ident.same id eid]} is more  correct, 
-                        however, it will introduce 
-                        a coercion, which is not necessary, 
-                        as long as its name is the same, we want to avoid 
-                        another coercion                        
-                     *)
-                     (coercions, 
-                      id :: new_exports, 
-                      Ident_set.add id new_export_set,
-                      export_map)
-                   | _ -> (** TODO : bug 
-                              check [map.ml] here coercion, we introduced 
-                              rebound which is not corrrect 
-                              {[
-                                let Make/identifier = function (funarg){
-                                    var $$let = Make/identifier(funarg);
-                                            return [0, ..... ]
-                                  }
-                              ]}
-                              Possible fix ? 
-                              change export identifier, we should do this in the very 
-                              beginning since lots of optimizations depend on this
-                              however
-                          *)
-                     (Lam_group.Single(Strict ,eid,  lam) :: coercions, 
-                      eid :: new_exports,
-                      Ident_set.add eid new_export_set, 
-                      Ident_map.add eid lam export_map))
-                meta.exports lambda_exports 
-                ([],[], Ident_set.empty, Ident_map.empty)
-          in
-          let () = 
-            let len = List.length new_exports in 
-            let tbl = String_hash_set.create len in 
-            new_exports |> List.iter 
-              (fun (id : Ident.t) -> 
-                 if not @@ String_hash_set.check_add tbl id.name then 
-                   Bs_exception.error (Bs_duplicate_exports id.name);
-                 Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp
-              ) 
-          in
-          let meta = { meta with 
-                       export_idents = new_export_set;
-                       exports = new_exports
-                     } in 
-          let (export_map, rest) = 
-            List.fold_left 
-              (fun (export_map, acc) x ->
-                 (match (x : Lam_group.t)  with 
-                 | Single (_,id,lam) when Ident_set.mem id new_export_set 
-                   -> Ident_map.add id lam export_map
-                 | _ -> export_map), x :: acc ) (export_map, coercion_groups) rest in
-
-          (* TODO: turn in on debug mode later*)
-          let () =
-            if Js_config.is_same_file () then
-              let f =
-                Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".lambda" in
-              Ext_pervasives.with_file_as_pp f @@ fun fmt ->
-              Format.pp_print_list ~pp_sep:Format.pp_print_newline
-                (Lam_group.pp_group env) fmt rest ;
-          in
-          let rest = Lam_dce.remove meta.exports rest 
-          in
-          let module  E = struct exception  Not_pure of string end in
-          (** Also need analyze its depenency is pure or not *)
-          let no_side_effects rest = 
-            Ext_list.for_all_opt (fun (x : Lam_group.t) -> 
-                match x with 
-                | Single(kind,id,body) -> 
-                  begin 
-                    match kind with 
-                    | Strict | Variable -> 
-                      if not @@ Lam_analysis.no_side_effects body 
-                      then Some  (Printf.sprintf "%s" id.name)
-                      else None
-                    | _ -> None
-                  end
-                | Recursive bindings -> 
-                  Ext_list.for_all_opt (fun (id,lam) -> 
-                      if not @@ Lam_analysis.no_side_effects lam 
-                      then Some (Printf.sprintf "%s" id.Ident.name )
-                      else None
-                    ) bindings
-                | Nop lam -> 
+    match Lam_group.flatten [] lam with 
+    | Lprim {primitive = Pmakeblock (_,_,_); args =  lambda_exports},
+      rest ->
+      let new_exports, new_export_set, export_map, rest = 
+        handle_exports  meta.exports lambda_exports rest in 
+      let meta = { meta with 
+                   export_idents = new_export_set;
+                   exports = new_exports
+                 } in 
+      (* TODO: turn in on debug mode later*)
+      let () =
+        let len = List.length new_exports in 
+        let tbl = String_hash_set.create len in 
+        new_exports |> List.iter 
+          (fun (id : Ident.t) -> 
+             if not @@ String_hash_set.check_add tbl id.name then 
+               Bs_exception.error (Bs_duplicate_exports id.name);
+             Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp
+          );
+        if Js_config.is_same_file () then
+          let f =
+            Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".lambda" in
+          Ext_pervasives.with_file_as_pp f begin fun fmt ->
+            Format.pp_print_list ~pp_sep:Format.pp_print_newline
+              (Lam_group.pp_group env) fmt rest 
+          end;
+      in
+
+      let module  E = struct exception  Not_pure of string end in
+      (** Also need analyze its depenency is pure or not *)
+      let no_side_effects rest = 
+        Ext_list.for_all_opt (fun (x : Lam_group.t) -> 
+            match x with 
+            | Single(kind,id,body) -> 
+              begin 
+                match kind with 
+                | Strict | Variable -> 
+                  if not @@ Lam_analysis.no_side_effects body 
+                  then Some  (Printf.sprintf "%s" id.name)
+                  else None
+                | _ -> None
+              end
+            | Recursive bindings -> 
+              Ext_list.for_all_opt (fun (id,lam) -> 
                   if not @@ Lam_analysis.no_side_effects lam 
-                  then 
-                    (*  (Lam_util.string_of_lambda lam) *)
-                    Some ""
-                  else None (* TODO :*))
-              rest
-          in
-          let maybe_pure = no_side_effects rest
-          in
-          let body  = 
-            rest
-            |> List.map (fun group -> compile_group meta group)
-            |> Js_output.concat
-            |> Js_output.to_block
+                  then Some (Printf.sprintf "%s" id.Ident.name )
+                  else None
+                ) bindings
+            | Nop lam -> 
+              if not @@ Lam_analysis.no_side_effects lam 
+              then 
+                (*  (Lam_util.string_of_lambda lam) *)
+                Some ""
+              else None (* TODO :*))
+          rest
+      in
+      let maybe_pure = no_side_effects rest
+      in
+      let body  = 
+        rest
+        |> List.map (fun group -> compile_group meta group)
+        |> Js_output.concat
+        |> Js_output.to_block
+      in
+      (* The file is not big at all compared with [cmo] *)
+      (* Ext_marshal.to_file (Ext_filename.chop_extension filename ^ ".mj")  js; *)
+      let js = 
+        Js_program_loader.make_program filename meta.exports
+          body 
+      in
+      js 
+      |> _j "initial"
+      |> Js_pass_flatten.program
+      |> _j "flattern"
+      |> Js_pass_tailcall_inline.tailcall_inline
+      |> _j "inline_and_shake"
+      |> Js_pass_flatten_and_mark_dead.program
+      |> _j "flatten_and_mark_dead"
+      (* |> Js_inline_and_eliminate.inline_and_shake *)
+      (* |> _j "inline_and_shake" *)
+      |> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
+      |> Js_shake.shake_program
+      |> _j "shake"
+      |> ( fun (js:  J.program) -> 
+          let external_module_ids = 
+            Lam_compile_env.get_requried_modules  
+              meta.env
+              meta.required_modules  
+              (Js_fold_basic.calculate_hard_dependencies js.block)
+            |>
+            (fun x ->
+               if !Js_config.sort_imports then
+                 Ext_list.sort_via_array
+                   (fun (id1 : Lam_module_ident.t) (id2 : Lam_module_ident.t) ->
+                      String.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
+                   ) x
+               else
+                 x
+            )
           in
-          (* The file is not big at all compared with [cmo] *)
-          (* Ext_marshal.to_file (Ext_filename.chop_extension filename ^ ".mj")  js; *)
-          let js = 
-            Js_program_loader.make_program filename meta.exports
-              body 
+
+          let v = 
+            Lam_stats_export.export_to_cmj meta  maybe_pure external_module_ids export_map
           in
-          js 
-          |> _j "initial"
-          |> Js_pass_flatten.program
-          |> _j "flattern"
-          |> Js_pass_tailcall_inline.tailcall_inline
-          |> _j "inline_and_shake"
-          |> Js_pass_flatten_and_mark_dead.program
-          |> _j "flatten_and_mark_dead"
-          (* |> Js_inline_and_eliminate.inline_and_shake *)
-          (* |> _j "inline_and_shake" *)
-          |> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
-          |> Js_shake.shake_program
-          |> _j "shake"
-          |> ( fun (js:  J.program) -> 
-            let external_module_ids = 
-              Lam_compile_env.get_requried_modules  
-                meta.env
-                meta.required_modules  
-                (Js_fold_basic.calculate_hard_dependencies js.block)
-              |>
-              (fun x ->
-                 if !Js_config.sort_imports then
-                   Ext_list.sort_via_array
-                     (fun (id1 : Lam_module_ident.t) (id2 : Lam_module_ident.t) ->
-                       String.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
-                     ) x
-                 else
-                   x
-              )
-            in
-
-            let v = 
-              Lam_stats_export.export_to_cmj meta  maybe_pure external_module_ids
-                (if no_export then Ident_map.empty else export_map) 
-            in
-            (if not @@ !Clflags.dont_write_files then
-               Js_cmj_format.to_file 
-                  (output_prefix ^ Js_config.cmj_ext) v);
-            Js_program_loader.decorate_deps external_module_ids v.effect js
-          )
-        | _ -> raise Not_a_module
-      end
-    | _ -> raise Not_a_module end
+          (if not @@ !Clflags.dont_write_files then
+             Js_cmj_format.to_file 
+               (output_prefix ^ Js_config.cmj_ext) v);
+          Js_program_loader.decorate_deps external_module_ids v.effect js
+        )
+    | _ -> raise Not_a_module
+  end
 ;;
 
 
@@ -441,7 +432,7 @@ let lambda_as_module
   begin 
     Js_config.set_current_file filename ;  
     Js_config.iset_debug_file "camlinternalFormat.ml";
-    let lambda_output = compile ~filename output_prefix false env sigs lam in
+    let lambda_output = compile ~filename output_prefix env sigs lam in
     let (//) = Filename.concat in 
     let basename =  
       (* #758, output_prefix is already chopped *)
@@ -468,8 +459,6 @@ let lambda_as_module
                 only generate little-case js file
              *)
           ) output_chan
-
-
     | NonBrowser (_package_name, module_systems) ->
       module_systems |> List.iter begin fun (module_system, _path) -> 
         let output_chan chan  = 
diff --git a/jscomp/core/lam_compile_group.mli b/jscomp/core/lam_compile_group.mli
index 9800d8c1fb..649d917f2c 100644
--- a/jscomp/core/lam_compile_group.mli
+++ b/jscomp/core/lam_compile_group.mli
@@ -40,7 +40,6 @@
 val compile :  
   filename : string -> 
   string -> 
-  bool -> 
   Env.t -> 
   Types.signature -> 
   Lambda.lambda -> 
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
index 4023c2d57d..0a7d7882fe 100644
--- a/jscomp/core/lam_compile_primitive.ml
+++ b/jscomp/core/lam_compile_primitive.ml
@@ -565,8 +565,8 @@ let translate  loc
       | Ostype_cygwin -> 
         if Sys.cygwin then E.caml_true else E.caml_false
     end
-  | Psetglobal _  -> 
-    assert false (* already handled *)
+  (* | Psetglobal _  ->  *)
+  (*   assert false (\* already handled *\) *)
     (* assert false *)
   | Pduprecord ((Record_regular 
                 | Record_float ),0)
diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml
index ecc5d9affe..63aa4f9f2a 100644
--- a/jscomp/core/lam_print.ml
+++ b/jscomp/core/lam_print.ml
@@ -113,7 +113,7 @@ let primitive ppf (prim : Lam.primitive) = match prim with
   | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
   | Pglobal_exception id ->
     fprintf ppf "global exception %a" Ident.print id                       
-  | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
+  (* | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id *)
   | Pmakeblock(tag, _, Immutable) -> fprintf ppf "makeblock %i" tag
   | Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag
   | Pfield (n,_) -> fprintf ppf "field %i" n
@@ -504,11 +504,12 @@ let rec flat (acc : (left * Lam.t) list ) (lam : Lam.t) =
 
 let lambda_as_module env  ppf (lam : Lam.t) = 
   try
-  match lam with
-  | Lprim {primitive = Psetglobal id ; args =  [biglambda]; _}
-  (* might be wrong in toplevel *) ->
+  (* match lam with *)
+  (* | Lprim {primitive = Psetglobal id ; args =  [biglambda]; _} *)
+  (* might be wrong in toplevel *) 
+  (* -> *)
       
-      begin match flat [] biglambda  with 
+      begin match flat [] lam  with 
       | (Nop, Lprim {primitive = Pmakeblock (_, _, _); args =  toplevels; _})
         :: rest ->
           (* let spc = ref false in *)
@@ -527,7 +528,7 @@ let lambda_as_module env  ppf (lam : Lam.t) =
           
       | _ -> raise Not_a_module
       end
-  | _ -> raise Not_a_module
+  (* | _ -> raise Not_a_module *)
   with _ -> 
     env_lambda env ppf lam;
     fprintf ppf "; lambda-failure"
diff --git a/jscomp/ounit_tests/ounit_hash_set_tests.ml b/jscomp/ounit_tests/ounit_hash_set_tests.ml
index 342f3e8e8d..f6c7f1f144 100644
--- a/jscomp/ounit_tests/ounit_hash_set_tests.ml
+++ b/jscomp/ounit_tests/ounit_hash_set_tests.ml
@@ -59,22 +59,32 @@ let suites =
       (*    bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *)
     end ;
     __LOC__ >:: begin fun _ -> 
-      let module Hash_set = Id_hash_set in 
-      let v = Hash_set.create 30 in 
+      let v = Id_hash_set.create 30 in 
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done ;
       for i = 0 to 2_000 do 
-        Hash_set.add v {name = "x" ; stamp = i}
+        Id_hash_set.add v {name = "x" ; stamp = i}
       done  ; 
       for i = 0 to 2_000 do 
-        assert (Hash_set.mem v {name = "x"; stamp = i})
+        assert (Id_hash_set.mem v {name = "x"; stamp = i})
       done;  
-      OUnit.assert_equal (Hash_set.length v)  2_001;
+      OUnit.assert_equal (Id_hash_set.length v)  2_001;
       for i =  1990 to 3_000 do 
-        Hash_set.remove v {name = "x"; stamp = i}
+        Id_hash_set.remove v {name = "x"; stamp = i}
       done ;
-      OUnit.assert_equal (Hash_set.length v) 1990;
+      OUnit.assert_equal (Id_hash_set.length v) 1990;
+      for i = 1000 to 3990 do 
+        Id_hash_set.remove v { name = "x"; stamp = i }
+      done;
+      OUnit.assert_equal (Id_hash_set.length v) 1000;
+      for i = 1000 to 1100 do 
+        Id_hash_set.add v { name = "x"; stamp = i};
+      done;
+      OUnit.assert_equal (Id_hash_set.length v ) 1101;
+      for i = 0 to 1100 do 
+        OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i})
+      done  
       (* OUnit.assert_equal (Hash_set.stats v) *)
       (*   {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *)
       (*    bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *)
diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile
index e6cf32518c..4350dbad2b 100644
--- a/jscomp/test/Makefile
+++ b/jscomp/test/Makefile
@@ -72,7 +72,7 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	gpr_904_test gpr_858_unit2_test inner_unused \
 	set_gen bal_tree string_set string_set_test \
 	math_test bal_set_mini gpr_974_test test_cpp\
-	global_module_alias_test
+	global_module_alias_test class_fib_open_recursion_test
 
 
 
diff --git a/jscomp/test/class_fib_open_recursion_test.js b/jscomp/test/class_fib_open_recursion_test.js
new file mode 100644
index 0000000000..2aac6fb477
--- /dev/null
+++ b/jscomp/test/class_fib_open_recursion_test.js
@@ -0,0 +1,93 @@
+'use strict';
+
+var Caml_builtin_exceptions = require("../../lib/js/caml_builtin_exceptions");
+var Hashtbl                 = require("../../lib/js/hashtbl");
+var Mt                      = require("./mt");
+var Block                   = require("../../lib/js/block");
+var Curry                   = require("../../lib/js/curry");
+var CamlinternalOO          = require("../../lib/js/camlinternalOO");
+
+var shared = ["calc"];
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+  test_id[0] = test_id[0] + 1 | 0;
+  suites[0] = /* :: */[
+    /* tuple */[
+      loc + (" id " + test_id[0]),
+      function () {
+        return /* Eq */Block.__(0, [
+                  x,
+                  y
+                ]);
+      }
+    ],
+    suites[0]
+  ];
+  return /* () */0;
+}
+
+function fib_init($$class) {
+  var calc = CamlinternalOO.get_method_label($$class, "calc");
+  CamlinternalOO.set_method($$class, calc, function (self$neg1, x) {
+        if (x === 0 || x === 1) {
+          return 1;
+        }
+        else {
+          return Curry._2(self$neg1[0][calc], self$neg1, x - 1 | 0) + Curry._2(self$neg1[0][calc], self$neg1, x - 2 | 0) | 0;
+        }
+      });
+  return function (_, self) {
+    return CamlinternalOO.create_object_opt(self, $$class);
+  };
+}
+
+var fib = CamlinternalOO.make_class(shared, fib_init);
+
+function memo_fib_init($$class) {
+  var ids = CamlinternalOO.new_methods_variables($$class, shared, ["cache"]);
+  var calc = ids[0];
+  var cache = ids[1];
+  var inh = CamlinternalOO.inherits($$class, 0, 0, shared, fib, 1);
+  var obj_init = inh[0];
+  var calc$1 = inh[1];
+  CamlinternalOO.set_method($$class, calc, function (self$neg2, x) {
+        try {
+          return Hashtbl.find(self$neg2[cache], x);
+        }
+        catch (exn){
+          if (exn === Caml_builtin_exceptions.not_found) {
+            var v = Curry._2(calc$1, self$neg2, x);
+            Hashtbl.add(self$neg2[cache], x, v);
+            return v;
+          }
+          else {
+            throw exn;
+          }
+        }
+      });
+  return function (_, self) {
+    var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+    self$1[cache] = Hashtbl.create(/* None */0, 31);
+    Curry._1(obj_init, self$1);
+    return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+  };
+}
+
+var memo_fib = CamlinternalOO.make_class(shared, memo_fib_init);
+
+var tmp = Curry._1(memo_fib[0], 0);
+
+eq('File "class_fib_open_recursion_test.ml", line 33, characters 5-12', Curry.js2(-1044768619, 1, tmp, 40), 165580141);
+
+Mt.from_pair_suites("class_fib_open_recursion_test.ml", suites[0]);
+
+exports.suites   = suites;
+exports.test_id  = test_id;
+exports.eq       = eq;
+exports.fib      = fib;
+exports.memo_fib = memo_fib;
+/* fib Not a pure module */
diff --git a/jscomp/test/class_fib_open_recursion_test.ml b/jscomp/test/class_fib_open_recursion_test.ml
new file mode 100644
index 0000000000..a7ee77ea28
--- /dev/null
+++ b/jscomp/test/class_fib_open_recursion_test.ml
@@ -0,0 +1,36 @@
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = 
+  incr test_id ; 
+  suites := 
+    (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+class fib = object (self)
+   method calc x = 
+     if x =0 || x = 1  then 1 
+     else self#calc (x - 1 ) + self#calc (x - 2)
+end
+
+
+class memo_fib = object (self)
+   val cache = Hashtbl.create 31 
+   inherit fib as super 
+   method calc x =
+    match Hashtbl.find cache x with 
+    | exception Not_found -> 
+      let v = (super#calc x) in 
+      Hashtbl.add cache x v ; v
+    | v -> v 
+end
+
+
+
+
+let () = 
+  (* print_endline (string_of_int ((new fib)#calc 50)) *)
+
+  eq __LOC__ (((new memo_fib)#calc 40)) 165580141
+
+
+let () = Mt.from_pair_suites __FILE__ !suites