[refact & fix] fix null_def case, add a regression test and clean up to-do lists (#344)

Author: bobzhang

jscomp/ext_ident.ml

@@ -29,17 +29,17 @@
 
 
 
-let js_flag = 8 (* check with ocaml compiler *)
+let js_flag = 0b1000 (* check with ocaml compiler *)
 
-let js_module_flag = 16 (* javascript external modules *)
+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 = 32 (* javascript object flags *)
+let js_object_flag = 0b10_0000 (* javascript object flags *)
 
 let is_js (i : Ident.t) = 
   i.flags land js_flag <> 0 

jscomp/ident_map.ml

@@ -33,7 +33,16 @@
 
 include Map.Make(struct 
   type t = Ident.t 
-  let compare  = Pervasives.compare (**TODO: fix me*)
+
+  let compare (x : t) (y : t) =
+    (* Can not overflow *)
+    let u = x.stamp - y.stamp in
+    if u = 0 then 
+      let u = String.compare x.name y.name in 
+      if u = 0 then 
+        x.flags - y.flags 
+      else  u 
+    else u 
 end)
 
 let of_list lst = 

jscomp/ident_map.mli

@@ -0,0 +1,33 @@
+(* 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.S with type key = Ident.t 
+
+val of_list  : (key * 'a) list -> 'a t
+
+val keys : 'a t -> key list
+
+val add_if_not_exist : key -> 'a -> 'a t -> 'a t
+
+val merge_disjoint : 'a t -> 'a t -> 'a t

jscomp/lam_comb.ml

@@ -27,7 +27,9 @@
 
 
 type t = Lambda.lambda
-
+type binop = t -> t -> t 
+type triop = t -> t -> t -> t 
+type unop = t -> t 
 let if_ a (b : t) c = 
   match a with
   | Lambda.Lconst v ->
@@ -65,3 +67,56 @@ let stringswitch lam cases default =
         end
     end
   | _ -> Lambda.Lstringswitch(lam, cases, default)
+
+
+let true_ : Lambda.lambda =
+  Lconst (Const_pointer ( 1, Pt_constructor "true")) 
+
+let false_ : Lambda.lambda =
+  Lconst (Const_pointer( 0, Pt_constructor "false"))
+
+let unit : Lambda.lambda = 
+  Lconst (Const_pointer( 0, Pt_constructor "()"))
+
+let not x : t = 
+  Lambda.Lprim (Pnot, [x])
+
+(** [l || r ] *)
+let sequor l r = if_ l true_ r 
+
+(** [l && r ] *)
+let sequand l r = if_ l r false_
+
+module Prim = struct 
+  type t = Lambda.primitive
+  let js_is_nil : t = 
+    Lambda.Pccall{ prim_name = "js_is_nil";
+                   prim_arity = 1 ;
+                   prim_alloc = false;
+                   prim_native_name = "js_is_nil";
+                   prim_native_float = false;
+                   prim_attributes = [];
+                   prim_ty = None
+                 }
+
+  let js_is_undef : t = 
+    Lambda.Pccall{ prim_name = "js_is_undef";
+                   prim_arity = 1 ;
+                   prim_alloc = false;
+                   prim_native_name = "js_is_undef";
+                   prim_native_float = false;
+                   prim_attributes = [];
+                   prim_ty = None
+                 }
+
+  let js_is_nil_undef : t  = 
+    Lambda.Pccall{ prim_name = "js_is_nil_undef";
+                   prim_arity = 1 ;
+                   prim_alloc = false;
+                   prim_native_name = "js_is_nil_undef";
+                   prim_native_float = false;
+                   prim_attributes = [];
+                   prim_ty = None
+                 }
+
+end

jscomp/lam_comb.mli

@@ -23,33 +23,29 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+type t = Lambda.lambda 
 
+type binop = t -> t -> t 
 
+type triop = t -> t -> t -> t 
 
+type unop = t ->  t
 
-(* 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 if_ : triop
+val switch : t -> Lambda.lambda_switch  -> t 
+val stringswitch : t -> (string * t) list -> t option -> t 
 
-type t = Lambda.lambda 
+val true_ : t 
+val false_ : t 
+val unit : t 
 
+val sequor : binop
+val sequand : binop
+val not : unop
 
-val if_ : t -> t -> t  -> t
-val switch : t -> Lambda.lambda_switch  -> t 
-val stringswitch : t -> (string * t) list -> t option -> t 
+module Prim : sig 
+  type t = Lambda.primitive
+  val js_is_nil : t 
+  val js_is_undef : t 
+  val js_is_nil_undef : t 
+end

jscomp/lam_compile.ml

@@ -677,7 +677,7 @@ and
         | {should_return = True _ } 
           (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
           ->
-          compile_lambda cxt (Lam_comb.if_ l r Lam_util.lam_false )
+          compile_lambda cxt (Lam_comb.sequand  l r )
         | _ -> 
           let l_block,l_expr = 
             match compile_lambda {cxt with st = NeedValue; should_return = False} l with 
@@ -700,7 +700,7 @@ and
         | {should_return = True _ }
           (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
           ->
-          compile_lambda cxt @@ Lam_comb.if_  l Lam_util.lam_true r
+          compile_lambda cxt @@ Lam_comb.sequor l r
         | _ ->
           let l_block,l_expr =
             match compile_lambda {cxt with st = NeedValue; should_return = False} l with
@@ -772,7 +772,7 @@ and
               compile_lambda cxt 
                   (Lfunction (Lambda.Curried, [], 
                               Lambda.Lapply(fn, 
-                                            [Lam_util.lam_unit],
+                                            [Lam_comb.unit],
                                             Lam_util.default_apply_info 
                                            )))
             else 

jscomp/lam_pass_remove_alias.ml

@@ -67,29 +67,20 @@ let simplify_alias
         -> simpl l2 
       | ImmutableBlock ( [| SimpleForm l |]  , x) 
         -> 
-        begin match x with 
-        | Null 
-          -> 
-          Lam_comb.if_ 
-            ( Lprim (Lam_util.js_is_nil_primitive, [l])) 
-            (simpl l3)  
-            (simpl l2)
-        | Undefined 
-          -> 
-          Lam_comb.if_ 
-            (Lprim (Lam_util.js_is_undef_primitive, [l]))
-            (simpl l3)
-            (simpl l2)
-        | Null_undefined (* TODO: fix me*)
-          -> 
-          Lam_comb.if_ 
-            ( Lprim (Pintcomp Ceq, [l; Lvar Ext_ident.nil])) 
-            (simpl l3)  
-            (simpl l2)
-
-        | Normal -> 
-          Lam_comb.if_ l1 (simpl l2) (simpl l3)
-        end
+        let l1 = 
+          match x with 
+          | Null 
+            -> Lam_comb.not ( Lprim (Lam_comb.Prim.js_is_nil, [l])) 
+          | Undefined 
+            -> 
+            Lam_comb.not (Lprim (Lam_comb.Prim.js_is_undef, [l]))
+          | Null_undefined
+            -> 
+            Lam_comb.not
+              ( Lprim (Lam_comb.Prim.js_is_nil_undef,  [l])) 
+          | Normal ->  l1 
+        in 
+        Lam_comb.if_ l1 (simpl l2) (simpl l3)
       | _ -> Lam_comb.if_ l1 (simpl l2) (simpl l3)
 
       | exception Not_found -> Lam_comb.if_ l1 (simpl l2) (simpl l3)

jscomp/lam_util.ml

@@ -324,14 +324,6 @@ let mk_apply_info ?(loc = Location.none)  apply_status : Lambda.apply_info =
   { apply_loc = loc; apply_status }
 
 
-let lam_true : Lambda.lambda =
-  Lconst (Const_pointer ( 1, Pt_constructor "true")) 
-
-let lam_false : Lambda.lambda =
-  Lconst (Const_pointer( 0, Pt_constructor "false"))
-
-let lam_unit : Lambda.lambda = 
-  Lconst (Const_pointer( 0, Pt_constructor "()"))
 
 let is_function (lam : Lambda.lambda) = 
   match lam with 
@@ -404,32 +396,3 @@ let eta_conversion n info fn args =
 let default_apply_info : Lambda.apply_info = 
   { apply_status = App_na ; apply_loc = Location.none }
 
-let js_is_nil_primitive = 
-  Lambda.Pccall{ prim_name = "js_is_nil";
-    prim_arity = 1 ;
-    prim_alloc = false;
-    prim_native_name = "js_is_nil";
-    prim_native_float = false;
-    prim_attributes = [];
-    prim_ty = None
-  }
-
-let js_is_undef_primitive = 
-  Lambda.Pccall{ prim_name = "js_is_undef";
-    prim_arity = 1 ;
-    prim_alloc = false;
-    prim_native_name = "js_is_undef";
-    prim_native_float = false;
-    prim_attributes = [];
-    prim_ty = None
-  }
-
-let js_is_nil_undef_primitive = 
-  Lambda.Pccall{ prim_name = "js_is_nil_undef";
-    prim_arity = 1 ;
-    prim_alloc = false;
-    prim_native_name = "js_is_nil_undef";
-    prim_native_float = false;
-    prim_attributes = [];
-    prim_ty = None
-  }

jscomp/lam_util.mli

@@ -68,9 +68,7 @@ val print_ident_set : Format.formatter -> Ident_set.t -> unit
 
 val mk_apply_info : ?loc:Location.t -> Lambda.apply_status -> Lambda.apply_info
 
-val lam_true : Lambda.lambda
-val lam_false : Lambda.lambda
-val lam_unit : Lambda.lambda 
+
 
 val not_function : Lambda.lambda -> bool 
 val is_function : Lambda.lambda -> bool 
@@ -82,6 +80,3 @@ val eta_conversion :
 
 val default_apply_info : Lambda.apply_info
 
-val js_is_nil_primitive : Lambda.primitive
-val js_is_undef_primitive : Lambda.primitive
-val js_is_nil_undef_primitive : Lambda.primitive

jscomp/runtime/caml_weak.js

@@ -30,11 +30,11 @@ function caml_weak_get(xs, i) {
 
 function caml_weak_get_copy(xs, i) {
   var match = xs[i];
-  if (match === undefined) {
-    return /* None */0;
+  if (match !== undefined) {
+    return /* Some */[Caml_obj.caml_obj_dup(match)];
   }
   else {
-    return /* Some */[Caml_obj.caml_obj_dup(match)];
+    return /* None */0;
   }
 }
 

jscomp/test/.depend

@@ -593,8 +593,8 @@ test_while_closure.cmo : ../stdlib/array.cmi
 test_while_closure.cmx : ../stdlib/array.cmx
 test_while_side_effect.cmo :
 test_while_side_effect.cmx :
-test_zero_nullable.cmo : ../lib/js.cmo
-test_zero_nullable.cmx : ../lib/js.cmx
+test_zero_nullable.cmo : mt.cmi ../lib/js.cmo
+test_zero_nullable.cmx : mt.cmx ../lib/js.cmx
 testing.cmo : ../stdlib/scanf.cmi ../stdlib/printf.cmi testing.cmi
 testing.cmx : ../stdlib/scanf.cmx ../stdlib/printf.cmx testing.cmi
 tfloat_record_test.cmo : mt_global.cmi mt.cmi ../stdlib/format.cmi \
@@ -1201,8 +1201,8 @@ test_while_closure.cmo : ../stdlib/array.cmi
 test_while_closure.cmj : ../stdlib/array.cmj
 test_while_side_effect.cmo :
 test_while_side_effect.cmj :
-test_zero_nullable.cmo : ../lib/js.cmo
-test_zero_nullable.cmj : ../lib/js.cmj
+test_zero_nullable.cmo : mt.cmi ../lib/js.cmo
+test_zero_nullable.cmj : mt.cmj ../lib/js.cmj
 testing.cmo : ../stdlib/scanf.cmi ../stdlib/printf.cmi testing.cmi
 testing.cmj : ../stdlib/scanf.cmj ../stdlib/printf.cmj testing.cmi
 tfloat_record_test.cmo : mt_global.cmi mt.cmi ../stdlib/format.cmi \