[commit: ghc] wip/impredicativity: Fix problems with the let/app invariant and InstanceOf constraints. (9a816cd)

git at git.haskell.org git at git.haskell.org
Wed Jun 24 07:32:52 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/impredicativity
Link       : http://ghc.haskell.org/trac/ghc/changeset/9a816cd31115c99419fb4f5019073277cf129c01/ghc

>---------------------------------------------------------------

commit 9a816cd31115c99419fb4f5019073277cf129c01
Author: Alejandro Serrano <trupill at gmail.com>
Date:   Wed Jun 24 09:32:49 2015 +0200

    Fix problems with the let/app invariant and InstanceOf constraints.


>---------------------------------------------------------------

9a816cd31115c99419fb4f5019073277cf129c01
 compiler/deSugar/DsBinds.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 95656ad..578f77c 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -801,7 +801,7 @@ dsHsWrapper (WpCast co)       e = ASSERT(tcCoercionRole co == Representational)
 dsHsWrapper (WpEvLam ev)      e = return $ Lam ev e
 dsHsWrapper (WpTyLam tv)      e = return $ Lam tv e
 dsHsWrapper (WpEvApp    tm)   e = liftM (App e) (dsEvTerm tm)
-dsHsWrapper (WpEvRevApp tm)   e = liftM (flip App e) (dsEvTerm tm)
+dsHsWrapper (WpEvRevApp tm)   e = liftM (flip mkCoreApp e) (dsEvTerm tm)
 
 --------------------------------------
 dsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]
@@ -1159,12 +1159,12 @@ dsEvInstanceOf _  (EvInstanceOfVar v)
   = return (Var v)
 dsEvInstanceOf ty (EvInstanceOfEq co)
   = do { bndr <- newSysLocalDs ty
-       ; expr <- dsTcCoercion co (\c -> Cast (Var bndr) (mkSubCo c))
+       ; expr <- dsTcCoercion co (\c -> mkCast (Var bndr) (mkSubCo c))
        ; return (mkCoreLams [bndr] expr) }
 dsEvInstanceOf ty (EvInstanceOfInst qvars co qs)
   = do { bndr <- newSysLocalDs ty
        ; qs'  <- mapM dsEvTerm qs
-       ; let exprTy = foldl (\e t -> App e (Type t)) (Var bndr) qvars
-             exprEv = foldl App exprTy qs'
-       ; expr <- dsTcCoercion co (\c -> Cast exprEv (mkSubCo c))
+       ; let exprTy = mkCoreApps (Var bndr) (map Type qvars)
+             exprEv = mkCoreApps exprTy qs'
+       ; expr <- dsTcCoercion co (\c -> mkCast exprEv (mkSubCo c))
        ; return (mkCoreLams [bndr] expr) }



More information about the ghc-commits mailing list