Merge pull request #66 from bloomberg/shake

add support for non export mode, so it play nice with playground

Author: bobzhang

jscomp/jsoo_driver.ml

@@ -30,7 +30,7 @@
      *  }
 *)
 
-let implementation ppf str  =
+let implementation non_export ppf  str  =
   let modulename = "Test" in
   (* let env = !Toploop.toplevel_env in *)
   (* Compmisc.init_path false; *)
@@ -51,7 +51,7 @@ let implementation ppf str  =
   |> (* Printlambda.lambda ppf *) (fun lam -> 
       let buffer = Buffer.create 1000 in 
       let () = Js_dump.(pp_program 
-                          (Lam_compile_group.compile ~filename:""
+                          (Lam_compile_group.compile ~filename:"" non_export
                              !finalenv !types_signature lam)
                           (Ext_pp.from_buffer buffer)) in
       let v = Buffer.contents buffer in 
@@ -88,8 +88,8 @@ let string_of_fmt (f : Format.formatter -> 'a -> unit) v =
     Format.pp_print_flush fmt () in
   Buffer.contents buf 
 
-let compile  : string -> string = string_of_fmt implementation
-
+let compile  : string -> string = string_of_fmt (implementation false)
+let shake_compile : string -> string = string_of_fmt (implementation true)
 
 
 (* local variables: *)

jscomp/jsoo_exports.ml

@@ -33,12 +33,19 @@ let () = JsooTop.initialize()
 let _ =
   export "ocaml"
     (Js.Unsafe.(obj
-         [|"compile",
-             inject @@ 
-             Js.wrap_meth_callback
-                (fun _ code ->
-                  Js.string (Jsoo_driver.compile (Js.to_string code)))
-             |]))
+                  [|"compile",
+                    inject @@ 
+                    Js.wrap_meth_callback
+                      (fun _ code ->
+                         Js.string (Jsoo_driver.compile (Js.to_string code)));
+                    "shake_compile",
+                    inject @@ 
+                    Js.wrap_meth_callback
+                      (fun _ code ->
+                         Js.string (Jsoo_driver.shake_compile (Js.to_string code)))
+                  |]))
+
+
 (* local variables: *)
 (* compile-command: "ocamlbuild -cflags -dsource -use-ocamlfind -no-hygiene  -pkgs js_of_ocaml,js_of_ocaml.toplevel exports.cmo" *)
 (* end: *)

jscomp/lam_compile_group.ml

@@ -151,9 +151,13 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
 (** Actually simplify_lets is kind of global optimization since it requires you to know whether 
     it's used or not 
 *)
-let compile ~filename env sigs lam  : J.program  = 
+let compile  ~filename non_export env _sigs lam  : J.program  = 
 
-  let export_idents = Translmod.get_export_identifiers() in
+  let export_idents = 
+    if non_export then
+      []    
+    else  Translmod.get_export_identifiers()  
+  in
   let ()   = Translmod.reset () in (* To make toplevel happy - reentrant for js-demo *)
   let ()   = Lam_compile_env.reset ()  in
 
@@ -206,28 +210,32 @@ let compile ~filename env sigs lam  : J.program  =
         match Lam_group.flatten [] biglambda with 
         | Lprim( (Pmakeblock (_,_,_), lambda_exports)),  rest ->
           let coercion_groups, new_exports = 
-            List.fold_right2 
-              (fun  eid lam (coercions, new_exports) ->
-                 match (lam : Lambda.lambda) with 
-                 | Lvar id when Ident.name id = Ident.name eid -> 
-                   (coercions, id :: new_exports)
-                 | _ -> (** 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))
-              meta.exports lambda_exports ([],[])in
+            if non_export then 
+              [], []
+            else
+              List.fold_right2 
+                (fun  eid lam (coercions, new_exports) ->
+                   match (lam : Lambda.lambda) with 
+                   | Lvar id when Ident.name id = Ident.name eid -> 
+                     (coercions, id :: new_exports)
+                   | _ -> (** 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))
+                meta.exports lambda_exports ([],[])
+          in
 
           let meta = { meta with 
                        export_idents = Lam_util.ident_set_of_list new_exports;
@@ -297,7 +305,8 @@ let compile ~filename env sigs lam  : J.program  =
           (* Exporting ... *)
           let v = 
             Lam_stats_util.export_to_cmj meta  maybe_pure external_module_ids
-              lambda_exports  in
+              (if non_export then [] else lambda_exports) 
+          in
           (if not @@ Ext_string.is_empty filename then
             Js_cmj_format.to_file 
               (Ext_filename.chop_extension ~loc:__LOC__  filename ^ ".cmj") v);
@@ -333,7 +342,7 @@ let lambda_as_module
     Lam_current_unit.set_debug_file "ari_regress_test.ml";
     Ext_pervasives.with_file_as_chan 
       (Ext_filename.chop_extension ~loc:__LOC__ filename ^  ".js")
-      (fun chan -> Js_dump.dump_program (compile ~filename env sigs lam) chan)
+      (fun chan -> Js_dump.dump_program (compile ~filename false env sigs lam) chan)
   end
 (* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, 
     We need handle some definitions in standard libraries in a special way, most are io specific, 

jscomp/lam_compile_group.mli

@@ -30,9 +30,12 @@
  *)
 val compile :  
   filename : string -> 
+  bool -> 
   Env.t -> 
   Types.signature -> 
   Lambda.lambda -> 
   J.program
 
-val lambda_as_module :  Env.t -> Types.signature -> string -> Lambda.lambda -> unit
+val lambda_as_module :  
+  Env.t ->
+  Types.signature -> string -> Lambda.lambda -> unit

jscomp/test/.depend

@@ -202,12 +202,6 @@ test_export2.cmo :
 test_export2.cmx :
 test_external.cmo :
 test_external.cmx :
-test_fastdt.cmo : ../stdlib/sys.cmi ../stdlib/string.cmi \
-    ../stdlib/random.cmi ../stdlib/printf.cmi ../stdlib/list.cmi \
-    ../stdlib/hashtbl.cmi ../stdlib/array.cmi
-test_fastdt.cmx : ../stdlib/sys.cmx ../stdlib/string.cmx \
-    ../stdlib/random.cmx ../stdlib/printf.cmx ../stdlib/list.cmx \
-    ../stdlib/hashtbl.cmx ../stdlib/array.cmx
 test_ffi.cmo :
 test_ffi.cmx :
 test_fib.cmo :
@@ -560,12 +554,6 @@ test_export2.cmo :
 test_export2.cmj :
 test_external.cmo :
 test_external.cmj :
-test_fastdt.cmo : ../stdlib/sys.cmi ../stdlib/string.cmi \
-    ../stdlib/random.cmi ../stdlib/printf.cmi ../stdlib/list.cmi \
-    ../stdlib/hashtbl.cmi ../stdlib/array.cmi
-test_fastdt.cmj : ../stdlib/sys.cmj ../stdlib/string.cmj \
-    ../stdlib/random.cmj ../stdlib/printf.cmj ../stdlib/list.cmj \
-    ../stdlib/hashtbl.cmj ../stdlib/array.cmj
 test_ffi.cmo :
 test_ffi.cmj :
 test_fib.cmo :

jscomp/test/test.mllib

@@ -13,7 +13,7 @@ test_order
 test_trywith
 arith_parser
 test_array_primitive
-test_fastdt
+# test_fastdt
 test_js_ffi
 test_pack
 test_seq