Proof of concept for extensible records

Uses convention on field name "dotdotdot", to be replaces with a parser producing e.g. a field called "...".
Currently expands the type eagerly.

See #5659

Author: cristianoc

jscomp/main/builtin_cmj_datasets.ml

@@ -416,6 +416,27 @@ let transl_declaration env sdecl id =
               then Record_optional_labels optionalLabels
               else Record_regular
           in
+          let lbls, lbls' = match lbls, lbls' with
+            | {ld_name = {txt = "dotdotdot"}; ld_type} :: rest, _ :: rest' ->
+              let rec extract t = match t.desc with
+                | Tpoly(t, []) -> extract t
+                | _ -> Ctype.repr t in
+              let mkLbl (l: Types.label_declaration) : Typedtree.label_declaration =
+                { ld_id = l.ld_id;
+                  ld_name = {txt = Ident.name l.ld_id; loc = l.ld_loc};
+                  ld_mutable = l.ld_mutable;
+                  ld_type = {ld_type with ctyp_type = l.ld_type};
+                  ld_loc = l.ld_loc;
+                  ld_attributes = l.ld_attributes; } in
+              let lbls, lbls' =
+                match Ctype.extract_concrete_typedecl env (extract ld_type.ctyp_type) with
+                (_p0, _p, {type_kind=Type_record (fields, _repr)}) ->
+                  (fields |> List.map mkLbl) @ rest, fields @ rest'
+                | _ -> assert false
+                | exception _ -> assert false
+              in
+              lbls, lbls'
+            | _ -> lbls, lbls' in
           Ttype_record lbls, Type_record(lbls', rep)
       | Ptype_open -> Ttype_open, Type_open
       in
@@ -569,7 +590,8 @@ let check_constraints env sdecl (_, decl) =
         | Ptype_variant _ | Ptype_abstract | Ptype_open -> assert false
       in
       let pl = find_pl sdecl.ptype_kind in
-      check_constraints_labels env visited l pl
+      let todoFIXTHIS = false in
+      if todoFIXTHIS then check_constraints_labels env visited l pl
   | Type_open -> ()
   end;
   begin match decl.type_manifest with

jscomp/ml/typedecl.ml

@@ -0,0 +1,11 @@
+'use strict';
+
+
+var v = {
+  x: 10,
+  y: "",
+  z: ""
+};
+
+exports.v = v;
+/* No side effect */

jscomp/test/DotDotDot.js

@@ -0,0 +1,7 @@
+type a = {x: int}
+
+type b = {dotdotdot: a, y: string}
+
+type c = {dotdotdot: b, z: string}
+
+let v: c = {x: 10, y: "", z: ""}

jscomp/test/DotDotDot.res

@@ -4,6 +4,19 @@ import * as Curry from "./curry.js";
 import * as Belt_Array from "./belt_Array.js";
 import * as Caml_option from "./caml_option.js";
 
+function copyBucket(c) {
+  if (c === undefined) {
+    return c;
+  }
+  var head = {
+    key: c.key,
+    value: c.value,
+    next: undefined
+  };
+  copyAuxCont(c.next, head);
+  return head;
+}
+
 function copyAuxCont(_c, _prec) {
   while(true) {
     var prec = _prec;
@@ -23,19 +36,6 @@ function copyAuxCont(_c, _prec) {
   };
 }
 
-function copyBucket(c) {
-  if (c === undefined) {
-    return c;
-  }
-  var head = {
-    key: c.key,
-    value: c.value,
-    next: undefined
-  };
-  copyAuxCont(c.next, head);
-  return head;
-}
-
 function copyBuckets(buckets) {
   var len = buckets.length;
   var newBuckets = new Array(len);

jscomp/test/build.ninja

@@ -4,6 +4,19 @@ var Curry = require("./curry.js");
 var Belt_Array = require("./belt_Array.js");
 var Caml_option = require("./caml_option.js");
 
+function copyBucket(c) {
+  if (c === undefined) {
+    return c;
+  }
+  var head = {
+    key: c.key,
+    value: c.value,
+    next: undefined
+  };
+  copyAuxCont(c.next, head);
+  return head;
+}
+
 function copyAuxCont(_c, _prec) {
   while(true) {
     var prec = _prec;
@@ -23,19 +36,6 @@ function copyAuxCont(_c, _prec) {
   };
 }
 
-function copyBucket(c) {
-  if (c === undefined) {
-    return c;
-  }
-  var head = {
-    key: c.key,
-    value: c.value,
-    next: undefined
-  };
-  copyAuxCont(c.next, head);
-  return head;
-}
-
 function copyBuckets(buckets) {
   var len = buckets.length;
   var newBuckets = new Array(len);