2 module Vectorise.Utils.Hoisting (
14 import Vectorise.Monad
17 import Vectorise.Utils.Poly
25 import BasicTypes( Arity )
30 -- Inline ---------------------------------------------------------------------
31 -- | Records whether we should inline a particular binding.
36 -- | Add to the arity contained within an `Inline`, if any.
37 addInlineArity :: Inline -> Int -> Inline
38 addInlineArity (Inline m) n = Inline (m+n)
39 addInlineArity DontInline _ = DontInline
41 -- | Says to always inline a binding.
46 -- Hoising --------------------------------------------------------------------
47 hoistBinding :: Var -> CoreExpr -> VM ()
48 hoistBinding v e = updGEnv $ \env ->
49 env { global_bindings = (v,e) : global_bindings env }
52 hoistExpr :: FastString -> CoreExpr -> Inline -> VM Var
55 var <- mk_inline `liftM` newLocalVar fs (exprType expr)
59 mk_inline var = case inl of
60 Inline arity -> var `setIdUnfolding`
61 mkInlineUnfolding (Just arity) expr
65 hoistVExpr :: VExpr -> Inline -> VM VVar
66 hoistVExpr (ve, le) inl
69 vv <- hoistExpr ('v' `consFS` fs) ve inl
70 lv <- hoistExpr ('l' `consFS` fs) le (addInlineArity inl 1)
74 hoistPolyVExpr :: [TyVar] -> Inline -> VM VExpr -> VM VExpr
75 hoistPolyVExpr tvs inline p
77 inline' <- liftM (addInlineArity inline) (polyArity tvs)
78 expr <- closedV . polyAbstract tvs $ \args ->
79 liftM (mapVect (mkLams $ tvs ++ args)) p
80 fn <- hoistVExpr expr inline'
81 polyVApply (vVar fn) (mkTyVarTys tvs)
84 takeHoisted :: VM [(Var, CoreExpr)]
88 setGEnv $ env { global_bindings = [] }
89 return $ global_bindings env