feat(compiler): Add magic primitive (grain-lang#1766)

Co-authored-by: Blaine Bublitz <blaine.bublitz@gmail.com>
av8ta · Apr 11, 2023 · a7b0253 · a7b0253
1 parent f9966ee
commit a7b0253
Show file tree

Hide file tree

Showing 13 changed files with 25 additions and 1 deletion.
diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re
@@ -2295,6 +2295,7 @@ let compile_prim1 = (wasm_mod, env, p1, arg, loc): Expression.t => {
         Expression.Unreachable.make(wasm_mod),
       ],
     )
+  | Magic => failwith("Unreachable case; should never get here: Magic")
   | Assert => failwith("Unreachable case; should never get here: Assert")
   | BuiltinId =>
     failwith("Unreachable case; should never get here: BuiltinId")

diff --git a/compiler/src/codegen/garbage_collection.re b/compiler/src/codegen/garbage_collection.re
@@ -456,7 +456,7 @@ let rec apply_gc = (~level, ~loop_context, ~implicit_return=false, instrs) => {
         | _ => ()
         };
         MPrim1(WasmFromGrain, handle_imm(~non_gc_instr=true, imm));
-      | MPrim1((Box | BoxBind | Throw) as prim1, imm) =>
+      | MPrim1((Box | BoxBind | Throw | Magic) as prim1, imm) =>
         MPrim1(prim1, handle_imm(imm))
       | MPrim1(prim1, imm) =>
         MPrim1(prim1, handle_imm(~non_gc_instr=true, imm))

diff --git a/compiler/src/codegen/mashtree.re b/compiler/src/codegen/mashtree.re
@@ -221,6 +221,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

diff --git a/compiler/src/middle_end/analyze_purity.re b/compiler/src/middle_end/analyze_purity.re
@@ -73,6 +73,7 @@ module PurityArg: Anf_iterator.IterArgument = {
           UntagUint8 |
           TagUint16 |
           UntagUint16 |
+          Magic |
           Not |
           Box |
           Unbox |

diff --git a/compiler/src/middle_end/anftree.re b/compiler/src/middle_end/anftree.re
@@ -207,6 +207,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

diff --git a/compiler/src/middle_end/anftree.rei b/compiler/src/middle_end/anftree.rei
@@ -208,6 +208,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

diff --git a/compiler/src/middle_end/linearize.re b/compiler/src/middle_end/linearize.re
@@ -341,6 +341,7 @@ let rec transl_imm =
       }
     | _ => failwith("Builtin must be a string literal")
     }
+  | TExpPrim1(Magic, arg) => transl_imm(~boxed, ~tail, arg)
   | TExpPrim1(op, arg) =>
     let tmp = gensym("unary");
     let (comp, comp_setup) = transl_comp_expression(e);
@@ -1034,6 +1035,7 @@ and transl_comp_expression =
       }
     | _ => failwith("Builtin must be a string literal")
     }
+  | TExpPrim1(Magic, arg) => transl_comp_expression(~name?, ~tail, arg)
   | TExpPrim1(Assert, arg) =>
     let (arg_imm, arg_setup) = transl_imm(arg);
     let assertion_error =

diff --git a/compiler/src/parsing/parsetree.re b/compiler/src/parsing/parsetree.re
@@ -375,6 +375,7 @@ type prim1 =
   | ArrayLength
   | Assert
   | Throw
+  | Magic
   | WasmFromGrain
   | WasmToGrain
   | WasmUnaryI32({

diff --git a/compiler/src/typed/translprim.re b/compiler/src/typed/translprim.re
@@ -90,6 +90,7 @@ let prim_map =
       ("@ignore", Primitive1(Ignore)),
       ("@assert", Primitive1(Assert)),
       ("@throw", Primitive1(Throw)),
+      ("@magic", Primitive1(Magic)),
       ("@unreachable", Primitive0(Unreachable)),
       ("@is", Primitive2(Is)),
       ("@eq", Primitive2(Eq)),
@@ -1589,6 +1590,7 @@ let transl_prim = (env, desc) => {
         | Ignore
         | Assert
         | Throw
+        | Magic
         | BuiltinId => []
         };
       (

diff --git a/compiler/src/typed/typecore.re b/compiler/src/typed/typecore.re
@@ -194,6 +194,8 @@ let prim1_type =
   | Assert => prim_type([Builtin_types.type_bool], Builtin_types.type_void)
   | Throw =>
     prim_type([Builtin_types.type_exception], newgenvar(~name="a", ()))
+  | Magic =>
+    prim_type([newgenvar(~name="a", ())], newgenvar(~name="b", ()))
   | WasmFromGrain =>
     prim_type([newgenvar(~name="a", ())], Builtin_types.type_wasmi32)
   | WasmToGrain =>

diff --git a/compiler/src/typed/typedtree.re b/compiler/src/typed/typedtree.re
@@ -230,6 +230,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

diff --git a/compiler/src/typed/typedtree.rei b/compiler/src/typed/typedtree.rei
@@ -230,6 +230,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

diff --git a/compiler/test/suites/basic_functionality.re b/compiler/test/suites/basic_functionality.re
@@ -309,6 +309,16 @@ describe("basic functionality", ({test, testSkip}) => {
     )
   );
 
+  assertRun(
+    "magic",
+    {|
+      primitive magic = "@magic"
+      let helloBytes = b"hello"
+      print(magic(helloBytes) ++ " world")
+    |},
+    "hello world\n",
+  );
+
   assertFilesize(
     ~config_fn=smallestFileConfig,
     "smallest_grain_program",