Commit 09d83049 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix Trac #5268: missing case for bytecode generation involving coercions

parent 58e156a6
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment