finish imul, add, sub support -- fix print ~ operator

jscomp/ext_ident.ml

@@ -225,6 +225,7 @@ let convert (name : string) =
      | '|' -> 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)

jscomp/ext_pervasives.ml

@@ -40,3 +40,14 @@ let with_file_as_pp filename f =
       Format.pp_print_flush fmt ();
       v
     ) close_out
+
+
+let  is_pos_pow n = 
+  let module M = struct exception E end in 
+  let rec aux c (n : Int32.t) = 
+    if n <= 0l then -2 
+    else if n = 1l then c 
+    else if Int32.logand n 1l =  0l then   
+      aux (c + 1) (Int32.shift_right n 1 )
+    else raise M.E in 
+  try aux 0 n  with M.E -> -1

jscomp/ext_pervasives.mli

@@ -29,3 +29,5 @@ val finally : 'a -> ('a -> 'b) -> ('a -> 'c) -> 'b
 val with_file_as_chan : string -> (out_channel -> 'a) -> 'a
 
 val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a
+
+val is_pos_pow : Int32.t -> int

jscomp/js_analyzer.ml

@@ -71,8 +71,8 @@ let free_variables_of_statement used_idents defined_idents st =
 let free_variables_of_expression used_idents defined_idents st = 
   ((free_variables used_idents defined_idents)#expression st) # get_depenencies
 
-let rec no_side_effect (x : J.expression)  = 
-  match x.expression_desc with 
+let rec no_side_effect_expression_desc (x : J.expression_desc)  = 
+  match x with 
   | Bool _ -> true 
   | Var _ -> true 
   | Access (a,b) -> no_side_effect a && no_side_effect b 
@@ -125,6 +125,8 @@ let rec no_side_effect (x : J.expression)  =
   | Caml_block_set_tag _ 
   | Caml_block_set_length _ (* actually true? *)
     -> false 
+and no_side_effect (x : J.expression)  = 
+  no_side_effect_expression_desc x.expression_desc
 
 let no_side_effect_expression (x : J.expression) = no_side_effect x 
 

jscomp/js_analyzer.mli

@@ -31,8 +31,10 @@ val free_variables_of_statement :
 val free_variables_of_expression : 
     Ident_set.t -> Ident_set.t -> J.finish_ident_expression -> Ident_set.t
 
+val no_side_effect_expression_desc :
+  J.expression_desc -> bool   
 val no_side_effect_expression : 
-    J.expression -> bool
+  J.expression -> bool
 (** [no_side_effect] means this expression has no side effect, 
     but it might *depend on value store*, so you can not just move it around,
 

jscomp/js_exp_make.ml

@@ -916,7 +916,7 @@ let to_uint32 ?comment (e : J.expression)  : J.expression =
    we can apply a more general optimization here, 
    do some algebraic rewerite rules to rewrite [triple_equal]           
 *)        
-let is_out ?comment (e : t) (range : t) : t  = 
+let rec is_out ?comment (e : t) (range : t) : t  = 
   begin match range.expression_desc, e.expression_desc with 
 
     | Number (Int {i = 1l}), Var _ 
@@ -925,8 +925,8 @@ let is_out ?comment (e : t) (range : t) : t  =
     | Number (Int {i = 1l}), 
       (
         Bin (Plus , {expression_desc = Number (Int {i ; _}) }, {expression_desc = Var _; _})
-      | Bin (Plus, {expression_desc = Var _; _}, {expression_desc = Number (Int {i ; _}) })
-      ) 
+      | Bin (Plus, {expression_desc = Var _; _}, {expression_desc = Number (Int {i ; _}) }))
+
       ->
       not (or_ (triple_equal e (int (Int32.neg i ))) (triple_equal e (int (Int32.sub Int32.one  i))))        
     | Number (Int {i = 1l}), 
@@ -946,6 +946,16 @@ let is_out ?comment (e : t) (range : t) : t  =
       *)        
       or_ (int_comp Cgt e (int ( k)))  (int_comp Clt e  zero_int_literal)
 
+    | _, Bin (Bor ,
+             ({expression_desc =
+                (Bin((Plus | Minus ) ,
+                    {expression_desc = Number (Int {i ; _}) }, {expression_desc = Var _; _})
+                |Bin((Plus | Minus ) ,
+                    {expression_desc = Var _; _}, {expression_desc = Number (Int {i ; _}) } ))
+                } as e), {expression_desc = Number (Int {i=0l} | Uint 0l | Nint 0n); _})
+      ->  
+      (* TODO: check correctness *)
+      is_out ?comment e range 
     | _, _ ->
       int_comp ?comment Cgt (to_uint32 e)  range 
   end
@@ -1004,9 +1014,6 @@ let int32_minus ?comment e1 e2 : J.expression =
 let unchecked_int32_minus ?comment e1 e2 : J.expression = 
   float_minus ?comment e1 e2
 
-let unchecked_prefix_inc ?comment (i : J.vident)  = 
-  let v : t = {expression_desc = Var i; comment = None} in
-  assign ?comment  v (unchecked_int32_add v one_int_literal)
 
 
 let float_div ?comment e1 e2 = 
@@ -1034,22 +1041,6 @@ let int32_div ?comment (e1 : J.expression) (e2 : J.expression)
     to_int32 (float_div ?comment e1 e2)
 
 
-(* TODO: call primitive *)    
-let int32_mul ?comment 
-    (e1 : J.expression) 
-    (e2 : J.expression) : J.expression = 
-  match e1.expression_desc, e2.expression_desc with 
-  | Number (Int{i = i0}), Number (Int {i = i1})
-    -> int (Int32.mul i0 i1)
-  | _ -> 
-    { comment ; 
-      expression_desc = Bin (Mul, e1,e2)
-    }
-
-let unchecked_int32_mul ?comment e1 e2 : J.expression = 
-  { comment ; 
-    expression_desc = Bin (Mul, e1,e2)
-  }
 
 let float_mul ?comment e1 e2 = 
   bin ?comment Mul e1 e2 
@@ -1068,6 +1059,32 @@ let int32_lsl ?comment e1 e2 : J.expression =
   }
 
 
+let int32_mul ?comment 
+    (e1 : J.expression) 
+    (e2 : J.expression) : J.expression = 
+  match e1, e2 with 
+  | {expression_desc = Number (Int {i = 0l}|  Uint 0l | Nint 0n); _}, x
+  | x, {expression_desc = Number (Int {i = 0l}|  Uint 0l | Nint 0n); _} 
+    when Js_analyzer.no_side_effect_expression x 
+    -> zero_int_literal
+  | {expression_desc = Number (Int{i = i0}); _}, {expression_desc = Number (Int {i = i1}); _}
+    -> int (Int32.mul i0 i1)
+  | e , {expression_desc = Number (Int {i = i0} | Uint i0 ); _}
+  | {expression_desc = Number (Int {i = i0} | Uint i0 ); _}, e 
+    -> 
+    let i =  Ext_pervasives.is_pos_pow i0  in 
+    if i >= 0 then 
+      int32_lsl e (small_int i)
+    else 
+      runtime_call ?comment Js_config.prim "imul" [e1;e2]
+  | _ -> 
+    runtime_call ?comment Js_config.prim "imul" [e1;e2]
+
+let unchecked_int32_mul ?comment e1 e2 : J.expression = 
+  { comment ; 
+    expression_desc = Bin (Mul, e1,e2)
+  }
+
 
 
 let rec int32_bxor ?comment (e1 : t) (e2 : t) : J.expression = 

jscomp/js_exp_make.mli

@@ -228,9 +228,6 @@ val inc : unary_op
 
 val dec : unary_op
 
-val unchecked_prefix_inc : ?comment:string -> J.vident -> t
-
-
 
 
 

jscomp/lam_compile.ml

@@ -1194,7 +1194,7 @@ and
         match lambda with
         | Lprim(Poffsetint  v, [Lvar id']) when Ident.same id id' ->
           [ S.exp (E.assign (E.var id) 
-                     (E.unchecked_int32_add (E.var id) (E.small_int  v)))
+                     (E.int32_add (E.var id) (E.small_int  v)))
           ]
         | _ ->
           begin 

jscomp/lam_compile_primitive.ml

@@ -81,12 +81,6 @@ let translate
 (** Negate boxed int end*)
 (* Int addition and subtraction *)
   | Paddint 
-    -> 
-      begin match args with 
-      | [e1; e2] 
-        -> E.unchecked_int32_add e1 e2
-      | _ -> assert false 
-      end
   | Paddbint  Pint32
     ->
     begin match args with
@@ -340,14 +334,14 @@ let translate
     end
   | Poffsetint n ->
     begin match args with
-      | [e] ->  E.unchecked_int32_add  e (E.small_int  n)
+      | [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.unchecked_int32_add v (E.small_int  n))
+        E.assign  v (E.int32_add v (E.small_int  n))
       | _ -> assert false
     end
 

jscomp/runtime/caml_array.js

@@ -8,8 +8,8 @@ function caml_array_sub(x, offset, len) {
   var i = offset;
   while(j < len) {
     result[j] = x[i];
-    ++ j;
-    ++ i;
+    j = j + 1 | 0;
+    i = i + 1 | 0;
   };
   return result;
 }
@@ -20,7 +20,7 @@ function len(_acc, _l) {
     var acc = _acc;
     if (l) {
       _l = l[1];
-      _acc = l[0].length + acc;
+      _acc = l[0].length + acc | 0;
       continue ;
 
     }
@@ -41,8 +41,8 @@ function fill(arr, _i, _l) {
       var j = 0;
       while(j < l$1) {
         arr[k] = x[j];
-        ++ k;
-        ++ j;
+        k = k + 1 | 0;
+        j = j + 1 | 0;
       };
       _l = l[1];
       _i = k;
@@ -73,13 +73,13 @@ function caml_make_vect(len, init) {
 function caml_array_blit(a1, i1, a2, i2, len) {
   if (i2 <= i1) {
     for(var j = 0 ,j_finish = len - 1; j<= j_finish; ++j){
-      a2[j + i2] = a1[j + i1];
+      a2[j + i2 | 0] = a1[j + i1 | 0];
     }
     return /* () */0;
   }
   else {
     for(var j$1 = len - 1; j$1>= 0; --j$1){
-      a2[j$1 + i2] = a1[j$1 + i1];
+      a2[j$1 + i2 | 0] = a1[j$1 + i1 | 0];
     }
     return /* () */0;
   }