Commit 07292e95 authored by Christiaan Baaij's avatar Christiaan Baaij Committed by Ben Gamari
Browse files

zonkCt tries to maintain the canonical form of a Ct.

For example,
 - a CDictCan should stay a CDictCan;
 - a CTyEqCan should stay a CTyEqCan (if the LHS stays as a variable.).
 - a CHoleCan should stay a CHoleCan

Why?  For CDicteqCan see Trac #11525.

Test Plan: Validate

Reviewers: austin, adamgundry, simonpj, goldfire, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3105
parent 56c9bb39
......@@ -1355,12 +1355,50 @@ zonkSimples cts = do { cts' <- mapBagM zonkCt' cts
zonkCt' :: Ct -> TcM Ct
zonkCt' ct = zonkCt ct
{- Note [zonkCt behaviour]
zonkCt tries to maintain the canonical form of a Ct. For example,
- a CDictCan should stay a CDictCan;
- a CTyEqCan should stay a CTyEqCan (if the LHS stays as a variable.).
- a CHoleCan should stay a CHoleCan
Why?, for example:
- For CDictCan, the @TcSimplify.expandSuperClasses@ step, which runs after the
simple wanted and plugin loop, looks for @CDictCan@s. If a plugin is in use,
constraints are zonked before being passed to the plugin. This means if we
don't preserve a canonical form, @expandSuperClasses@ fails to expand
superclasses. This is what happened in Trac #11525.
- For CHoleCan, once we forget that it's a hole, we can never recover that info.
NB: we do not expect to see any CFunEqCans, because zonkCt is only
called on unflattened constraints.
NB: Constraints are always re-flattened etc by the canonicaliser in
@TcCanonical@ even if they come in as CDictCan. Only canonical constraints that
are actually in the inert set carry all the guarantees. So it is okay if zonkCt
creates e.g. a CDictCan where the cc_tyars are /not/ function free.
-}
zonkCt :: Ct -> TcM Ct
zonkCt ct@(CHoleCan { cc_ev = ev })
= do { ev' <- zonkCtEvidence ev
; return $ ct { cc_ev = ev' } }
zonkCt ct@(CDictCan { cc_ev = ev, cc_tyargs = args })
= do { ev' <- zonkCtEvidence ev
; args' <- mapM zonkTcType args
; return $ ct { cc_ev = ev', cc_tyargs = args' } }
zonkCt ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv, cc_rhs = rhs })
= do { ev' <- zonkCtEvidence ev
; tv_ty' <- zonkTcTyVar tv
; case getTyVar_maybe tv_ty' of
Just tv' -> do { rhs' <- zonkTcType rhs
; return ct { cc_ev = ev'
, cc_tyvar = tv'
, cc_rhs = rhs' } }
Nothing -> return (mkNonCanonical ev') }
zonkCt ct
= do { fl' <- zonkCtEvidence (cc_ev ct)
= ASSERT( not (isCFunEqCan ct) )
-- We do not expect to see any CFunEqCans, because zonkCt is only called on
-- unflattened constraints.
do { fl' <- zonkCtEvidence (cc_ev ct)
; return (mkNonCanonical fl') }
zonkCtEvidence :: CtEvidence -> TcM CtEvidence
......
{-# LANGUAGE DataKinds, TypeOperators, KindSignatures, TypeFamilies,
ConstraintKinds, FlexibleContexts #-}
{-# OPTIONS_GHC -fplugin T11525_Plugin #-}
module T11525 where
import GHC.TypeLits
import Data.Proxy
truncateB :: KnownNat a => Proxy (a + b) -> Proxy a
truncateB Proxy = Proxy
class Bus t where
type AddrBits t :: Nat
data MasterOut b = MasterOut
{ adr :: Proxy (AddrBits b)
}
type WiderAddress b b' k = ( KnownNat (AddrBits b)
, AddrBits b' ~ (AddrBits b + k)
)
narrowAddress' :: (WiderAddress b b' k)
=> MasterOut b'
-> MasterOut b
narrowAddress' m = MasterOut { adr = truncateB (adr m) }
module T11525_Plugin(plugin) where
import TcRnMonad ( TcPlugin(..), TcPluginResult(..) )
import Plugins ( defaultPlugin, Plugin(..), CommandLineOption )
plugin :: Plugin
plugin = defaultPlugin { tcPlugin = Just . thePlugin }
thePlugin :: [CommandLineOption] -> TcPlugin
thePlugin opts = TcPlugin
{ tcPluginInit = return ()
, tcPluginSolve = \_ _ _ _ -> return $ TcPluginOk [] []
, tcPluginStop = \_ -> return ()
}
......@@ -536,3 +536,6 @@ test('T11723', normal, compile, [''])
test('T12987', normal, compile, [''])
test('T11736', normal, compile, [''])
test('T13248', expect_broken(13248), compile, [''])
test('T11525', [unless(have_dynamic(), expect_broken(10301))], multi_compile,
['', [('T11525_Plugin.hs', '-package ghc'), ('T11525.hs', '')],
'-dynamic'])
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