X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=40a20cc91ef5fc1a0bfd31868053d6829b2c1b55;hb=939ce676b146713bbe0de42dec6c30da2c948049;hp=db4e18cd3917aaf28b0654c333c1f3f88b676332;hpb=844fa86873b806594191043afdea638472f45619;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index db4e18c..40a20cc 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -253,6 +253,7 @@ schemeR fvs (nm, rhs) = schemeR_wrk fvs nm rhs (collect [] rhs) collect xs (_, AnnNote note e) = collect xs e +collect xs (_, AnnCast e _) = collect xs e collect xs (_, AnnLam x e) = collect (if isTyVar x then xs else (x:xs)) e collect xs (_, not_lambda) = (reverse xs, not_lambda) @@ -1110,6 +1111,9 @@ pushAtom d p (AnnLit lit) -- Get the addr on the stack, untaggedly returnBc (unitOL (PUSH_UBX (Right addr) 1), 1) +pushAtom d p (AnnCast e _) + = pushAtom d p (snd e) + pushAtom d p other = pprPanic "ByteCodeGen.pushAtom" (pprCoreExpr (deAnnotate (undefined, other))) @@ -1271,6 +1275,7 @@ splitApp (AnnApp (_,f) (_,a)) | otherwise = case splitApp f of (f', as) -> (f', a:as) splitApp (AnnNote n (_,e)) = splitApp e +splitApp (AnnCast (_,e) _) = splitApp e splitApp e = (e, []) @@ -1281,6 +1286,7 @@ isTypeAtom _ = False isVoidArgAtom :: AnnExpr' id ann -> Bool isVoidArgAtom (AnnVar v) = typeCgRep (idType v) == VoidArg isVoidArgAtom (AnnNote n (_,e)) = isVoidArgAtom e +isVoidArgAtom (AnnCast (_,e) _) = isVoidArgAtom e isVoidArgAtom _ = False atomRep :: AnnExpr' Id ann -> CgRep @@ -1289,6 +1295,7 @@ atomRep (AnnLit l) = typeCgRep (literalType l) atomRep (AnnNote n b) = atomRep (snd b) atomRep (AnnApp f (_, AnnType _)) = atomRep (snd f) atomRep (AnnLam x e) | isTyVar x = atomRep (snd e) +atomRep (AnnCast b _) = atomRep (snd b) atomRep other = pprPanic "atomRep" (ppr (deAnnotate (undefined,other))) isPtrAtom :: AnnExpr' Id ann -> Bool