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