generate defensive code

Author: bobzhang

jscomp/others/js_mapperRt.ml

@@ -32,13 +32,14 @@
    [uper -lower > 1], [mid <> lower]
  *)  
 let rec binSearchAux lower upper xs (k : int) = 
+  [%assert lower < upper];
   let mid = (lower + upper) / 2 in 
-  let i,v = Array.unsafe_get xs mid in 
+  let i,v = Array.unsafe_get xs mid in   
   if i = k then v
   else if i < k then 
     binSearchAux (mid + 1) upper xs k
   else 
-    binSearchAux lower (mid - 1) xs k  
+    binSearchAux lower mid  xs k  (*Invariant: mid < upper *)
 
 
 
@@ -58,16 +59,17 @@ let rec revSearchAux
 let revSearch len array (x : string)  : int option =  
   revSearchAux 0 len array x
 
-let rec revSearchAssertAux 
+let rec revSearchAssertAux len
     i  (xs : (int * string) array) (k : string) = 
+  [%assert i < len];  
   let (idx,s) = Array.unsafe_get xs i  in 
   if s = k then 
     idx 
   else 
-    revSearchAssertAux (i + 1)  xs k 
+    revSearchAssertAux len (i + 1)  xs k 
 
-let revSearchAssert  array (x : string) : int =  
-  revSearchAssertAux 0 array x
+let revSearchAssert len  array (x : string) : int =  
+  revSearchAssertAux len 0 array x
 
 let toInt (i : int) (xs : int array) =   
   Array.unsafe_get xs i
@@ -82,12 +84,13 @@ let rec fromIntAux (enum : int) i len xs =
 let fromInt len (xs : int array) (enum : int )  : 'variant option =   
   fromIntAux enum 0 len xs 
 
-let rec fromIntAssertAux (enum : int) i  xs = 
-    let k = Array.unsafe_get xs i in 
-    if k = enum then  i 
-    else fromIntAssertAux enum (i + 1)  xs 
-  
+let rec fromIntAssertAux len (enum : int) i  xs = 
+  [%assert i < len];
+  (*TODO: replaced by [%assert i < len ]*)
+  let k = Array.unsafe_get xs i in 
+  if k = enum then  i 
+  else fromIntAssertAux len enum (i + 1)  xs 
+
 (** [length] is not relevant any more *)    
-let fromIntAssert  (xs : int array) (enum : int )=   
-  fromIntAssertAux enum 0  xs 
-    
+let fromIntAssert  len (xs : int array) (enum : int )=   
+  fromIntAssertAux len enum 0  xs 

jscomp/others/js_mapperRt.mli

@@ -44,6 +44,7 @@ val revSearch:
   int option
 
 val revSearchAssert:  
+  int -> (* len *)
   (int * string) array ->
   string ->
   int 
@@ -66,6 +67,7 @@ val fromInt :
   int option 
 
 val fromIntAssert:   
+  int -> (* len *)
   int array -> 
   int -> 
   int 

jscomp/syntax/ast_derive_js_mapper.ml

@@ -58,6 +58,8 @@ let handle_config (config : Parsetree.expression option) =
            }
          ],None)
        ->  not (x = "false")
+     | Pexp_ident {txt = Lident ("jsType")} 
+       -> true
      | _ -> invalid_config config)
   | None -> false
 let noloc = Location.none
@@ -110,11 +112,12 @@ let revSearch len constantArray exp =
     constantArray
     exp
 
-let revSearchAssert  constantArray exp =   
-  app2 
+let revSearchAssert  len constantArray exp =   
+  app3 
     (Exp.ident 
        {loc= noloc; 
         txt = Longident.Ldot (jsMapperRt, "revSearchAssert")})
+    len
     constantArray
     exp
 
@@ -134,14 +137,24 @@ let fromInt len array exp =
     array
     exp
 
-let fromIntAssert array exp = 
-  app2
+let fromIntAssert len array exp = 
+  app3
     (Exp.ident 
        {loc = noloc; 
         txt = Longident.Ldot (jsMapperRt,"fromIntAssert")})
+    len
     array
     exp
 
+
+let assertExp e = 
+  Exp.extension 
+    ({Asttypes.loc = noloc; txt = "assert"},
+     (PStr 
+        [Str.eval e ]
+     )
+    )
+
 let init () =      
   Ast_derive.register
     "jsMapper"
@@ -267,6 +280,7 @@ let init () =
                                (Pat.var pat_param)
                                (if createType then 
                                   revSearchAssert
+                                    exp_len
                                     expConstantArray
                                     (exp_param +: newType)
                                   +>
@@ -295,6 +309,7 @@ let init () =
                    match xs with 
                    | `New xs ->
                      let constantArrayExp = Exp.ident {loc; txt = Lident constantArray} in
+                     let exp_len = const_int (List.length ctors) in
                      let v = [
                        eraseTypeStr;
                        Ast_comb.single_non_rec_value 
@@ -316,13 +331,14 @@ let init () =
                             (
                               if createType then 
                                 fromIntAssert
+                                  exp_len
                                   constantArrayExp
                                   (exp_param +: newType)
                                 +>
                                 core_type
                               else 
                                 fromInt                                 
-                                  (const_int (List.length ctors))
+                                  exp_len
                                   constantArrayExp
                                   exp_param
                                 +>
@@ -340,18 +356,30 @@ let init () =
                               (eraseType exp_param +~ const_int offset)
                           )
                           ;
+                          let len = List.length ctors in 
+                          let range_low = const_int (offset + 0) in 
+                          let range_upper = const_int (offset + len - 1) in 
+
                           Ast_comb.single_non_rec_value
                             {loc ; txt = fromJs}
                             (Exp.fun_ "" None 
                                (Pat.var pat_param)
                                (if createType then 
-                                  (( exp_param +: newType) -~ const_int offset)
+                                  (Exp.let_ Nonrecursive
+                                     [Vb.mk
+                                        (Pat.var pat_param)
+                                        (exp_param +: newType)
+                                     ]
+                                     (
+                                       Exp.sequence
+                                         (assertExp 
+                                            ((exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
+                                         )
+                                         (exp_param  -~ const_int offset))
+                                  )
                                   +>
                                   core_type
                                 else
-                                  let len = List.length ctors in 
-                                  let range_low = const_int (offset + 0) in 
-                                  let range_upper = const_int (offset + len - 1) in 
                                   (Exp.ifthenelse
                                      ( (exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
                                      (Exp.construct {loc; txt = Lident "Some"} 

jscomp/test/.depend

@@ -64,9 +64,10 @@ array_safe_get.cmj : ../stdlib/array.cmj
 array_subtle_test.cmj : mt.cmj ../runtime/js.cmj ../stdlib/array.cmj
 array_test.cmj : ../stdlib/pervasives.cmj mt.cmj ../stdlib/list.cmj \
     ../stdlib/array.cmj array_test.cmi
-ast_abstract_test.cmj :
+ast_abstract_test.cmj : mt.cmj
 ast_js_mapper_poly_test.cmj : mt.cmj ../stdlib/array.cmj
 ast_js_mapper_test.cmj : ../stdlib/array.cmj ast_js_mapper_test.cmi
+ast_mapper_defensive_test.cmj : ../stdlib/obj.cmj mt.cmj
 async_ideas.cmj :
 attr_test.cmj :
 b.cmj :

jscomp/test/Makefile

@@ -204,7 +204,8 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_
 	ast_js_mapper_test\
 	ast_js_mapper_poly_test\
 	big_polyvar_test\
-	ast_abstract_test
+	ast_abstract_test\
+	ast_mapper_defensive_test\
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 # simple_derive_test