feat(compiler): Add magic primitive (#1766)

Co-authored-by: Blaine Bublitz <blaine.bublitz@gmail.com>

Author: ospencer

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")

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))

compiler/src/codegen/mashtree.re

@@ -221,6 +221,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

compiler/src/middle_end/analyze_purity.re

@@ -73,6 +73,7 @@ module PurityArg: Anf_iterator.IterArgument = {
           UntagUint8 |
           TagUint16 |
           UntagUint16 |
+          Magic |
           Not |
           Box |
           Unbox |

compiler/src/middle_end/anftree.re

@@ -207,6 +207,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

compiler/src/middle_end/anftree.rei

@@ -208,6 +208,7 @@ type prim1 =
     | ArrayLength
     | Assert
     | Throw
+    | Magic
     | WasmFromGrain
     | WasmToGrain
     | WasmUnaryI32({

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 =

compiler/src/parsing/parsetree.re

@@ -375,6 +375,7 @@ type prim1 =
   | ArrayLength
   | Assert
   | Throw
+  | Magic
   | WasmFromGrain
   | WasmToGrain
   | WasmUnaryI32({

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 => []
         };
       (

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 =>