feat(compiler): Add magic primitive

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

compiler/src/typed/typedtree.re

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

compiler/src/typed/typedtree.rei

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

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