diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-07-29 16:38:44 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-07-30 11:03:08 +0100 |
commit | 92d2567230e28010e425b47057ccca66d1a9a712 (patch) | |
tree | 2a51a154fce83971874a6b9604b3d02e762b28e8 /compiler/deSugar/DsUtils.hs | |
parent | 4e8d74d2362fbb025614ddeedfa3a9202bb6f2bb (diff) | |
download | haskell-92d2567230e28010e425b47057ccca66d1a9a712.tar.gz |
Define DsUtils.mkCastDs and use it
This change avoids a spurious WARNing from mkCast. In the output of
the desugarer (only, I think) we can have a cast where the type of the
expression and cast don't syntactically match, because of an enclosing
type-let binding.
Diffstat (limited to 'compiler/deSugar/DsUtils.hs')
-rw-r--r-- | compiler/deSugar/DsUtils.hs | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index f94b831a6f..819944312b 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -24,7 +24,7 @@ module DsUtils ( mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult, mkCoSynCaseMatchResult, wrapBind, wrapBinds, - mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, + mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs, seqVar, @@ -44,6 +44,7 @@ import {-# SOURCE #-} Match ( matchSimply ) import HsSyn import TcHsSyn +import Coercion( Coercion, isReflCo ) import TcType( tcSplitTyConApp ) import CoreSyn import DsMonad @@ -549,10 +550,22 @@ mkCoreAppDs fun arg = mkCoreApp fun arg -- The rest is done in MkCore mkCoreAppsDs :: CoreExpr -> [CoreExpr] -> CoreExpr mkCoreAppsDs fun args = foldl mkCoreAppDs fun args +mkCastDs :: CoreExpr -> Coercion -> CoreExpr +-- We define a desugarer-specific verison of CoreUtils.mkCast, +-- because in the immediate output of the desugarer, we can have +-- apparently-mis-matched coercions: E.g. +-- let a = b +-- in (x :: a) |> (co :: b ~ Int) +-- Lint know about type-bindings for let and does not complain +-- So here we do not make the assertion checks that we make in +-- CoreUtils.mkCast; and we do less peephole optimisation too +mkCastDs e co | isReflCo co = e + | otherwise = Cast e co + {- ************************************************************************ * * -\subsection[mkSelectorBind]{Make a selector bind} + Tuples and selector bindings * * ************************************************************************ @@ -720,7 +733,7 @@ mkBigLHsPatTup = mkChunkified mkLHsPatTup {- ************************************************************************ * * -\subsection[mkFailurePair]{Code for pattern-matching and other failures} + Code for pattern-matching and other failures * * ************************************************************************ @@ -805,7 +818,13 @@ entered at most once. Adding a dummy 'realWorld' token argument makes it clear that sharing is not an issue. And that in turn makes it more CPR-friendly. This matters a lot: if you don't get it right, you lose the tail call property. For example, see Trac #3403. --} + + +************************************************************************ +* * + Ticks +* * +********************************************************************* -} mkOptTickBox :: [Tickish Id] -> CoreExpr -> CoreExpr mkOptTickBox = flip (foldr Tick) |