[feature] extensible record with readable output

docs/book.json

@@ -0,0 +1,10 @@
+{
+
+    "plugins": ["[email protected]"],
+    "pluginsConfig": {
+            "edit-link": {
+                "base": "https://github.com/bloomberg/bucklescript/tree/master/docs",
+                "label": "Edit This Page"
+            }
+    }
+}

docs/build-doc.sh

@@ -1,4 +1,5 @@
 #!/bin/sh
 set -e
-node process.js
-cp -r dist/* $BUCKLESCRIPT_DOC
+# node process.js
+# gitbook build 
+cp -r _book/* $BUCKLESCRIPT_DOC

jscomp/ppx_entry.ml

@@ -97,6 +97,89 @@ let discard_js_value loc e  : Parsetree.expression =
   }
 
 
+let create_local_external loc 
+     ~pval_prim
+     ~pval_type ~pval_attributes 
+     local_module_name 
+     local_fun_name
+     args
+  : Parsetree.expression_desc = 
+  Pexp_letmodule
+    ({txt = local_module_name; loc},
+     {pmod_desc =
+        Pmod_structure
+          [{pstr_desc =
+              Pstr_primitive
+                {pval_name = {txt = local_fun_name; loc};
+                 pval_type ;
+                 pval_loc = loc;
+                 pval_prim = [pval_prim];
+                 pval_attributes };
+            pstr_loc = loc;
+           }];
+      pmod_loc = loc;
+      pmod_attributes = []},
+     {
+       pexp_desc =
+         Pexp_apply
+           (({pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); 
+                                      loc};
+              pexp_attributes = [] ;
+              pexp_loc = loc} : Parsetree.expression),
+            args);
+       pexp_attributes = [];
+       pexp_loc = loc
+     })
+
+let handle_record_as_js_object 
+    loc 
+    attr
+    (label_exprs : (Longident.t Asttypes.loc * Parsetree.expression) list)
+    (mapper : Ast_mapper.mapper) : Parsetree.expression_desc = 
+  let labels, args = 
+    Ext_list.split_map (fun ({Location.txt ; loc}, e) -> 
+        match txt with
+        | Longident.Lident x -> (x, (x, mapper.expr mapper e))
+        | Ldot _ | Lapply _ ->  
+          Location.raise_errorf ~loc "invalid js label "
+  ) label_exprs in 
+  let pval_prim = "" in 
+  let pval_attributes = [attr] in 
+  let local_module_name = "Tmp" in 
+  let local_fun_name = "run" in 
+  let arrow label a b = 
+    {Parsetree.ptyp_desc = Ptyp_arrow (label, a, b);
+     ptyp_attributes = [];
+     ptyp_loc = loc} in 
+
+  let pval_type = 
+    let arity = List.length labels in 
+    let tyvars = (Ext_list.init arity (fun i ->      
+        {Parsetree.ptyp_desc = Ptyp_var ("a" ^ string_of_int i); 
+         ptyp_attributes = [] ;
+         ptyp_loc = loc})) in 
+
+    let result_type = 
+      {Parsetree.ptyp_desc = 
+         Ptyp_constr ({txt = Ldot(Lident "Js", "t"); loc},
+                      [{ Parsetree.ptyp_desc = 
+                           Ptyp_object (List.map2 (fun x y -> x ,[], y) labels tyvars, Closed);
+                         ptyp_attributes = [];
+                         ptyp_loc = loc
+                       }]);
+       ptyp_loc = loc;
+       ptyp_attributes = []
+      } in 
+    List.fold_right2 
+      (fun label tyvar acc -> arrow label tyvar acc) labels tyvars  result_type
+  in 
+  create_local_external loc 
+    ~pval_prim
+    ~pval_type ~pval_attributes 
+    local_module_name 
+    local_fun_name
+    args 
+
 let gen_fn_run loc arity args  : Parsetree.expression_desc = 
   let open Parsetree in 
   let ptyp_attributes = [] in 
@@ -131,32 +214,8 @@ let gen_fn_run loc arity args  : Parsetree.expression_desc =
   (** could be optimized *)
   let pval_type = 
     Ext_list.reduce_from_right arrow (uncurry_fn :: tyvars) in 
-  Pexp_letmodule
-    ({txt = local_module_name; loc},
-     {pmod_desc =
-        Pmod_structure
-          [{pstr_desc =
-              Pstr_primitive
-                {pval_name = {txt = local_fun_name; loc};
-                 pval_type ;
-                 pval_loc = loc;
-                 pval_prim = [pval_prim];
-                 pval_attributes = []};
-            pstr_loc = loc;
-           }];
-      pmod_loc = loc;
-      pmod_attributes = []},
-     {
-       pexp_desc =
-         Pexp_apply
-           (({pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); 
-                                      loc};
-              pexp_attributes = [] ;
-              pexp_loc = loc} : Parsetree.expression),
-            args);
-       pexp_attributes = [];
-       pexp_loc = loc
-     })
+  create_local_external loc ~pval_prim ~pval_type ~pval_attributes:[] 
+    local_module_name local_fun_name args 
 
 let gen_fn_mk loc arity args  : Parsetree.expression_desc = 
   let open Parsetree in 
@@ -195,33 +254,8 @@ let gen_fn_mk loc arity args  : Parsetree.expression_desc =
       arrow (arrow predef_unit_type (List.hd tyvars) ) uncurry_fn
     else 
       arrow (Ext_list.reduce_from_right arrow tyvars) uncurry_fn in 
-
-  Pexp_letmodule
-    ({txt = local_module_name; loc},
-     {pmod_desc =
-        Pmod_structure
-          [{pstr_desc =
-              Pstr_primitive
-                {pval_name = {txt = local_fun_name; loc};
-                 pval_type ;
-                 pval_loc = loc;
-                 pval_prim = [pval_prim];
-                 pval_attributes = []};
-            pstr_loc = loc;
-           }];
-      pmod_loc = loc;
-      pmod_attributes = []},
-     {
-       pexp_desc =
-         Pexp_apply
-           (({pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); 
-                                      loc};
-              pexp_attributes = [] ;
-              pexp_loc = loc} : Parsetree.expression),
-            args);
-       pexp_attributes = [];
-       pexp_loc = loc
-     })
+  create_local_external loc ~pval_prim ~pval_type ~pval_attributes:[] 
+    local_module_name local_fun_name args 
 
 
 
@@ -623,7 +657,20 @@ let rec unsafe_mapper : Ast_mapper.mapper =
                         ) )
                       ])
           -> handle_obj_property loc obj name e mapper
-
+        | Pexp_record (label_exprs, None)   -> 
+          begin match  (* exclude {[ u with ..]} syntax currently *)
+              Ext_list.exclude_with_fact 
+                (function({Location.txt  = "bs.obj"}, _)  -> true | _ -> false) 
+                e.pexp_attributes
+            with 
+          | Some attr, pexp_attributes -> 
+            { e with
+              pexp_desc =  handle_record_as_js_object e.pexp_loc attr label_exprs mapper;
+              pexp_attributes 
+            }
+          | None , _ -> 
+            Ast_mapper.default_mapper.expr  mapper e
+          end
         | _ ->  Ast_mapper.default_mapper.expr  mapper e
       );
     typ = (fun self typ -> handle_typ Ast_mapper.default_mapper self typ);

jscomp/test/.depend

@@ -330,6 +330,10 @@ mt_global.cmj : mt.cmi mt_global.cmi
 mt_global.cmx : mt.cmx mt_global.cmi
 number_lexer.cmj : ../stdlib/sys.cmi ../stdlib/lexing.cmi
 number_lexer.cmx : ../stdlib/sys.cmx ../stdlib/lexing.cmx
+obj_literal_ppx.cmj : ../stdlib/array.cmi
+obj_literal_ppx.cmx : ../stdlib/array.cmx
+obj_literal_ppx_test.cmj : ../runtime/js.cmj
+obj_literal_ppx_test.cmx : ../runtime/js.cmx
 obj_magic_test.cmj : ../stdlib/obj.cmi mt.cmi
 obj_magic_test.cmx : ../stdlib/obj.cmx mt.cmx
 obj_test.cmj : mt.cmi
@@ -974,6 +978,10 @@ mt_global.cmo : mt.cmi mt_global.cmi
 mt_global.cmj : mt.cmj mt_global.cmi
 number_lexer.cmo : ../stdlib/sys.cmi ../stdlib/lexing.cmi
 number_lexer.cmj : ../stdlib/sys.cmj ../stdlib/lexing.cmj
+obj_literal_ppx.cmo : ../stdlib/array.cmi
+obj_literal_ppx.cmj : ../stdlib/array.cmj
+obj_literal_ppx_test.cmo : ../runtime/js.cmo
+obj_literal_ppx_test.cmj : ../runtime/js.cmj
 obj_magic_test.cmo : ../stdlib/obj.cmi mt.cmi
 obj_magic_test.cmj : ../stdlib/obj.cmj mt.cmj
 obj_test.cmo : mt.cmi

jscomp/test/obj_literal_ppx.ml

@@ -0,0 +1,17 @@
+
+
+let a = { x = 3 ; y = [| 1|]} [@bs.obj]
+
+let b = { x = 3 ; y = [| 1 |]; z = 3; u = fun %uncurry (x,y) -> x + y } [@bs.obj]
+
+let f obj = 
+  obj ## x + Array.length (obj ## y)
+
+let h obj = obj##u (1,2)
+
+let u = f  a
+
+let v = f b 
+
+let vv = h b 
+

jscomp/test/obj_literal_ppx_test.ml

@@ -0,0 +1,6 @@
+
+let a = 
+let module N = struct 
+    external create : x : 'a0 -> y : 'a1 -> < x : 'a0 ; y : 'a1 > Js.t = ""[@@bs.obj]
+  end in 
+  N.create ~x:3 ~y:[1;2;3]

jscomp/test/test.mllib

@@ -304,3 +304,5 @@ ignore_test
 
 test_index
 
+obj_literal_ppx_test
+obj_literal_ppx

lib/js/test/obj_literal_ppx.js

@@ -0,0 +1,40 @@
+// GENERATED CODE BY BUCKLESCRIPT VERSION 0.4.2 , PLEASE EDIT WITH CARE
+'use strict';
+
+
+var a = {
+  "x": 3,
+  "y": /* int array */[1]
+};
+
+var b = {
+  "x": 3,
+  "y": /* int array */[1],
+  "z": 3,
+  "u": function (x, y) {
+    return x + y | 0;
+  }
+};
+
+function f(obj) {
+  return obj.x + obj.y.length | 0;
+}
+
+function h(obj) {
+  return obj.u(1, 2);
+}
+
+var u = f(a);
+
+var v = f(b);
+
+var vv = h(b);
+
+exports.a  = a;
+exports.b  = b;
+exports.f  = f;
+exports.h  = h;
+exports.u  = u;
+exports.v  = v;
+exports.vv = vv;
+/* a Not a pure module */

lib/js/test/obj_literal_ppx_test.js

@@ -0,0 +1,20 @@
+// GENERATED CODE BY BUCKLESCRIPT VERSION 0.4.2 , PLEASE EDIT WITH CARE
+'use strict';
+
+
+var a = {
+  "x": 3,
+  "y": /* :: */[
+    1,
+    /* :: */[
+      2,
+      /* :: */[
+        3,
+        /* [] */0
+      ]
+    ]
+  ]
+};
+
+exports.a = a;
+/* a Not a pure module */