feat(compiler)!: Supply primitive types via the compiler (#1667)

Author: ospencer

compiler/src/codegen/compcore.re

@@ -2379,6 +2379,7 @@ let compile_prim0 = (wasm_mod, env, p0): Expression.t => {
     allocate_number_uninitialized(wasm_mod, env, BoxedRational)
   | AllocateUint32 => allocate_uint_uninitialized(wasm_mod, env, true)
   | AllocateUint64 => allocate_uint_uninitialized(wasm_mod, env, false)
+  | WasmMemorySize => Expression.Memory_size.make(wasm_mod)
   | Unreachable => Expression.Unreachable.make(wasm_mod)
   };
 };
@@ -2665,7 +2666,6 @@ let compile_primn = (wasm_mod, env: codegen_env, p, args): Expression.t => {
     compile_wasm_store(~sz, ~ty=Type.int64, wasm_mod, env, args)
   | WasmStoreF32 => compile_wasm_store(~ty=Type.float32, wasm_mod, env, args)
   | WasmStoreF64 => compile_wasm_store(~ty=Type.float64, wasm_mod, env, args)
-  | WasmMemorySize => Expression.Memory_size.make(wasm_mod)
   | WasmMemoryCopy =>
     Expression.Block.make(
       wasm_mod,

compiler/src/codegen/mashtree.re

@@ -179,6 +179,7 @@ type prim0 =
     | AllocateFloat32
     | AllocateFloat64
     | AllocateRational
+    | WasmMemorySize
     | Unreachable;
 
 type prim1 =
@@ -281,7 +282,6 @@ type primn =
     | WasmStoreF64
     | WasmMemoryCopy
     | WasmMemoryFill
-    | WasmMemorySize
     | WasmMemoryCompare;
 
 [@deriving sexp]

compiler/src/formatting/format.re

@@ -4703,13 +4703,13 @@ let print_foreign_value_description =
   ]);
 };
 
-let print_primitive_value_description =
+let print_primitive_description =
     (
       ~original_source: array(string),
       ~comments: list(Parsetree.comment),
-      vd: Parsetree.value_description,
+      pd: Parsetree.primitive_description,
     ) => {
-  let ident = vd.pval_name.txt;
+  let ident = pd.pprim_ident.txt;
 
   let fixed_ident =
     if (infixop(ident) || prefixop(ident)) {
@@ -4720,14 +4720,11 @@ let print_primitive_value_description =
 
   Doc.concat([
     fixed_ident,
-    Doc.text(":"),
-    Doc.space,
-    print_type(~original_source, ~comments, vd.pval_type),
     Doc.space,
     Doc.equal,
     Doc.space,
     Doc.text("\""),
-    Doc.join(~sep=Doc.text(","), List.map(p => Doc.text(p), vd.pval_prim)),
+    Doc.text(pd.pprim_name.txt),
     Doc.text("\""),
   ]);
 };
@@ -4758,7 +4755,7 @@ let rec toplevel_print =
           value_description,
         ),
       ]);
-    | PTopPrimitive(provide_flag, value_description) =>
+    | PTopPrimitive(provide_flag, primitive_description) =>
       let provide =
         switch (provide_flag) {
         | NotProvided => Doc.nil
@@ -4768,10 +4765,10 @@ let rec toplevel_print =
       Doc.concat([
         provide,
         Doc.text("primitive "),
-        print_primitive_value_description(
+        print_primitive_description(
           ~original_source,
           ~comments,
-          value_description,
+          primitive_description,
         ),
       ]);
     | PTopData(data_declarations) =>

compiler/src/middle_end/analyze_purity.re

@@ -47,7 +47,7 @@ module PurityArg: Anf_iterator.IterArgument = {
           AllocateRational,
         ) =>
         true
-      | CPrim0(Unreachable) => false
+      | CPrim0(WasmMemorySize | Unreachable) => false
       | CPrim1(
           AllocateArray | AllocateTuple | AllocateBytes | AllocateString |
           BuiltinId |
@@ -98,7 +98,6 @@ module PurityArg: Anf_iterator.IterArgument = {
           WasmStoreI32(_) | WasmStoreI64(_) | WasmStoreF32 | WasmStoreF64 |
           WasmMemoryCopy |
           WasmMemoryFill |
-          WasmMemorySize |
           WasmMemoryCompare,
           _,
         ) =>

compiler/src/middle_end/anftree.re

@@ -165,6 +165,7 @@ type prim0 =
     | AllocateFloat32
     | AllocateFloat64
     | AllocateRational
+    | WasmMemorySize
     | Unreachable;
 
 type prim1 =
@@ -267,7 +268,6 @@ type primn =
     | WasmStoreF64
     | WasmMemoryCopy
     | WasmMemoryFill
-    | WasmMemorySize
     | WasmMemoryCompare;
 
 let (prim0_of_sexp, sexp_of_prim0) = (

compiler/src/middle_end/anftree.rei

@@ -166,6 +166,7 @@ type prim0 =
     | AllocateFloat32
     | AllocateFloat64
     | AllocateRational
+    | WasmMemorySize
     | Unreachable;
 
 type prim1 =
@@ -268,7 +269,6 @@ type primn =
     | WasmStoreF64
     | WasmMemoryCopy
     | WasmMemoryFill
-    | WasmMemorySize
     | WasmMemoryCompare;
 
 /** Immediate expressions (requiring no computation) */

compiler/src/parsing/ast_helper.re

@@ -450,6 +450,12 @@ module Toplevel = {
     mk(~loc, ~attributes?, PTopProvide(e));
 };
 
+module PrimitiveDescription = {
+  let mk = (~loc, ~ident, ~name, ()) => {
+    {pprim_ident: ident, pprim_name: name, pprim_loc: loc};
+  };
+};
+
 module ValueDescription = {
   let mk = (~loc=?, ~mod_, ~name, ~alias, ~typ, ~prim, ()) => {
     let loc = Option.value(~default=Location.dummy_loc, loc);

compiler/src/parsing/ast_helper.rei

@@ -265,7 +265,7 @@ module Toplevel: {
       ~loc: loc=?,
       ~attributes: attributes=?,
       provide_flag,
-      value_description
+      primitive_description
     ) =>
     toplevel_stmt;
   let data:
@@ -295,6 +295,10 @@ module Toplevel: {
     toplevel_stmt;
 };
 
+module PrimitiveDescription: {
+  let mk: (~loc: loc, ~ident: str, ~name: str, unit) => primitive_description;
+};
+
 module ValueDescription: {
   let mk:
     (

compiler/src/parsing/ast_mapper.re

@@ -15,6 +15,8 @@ type mapper = {
   provide: (mapper, list(provide_item)) => list(provide_item),
   value_binding: (mapper, value_binding) => value_binding,
   match_branch: (mapper, match_branch) => match_branch,
+  primitive_description:
+    (mapper, primitive_description) => primitive_description,
   value_description: (mapper, value_description) => value_description,
   grain_exception: (mapper, type_exception) => type_exception,
   toplevel: (mapper, toplevel_stmt) => toplevel_stmt,
@@ -390,6 +392,15 @@ module Pr = {
   };
 };
 
+module PD = {
+  let map = (sub, {pprim_ident: ident, pprim_name: name, pprim_loc: loc}) => {
+    let pprim_loc = sub.location(sub, loc);
+    let pprim_ident = map_loc(sub, ident);
+    let pprim_name = map_loc(sub, name);
+    {pprim_ident, pprim_name, pprim_loc};
+  };
+};
+
 module VD = {
   let map = (sub, {pval_mod: vmod, pval_name: vname, pval_loc: loc} as d) => {
     let pval_loc = sub.location(sub, loc);
@@ -415,7 +426,12 @@ module TL = {
     | PTopForeign(e, d) =>
       Toplevel.foreign(~loc, ~attributes, e, sub.value_description(sub, d))
     | PTopPrimitive(e, d) =>
-      Toplevel.primitive(~loc, ~attributes, e, sub.value_description(sub, d))
+      Toplevel.primitive(
+        ~loc,
+        ~attributes,
+        e,
+        sub.primitive_description(sub, d),
+      )
     | PTopData(dd) =>
       Toplevel.data(
         ~loc,
@@ -465,6 +481,7 @@ let default_mapper = {
   provide: Pr.map,
   value_binding: V.map,
   match_branch: MB.map,
+  primitive_description: PD.map,
   value_description: VD.map,
   grain_exception: Exc.map,
   toplevel: TL.map,

compiler/src/parsing/ast_mapper.rei

@@ -35,6 +35,8 @@ type mapper = {
   provide: (mapper, list(provide_item)) => list(provide_item),
   value_binding: (mapper, value_binding) => value_binding,
   match_branch: (mapper, match_branch) => match_branch,
+  primitive_description:
+    (mapper, primitive_description) => primitive_description,
   value_description: (mapper, value_description) => value_description,
   grain_exception: (mapper, type_exception) => type_exception,
   toplevel: (mapper, toplevel_stmt) => toplevel_stmt,