Improved compilation of JavaScript literal objects

Author: vouillon

compiler/annot_lexer.mll

@@ -30,6 +30,7 @@ rule initial = parse
   | "mutable" {TA_Mutable }
   | "mutator" {TA_Mutator }
   | "shallow" {TA_Shallow}
+  | "object_literal" {TA_Object_literal}
   | "Version" {TVersion}
   | ['a'-'z''A'-'Z''$''_']['a'-'z''A'-'Z''$''_''0'-'9']* {
       let x = Lexing.lexeme lexbuf in

compiler/annot_parser.mly

@@ -20,7 +20,7 @@
 
 
 %token TProvides TRequires TVersion
-%token TA_Pure TA_Const TA_Mutable TA_Mutator TA_Shallow
+%token TA_Pure TA_Const TA_Mutable TA_Mutator TA_Shallow TA_Object_literal
 %token<string> TIdent TVNum
 %token TComma TSemi EOF EOL LE LT GE GT EQ LPARENT RPARENT
 %token<string> TOTHER
@@ -49,6 +49,7 @@ prim_annot:
 arg_annot:
   | TA_Const { `Const }
   | TA_Shallow { `Shallow_const}
+  | TA_Object_literal { `Object_literal}
   | TA_Mutable { `Mutable}
 
 op:

compiler/flow.ml

@@ -230,8 +230,23 @@ let expr_escape st _x e =
               | Expr (Block (_, a)) ->
                 Array.iter (fun x -> block_escape st x) a
               | _ -> block_escape st v
+            end
+          | Pv v,`Object_literal ->
+            begin match st.defs.(Var.idx v) with
+              | Expr (Block (_, a)) ->
+                Array.iter
+                  (fun x ->
+                     begin match st.defs.(Var.idx x) with
+                       | Expr (Block (_, [|k; v|])) ->
+                         block_escape st v
+                       | _ ->
+                         block_escape st x
+                     end)
+                  a
+              | _ ->
+                block_escape st v
             end;
-          | Pv v, _ -> block_escape st v
+          | Pv v, `Mutable -> block_escape st v
         end;
         loop ax kx in
     loop l ka

compiler/jsoo_primitive.ml

@@ -25,7 +25,7 @@ let rec resolve nm = try resolve (Hashtbl.find aliases nm) with Not_found -> nm
 (****)
 
 type kind = [ `Pure | `Mutable | `Mutator ]
-type kind_arg = [`Shallow_const | `Const | `Mutable]
+type kind_arg = [`Shallow_const | `Object_literal | `Const | `Mutable]
 type t = [
   | `Requires of Parse_info.t option * string list
   | `Provides of Parse_info.t option * string * kind * kind_arg list option

compiler/jsoo_primitive.mli

@@ -22,7 +22,7 @@ val is_pure : string -> bool
 val exists : string -> bool
 
 type kind = [ `Pure | `Mutable | `Mutator ]
-type kind_arg = [`Shallow_const | `Const | `Mutable]
+type kind_arg = [`Shallow_const | `Object_literal | `Const | `Mutable]
 type t =
   [ `Requires of Parse_info.t option * string list
   | `Provides of Parse_info.t option * string * kind * kind_arg list option

runtime/jslib_js_of_ocaml.js

@@ -125,7 +125,7 @@ function caml_pure_js_expr (s){
   js_print_stderr("caml_pure_js_expr: fallback to runtime evaluation");
   return eval(s.toString());}
 
-//Provides: caml_js_object (shallow)
+//Provides: caml_js_object (object_literal)
 //Requires: MlString
 function caml_js_object (a) {
   var o = {};