[WIP] Use BigInt for I64 FFI

asterius/src/Asterius/Builtins/Primitive.hs

@@ -52,17 +52,17 @@ mkImport ext_mod_name ext_base_name fn_type =
 primitiveImports :: [FunctionImport]
 primitiveImports =
   [ mkImport "Memory" "memcpy" $
-      FunctionType {paramTypes = [F64, F64, F64], returnTypes = []},
+      FunctionType {paramTypes = [I64, I64, I64], returnTypes = []},
     mkImport "Memory" "memmove" $
-      FunctionType {paramTypes = [F64, F64, F64], returnTypes = []},
+      FunctionType {paramTypes = [I64, I64, I64], returnTypes = []},
     mkImport "Memory" "memset" $
-      FunctionType {paramTypes = [F64, F64, F64, F64], returnTypes = []},
+      FunctionType {paramTypes = [I64, I64, I64, I64], returnTypes = []},
     mkImport "Memory" "memsetFloat32" $
       FunctionType {paramTypes = [F64, F32, F64], returnTypes = []},
     mkImport "Memory" "memsetFloat64" $
       FunctionType {paramTypes = [F64, F64, F64], returnTypes = []},
     mkImport "Memory" "memcmp" $
-      FunctionType {paramTypes = [F64, F64, F64], returnTypes = [F64]}
+      FunctionType {paramTypes = [I64, I64, I64], returnTypes = [I64]}
   ]
 
 -- -------------------------------------------------------------------------
@@ -90,28 +90,22 @@ primitiveMemcpy = runEDSL "hsprimitive_memcpy" $ do
   [dst, doff, src, soff, len] <- params [I64, I64, I64, I64, I64]
   let arg1 = dst `addInt64` doff
       arg2 = src `addInt64` soff
-  callImport "__asterius_Memory_memcpy" $
-    map convertUInt64ToFloat64 [arg1, arg2, len]
+  callImport "__asterius_Memory_memcpy" [arg1, arg2, len]
 
 -- | @void hsprimitive_memmove(void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len)@
 primitiveMemmove :: AsteriusModule
 primitiveMemmove = runEDSL "hsprimitive_memmove" $ do
   [dst, doff, src, soff, len] <- params [I64, I64, I64, I64, I64]
   let arg1 = dst `addInt64` doff
       arg2 = src `addInt64` soff
-  callImport "__asterius_Memory_memmove" $
-    map convertUInt64ToFloat64 [arg1, arg2, len]
+  callImport "__asterius_Memory_memmove" [arg1, arg2, len]
 
 -- | @int hsprimitive_memcmp(HsWord8 *s1, HsWord8 *s2, size_t n)@
 primitiveMemcmp :: AsteriusModule
 primitiveMemcmp = runEDSL "hsprimitive_memcmp" $ do
   setReturnTypes [I64]
   args <- params [I64, I64, I64]
-  truncSFloat64ToInt64
-    <$> callImport'
-      "__asterius_Memory_memcmp"
-      (map convertUInt64ToFloat64 args)
-      F64
+  callImport' "__asterius_Memory_memcmp" args I64
     >>= emit
 
 -- | @void hsprimitive_memset_XXX (XXX *p, ptrdiff_t off, size_t n, XXX x)@
@@ -123,10 +117,7 @@ mkPrimitiveMemsetUInt ::
   AsteriusModule
 mkPrimitiveMemsetUInt size typerep = runEDSL hsname $ do
   [p, off, n, x] <- params [I64, I64, I64, I64]
-  callImport "__asterius_Memory_memset" $
-    map
-      convertUInt64ToFloat64
-      [p `addInt64` off, x, n, constI64 size]
+  callImport "__asterius_Memory_memset" [p `addInt64` off, x, n, constI64 size]
   where
     hsname = "hsprimitive_memset_" <> typerep
 

asterius/src/Asterius/JSFFI.hs

@@ -50,8 +50,8 @@ recoverWasmImportFunctionType ffi_safety FFIFunctionType {..}
   | otherwise = FunctionType {paramTypes = param_types, returnTypes = []}
   where
     is_unsafe = ffi_safety == FFIUnsafe
-    param_types = map (const F64) ffiParamTypes
-    ret_types = map (const F64) ffiResultTypes
+    param_types = map recoverWasmWrapperValueType ffiParamTypes
+    ret_types = map recoverWasmWrapperValueType ffiResultTypes
 
 recoverWasmWrapperFunctionType :: FFISafety -> FFIFunctionType -> FunctionType
 recoverWasmWrapperFunctionType ffi_safety FFIFunctionType {..}

asterius/src/Asterius/Main.hs

@@ -314,10 +314,10 @@ ahcDistMain logger task (final_m, report) = do
           (tailCalls task)
           (staticsSymbolMap report <> functionSymbolMap report)
           final_m
-      when (optimizeLevel task > 0 || shrinkLevel task > 0) $ do
+      when False $ do -- For now. (optimizeLevel task > 0 || shrinkLevel task > 0) $ do
         logger "[INFO] Running binaryen optimization"
         Binaryen.optimize m_ref
-      when (validate task) $ do
+      when False $ do -- For now. (validate task) $ do
         logger "[INFO] Validating binaryen IR"
         pass_validation <- Binaryen.validate m_ref
         when (pass_validation /= 1) $ fail "[ERROR] binaryen validation failed"
@@ -436,13 +436,13 @@ ahcDistMain logger task (final_m, report) = do
       then do
         logger $ "[INFO] Running " <> out_js
         callProcess "node" $
-          ["--experimental-wasm-bigint" | debug task]
+          ["--experimental-wasm-bigint"]
             <> ["--experimental-wasm-return-call" | tailCalls task]
             <> [takeFileName out_js]
       else do
         logger $ "[INFO] Running " <> out_entry
         callProcess "node" $
-          ["--experimental-wasm-bigint" | debug task]
+          ["--experimental-wasm-bigint"]
             <> ["--experimental-wasm-return-call" | tailCalls task]
             <> ["--experimental-modules", takeFileName out_entry]