diff options
| author | simonpj@microsoft.com <unknown> | 2008-10-21 14:30:19 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2008-10-21 14:30:19 +0000 |
| commit | e1e3d37b988c8839a74552bcebeef7f9293b0a6c (patch) | |
| tree | 0861f8363ccb86a5aa79ab83f8b11b612ed9edc0 /compiler/simplCore/SetLevels.lhs | |
| parent | da1de991e04dd9a25e9c7253ade7eadf9f399c84 (diff) | |
| download | haskell-e1e3d37b988c8839a74552bcebeef7f9293b0a6c.tar.gz | |
Don't float an expression wrapped in a cast
There is no point in floating out an expression wrapped in a coercion;
If we do we'll transform
lvl = e |> co [_$_]
to
lvl' = e; lvl = lvl' |> co
and then inline lvl. Better just to float out the payload (e).
Diffstat (limited to 'compiler/simplCore/SetLevels.lhs')
| -rw-r--r-- | compiler/simplCore/SetLevels.lhs | 7 |
1 files changed, 7 insertions, 0 deletions
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 2c84589e7b..e20bc833c7 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -376,6 +376,13 @@ lvlMFE :: Bool -- True <=> strict context [body of case or let] lvlMFE _ _ _ (_, AnnType ty) = return (Type ty) +-- No point in floating out an expression wrapped in a coercion; +-- If we do we'll transform lvl = e |> co +-- to lvl' = e; lvl = lvl' |> co +-- and then inline lvl. Better just to float out the payload. +lvlMFE strict_ctxt ctxt_lvl env (_, AnnCast e co) + = do { expr' <- lvlMFE strict_ctxt ctxt_lvl env e + ; return (Cast expr' co) } lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _) | isUnLiftedType ty -- Can't let-bind it; see Note [Unlifted MFEs] |