From 09d83049b2c5a6a9b44e70f19ae09f9cb08b3da2 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 23 Jun 2011 14:28:50 +0100
Subject: Fix Trac #5268: missing case for bytecode generation involving
 coercions

---
 compiler/ghci/ByteCodeGen.lhs | 40 ++++++++++++++++++----------------------
 1 file changed, 18 insertions(+), 22 deletions(-)

(limited to 'compiler')

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 426f4f251b..30bcef2e0c 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,
-- 
cgit v1.2.1