diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | 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 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, |