Misc FFI-related fixes (#351)

tweag · Nov 28, 2019 · 1777faf · 1777faf
1 parent cc2e89d
commit 1777faf
Show file tree

Hide file tree

Showing 2 changed files with 71 additions and 2 deletions.
diff --git a/asterius/src/Asterius/Foreign.hs b/asterius/src/Asterius/Foreign.hs
@@ -28,6 +28,7 @@ import MkId
 import OrdList
 import Outputable
 import Pair
+import Panic
 import Platform
 import PrelNames
 import RepType
@@ -88,7 +89,9 @@ asteriusDsCImport id co (CFunction target) cconv@PrimCallConv safety _ =
   asteriusDsPrimCall id co (CCall (CCallSpec target cconv safety))
 asteriusDsCImport id co (CFunction target) cconv safety _ =
   asteriusDsFCall id co (CCall (CCallSpec target cconv safety))
-asteriusDsCImport _ _ _ _ _ _ = panic "asteriusDsCImport"
+asteriusDsCImport id co _ cconv safety mHeader =
+  panicDoc "asteriusDsCImport" $
+    vcat [ppr id, ppr co, ppr cconv, ppr safety, ppr mHeader]
 
 funTypeArgStdcallInfo :: DynFlags -> CCallConv -> Type -> Maybe Int
 funTypeArgStdcallInfo dflags StdCallConv ty
@@ -269,7 +272,9 @@ asteriusTcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) m
           addErrTc (text "`value' imports cannot have function types")
       _ -> return ()
     return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src
-asteriusTcCheckFIType _ _ _ = panic "asteriusTcCheckFIType"
+asteriusTcCheckFIType arg_tys res_ty imp_decl =
+  panicDoc "asteriusTcCheckFIType" $
+    vcat [ppr arg_tys, ppr res_ty, ppr imp_decl]
 
 checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
 checkMissingAmpersand dflags arg_tys res_ty

diff --git a/asterius/src/Asterius/Foreign/Internals.hs b/asterius/src/Asterius/Foreign/Internals.hs
@@ -73,6 +73,38 @@ ffiBoxedValueTypeMap0 =
             signed = True
           }
       ),
+      ( GHC.int8TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Int8",
+            signed = True
+          }
+      ),
+      ( GHC.int16TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Int16",
+            signed = True
+          }
+      ),
+      ( GHC.int32TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Int32",
+            signed = True
+          }
+      ),
+      ( GHC.int64TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Int64",
+            signed = True
+          }
+      ),
       ( GHC.wordTyConName,
         FFI_VAL
           { ffiWasmValueType = I64,
@@ -81,6 +113,38 @@ ffiBoxedValueTypeMap0 =
             signed = False
           }
       ),
+      ( GHC.word8TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Word8",
+            signed = False
+          }
+      ),
+      ( GHC.word16TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Word16",
+            signed = False
+          }
+      ),
+      ( GHC.word32TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Word32",
+            signed = False
+          }
+      ),
+      ( GHC.word64TyConName,
+        FFI_VAL
+          { ffiWasmValueType = I64,
+            ffiJSValueType = F64,
+            hsTyCon = "Word64",
+            signed = False
+          }
+      ),
       ( GHC.floatTyConName,
         FFI_VAL
           { ffiWasmValueType = F32,