X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FFloatOut.lhs;h=9dd4d689d0dd7ba8342825512c63f40c3414bbfa;hb=facfbf28a9bd4edeebc23e6d74a77a7ea83e5c61;hp=6562c84e8c6eca17c14b148c8cecb401665a164e;hpb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;p=ghc-hetmet.git diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index 6562c84..9dd4d68 100644 --- a/compiler/simplCore/FloatOut.lhs +++ b/compiler/simplCore/FloatOut.lhs @@ -19,7 +19,7 @@ import Type ( isUnLiftedType ) import SetLevels ( Level(..), LevelledExpr, LevelledBind, setLevels, ltMajLvl, ltLvl, isTopLvl ) import UniqSupply ( UniqSupply ) -import List ( partition ) +import Data.List import Outputable import FastString \end{code} @@ -297,13 +297,6 @@ floatExpr lvl (Note note@(SCC cc) expr) ann_bind (Rec pairs) = Rec [(binder, mkSCC dupd_cc rhs) | (binder, rhs) <- pairs] -floatExpr _ (Note InlineMe expr) -- Other than SCCs - = (zeroStats, [], Note InlineMe (unTag expr)) - -- Do no floating at all inside INLINE. - -- The SetLevels pass did not clone the bindings, so it's - -- unsafe to do any floating, even if we dump the results - -- inside the Note (which is what we used to do). - floatExpr lvl (Note note expr) -- Other than SCCs = case (floatExpr lvl expr) of { (fs, floating_defns, expr') -> (fs, floating_defns, Note note expr') } @@ -344,22 +337,6 @@ floatList _ [] = (zeroStats, [], []) floatList f (a:as) = case f a of { (fs_a, binds_a, b) -> case floatList f as of { (fs_as, binds_as, bs) -> (fs_a `add_stats` fs_as, binds_a ++ binds_as, b:bs) }} - -unTagBndr :: TaggedBndr tag -> CoreBndr -unTagBndr (TB b _) = b - -unTag :: TaggedExpr tag -> CoreExpr -unTag (Var v) = Var v -unTag (Lit l) = Lit l -unTag (Type ty) = Type ty -unTag (Note n e) = Note n (unTag e) -unTag (App e1 e2) = App (unTag e1) (unTag e2) -unTag (Lam b e) = Lam (unTagBndr b) (unTag e) -unTag (Cast e co) = Cast (unTag e) co -unTag (Let (Rec prs) e) = Let (Rec [(unTagBndr b,unTag r) | (b, r) <- prs]) (unTag e) -unTag (Let (NonRec b r) e) = Let (NonRec (unTagBndr b) (unTag r)) (unTag e) -unTag (Case e b ty alts) = Case (unTag e) (unTagBndr b) ty - [(c, map unTagBndr bs, unTag r) | (c,bs,r) <- alts] \end{code} %************************************************************************