module FloatIn ( floatInwards ) 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
\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}
-> [(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}
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
(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