summaryrefslogtreecommitdiff
path: root/compiler/stgSyn
diff options
context:
space:
mode:
authorAndrew Martin <andrew.thaddeus@gmail.com>2019-05-25 15:36:14 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-06-04 01:09:43 -0400
commitdb78ac6f5d69618ff143ab4b572e7f58a1805687 (patch)
treebfff3f99e6710e1a5cad691d3bf6fba42d1d3419 /compiler/stgSyn
parent286827be471f9efa67303d57b979e0c32cb8936e (diff)
downloadhaskell-db78ac6f5d69618ff143ab4b572e7f58a1805687.tar.gz
Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call.
Diffstat (limited to 'compiler/stgSyn')
-rw-r--r--compiler/stgSyn/CoreToStg.hs2
-rw-r--r--compiler/stgSyn/StgSyn.hs10
2 files changed, 8 insertions, 4 deletions
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index 7f60bb21d2..12766e90d4 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -539,7 +539,7 @@ coreToStgApp _ f args ticks = do
-- A regular foreign call.
FCallId call -> ASSERT( saturated )
- StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
+ StgOpApp (StgFCallOp call (idType f) (idUnique f)) args' res_ty
TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args')
_other -> StgApp f args'
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs
index 3a6cf3f133..274b0696fb 100644
--- a/compiler/stgSyn/StgSyn.hs
+++ b/compiler/stgSyn/StgSyn.hs
@@ -686,10 +686,14 @@ data StgOp
| StgPrimCallOp PrimCall
- | StgFCallOp ForeignCall Unique
+ | StgFCallOp ForeignCall Type Unique
-- The Unique is occasionally needed by the C pretty-printer
-- (which lacks a unique supply), notably when generating a
- -- typedef for foreign-export-dynamic
+ -- typedef for foreign-export-dynamic. The Type, which is
+ -- obtained from the foreign import declaration itself, is
+ -- needed by the stg-to-cmm pass to determine the offset to
+ -- apply to unlifted boxed arguments in StgCmmForeign.
+ -- See Note [Unlifted boxed arguments to foreign calls]
{-
************************************************************************
@@ -860,7 +864,7 @@ pprStgAlt indent (con, params, expr)
pprStgOp :: StgOp -> SDoc
pprStgOp (StgPrimOp op) = ppr op
pprStgOp (StgPrimCallOp op)= ppr op
-pprStgOp (StgFCallOp op _) = ppr op
+pprStgOp (StgFCallOp op _ _) = ppr op
instance Outputable AltType where
ppr PolyAlt = text "Polymorphic"