Break out hoisting utils into their own module

[ghc-hetmet.git] / compiler / vectorise / VectUtils.hs

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index 8c82fb0..9c50d4a 100644 (file)
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -16,37 +16,27 @@ module VectUtils (
   combinePD,
   liftPD,
   zipScalars, scalarClosure,
-  polyAbstract, polyApply, polyVApply, polyArity,
-  Inline(..), addInlineArity, inlineMe,
-  hoistBinding, hoistExpr, hoistPolyVExpr, takeHoisted,
+  polyAbstract, polyApply, polyVApply, polyArity
 ) where
-
-
 import Vectorise.Monad
-import Vectorise.Env
 import Vectorise.Vect
 import Vectorise.Builtins
 
 import CoreSyn
 import CoreUtils
-import CoreUnfold         ( mkInlineRule )
 import Coercion
 import Type
 import TypeRep
 import TyCon
 import DataCon
 import Var
-import MkId               ( unwrapFamInstScrut )
-import Id                 ( setIdUnfolding )
-import BasicTypes
-import Literal            ( Literal, mkMachInt )
-
-
+import MkId
+import Literal
 import Outputable
 import FastString
-
 import Control.Monad
 
+
 collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
 collectAnnTypeArgs expr = go expr []
   where
@@ -363,62 +353,6 @@ polyVApply expr tys
  = do Just dicts <- liftM sequence $ mapM paDictOfType tys
       return     $ mapVect (\e -> e `mkTyApps` tys `mkApps` dicts) expr
 
--- Inline ---------------------------------------------------------------------
--- | Records whether we should inline a particular binding.
-data Inline 
-        = Inline Arity
-        | DontInline
-
--- | Add to the arity contained within an `Inline`, if any.
-addInlineArity :: Inline -> Int -> Inline
-addInlineArity (Inline m) n = Inline (m+n)
-addInlineArity DontInline _ = DontInline
-
--- | Says to always inline a binding.
-inlineMe :: Inline
-inlineMe = Inline 0
-
-
--- Hoising --------------------------------------------------------------------
-hoistBinding :: Var -> CoreExpr -> VM ()
-hoistBinding v e = updGEnv $ \env ->
-  env { global_bindings = (v,e) : global_bindings env }
-
-hoistExpr :: FastString -> CoreExpr -> Inline -> VM Var
-hoistExpr fs expr inl
-  = do
-      var <- mk_inline `liftM` newLocalVar fs (exprType expr)
-      hoistBinding var expr
-      return var
-  where
-    mk_inline var = case inl of
-                      Inline arity -> var `setIdUnfolding`
-                                      mkInlineRule expr (Just arity)
-                      DontInline   -> var
-
-hoistVExpr :: VExpr -> Inline -> VM VVar
-hoistVExpr (ve, le) inl
-  = do
-      fs <- getBindName
-      vv <- hoistExpr ('v' `consFS` fs) ve inl
-      lv <- hoistExpr ('l' `consFS` fs) le (addInlineArity inl 1)
-      return (vv, lv)
-
-hoistPolyVExpr :: [TyVar] -> Inline -> VM VExpr -> VM VExpr
-hoistPolyVExpr tvs inline p
-  = do
-      inline' <- liftM (addInlineArity inline) (polyArity tvs)
-      expr <- closedV . polyAbstract tvs $ \args ->
-              liftM (mapVect (mkLams $ tvs ++ args)) p
-      fn   <- hoistVExpr expr inline'
-      polyVApply (vVar fn) (mkTyVarTys tvs)
-
-takeHoisted :: VM [(Var, CoreExpr)]
-takeHoisted
-  = do
-      env <- readGEnv id
-      setGEnv $ env { global_bindings = [] }
-      return $ global_bindings env
 
 {-
 boxExpr :: Type -> VExpr -> VM VExpr