start support currying

Author: bobzhang

jscomp/js_config.ml

@@ -102,3 +102,27 @@ let runtime_set = String_set.of_list [
     "caml_lexer.js";
     "caml_string.js"
 ]
+
+
+let prim = "Caml_primitive" 
+
+let exceptions = "Caml_exceptions"
+
+let io = "Caml_io"
+
+let sys = "Caml_sys"
+
+let lex_parse = "Caml_lexer"
+
+let obj_runtime = "Caml_obj_runtime"
+
+let array = "Caml_array"
+
+let format = "Caml_format"
+
+let string = "Caml_string"
+
+let float = "Caml_float"
+
+let oo = "Caml_oo"
+let curry = "Caml_curry"

jscomp/js_config.mli

@@ -30,4 +30,29 @@ val set_env : env -> unit
 val runtime_set : String_set.t
 val stdlib_set : String_set.t
 
+val prim : string 
+
+val exceptions : string
+
+val io : string
+
+val oo : string
+
+val sys : string
+
+val lex_parse : string 
+
+val obj_runtime : string
+
+val array : string
+
+val format : string
+
+val string : string 
+
+val float : string 
+
+val curry : string 
+
+
 

jscomp/js_dump.ml

@@ -393,12 +393,24 @@ and
   | Call (e, el, info) ->
     let action () = 
       P.group f 1 (fun _ -> 
-          let () =
-            match info with
-            | {arity = NA } -> ipp_comment f (Some "!")
-            | _ -> () in
-          let cxt = expression 15 cxt f e in 
-          P.paren_group f 1 (fun _ -> arguments cxt  f el ) ) 
+
+          match info with
+          | {arity = NA } -> 
+            (* ipp_comment f (Some "!") *)
+            P.string f  Js_config.curry; 
+            P.string f L.dot;
+            let len = List.length el in
+            if len <= 8 then  
+              begin
+                P.string f (Printf.sprintf "app%d" len);
+                P.paren_group f 1 (fun _ -> arguments cxt f (e::el))
+              end
+            else assert false (* TODO *)
+           (* let cxt = expression 15 cxt f e in  *)
+            (* P.paren_group f 1 (fun _ -> arguments cxt  f el ) )  *)
+          | _ -> 
+            let cxt = expression 15 cxt f e in 
+            P.paren_group f 1 (fun _ -> arguments cxt  f el ) ) 
     in
     if l > 15 then P.paren_group f 1 action   
     else action ()

jscomp/js_fold_basic.ml

@@ -54,7 +54,16 @@ class count_hard_dependencies =
       | Qualified (id,kind,_) ->
           Hash_set.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_helper.Exp.runtime_var_dot] *)
+        -> begin 
+            Hash_set.add hard_dependencies 
+              (Lam_module_ident.of_runtime (Ext_ident.create_js Js_config.curry));
+            super#expression x             
+          end
+      | _ -> super#expression x
     method get_hard_dependencies = hard_dependencies
   end
 

jscomp/js_helper.ml

@@ -18,30 +18,6 @@
 
 (* Author: Hongbo Zhang  *)
 
-
-
-let prim = "Caml_primitive" 
-
-let exceptions = "Caml_exceptions"
-
-let io = "Caml_io"
-
-let sys = "Caml_sys"
-
-let lex_parse = "Caml_lexer"
-
-let obj_runtime = "Caml_obj_runtime"
-
-let array = "Caml_array"
-
-let format = "Caml_format"
-
-let string = "Caml_string"
-
-let float = "Caml_float"
-
-let oo = "Caml_oo"
-
 let no_side_effect = Js_analyzer.no_side_effect_expression
 
 type binary_op =   ?comment:string -> J.expression -> J.expression -> J.expression 

jscomp/js_helper.mli

@@ -22,27 +22,7 @@
 
 (** Creator utilities for the [J] module *) 
 
-val prim : string 
 
-val exceptions : string
-
-val io : string
-
-val oo : string
-
-val sys : string
-
-val lex_parse : string 
-
-val obj_runtime : string
-
-val array : string
-
-val format : string
-
-val string : string 
-
-val float : string 
 
 val no_side_effect : J.expression -> bool
 

jscomp/js_of_lam_string.ml

@@ -67,10 +67,10 @@ module A = struct
  *)
 
   let bytes_to_string e = 
-    E.runtime_call Js_helper.string "bytes_to_string" [e]
+    E.runtime_call Js_config.string "bytes_to_string" [e]
 
   let bytes_of_string s =
-    E.runtime_call Js_helper.string "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 
@@ -120,10 +120,10 @@ module B = struct
  *)
 
   let bytes_to_string e = 
-    E.runtime_call Js_helper.string "bytes_to_string" [e]
+    E.runtime_call Js_config.string "bytes_to_string" [e]
 
   let bytes_of_string s =
-    E.runtime_call Js_helper.string "bytes_of_string" [s]
+    E.runtime_call Js_config.string "bytes_of_string" [s]
 end
 
 (* include A *)

jscomp/lam_compile.ml

@@ -122,7 +122,7 @@ and compile_recursive_let (cxt : Lam_compile_defs.cxt) (id : Ident.t) (arg : Lam
             could be improved for simple cases
         *)
         Js_output.of_block  (
-          b  @ [S.exp(E.runtime_call Js_helper.prim "caml_update_dummy" [ E.var id;  v])]),
+          b  @ [S.exp(E.runtime_call Js_config.prim "caml_update_dummy" [ E.var id;  v])]),
         [id]
       (* S.define ~kind:Variable id (E.arr Mutable [])::  *)
       | _ -> assert false 
@@ -1143,7 +1143,7 @@ and
 
         | Cached | Public None  (* TODO: check -- 1. js object propagate 2. js object create  *)
           -> 
-          let get = E.runtime_ref  Js_helper.oo "caml_get_public_method" in
+          let get = E.runtime_ref  Js_config.oo "caml_get_public_method" in
           let cache = !method_cache_id in
           let () = 
             begin 
@@ -1207,7 +1207,7 @@ and
               end in
               (* Js_output.make [S.unknown_lambda lam] ~value:(E.unit ()) *)
               Js_output.handle_block_return st should_return lam (List.concat args_code)
-                (E.call (E.runtime_call Js_helper.oo "caml_get_public_method"
+                (E.call (E.runtime_call Js_config.oo "caml_get_public_method"
                            [obj'; label; E.int cache]) (obj'::args))
                 (* avoid duplicated compuattion *)
           end

jscomp/lam_compile_global.ml

@@ -66,7 +66,7 @@ let get_exp (key : Lam_compile_env.key) : J.expression =
     if Ident.is_predef_exn id 
     then 
       begin 
-        E.runtime_ref Js_helper.exceptions id.name
+        E.runtime_ref Js_config.exceptions id.name
       end
     else 
       Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) env

jscomp/lam_compile_group.ml

@@ -41,7 +41,7 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
   | Single(_, ({name="stdout"|"stderr"|"stdin";_} as id),_ ),
     "pervasives.ml" -> 
     Js_output.of_stmt @@ S.alias_variable id
-      ~exp:(E.runtime_ref  Js_helper.io id.name)
+      ~exp:(E.runtime_ref  Js_config.io id.name)
   (* 
          we delegate [stdout, stderr, and stdin] into [caml_io] module, 
          the motivation is to help dead code eliminatiion, it's helpful 

jscomp/lam_dispatch_primitive.ml

@@ -263,7 +263,7 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_hypot_float"
 
       ->
-      E.runtime_call Js_helper.float prim.prim_name args
+      E.runtime_call Js_config.float prim.prim_name args
     | "caml_fmod_float" 
       (* float module like js number module *)      
       ->      
@@ -329,7 +329,7 @@ let query (prim : Lam_compile_env.primitive_description)
           E.uninitialized_array v 
         (* TODO: inline and spits out a warning when i is negative *)
         | _ -> 
-          E.runtime_call Js_helper.string prim.prim_name args
+          E.runtime_call Js_config.string prim.prim_name args
       end
 
     | "caml_string_get"
@@ -343,7 +343,7 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_blit_string" 
     | "caml_blit_bytes"
       -> 
-      E.runtime_call Js_helper.string prim.prim_name args
+      E.runtime_call Js_config.string prim.prim_name args
 
     | "caml_register_named_value" -> 
       (**
@@ -423,12 +423,12 @@ let query (prim : Lam_compile_env.primitive_description)
                       ([ tag; str ; 
                          E.prefix_inc
                            (E.runtime_var_vid
-                              Js_helper.exceptions
+                              Js_config.exceptions
                               "caml_oo_last_id") 
                        ], flag)
           }
         | _ ->  
-          E.runtime_call Js_helper.exceptions prim.prim_name args 
+          E.runtime_call Js_config.exceptions prim.prim_name args 
       end
 
     | "caml_sys_const_big_endian" -> 
@@ -455,12 +455,12 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_sys_random_seed"
     | "caml_sys_getenv"
     | "caml_sys_system_command" -> 
-      E.runtime_call Js_helper.sys prim.prim_name args 
+      E.runtime_call Js_config.sys prim.prim_name args 
     | "caml_lex_engine"
     | "caml_new_lex_engine"
     | "caml_parse_engine"
     | "caml_set_parser_trace" -> 
-      E.runtime_call Js_helper.lex_parse prim.prim_name args 
+      E.runtime_call Js_config.lex_parse prim.prim_name args 
 
     | "caml_array_sub"
     | "caml_array_concat"
@@ -469,7 +469,7 @@ let query (prim : Lam_compile_env.primitive_description)
 
     | "caml_array_blit"
     | "caml_make_vect" -> 
-      E.runtime_call Js_helper.array prim.prim_name args 
+      E.runtime_call Js_config.array prim.prim_name args 
     | "caml_ml_flush"
     | "caml_ml_out_channels_list"
     | "caml_ml_open_descriptor_in" 
@@ -478,7 +478,7 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_ml_output" 
     | "caml_ml_input_char"
       -> 
-      E.runtime_call Js_helper.io prim.prim_name args 
+      E.runtime_call Js_config.io prim.prim_name args 
 
     | "caml_obj_dup" -> 
       (** Note currently is an Array copy function, this is tightly coupled with 
@@ -490,7 +490,7 @@ let query (prim : Lam_compile_env.primitive_description)
         match args with 
         | [ a ] when Js_helper.is_constant a ->  a 
         | _ -> 
-          E.runtime_call Js_helper.obj_runtime prim.prim_name args 
+          E.runtime_call Js_config.obj_runtime prim.prim_name args 
       end
     | "caml_obj_block" -> 
       (** TODO: Optimize  for [CamlinternalOO] input 
@@ -504,7 +504,7 @@ let query (prim : Lam_compile_env.primitive_description)
             {expression_desc = Number (Int { i = 0;_}); _} ] ->
           E.arr Immutable [E.int tag] (** size 0*)
         | _ -> 
-          E.runtime_call Js_helper.obj_runtime prim.prim_name args 
+          E.runtime_call Js_config.obj_runtime prim.prim_name args 
 
       end
     | "caml_obj_is_block"
@@ -514,7 +514,7 @@ let query (prim : Lam_compile_env.primitive_description)
 
     | "caml_obj_truncate"
     | "caml_lazy_make_forward" -> 
-      E.runtime_call Js_helper.obj_runtime prim.prim_name args 
+      E.runtime_call Js_config.obj_runtime prim.prim_name args 
 
     | "caml_format_float"
     | "caml_format_int"
@@ -524,7 +524,7 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_int_of_string" (* what is the semantics?*)
     | "caml_int32_of_string"
     | "caml_nativeint_of_string" -> 
-      E.runtime_call Js_helper.format prim.prim_name args
+      E.runtime_call Js_config.format prim.prim_name args
 
 
     (*   "caml_alloc_dummy"; *)
@@ -549,10 +549,10 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_int32_bswap"
     | "caml_nativeint_bswap"
     | "caml_int64_bswap"
-      -> E.runtime_call Js_helper.prim prim.prim_name args 
+      -> E.runtime_call Js_config.prim prim.prim_name args 
     | "caml_get_public_method"
       ->
-      E.runtime_call Js_helper.oo prim.prim_name args      
+      E.runtime_call Js_config.oo prim.prim_name args      
     (** TODO: Primitives not implemented yet ...*)
     | "caml_install_signal_handler"
     | "caml_output_value_to_buffer"
@@ -596,7 +596,7 @@ let query (prim : Lam_compile_env.primitive_description)
     | "caml_ml_seek_out_64"
     | "caml_ml_set_binary_mode"
     | "caml_sys_getcwd" (* check browser or nodejs *)
-      ->  E.runtime_call Js_helper.prim prim.prim_name args 
+      ->  E.runtime_call Js_config.prim prim.prim_name args 
 
 
     | "js_function_length"

jscomp/runtime/.depend

@@ -3,17 +3,17 @@ caml_oo.cmi :
 caml_string.cmi :
 caml_array.cmo : caml_array.cmi
 caml_array.cmx : caml_array.cmi
+caml_curry.cmo :
+caml_curry.cmx :
 caml_oo.cmo : caml_oo.cmi
 caml_oo.cmx : caml_oo.cmi
 caml_string.cmo : caml_string.cmi
 caml_string.cmx : caml_string.cmi
-curry.cmo :
-curry.cmx :
 caml_array.cmo : caml_array.cmi
 caml_array.cmj : caml_array.cmi
+caml_curry.cmo :
+caml_curry.cmj :
 caml_oo.cmo : caml_oo.cmi
 caml_oo.cmj : caml_oo.cmi
 caml_string.cmo : caml_string.cmi
 caml_string.cmj : caml_string.cmi
-curry.cmo :
-curry.cmj :