fix(compiler)!: Disallow multiple provides of the same value

compiler/src/parsing/well_formedness.re

@@ -18,7 +18,8 @@ type wferr =
   | LoopControlOutsideLoop(string, Location.t)
   | ReturnStatementOutsideFunction(Location.t)
   | MismatchedReturnStyles(Location.t)
-  | LocalIncludeStatement(Location.t);
+  | LocalIncludeStatement(Location.t)
+  | ProvidedMultipleTimes(string, Location.t);
 
 exception Error(wferr);
 
@@ -78,6 +79,12 @@ let prepare_error =
           ~loc,
           "`include` statements may only appear at the file level.",
         )
+      | ProvidedMultipleTimes(name, loc) =>
+        errorf(
+          ~loc,
+          "%s was provided multiple times, but can only be provided once.",
+          name,
+        )
     )
   );
 
@@ -557,6 +564,194 @@ let no_local_include = (errs, super) => {
   };
 };
 
+type provided_multiple_times_ctx = {
+  modules: Hashtbl.t(string, unit),
+  types: Hashtbl.t(string, unit),
+  values: Hashtbl.t(string, unit),
+};
+
+let provided_multiple_times = (errs, super) => {
+  let rec extract_bindings = (binds, pattern) =>
+    switch (pattern.ppat_desc) {
+    | PPatAny => binds
+    | PPatVar(bind) => [bind, ...binds]
+    | PPatTuple(pats)
+    | PPatArray(pats) => List.fold_left(extract_bindings, binds, pats)
+    | PPatRecord(pats, _) =>
+      List.fold_left(
+        (binds, (_, pat)) => extract_bindings(binds, pat),
+        binds,
+        pats,
+      )
+    | PPatConstant(_) => binds
+    | PPatConstraint(pat, _) => extract_bindings(binds, pat)
+    | PPatConstruct(_, cstr) =>
+      switch (cstr) {
+      | PPatConstrRecord(pats, _) =>
+        List.fold_left(
+          (binds, (_, pat)) => extract_bindings(binds, pat),
+          binds,
+          pats,
+        )
+      | PPatConstrTuple(pats) =>
+        List.fold_left(extract_bindings, binds, pats)
+      }
+    | PPatOr(pat1, pat2) =>
+      extract_bindings([], pat1) @ extract_bindings(binds, pat2)
+    | PPatAlias(pat, bind) => extract_bindings([bind, ...binds], pat)
+    };
+
+  let ctx =
+    ref([
+      {
+        modules: Hashtbl.create(64),
+        types: Hashtbl.create(64),
+        values: Hashtbl.create(64),
+      },
+    ]);
+
+  let enter_module = (p, d) => {
+    ctx :=
+      [
+        {
+          modules: Hashtbl.create(64),
+          types: Hashtbl.create(64),
+          values: Hashtbl.create(64),
+        },
+        ...ctx^,
+      ];
+    super.enter_module(p, d);
+  };
+
+  let leave_module = (p, d) => {
+    ctx := List.tl(ctx^);
+    super.leave_module(p, d);
+  };
+
+  let enter_toplevel_stmt = ({ptop_desc: desc} as top) => {
+    let {values, modules, types} = List.hd(ctx^);
+    switch (desc) {
+    | PTopModule(Provided | Abstract, {pmod_name, pmod_loc}) =>
+      if (Hashtbl.mem(modules, pmod_name.txt)) {
+        errs := [ProvidedMultipleTimes(pmod_name.txt, pmod_loc), ...errs^];
+      } else {
+        Hashtbl.add(modules, pmod_name.txt, ());
+      }
+    | PTopForeign(
+        Provided | Abstract,
+        {pval_name, pval_name_alias, pval_loc},
+      )
+    | PTopPrimitive(
+        Provided | Abstract,
+        {pval_name, pval_name_alias, pval_loc},
+      ) =>
+      let name = Option.value(~default=pval_name, pval_name_alias);
+      if (Hashtbl.mem(values, name.txt)) {
+        errs := [ProvidedMultipleTimes(name.txt, pval_loc), ...errs^];
+      } else {
+        Hashtbl.add(values, name.txt, ());
+      };
+    | PTopData(decls) =>
+      List.iter(
+        decl => {
+          switch (decl) {
+          | (Provided | Abstract, {pdata_name, pdata_loc}) =>
+            if (Hashtbl.mem(types, pdata_name.txt)) {
+              errs :=
+                [ProvidedMultipleTimes(pdata_name.txt, pdata_loc), ...errs^];
+            } else {
+              Hashtbl.add(types, pdata_name.txt, ());
+            }
+          | (NotProvided, _) => ()
+          }
+        },
+        decls,
+      )
+    | PTopLet(Provided | Abstract, _, _, binds) =>
+      List.iter(
+        bind => {
+          let names = extract_bindings([], bind.pvb_pat);
+          List.iter(
+            name =>
+              if (Hashtbl.mem(values, name.txt)) {
+                errs := [ProvidedMultipleTimes(name.txt, name.loc), ...errs^];
+              } else {
+                Hashtbl.add(values, name.txt, ());
+              },
+            names,
+          );
+        },
+        binds,
+      )
+    | PTopException(
+        Provided | Abstract,
+        {ptyexn_constructor: {pext_name, pext_loc}},
+      ) =>
+      if (Hashtbl.mem(values, pext_name.txt)) {
+        errs := [ProvidedMultipleTimes(pext_name.txt, pext_loc), ...errs^];
+      } else {
+        Hashtbl.add(values, pext_name.txt, ());
+      }
+    | PTopProvide(items) =>
+      let apply_alias = (name, alias) => {
+        let old_name = Identifier.string_of_ident(name.txt);
+        let new_name =
+          switch (alias) {
+          | Some(alias) => Identifier.string_of_ident(alias.txt)
+          | None => old_name
+          };
+        (old_name, new_name);
+      };
+      List.iter(
+        item => {
+          switch (item) {
+          | PProvideType({name, alias, loc}) =>
+            let (_, name) = apply_alias(name, alias);
+            if (Hashtbl.mem(types, name)) {
+              errs := [ProvidedMultipleTimes(name, loc), ...errs^];
+            } else {
+              Hashtbl.add(types, name, ());
+            };
+          | PProvideModule({name, alias, loc}) =>
+            let (_, name) = apply_alias(name, alias);
+            if (Hashtbl.mem(modules, name)) {
+              errs := [ProvidedMultipleTimes(name, loc), ...errs^];
+            } else {
+              Hashtbl.add(modules, name, ());
+            };
+          | PProvideValue({name, alias, loc}) =>
+            let (_, name) = apply_alias(name, alias);
+            if (Hashtbl.mem(values, name)) {
+              errs := [ProvidedMultipleTimes(name, loc), ...errs^];
+            } else {
+              Hashtbl.add(values, name, ());
+            };
+          }
+        },
+        items,
+      );
+    | PTopModule(NotProvided, _)
+    | PTopForeign(NotProvided, _)
+    | PTopPrimitive(NotProvided, _)
+    | PTopLet(NotProvided, _, _, _)
+    | PTopException(NotProvided, _)
+    | PTopInclude(_)
+    | PTopExpr(_) => ()
+    };
+    super.enter_toplevel_stmt(top);
+  };
+
+  {
+    errs,
+    iter_hooks: {
+      ...super,
+      enter_toplevel_stmt,
+      enter_module,
+      leave_module,
+    },
+  };
+};
+
 let compose_well_formedness = ({errs, iter_hooks}, cur) =>
   cur(errs, iter_hooks);
 
@@ -572,6 +767,7 @@ let well_formedness_checks = [
   no_loop_control_statement_outside_of_loop,
   malformed_return_statements,
   no_local_include,
+  provided_multiple_times,
 ];
 
 let well_formedness_checker = () =>

compiler/test/__snapshots__/includes.03ddcd3b.0.snapshot → compiler/test/__snapshots__/provides.2a5f527b.0.snapshot

@@ -1,20 +1,20 @@
-includes › include_with_export_multiple
+provides › multiple_provides_8
 (module
  (type $none_=>_none (func))
  (type $none_=>_i32 (func (result i32)))
  (type $i32_i32_=>_i32 (func (param i32 i32) (result i32)))
- (type $i32_=>_i32 (func (param i32) (result i32)))
  (import \"_genv\" \"mem\" (memory $0 0))
  (import \"_genv\" \"tbl\" (table $tbl 0 funcref))
  (import \"_genv\" \"relocBase\" (global $relocBase_0 i32))
  (import \"_genv\" \"moduleRuntimeId\" (global $moduleRuntimeId_0 i32))
- (import \"GRAIN$MODULE$runtime/gc\" \"GRAIN$EXPORT$incRef\" (global $GRAIN$EXPORT$incRef_0 (mut i32)))
- (import \"GRAIN$MODULE$sameProvide\" \"GRAIN$EXPORT$foo\" (global $foo_1113 (mut i32)))
- (import \"GRAIN$MODULE$runtime/gc\" \"incRef\" (func $incRef_0 (param i32 i32) (result i32)))
- (import \"GRAIN$MODULE$sameProvide\" \"foo\" (func $foo_1113 (param i32) (result i32)))
+ (import \"GRAIN$MODULE$runtime/gc\" \"GRAIN$EXPORT$decRef\" (global $GRAIN$EXPORT$decRef_0 (mut i32)))
+ (import \"GRAIN$MODULE$runtime/gc\" \"decRef\" (func $decRef_0 (param i32 i32) (result i32)))
+ (global $foo_1110 (mut i32) (i32.const 0))
  (global $GRAIN$TABLE_SIZE i32 (i32.const 0))
  (elem $elem (global.get $relocBase_0))
  (export \"memory\" (memory $0))
+ (export \"GRAIN$EXPORT$bar\" (global $foo_1110))
+ (export \"GRAIN$EXPORT$foo\" (global $foo_1110))
  (export \"_gmain\" (func $_gmain))
  (export \"_gtype_metadata\" (func $_gtype_metadata))
  (export \"_start\" (func $_start))
@@ -36,15 +36,25 @@ includes › include_with_export_multiple
   (local $4 f32)
   (local $5 f64)
   (return
-   (block $cleanup_locals.2 (result i32)
+   (block $cleanup_locals.4 (result i32)
     (local.set $0
-     (block $compile_block.1 (result i32)
-      (call $foo_1113
-       (call $incRef_0
-        (global.get $GRAIN$EXPORT$incRef_0)
-        (global.get $foo_1113)
+     (block $compile_block.3 (result i32)
+      (block $compile_store.2
+       (global.set $foo_1110
+        (tuple.extract 0
+         (tuple.make
+          (i32.const 3)
+          (call $decRef_0
+           (global.get $GRAIN$EXPORT$decRef_0)
+           (global.get $foo_1110)
+          )
+         )
+        )
+       )
+       (block $do_backpatches.1
        )
       )
+      (i32.const 1879048190)
      )
     )
     (local.get $0)
@@ -56,5 +66,5 @@ includes › include_with_export_multiple
    (call $_gmain)
   )
  )
- ;; custom section \"cmi\", size 287
+ ;; custom section \"cmi\", size 1303
 )

compiler/test/suites/includes.re

@@ -22,10 +22,6 @@ describe("includes", ({test, testSkip}) => {
     "include_all_constructor",
     "include \"tlists\" as TLists; from TLists use *; Cons(2, Empty)",
   );
-  assertSnapshot(
-    "include_with_export_multiple",
-    "include \"sameProvide\" as SameProvide; from SameProvide use *; foo()",
-  );
   /* use {} tests */
   assertSnapshot(
     "include_some",

compiler/test/suites/provides.re

@@ -104,6 +104,50 @@ describe("provides", ({test, testSkip}) => {
     "provide { foo }",
     "Unbound value foo",
   );
+  assertCompileError(
+    "multiple_provides_1",
+    "provide let foo = 1; provide let foo = 2",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_2",
+    "provide let foo = 1; provide {foo}",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_3",
+    "provide enum Foo {Foo}; provide enum Foo {Foo}",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_4",
+    "provide enum Foo {Foo}; provide {type Foo}",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_5",
+    "provide module Foo {void}; provide module Foo {void}",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_6",
+    "provide module Foo {void}; provide {Foo}",
+    "provided multiple times",
+  );
+  assertCompileError(
+    "multiple_provides_7",
+    "let foo = 1; provide {foo, foo}",
+    "provided multiple times",
+  );
+  assertSnapshot(
+    "multiple_provides_8",
+    "let foo = 1; provide {foo, foo as bar}",
+  );
+  assertCompileError(
+    "multiple_provides_9",
+    "let foo = 1; let bar = 2; provide {foo, foo as bar, bar as foo}",
+    "provided multiple times",
+  );
 
   assertSnapshot("let_rec_provide", "provide let rec foo = () => 5");
 

stdlib/runtime/numbers.gr

@@ -597,7 +597,7 @@ provide let coerceNumberToUnsignedWasmI32 = (x: Number) => {
 }
 
 @unsafe
-provide let coerceNumberToBigInt = (x: Number) => {
+let coerceNumberToBigInt = (x: Number) => {
   let x = WasmI32.fromGrain(x)
   if (isSimpleNumber(x)) {
     BI.makeWrappedInt32(untagSimple(x))
@@ -2386,17 +2386,7 @@ provide let coerceNumberToInt64 = (x: Number) => {
 
 @unsafe
 provide let coerceNumberToBigInt = (x: Number) => {
-  let x = WasmI32.fromGrain(x)
-  let result = if (isBigInt(x)) {
-    // avoid extra malloc and prevent x from being freed
-    Memory.incRef(x)
-    x
-  } else {
-    // incRef x to reuse it via WasmI32.toGrain
-    Memory.incRef(x)
-    BI.makeWrappedInt64(coerceNumberToWasmI64(WasmI32.toGrain(x): Number))
-  }
-  WasmI32.toGrain(result): BigInt
+  WasmI32.toGrain(coerceNumberToBigInt(x)): BigInt
 }
 
 @unsafe