X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=c07073aee6a5343d8026f139617877802e85531a;hb=ca53c38335cdc671f0b1e0949aa1514fc3fd72a5;hp=f34ac9c1726f47a3c77e10458f5a135b4397f707;hpb=35a77384d096e9cec8488f09ddaee533ad61051a;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index f34ac9c..c07073a 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -30,10 +30,7 @@ import CoreFVs import Type import DataCon import TyCon --- import Type import Util --- import DataCon -import Var import VarSet import TysPrim import DynFlags @@ -253,7 +250,7 @@ schemeR fvs (nm, rhs) {- | trace (showSDoc ( (char ' ' - $$ (ppr.filter (not.isTyCoVar).varSetElems.fst) rhs + $$ (ppr.filter (not.isTyVar).varSetElems.fst) rhs $$ pprCoreExpr (deAnnotate rhs) $$ char ' ' ))) False @@ -838,7 +835,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple rhs_code <- schemeE (d_alts+size) s p' rhs return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code) where - real_bndrs = filter (not.isTyCoVar) bndrs + real_bndrs = filterOut isTyVar bndrs my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) @@ -1201,6 +1198,9 @@ pushAtom d p e | Just e' <- bcView e = pushAtom d p e' +pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, + = return (nilOL, 0) -- treated just like a variable VoidArg + pushAtom d p (AnnVar v) | idCgRep v == VoidArg = return (nilOL, 0) @@ -1274,9 +1274,6 @@ pushAtom _ _ (AnnLit lit) -- Get the addr on the stack, untaggedly return (unitOL (PUSH_UBX (Right addr) 1), 1) -pushAtom d p (AnnCast e _) - = pushAtom d p (snd e) - pushAtom _ _ expr = pprPanic "ByteCodeGen.pushAtom" (pprCoreExpr (deAnnotate (undefined, expr))) @@ -1460,19 +1457,21 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- whereas value lambdas cannot; that is why they are nuked here bcView (AnnNote _ (_,e)) = Just e bcView (AnnCast (_,e) _) = Just e -bcView (AnnLam v (_,e)) | isTyCoVar v = Just e +bcView (AnnLam v (_,e)) | isTyVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e bcView _ = Nothing isVoidArgAtom :: AnnExpr' Var ann -> Bool isVoidArgAtom e | Just e' <- bcView e = isVoidArgAtom e' isVoidArgAtom (AnnVar v) = typePrimRep (idType v) == VoidRep +isVoidArgAtom (AnnCoercion {}) = True isVoidArgAtom _ = False atomPrimRep :: AnnExpr' Id ann -> PrimRep atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = typePrimRep (idType v) atomPrimRep (AnnLit l) = typePrimRep (literalType l) +atomPrimRep (AnnCoercion {}) = VoidRep atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other))) atomRep :: AnnExpr' Id ann -> CgRep