X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FFloatIn.lhs;h=29ce8a9dd349084786bfd481eecd670aba1571c3;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=b534011a6337655b9c3f01d993bea97b82cfb20b;hpb=f01a8e8c9c53bfb5ab3393ed3457ebf25390efa1;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs index b534011..29ce8a9 100644 --- a/ghc/compiler/simplCore/FloatIn.lhs +++ b/ghc/compiler/simplCore/FloatIn.lhs @@ -14,22 +14,18 @@ then discover that they aren't needed in the chosen branch. \begin{code} #include "HsVersions.h" -module FloatIn ( - floatInwards +module FloatIn ( floatInwards ) where - -- and to make the interface self-sufficient... - ) where - -import Ubiq{-uitous-} +IMP_Ubiq(){-uitous-} import AnnCoreSyn import CoreSyn import FreeVars import Id ( emptyIdSet, unionIdSets, unionManyIdSets, - elementOfIdSet, IdSet(..) + elementOfIdSet, SYN_IE(IdSet), GenId ) -import Util ( panic ) +import Util ( nOfThem, panic, zipEqual ) \end{code} Top-level interface function, @floatInwards@. Note that we do not @@ -202,7 +198,7 @@ fiExpr to_drop (_, AnnSCC cc expr) \begin{code} fiExpr to_drop (_, AnnCoerce c ty expr) - = _trace "fiExpr:Coerce:wimping out" $ + = --trace "fiExpr:Coerce:wimping out" $ mkCoLets' to_drop (Coerce c ty (fiExpr [] expr)) \end{code} @@ -272,7 +268,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body) -> [(Id, CoreExpr)] fi_bind to_drops pairs - = [ (binder, fiExpr to_drop rhs) | ((binder, rhs), to_drop) <- zip pairs to_drops ] + = [ (binder, fiExpr to_drop rhs) | ((binder, rhs), to_drop) <- zipEqual "fi_bind" pairs to_drops ] \end{code} For @Case@, the possible ``drop points'' for the \tr{to_drop} @@ -307,13 +303,13 @@ fiExpr to_drop (_, AnnCase scrut alts) fi_alts to_drop_deflt to_drop_alts (AnnAlgAlts alts deflt) = AlgAlts [ (con, params, fiExpr to_drop rhs) - | ((con, params, rhs), to_drop) <- alts `zip` to_drop_alts ] + | ((con, params, rhs), to_drop) <- zipEqual "fi_alts" alts to_drop_alts ] (fi_default to_drop_deflt deflt) fi_alts to_drop_deflt to_drop_alts (AnnPrimAlts alts deflt) = PrimAlts [ (lit, fiExpr to_drop rhs) - | ((lit, rhs), to_drop) <- alts `zip` to_drop_alts ] + | ((lit, rhs), to_drop) <- zipEqual "fi_alts2" alts to_drop_alts ] (fi_default to_drop_deflt deflt) fi_default to_drop AnnNoDefault = NoDefault @@ -358,8 +354,7 @@ sepBindsByDropPoint drop_pts floaters (per_drop_pt, must_stay_here, _) --= sep drop_pts emptyIdSet{-fvs of prev drop_pts-} floaters = split' drop_pts floaters [] empty_boxes - empty_boxes = take (length drop_pts) (repeat []) - + empty_boxes = nOfThem (length drop_pts) [] in (map reverse per_drop_pt, reverse must_stay_here) where @@ -391,9 +386,9 @@ sepBindsByDropPoint drop_pts floaters ------------------------- fvsOfBind (_,fvs) = fvs ---floatedBindsFVs :: +floatedBindsFVs :: FloatingBinds -> FreeVarsSet floatedBindsFVs binds = unionManyIdSets (map snd binds) ---mkCoLets' :: [FloatingBinds] -> CoreExpr -> CoreExpr +mkCoLets' :: FloatingBinds -> CoreExpr -> CoreExpr mkCoLets' to_drop e = mkCoLetsNoUnboxed (reverse (map fst to_drop)) e \end{code}