1. add complete object ffi support

2. add zero cost nullable support

Author: Hongbo Zhang

.gitignore

@@ -45,7 +45,7 @@ ocaml/man
 *~
 *.annot
 *.mj
-jscomp/bench/*.js
+
 *.bak
 .vscode
 *.jsx

jscomp/compiler.mllib

@@ -60,9 +60,11 @@ lam_register
 lam_analysis
 lam_group
 lam_current_unit
+lam_methname 
 
 j
 js_config
+js_array
 js_program_loader
 js_output
 js_dump
@@ -75,6 +77,8 @@ js_pass_flatten_and_mark_dead
 js_pass_scope
 js_call_info
 js_pass_debug
+
+js_of_lam_option
 js_of_lam_float_record
 js_of_lam_record
 js_of_lam_tuple

jscomp/ext_ident.ml

@@ -35,6 +35,9 @@ let js_object_flag = 32 (* 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 
 
@@ -234,3 +237,6 @@ let reset () =
   begin
     Hashtbl.clear js_module_table
   end
+
+let undefined = create_js "undefined"
+let null = create_js "null"

jscomp/ext_ident.mli

@@ -43,3 +43,6 @@ val make_unused : unit -> Ident.t
 val is_unused_ident : Ident.t -> bool 
 
 val convert : string -> string
+val undefined : Ident.t 
+val is_js_or_global : Ident.t -> bool
+val null : Ident.t

jscomp/ext_list.ml

@@ -116,6 +116,13 @@ let take n l =
   else (Array.to_list (Array.sub arr 0 n ), 
         Array.to_list (Array.sub arr n (arr_length - n)))
 
+let try_take n l = 
+  let arr = Array.of_list l in 
+  let arr_length =  Array.length arr in
+  if arr_length  <= n then 
+    l,  arr_length, []
+  else Array.to_list (Array.sub arr 0 n ), n, (Array.to_list (Array.sub arr n (arr_length - n)))
+
 let exclude_tail (x : 'a list) : 'a list = 
   let rec aux acc x = 
     match x with 

jscomp/ext_list.mli

@@ -31,6 +31,7 @@ val same_length : 'a list -> 'b list -> bool
 val init : int -> (int -> 'a) -> 'a list
 
 val take : int -> 'a list -> 'a list * 'a list
+val try_take : int -> 'a list -> 'a list * int * 'a list 
 
 val exclude_tail : 'a list -> 'a list
 

jscomp/ext_log.ml

@@ -25,7 +25,7 @@
 type 'a logging =  ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a
 
 let err str f  =
-  Format.fprintf Format.err_formatter ("%s " ^^ f) str  
+  Format.fprintf Format.err_formatter ("%s " ^^ f ^^ "@.") str  
 
 let ierr b str f  =
   if b then 

jscomp/ext_string.ml

@@ -38,6 +38,7 @@ let split_by ?(keep_empty=false) is_delim str =
   loop [] len (len - 1)
 
 let split ?keep_empty  str on = 
+  if str = "" then [] else 
   split_by ?keep_empty (fun x -> (x : char) = on) str  ;;
 
 let starts_with s beg = 
@@ -102,3 +103,49 @@ let repeat n s  =
   Bytes.to_string res
 
 let equal (x : string) y  = x = y
+
+
+
+let _is_sub ~sub i s j ~len =
+  let rec check k =
+    if k = len
+    then true
+    else 
+      String.unsafe_get sub (i+k) = 
+      String.unsafe_get s (j+k) && check (k+1)
+  in
+  j+len <= String.length s && check 0
+
+
+
+let find ?(start=0) ~sub s =
+  let n = String.length sub in
+  let i = ref start in
+  let module M = struct exception Exit end  in
+  try
+    while !i + n <= String.length s do
+      if _is_sub ~sub 0 s !i ~len:n then raise M.Exit;
+      incr i
+    done;
+    -1
+  with M.Exit ->
+    !i
+
+
+let rfind ~sub s =
+  let n = String.length sub in
+  let i = ref (String.length s - n) in
+  let module M = struct exception Exit end in 
+  try
+    while !i >= 0 do
+      if _is_sub ~sub 0 s !i ~len:n then raise M.Exit;
+      decr i
+    done;
+    -1
+  with M.Exit ->
+    !i
+
+let tail_from s x = 
+  let len = String.length s  in 
+  if  x > len then invalid_arg ("Ext_string.tail_from " ^s ^ " : "^ string_of_int x )
+  else String.sub s x (len - x)

jscomp/ext_string.mli

@@ -41,3 +41,9 @@ val is_empty : string -> bool
 val repeat : int -> string -> string 
 
 val equal : string -> string -> bool
+
+val find : ?start:int -> sub:string -> string -> int
+
+val rfind : sub:string -> string -> int
+
+val tail_from : string -> int -> string

jscomp/idents_analysis.ml

@@ -38,7 +38,20 @@ let calculate_used_idents
     Ident_set.(
     delta := 
       diff (fold (fun  id acc  ->
-        union acc (Hashtbl.find ident_free_vars id ))  !delta empty)
+
+          if Ext_ident.is_js_or_global id  then
+            acc (* will not pull in dependencies  any more *)             
+          else
+            union acc (
+              begin match Hashtbl.find ident_free_vars id with 
+                | exception Not_found -> 
+                  Ext_log.err __LOC__ "%s/%d" id.name id.stamp; 
+                  assert false 
+                | e -> e 
+              end
+            )
+
+        )  !delta empty)
         !current_ident_sets;
      not (is_empty !delta)) do
     current_ident_sets := Ident_set.(union !current_ident_sets !delta)

jscomp/j.ml

@@ -165,6 +165,11 @@ and expression_desc =
        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 

jscomp/js_analyzer.ml

@@ -87,6 +87,9 @@ let rec no_side_effect (x : J.expression)  =
           the block is mutable does not mean this operation is non-pure
        *)
       List.for_all no_side_effect  xs 
+  | Bind(fn, obj) -> no_side_effect fn && no_side_effect obj
+  | Object kvs -> 
+    List.for_all (fun (_property_name, y) -> no_side_effect y ) kvs 
   | Array_append (a,b) 
   | String_append (a,b)
   | Seq (a,b) -> no_side_effect a && no_side_effect b 
@@ -117,7 +120,7 @@ let rec no_side_effect (x : J.expression)  =
   | New _ 
   | Caml_uninitialized_obj _
   | String_access _
-  | Object _
+
   | Caml_block_set_tag _ 
   | Caml_block_set_length _ (* actually true? *)
     -> false 

jscomp/js_array.ml

@@ -0,0 +1,27 @@
+(* 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  *)
+
+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

jscomp/js_array.mli

@@ -0,0 +1,24 @@
+(* 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  *)
+
+
+val set_array : J.expression -> J.expression -> J.expression -> J.expression
+
+val ref_array : J.expression -> J.expression -> J.expression

jscomp/js_dump.ml

@@ -90,6 +90,7 @@ module L = struct
 
   let curry = "curry" (* curry arbitrary args *)
   let tag = "tag"
+  let bind = "bind"
 end
 let return_indent = (String.length L.return / Ext_pp.indent_length) 
 
@@ -419,7 +420,11 @@ and
     in
     if l > 15 then P.paren_group f 1 action   
     else action ()
-
+  | Bind (a,b) -> 
+    begin
+      expression_desc cxt l f  
+        (Call ({expression_desc = Dot(a,L.bind, true); comment = None }, [b], {arity = Full}))
+    end    
   (* | Tag_ml_obj e ->  *)
   (*   P.group f 1 (fun _ ->  *)
   (*       P.string f "Object.defineProperty"; *)
@@ -1056,6 +1061,7 @@ and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t =
       | Caml_block  _ 
       | FlatCall _ 
       | Typeof _
+      | Bind _ 
       | Number _
       | Not _ 
       | New _ 

jscomp/js_exp_make.ml

@@ -188,6 +188,9 @@ let index ?comment (e0 : t)  (e1 : int) : t =
   match e0.expression_desc with
   | Array (l,_mutable_flag)  when no_side_effect e0 -> 
     List.nth l  e1  (* Float i -- should not appear here *)
+  | Caml_block (l,_mutable_flag, _, _)  when no_side_effect e0 -> 
+    List.nth l  e1  (* Float i -- should not appear here *)
+
   | _ -> { expression_desc = Access (e0, int e1); comment} 
 
 let call ?comment ?info e0 args : t = 
@@ -237,7 +240,7 @@ let is_caml_block ?comment (e : t) : t =
 let array_length ?comment (e : t) : t = 
   match e.expression_desc with 
   (* TODO: use array instead? *)
-  | Array (l, _) -> int ?comment (List.length l)
+  | (Array (l, _) | Caml_block(l,_,_,_)) when no_side_effect e -> int ?comment (List.length l)
   | _ -> { expression_desc = Length (e, Array) ; comment }
 
 let string_length ?comment (e : t) : t =
@@ -330,6 +333,18 @@ let tag_ml_obj ?comment e : t =
 let var_dot ?comment (x : Ident.t)  (e1 : string) : t = 
   {expression_desc = Dot (var x,  e1, true); comment} 
 
+let bind_call ?comment obj  (e1 : string) args  : t = 
+  call {expression_desc = 
+     Bind ({expression_desc = Dot (obj,  e1, true); comment} , obj);
+   comment = None } args 
+
+let bind_var_call ?comment (x : Ident.t)  (e1 : string) args  : t = 
+  let obj =  var x in 
+  call {expression_desc = 
+     Bind ({expression_desc = Dot (obj,  e1, true); comment} , obj);
+   comment = None } args 
+
+
 (* Dot .....................**)        
 
 let float ?comment f : t = 
@@ -466,7 +481,7 @@ let rec econd ?comment (b : t) (t : t) (f : t) : t =
 
   | Number ((Int { i = 0; _}) ), _, _ 
     -> f  (* TODO: constant folding: could be refined *)
-  | (Number _ | Array _), _, _ 
+  | (Number _ | Array _ | Caml_block _), _, _ when no_side_effect b &&  no_side_effect f 
     -> t  (* a block can not be false in OCAML, CF - relies on flow inference*)
   | (Bin (Bor, v , {expression_desc = Number (Int {i = 0 ; _})})), _, _
     -> econd v t f 
@@ -687,6 +702,9 @@ let tag ?comment e : t =
      Bin (Bor, {expression_desc = Caml_block_tag e; comment }, int 0 );
    comment = None }    
 
+let bind ?comment fn obj  : t = 
+  {expression_desc = Bind (fn, obj) ; comment }
+
 let public_method_call meth_name obj label cache args = 
   let len = List.length args in 
   (** FIXME: not caml object *)
@@ -714,13 +732,26 @@ let public_method_call meth_name obj label cache args =
        how about x#|getElementById|2|
     *)
     (
-      if len <=8 then 
+      let fn = bind (dot obj meth_name) obj in
+      if len = 0 then 
+        dot obj meth_name
+        (* Note that when no args supplied, 
+           it is not necessarily a function, [bind]
+           is dangerous
+           so if user write such code
+           {[
+             let  u = x # say in
+             u 3              
+           ]}    
+           It's reasonable to drop [this] support       
+        *)
+      else if len <=8 then 
         let len_str = string_of_int len in
         runtime_call Js_config.curry ("app"^len_str) 
-          (dot obj meth_name ::  args)
+          (fn ::  args)
       else 
         runtime_call Js_config.curry "app"           
-          [dot obj meth_name ; arr NA args ]            
+          [fn  ; arr NA args ]            
     )
 
 let set_tag ?comment e tag : t = 

jscomp/js_exp_make.mli

@@ -118,7 +118,8 @@ val string_append : binary_op
 val tag_ml_obj : unary_op
 
 val var_dot : ?comment:string -> Ident.t -> string -> t
-
+val bind_var_call : ?comment:string -> Ident.t -> string -> t list -> t 
+val bind_call : ?comment:string -> J.expression -> string -> J.expression list -> t
 val js_global_dot : ?comment:string -> string -> string -> t
 
 val index : ?comment:string -> t -> int -> t
@@ -244,3 +245,4 @@ val dummy_obj : ?comment:string ->  unit -> t
 (** convert a block to expresion by using IIFE *)    
 val of_block : ?comment:string -> J.statement list -> J.expression -> t
 
+val bind : binary_op