diff options
| author | Max Bolingbroke <batterseapower@hotmail.com> | 2011-05-13 15:46:17 +0100 |
|---|---|---|
| committer | Max Bolingbroke <batterseapower@hotmail.com> | 2011-05-13 15:46:17 +0100 |
| commit | 526f9d497e57cdc6884544d18d5a0412a7518266 (patch) | |
| tree | 5f94c74e34b0160452e80464d4d6e3de3ccac0ad /compiler/ghci/ByteCodeGen.lhs | |
| parent | 287ef8ccbad97fbda6bec4ab847ef8d57d906a89 (diff) | |
| parent | cfbf0eb134efd1c5d9a589f6ae2139d7fad60581 (diff) | |
| download | haskell-encoding.tar.gz | |
Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/ghc into encodingencoding
Diffstat (limited to 'compiler/ghci/ByteCodeGen.lhs')
| -rw-r--r-- | compiler/ghci/ByteCodeGen.lhs | 31 |
1 files changed, 16 insertions, 15 deletions
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index b888747d82..426f4f251b 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -31,7 +31,6 @@ import Type import DataCon import TyCon import Util -import Var import VarSet import TysPrim import DynFlags @@ -249,7 +248,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 @@ -833,8 +832,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple MASSERT(isAlgCase) 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 + where + real_bndrs = filterOut isTyVar bndrs my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) @@ -1197,6 +1196,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) @@ -1270,9 +1272,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))) @@ -1454,21 +1453,23 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- d) notes -- Type lambdas *can* occur in random expressions, -- 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 (AnnApp (_,e) (_, AnnType _)) = Just e -bcView _ = Nothing +bcView (AnnNote _ (_,e)) = Just e +bcView (AnnCast (_,e) _) = 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 _ = False +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 (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 |