Misc simplifications (#883)

asterius/package.yaml

@@ -50,6 +50,7 @@ _exe-ghc-options: &exe-ghc-options
 dependencies:
   - base
   - binary
+  - binaryen
   - bytestring
   - Cabal
   - containers
@@ -60,25 +61,18 @@ dependencies:
   - ghc-asterius
   - ghc-boot-asterius
   - ghc-prim
-  - ghc-toolkit
   - ghci-asterius
   - inline-js-core
   - mtl
   - process
+  - template-haskell
+  - template-haskell-asterius
   - transformers
 
-internal-libraries:
-  asterius-types:
-    source-dirs: src-types
-    dependencies:
-      - template-haskell
-
 library:
-  source-dirs: src
-  dependencies:
-    - asterius-types
-    - binaryen
-    - template-haskell-asterius
+  source-dirs:
+    - src
+    - src-types
 
 executables:
   ahc:

asterius/rts/browser/default.mjs

@@ -37,18 +37,6 @@ class Posix {
   readdir() {
     throw WebAssembly.RuntimeError("Unsupported rts interface: readdir");
   }
-  closedir() {
-    throw WebAssembly.RuntimeError("Unsupported rts interface: closedir");
-  }
-  getenv() {
-    throw WebAssembly.RuntimeError("Unsupported rts interface: getenv");
-  }
-  access() {
-    throw WebAssembly.RuntimeError("Unsupported rts interface: access");
-  }
-  getcwd() {
-    throw WebAssembly.RuntimeError("Unsupported rts interface: getcwd");
-  }
 }
 
 export default {

asterius/rts/node/default.mjs

@@ -140,58 +140,6 @@ class Posix {
       return -1;
     }
   }
-  closedir(dirPtr) {
-    try {
-      this.dirs.get(dirPtr).closeSync();
-      this.dirs.delete(dirPtr);
-      return 0;
-    } catch (err) {
-      this.set_errno(-err.errno);
-      return -1;
-    }
-  }
-  getenv(keyPtr, resPtr) {
-    const res = process.env[this.memory.strLoad(keyPtr)];
-    if (res) {
-      const l = resPtr & 0xffffffff;
-      const { read, written } = new TextEncoder().encodeInto(
-        res,
-        this.memory.i8View.subarray(l, l + 32767)
-      );
-      if (read !== res.length)
-        throw new WebAssembly.RuntimeError(
-          `${res} exceeded environment variable limit`
-        );
-      this.memory.i8View[l + written] = 0;
-      return resPtr;
-    } else {
-      return 0;
-    }
-  }
-  access(f, m) {
-    try {
-      fs.accessSync(this.memory.strLoad(f), m);
-      return 0;
-    } catch (err) {
-      this.set_errno(-err.errno);
-      return -1;
-    }
-  }
-  getcwd(buf, size) {
-    const cwd = process.cwd();
-    const l = buf & 0xffffffff;
-    const { read, written } = new TextEncoder().encodeInto(
-      cwd,
-      this.memory.i8View.subarray(l, l - 1 + size)
-    );
-    this.memory.i8View[l + written] = 0;
-    if (read === cwd.length) {
-      return buf;
-    } else {
-      this.set_errno(34);
-      return 0;
-    }
-  }
 }
 
 export default {

asterius/rts/rts.exception.mjs

@@ -33,6 +33,7 @@ export class ExceptionHelper {
     isI32(tso);
     isI32(exception);
     const raise_closure = this.heapAlloc.allocate(
+      0xdeadbeef,
       Math.ceil(rtsConstants.sizeof_StgThunk / 4) + 1
     );
     this.memory.i32Store(

asterius/rts/rts.gc.mjs

@@ -111,7 +111,7 @@ export class GC {
    * @param bytes The size in bytes of the closure
    */
   copyClosure(c, bytes) {
-    const dest_c = this.heapAlloc.allocate(Math.ceil(bytes / 4));
+    const dest_c = this.heapAlloc.allocate(0xdeadbeef, Math.ceil(bytes / 4));
     this.memory.memcpy(dest_c, c, bytes);
     const dest_block = this.components.exports.__ahc_Bdescr(dest_c);
     if (!this.liveBlocks.has(dest_block)) {

asterius/rts/rts.heapalloc.mjs

@@ -80,7 +80,7 @@ export class HeapAlloc {
    * @param n The number of (64 bit) words to allocate
    * @param pinned Whether to allocate in the pinned pool
    */
-  allocate(n, pinned = false) {
+  allocate(cap, n, pinned = false) {
     isI32(n);
     const b = n << 2; // The size in bytes
     // Large objects are forced to be pinned as well
@@ -134,8 +134,12 @@ export class HeapAlloc {
    * Allocates the given number of words in the pinned pool.
    * @param n The number of (64 bit) words to allocate
    */
-  allocatePinned(n) {
-    return this.allocate(n, true);
+  allocatePinned(cap, n) {
+    return this.allocate(cap, n, true);
+  }
+
+  allocateMightFail(cap, n) {
+    return this.allocate(cap, n, false);
   }
 
   /**

asterius/rts/rts.jsval.mjs

@@ -6,7 +6,7 @@ export class JSValManager {
   }
 
   newJSValzh(v) {
-    const c = this.components.heapAlloc.allocate(1);
+    const c = this.components.heapAlloc.allocate(0xdeadbeef, 1);
     this.components.memory.i32Store(
       c,
       this.components.symbolTable.addressOf("stg_JSVAL_info")

asterius/rts/rts.memory.mjs

@@ -138,11 +138,6 @@ export class Memory {
     return new t(this.memory.buffer, p, len);
   }
 
-  strlen(_str) {
-    isI32(_str);
-    return isI32(this.components.exports.strlen(_str));
-  }
-
   strLoad(_str) {
     let p = _str;
     let s = "";
@@ -158,13 +153,6 @@ export class Memory {
     }
   }
 
-  memchr(_ptr, val, num) {
-    isI32(_ptr);
-    isI32(val);
-    isI32(num);
-    return isI32(this.components.exports.memchr(_ptr, val, num));
-  }
-
   memcpy(_dst, _src, n) {
     return this.components.exports.memcpy(_dst, _src, n);
   }

asterius/rts/rts.stablename.mjs

@@ -21,6 +21,7 @@ export class StableNameManager {
 
     // https://github.com/ghc/ghc/blob/fe819dd637842fb564524a7cf80612a3673ce14c/includes/rts/storage/Closures.h#L197
     let stableptr = this.heapalloc.allocate(
+      0xdeadbeef,
       Math.ceil(rtsConstants.sizeof_StgStableName / 4)
     );
     this.memory.i32Store(stableptr, this.SymbolTable.addressOf("stg_STABLE_NAME_info"));

asterius/src-types/Asterius/Binary/TH.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -9,7 +10,7 @@ where
 import qualified Binary as GHC
 import Data.Foldable
 import Data.Word
-import Language.Haskell.TH
+import "template-haskell" Language.Haskell.TH
 
 genBinary :: Name -> Q [Dec]
 genBinary ty = do

asterius/src-types/Asterius/Monoid/TH.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -7,7 +8,7 @@ module Asterius.Monoid.TH
 where
 
 import Data.List (foldl')
-import Language.Haskell.TH
+import "template-haskell" Language.Haskell.TH
 
 -- | Generate a 'Monoid' instance of the form
 --

asterius/src-types/Asterius/NFData/TH.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -8,7 +9,7 @@ where
 
 import Control.DeepSeq
 import Data.List (foldl1')
-import Language.Haskell.TH
+import "template-haskell" Language.Haskell.TH
 
 genNFData :: Name -> Q [Dec]
 genNFData ty = do

asterius/src-types/Asterius/Semigroup/TH.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -7,7 +8,7 @@ module Asterius.Semigroup.TH
 where
 
 import Data.List (foldl')
-import Language.Haskell.TH
+import "template-haskell" Language.Haskell.TH
 
 -- | Generate a 'Semigroup' instance of the form
 --