Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/09d83049b2c5a6a9b44e70f19ae09f9cb08b3da2 >--------------------------------------------------------------- commit 09d83049b2c5a6a9b44e70f19ae09f9cb08b3da2 Author: Simon Peyton Jones <[email protected]> Date: Thu Jun 23 14:28:50 2011 +0100 Fix Trac #5268: missing case for bytecode generation involving coercions >--------------------------------------------------------------- compiler/ghci/ByteCodeGen.lhs | 40 ++++++++++++++++++---------------------- 1 files changed, 18 insertions(+), 22 deletions(-) diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 426f4f2..30bcef2 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -344,6 +344,17 @@ instance Outputable TickInfo where parens (int (tickInfo_number info) <+> ppr (tickInfo_module info) <+> ppr (tickInfo_locals info)) +returnUnboxedAtom :: Word16 -> Sequel -> BCEnv + -> AnnExpr' Id VarSet -> CgRep + -> BcM BCInstrList +-- Returning an unlifted value. +-- Heave it on the stack, SLIDE, and RETURN. +returnUnboxedAtom d s p e e_rep + = do (push, szw) <- pushAtom d p e + return (push -- value onto stack + `appOL` mkSLIDE szw (d-s) -- clear to sequel + `snocOL` RETURN_UBX e_rep) -- go + -- Compile code to apply the given expression to the remaining args -- on the stack, returning a HNF. schemeE :: Word16 -> Sequel -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList @@ -353,31 +364,16 @@ schemeE d s p e = schemeE d s p e' -- Delegate tail-calls to schemeT. -schemeE d s p e@(AnnApp _ _) - = schemeT d s p e +schemeE d s p e@(AnnApp _ _) = schemeT d s p e -schemeE d s p e@(AnnVar v) - | not (isUnLiftedType v_type) - = -- Lifted-type thing; push it in the normal way - schemeT d s p e +schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeCgRep (literalType lit)) +schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e VoidArg - | otherwise - = do -- Returning an unlifted value. - -- Heave it on the stack, SLIDE, and RETURN. - (push, szw) <- pushAtom d p (AnnVar v) - return (push -- value onto stack - `appOL` mkSLIDE szw (d-s) -- clear to sequel - `snocOL` RETURN_UBX v_rep) -- go +schemeE d s p e@(AnnVar v) + | isUnLiftedType v_type = returnUnboxedAtom d s p e (typeCgRep v_type) + | otherwise = schemeT d s p e where - v_type = idType v - v_rep = typeCgRep v_type - -schemeE d s p (AnnLit literal) - = do (push, szw) <- pushAtom d p (AnnLit literal) - let l_rep = typeCgRep (literalType literal) - return (push -- value onto stack - `appOL` mkSLIDE szw (d-s) -- clear to sequel - `snocOL` RETURN_UBX l_rep) -- go + v_type = idType v schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) | (AnnVar v, args_r_to_l) <- splitApp rhs, _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
