Commit e40db7b1 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Detect levity-polymorphic uses of unsafeCoerce#

This bug was shown up by Trac #14561. The deguarer carefully
detects unsaturated and levity-polymorphic uses of primops,
but not of things like unsafeCoerce#.

The fix is simple: see Note [Levity-polymorphic Ids] in Id.
parent a106a200
......@@ -119,7 +119,8 @@ module Id (
import GhcPrelude
import DynFlags
import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding, Unfolding( NoUnfolding ) )
import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,
isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
import IdInfo
import BasicTypes
......@@ -519,7 +520,8 @@ hasNoBinding id = case Var.idDetails id of
PrimOpId _ -> True -- See Note [Primop wrappers]
FCallId _ -> True
DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
_ -> False
_ -> isCompulsoryUnfolding (idUnfolding id)
-- See Note [Levity-polymorphic Ids]
isImplicitId :: Id -> Bool
-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
......@@ -541,7 +543,25 @@ isImplicitId id
idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
{-
{- Note [Levity-polymorphic Ids]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Some levity-polymorphic Ids must be applied and and inlined, not left
un-saturated. Example:
unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b
This has a compulsory unfolding because we can't lambda-bind those
arguments. But the compulsory unfolding may leave levity-polymorphic
lambdas if it is not applied to enough arguments; e.g. (Trac #14561)
bad :: forall (a :: TYPE r). a -> a
bad = unsafeCoerce#
The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.
And we want that magic to apply to levity-polymorphic compulsory-inline things.
The easiest way to do this is for hasNoBinding to return True of all things
that have compulsory unfolding. A very Ids with a compulsory unfolding also
have a binding, but it does not harm to say they don't here, and its a very
simple way to fix Trac #14561.
Note [Primop wrappers]
~~~~~~~~~~~~~~~~~~~~~~
Currently hasNoBinding claims that PrimOpIds don't have a curried
......
......@@ -260,7 +260,8 @@ ds_expr _ (HsLit lit) = dsLit (convertLit lit)
ds_expr _ (HsOverLit lit) = dsOverLit lit
ds_expr _ (HsWrap co_fn e)
= do { e' <- ds_expr True e
= do { e' <- ds_expr True e -- This is the one place where we recurse to
-- ds_expr (passing True), rather than dsExpr
; wrap' <- dsHsWrapper co_fn
; dflags <- getDynFlags
; let wrapped_e = wrap' e'
......
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MagicHash #-}
module T14561 where
import GHC.Types
import GHC.Prim
badId :: forall (a :: TYPE r). a -> a
badId = unsafeCoerce#
-- Un-saturated application of a levity-polymorphic
-- function that must be eta-expanded
goodId :: forall (a :: Type). a -> a
goodId = unsafeCoerce#
-- But this one is OK
......@@ -180,4 +180,5 @@ test('T14520', normal, compile_fail, [''])
test('T11203', normal, compile_fail, [''])
test('T14555', normal, compile_fail, [''])
test('T14563', normal, compile_fail, [''])
test('T14561', normal, compile_fail, [''])
Markdown is supported
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