diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re index de948ffc95..a35ba089d7 100644 --- 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 index 1d6f554c66..f44c49a86f 100644 --- 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 index e1d4a62646..f3ced28a80 100644 --- 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 index ea2c8d100e..8cb9574f9e 100644 --- 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 index db6dd4525c..40f40c7b4b 100644 --- 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 index 7a34d4503d..fcbaff05b1 100644 --- 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 index 304d83a49f..1ebceb3f3c 100644 --- 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 index 5e5fff5a6a..bc93465728 100644 --- 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 index a2e9fdc2e6..9311bdd5ef 100644 --- 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 index ff388902c3..394f1a674b 100644 --- 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 index e4820c4379..6d3f0cef02 100644 --- 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 index 15ce535df4..568055b330 100644 --- 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 index 10c721cd9d..fe3c8f94d6 100644 --- 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",