[Git][ghc/ghc][wip/T15933] Look at Core/STG type not Cmm type

[Peter Trommler]

Peter Trommler pushed to branch wip/T15933 at Glasgow Haskell Compiler / GHC


Commits:
0bdb39eb by Peter Trommler at 2020-06-12T15:19:30+02:00
Look at Core/STG type not Cmm type

- - - - -


1 changed file:

- compiler/GHC/HsToCore/Foreign/Decl.hs


Changes:

=====================================
compiler/GHC/HsToCore/Foreign/Decl.hs
=====================================
@@ -536,8 +536,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
   arg_info  = [ let stg_type = showStgType ty
                     cmm_type = typeCmmType platform (getPrimTyOf ty)
                     stack_type
-                      = if isBitsType cmm_type -- TODO: check Float on 64-bit
-                           && typeWidth cmm_type < wordWidth platform
+                      = if int_promote (typeTyCon ty)
                         then text "HsWord"
                         else stg_type
                 in
@@ -547,6 +546,19 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
                  cmm_type)
               | (ty,n) <- zip arg_htys [1::Int ..] ]
 
+  int_promote ty_con
+    | ty_con `hasKey` int8TyConKey = True
+    | ty_con `hasKey` int16TyConKey = True
+    | ty_con `hasKey` int32TyConKey
+    , platformWordSizeInBytes platform > 4
+    = True
+    | ty_con `hasKey` word8TyConKey = True
+    | ty_con `hasKey` word16TyConKey = True
+    | ty_con `hasKey` word32TyConKey
+    , platformWordSizeInBytes platform > 4
+    = True
+    | otherwise = False
+
 
   arg_cname n stg_ty stack_ty
         | libffi    = parens (stg_ty) <> char '*' <>



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bdb39ebbc221f0636f63b2f720da6610f6de619

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bdb39ebbc221f0636f63b2f720da6610f6de619
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200612/5449b86f/attachment-0001.html>