feat(compiler)!: Convert box from a tuple to a record

compiler/src/codegen/compcore.re

@@ -1,4 +1,5 @@
 open Grain_typed;
+open Grain_middle_end;
 open Mashtree;
 open Linkedtree;
 open Value_tags;
@@ -505,6 +506,13 @@ let tee_swap = (~ty as typ=Types.GrainValue, wasm_mod, env, idx, value) =>
     );
   };
 
+let imm = i => {
+  immediate_desc: i,
+  immediate_analyses: {
+    last_usage: Unknown,
+  },
+};
+
 let rec compile_imm = (wasm_mod, env: codegen_env, i: immediate): Expression.t =>
   switch (i.immediate_desc) {
   | MImmConst(c) => compile_const(wasm_mod, c)
@@ -537,14 +545,8 @@ let allocate_adt = (wasm_mod, env, type_hash, ttag, vtag, elts) => {
 };
 
 let call_error_handler = (wasm_mod, env, err, args) => {
-  let imm = i => {
-    immediate_desc: i,
-    immediate_analyses: {
-      last_usage: Unknown,
-    },
-  };
-
   // Use a special hash value for exceptions
+
   let type_hash = imm(MImmConst(MConstSimpleNumber(0l)));
   let ty_id =
     imm(
@@ -628,15 +630,6 @@ let compile_tuple_op = (wasm_mod, env, tup_imm, op) => {
   };
 };
 
-let compile_box_op = (wasm_mod, env, box_imm, op) =>
-  /* At the moment, we make no runtime distinction between boxes and tuples */
-  switch (op) {
-  | MBoxUnbox =>
-    compile_tuple_op(wasm_mod, env, box_imm, MTupleGet(Int32.zero))
-  | MBoxUpdate(imm) =>
-    compile_tuple_op(wasm_mod, env, box_imm, MTupleSet(Int32.zero, imm))
-  };
-
 let compile_array_op = (wasm_mod, env, arr_imm, op) => {
   let get_swap = (~ty=?, n) => get_swap(~ty?, wasm_mod, env, n);
   let set_swap = (~ty=?, n) => set_swap(~ty?, wasm_mod, env, n);
@@ -858,6 +851,14 @@ let compile_record_op = (wasm_mod, env, rec_imm, op) => {
   };
 };
 
+let compile_box_op = (wasm_mod, env, box_imm, op) =>
+  switch (op) {
+  | MBoxUnbox =>
+    compile_record_op(wasm_mod, env, box_imm, MRecordGet(Int32.zero))
+  | MBoxUpdate(imm) =>
+    compile_record_op(wasm_mod, env, box_imm, MRecordSet(Int32.zero, imm))
+  };
+
 let compile_closure_op = (wasm_mod, env, closure_imm, op) => {
   let closure = () => compile_imm(wasm_mod, env, closure_imm);
   switch (op) {
@@ -1197,10 +1198,6 @@ let allocate_uninitialized_tuple = (wasm_mod, env, num_elts) => {
   );
 };
 
-let allocate_box = (wasm_mod, env, elt) =>
-  /* At the moment, we make no runtime distinction between boxes and tuples */
-  allocate_tuple(wasm_mod, env, [elt]);
-
 let allocate_uninitialized_wasm_array_any_ref =
     (wasm_mod, env, num_elts, initial_value) => {
   Expression.Array.new_(
@@ -1272,6 +1269,27 @@ let allocate_record = (wasm_mod, env, type_hash, ttag, elts) => {
   );
 };
 
+let allocate_box = (wasm_mod, env, elt) => {
+  let raw_type_hash =
+    Int32.of_int(Linearize.get_type_hash(Builtin_types.decl_box));
+  let type_hash = imm(MImmConst(MConstSimpleNumber(raw_type_hash)));
+  let ty_id =
+    imm(
+      MImmConst(
+        MConstSimpleNumber(
+          Int32.of_int(Path.stamp(Builtin_types.path_box)),
+        ),
+      ),
+    );
+  allocate_record(
+    wasm_mod,
+    env,
+    type_hash,
+    ty_id,
+    [(Builtin_types.ident_box_value, elt)],
+  );
+};
+
 type alloc_alt_num_type =
   | Int32(Expression.t)
   | Float32(Expression.t)

compiler/src/typed/builtin_types.re

@@ -63,6 +63,7 @@ and ident_bytes = ident_create("Bytes")
 and ident_char = ident_create("Char")
 and ident_void = ident_create("Void")
 and ident_box = ident_create("Box")
+and ident_box_value = ident_create("_value")
 and ident_array = ident_create("Array")
 and ident_assertion_error = ident_create_predef_exn("AssertionError")
 and ident_index_out_of_bounds = ident_create_predef_exn("IndexOutOfBounds")
@@ -251,6 +252,15 @@ and decl_box = {
     ...decl_abstr(GrainValue, path_box),
     type_params: [tvar],
     type_arity: 1,
+    type_kind:
+      TDataRecord([
+        {
+          rf_name: ident_box_value,
+          rf_type: tvar,
+          rf_mutable: true,
+          rf_loc: Location.dummy_loc,
+        },
+      ]),
   };
 }
 and decl_array = {

compiler/test/__snapshots__/basic_functionality.2bcc447b.0.snapshot

@@ -76,7 +76,7 @@ basic functionality › assert2
                    (immediate_analyses ((last_usage Unknown))))
                   ((immediate_desc (MImmConst (MConstSimpleNumber 30)))
                    (immediate_analyses ((last_usage Unknown))))
-                  ((immediate_desc (MImmConst (MConstSimpleNumber 33)))
+                  ((immediate_desc (MImmConst (MConstSimpleNumber 34)))
                    (immediate_analyses ((last_usage Unknown))))
                   (((immediate_desc (MImmBinding (MLocalBind 2 GrainValue)))
                     (immediate_analyses ((last_usage Unknown))))))))))))))

compiler/test/__snapshots__/pattern_matching.2cd894dc.0.snapshot

@@ -0,0 +1,67 @@
+pattern matching › box_record_match
+((mash_code
+  ((functions ()) (imports ()) (exports ())
+   (main_body
+    (((instr_desc
+       (MStore
+        (((MLocalBind 0 GrainValue)
+          ((instr_desc
+            (MAllocate
+             (MBox
+              ((immediate_desc (MImmConst (MConstSimpleNumber 1)))
+               (immediate_analyses ((last_usage Unknown)))))))))))))
+     ((instr_desc
+       (MStore
+        (((MLocalBind 1 GrainValue)
+          ((instr_desc
+            (MRecordOp (MRecordGet 0)
+             ((immediate_desc (MImmBinding (MLocalBind 0 GrainValue)))
+              (immediate_analyses ((last_usage Unknown))))))))))))
+     ((instr_desc
+       (MStore
+        (((MLocalBind 2 GrainValue)
+          ((instr_desc
+            (MPrim2 Eq
+             ((immediate_desc (MImmBinding (MLocalBind 1 GrainValue)))
+              (immediate_analyses ((last_usage Unknown))))
+             ((immediate_desc (MImmConst (MConstSimpleNumber 1)))
+              (immediate_analyses ((last_usage Unknown))))))))))))
+     ((instr_desc
+       (MStore
+        (((MLocalBind 3 GrainValue)
+          ((instr_desc
+            (MIf
+             ((immediate_desc (MImmBinding (MLocalBind 2 GrainValue)))
+              (immediate_analyses ((last_usage Unknown))))
+             (((instr_desc
+                (MImmediate
+                 ((immediate_desc (MImmConst (MConstSimpleNumber 0)))
+                  (immediate_analyses ((last_usage Unknown))))))))
+             (((instr_desc
+                (MImmediate
+                 ((immediate_desc (MImmConst (MConstSimpleNumber 1)))
+                  (immediate_analyses ((last_usage Unknown))))))))))))))))
+     ((instr_desc
+       (MSwitch
+        ((immediate_desc (MImmBinding (MLocalBind 3 GrainValue)))
+         (immediate_analyses ((last_usage Unknown))))
+        ((0
+          (((instr_desc
+             (MImmediate
+              ((immediate_desc (MImmConst MConstTrue))
+               (immediate_analyses ((last_usage Unknown)))))))))
+         (1
+          (((instr_desc
+             (MImmediate
+              ((immediate_desc (MImmConst MConstFalse))
+               (immediate_analyses ((last_usage Unknown))))))))))
+        (((instr_desc
+           (MImmediate
+            ((immediate_desc MImmTrap)
+             (immediate_analyses ((last_usage Unknown))))))))
+        GrainValue)))))
+   (main_body_stack_size
+    ((stack_size_ref 4) (stack_size_i32 0) (stack_size_i64 0)
+     (stack_size_f32 0) (stack_size_f64 0)))
+   (globals ()) (compilation_mode Normal) (type_metadata <opaque>)))
+ (signature <opaque>))

compiler/test/suites/boxes.re

@@ -35,6 +35,7 @@ describe("boxes", ({test, testSkip}) => {
     "let b = box(4);\n            {\n              b := unbox(b) - 1;\n              print(unbox(b))\n            }",
     "3\n",
   );
+  assertRun("raw_box", "print({ _value: 2 } == box(2))", "true\n");
   assertSnapshot("test_set_extra1", "box(1) := 2");
   assertFileRun("counter-box", "counter-box", "1\n2\n3\n");
   assertCompileError("test_unbox_err", "unbox(5)", "Box");

compiler/test/suites/pattern_matching.re

@@ -102,6 +102,10 @@ describe("pattern matching", ({test, testSkip}) => {
     |},
     Warnings.PartialMatch("({b: {a: 0}, c: 0}|{b: {a: 1}, _ })"),
   );
+  assertSnapshot(
+    "box_record_match",
+    "match(box(1)) { { _value: 1 } => true, _ => false}",
+  );
   /* Pattern matching on ADTs */
   assertSnapshot(
     "adt_match_1",

stdlib/runtime/string.gr

@@ -86,6 +86,8 @@ let _OPTION_ID = builtinId("Option")
 let _RESULT_ID = builtinId("Result")
 @unsafe
 let _RANGE_ID = builtinId("Range")
+@unsafe
+let _BOX_ID = builtinId("Box")
 
 let _SOME = "Some"
 let _NONE = "None"
@@ -161,6 +163,12 @@ let isRangeRecord = record_ => {
   typeId is _RANGE_ID
 }
 
+@unsafe
+let isBoxRecord = record_ => {
+  let typeId = DataStructures.loadRecordTypeId(record_)
+  typeId is _BOX_ID
+}
+
 @unsafe
 let getBuiltinVariantName = variant => {
   let typeId = DataStructures.loadVariantTypeId(variant)
@@ -551,6 +559,22 @@ let rec heapValueToString = (ref, extraIndents, toplevel, cycles) => {
         },
       }
     },
+    t when t == Tags._GRAIN_RECORD_HEAP_TAG && isBoxRecord(ref) => {
+      if (loadCycleMarker(ref) != 0n) {
+        reportCycle(ref, cycles)
+      } else {
+        storeCycleMarker(ref, _VISITED_BIT)
+        let recordValues = getCompoundValueArrayRef(ref)
+        let fieldValue = toStringHelp(
+          WasmArrayRef.getAny(recordValues, 0n),
+          0n,
+          false,
+          cycles
+        )
+        storeCycleMarker(ref, 0n)
+        join([cyclePrefix(ref, cycles), "box(", fieldValue, ")"])
+      }
+    },
     t when t == Tags._GRAIN_RECORD_HEAP_TAG => {
       let recordArity = WasmArrayRef.length(getCompoundValueArrayRef(ref))
       let fields = getRecordFieldNames(ref)
@@ -669,11 +693,6 @@ let rec heapValueToString = (ref, extraIndents, toplevel, cycles) => {
         storeCycleMarker(ref, 0n)
 
         strings = [lparen, ...strings]
-        if (tupleLength <= 1n) {
-          // Special case: unary tuple, which is not valid Grain syntax; however, boxed values
-          // are stored as a unary tuple, so we keep this in case one gets printed
-          strings = ["box", ...strings]
-        }
         join([cyclePrefix(ref, cycles), ...strings])
       }
     },