Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/3d7a4476e7bc20ea19235fcca2baf690b56e632a >--------------------------------------------------------------- commit 3d7a4476e7bc20ea19235fcca2baf690b56e632a Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Mon Feb 20 16:02:00 2012 +0000 Fix the DFunUnfolding elaboration so it isn't totally bogus >--------------------------------------------------------------- compiler/supercompile/Supercompile.hs | 7 +++++-- 1 files changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/supercompile/Supercompile.hs b/compiler/supercompile/Supercompile.hs index 46dfeed..b975012 100644 --- a/compiler/supercompile/Supercompile.hs +++ b/compiler/supercompile/Supercompile.hs @@ -27,7 +27,7 @@ import CoreSyn import CoreFVs (exprFreeVars) import CoreUtils (exprType) import Coercion (isCoVar, mkCoVarCo, mkAxInstCo) -import DataCon (dataConAllTyVars, dataConRepArgTys, dataConTyCon) +import DataCon (dataConAllTyVars, dataConRepArgTys, dataConInstOrigArgTys, dataConTyCon, dataConWorkId) import VarSet import VarEnv import Name (localiseName, mkSystemName) @@ -37,6 +37,7 @@ import Id import FastString (fsLit) import PrelNames (undefinedName) import PrimOp (primOpSig) +import TcType (tcSplitDFunTy) import Type (mkTyVarTy, mkForAllTy, mkFunTys) import TysPrim (alphaTyVar, argAlphaTyVar) import TyCon (newTyConCo_maybe) @@ -143,7 +144,9 @@ termUnfoldings e = go (S.termFreeVars e) emptyVarSet [] | otherwise = case realIdUnfolding x of NoUnfolding -> Nothing OtherCon _ -> Nothing - DFunUnfolding _ dc es -> Just $ runParseM $ conAppToTerm dc es + DFunUnfolding _ dc es -> Just $ runParseM $ coreExprToTerm $ mkLams as $ mkLams xs $ Var (dataConWorkId dc) `mkTyApps` cls_tys `mkApps` [(e `mkTyApps` map mkTyVarTy as) `mkVarApps` xs | e <- es] + where (as, theta, _cls, cls_tys) = tcSplitDFunTy (idType x) + xs = zipWith (mkSysLocal (fsLit "x")) bv_uniques theta CoreUnfolding { uf_tmpl = e } -> Just $ runParseM $ coreExprToTerm e -- NB: it's OK if the unfolding is a non-value, as the evaluator won't inline LetBound non-values _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
