Commit e090f1bc authored by Luite Stegeman's avatar Luite Stegeman Committed by Ben Gamari
Browse files

Change demand information for foreign calls

Foreign calls may not be strict for lifted arguments. Fixes Trac #11076.

Test Plan: ./validate

Reviewers: simonpj, bgamari, austin

Subscribers: thomie

Differential Revision:

GHC Trac Issues: #11076
parent 4a32bf92
......@@ -990,8 +990,11 @@ mkFCallId dflags uniq fcall ty
(_, tau) = tcSplitForAllTys ty
(arg_tys, _) = tcSplitFunTys tau
arity = length arg_tys
strict_sig = mkClosedStrictSig (replicate arity evalDmd) topRes
strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes
-- the call does not claim to be strict in its arguments, since they
-- may be lifted (foreign import prim) and the called code doen't
-- necessarily force them. See Trac #11076.
* *
Test case for a problem where GHC had incorrect strictness
information for foreign calls with lifted arguments
{-# OPTIONS_GHC -O0 #-}
module Main where
import T11076A
import Control.Exception
x :: Bool
x = error "OK: x has been forced"
main :: IO ()
main = print (testBool x) `catch`
\(ErrorCall e) -> putStrLn e -- x should be forced
{-# OPTIONS_GHC -O #-}
{-# LANGUAGE MagicHash,
module T11076A where
import GHC.Exts
import Unsafe.Coerce
If the demand type for the foreign call argument is incorrectly strict,
the bang pattern can be optimized out
testBool :: Bool -> Int
testBool !x = I# (cmm_testPrim (unsafeCoerce x))
{-# INLINE testBool #-}
foreign import prim "testPrim" cmm_testPrim :: Any -> Int#
#include "Cmm.h"
#include "MachDeps.h"
testPrim(gcptr x)
W_ a;
a = 123;
return (a);
......@@ -10,3 +10,4 @@ test('T7649', normal, compile_and_run, [''])
test('T9254', normal, compile_and_run, [''])
test('T10148', normal, compile_and_run, [''])
test('T10218', normal, compile_and_run, [''])
test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm'])
==================== Strictness signatures ====================
T8598.$trModule: m <S(S),1*U(U)>m <S,1*U(U)>m
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment