Simplify some simplifier types.

diku-dk · Dec 16, 2017 · 13c0e0f · 13c0e0f
1 parent 886c10b
commit 13c0e0f
Show file tree

Hide file tree

Showing 5 changed files with 35 additions and 35 deletions.
diff --git a/src/Futhark/Optimise/Simplifier.hs b/src/Futhark/Optimise/Simplifier.hs
@@ -43,7 +43,7 @@ import Futhark.Optimise.Simplifier.Engine
 simplifyProgWithRules :: (MonadFreshNames m, SimplifiableLore lore) =>
                          SimpleOps lore
                       -> RuleBook (SimpleM lore)
-                      -> HoistBlockers (SimpleM lore)
+                      -> HoistBlockers lore
                       -> Prog lore -> m (Prog lore)
 simplifyProgWithRules simpl rules blockers =
   fmap removeProgWisdom .
@@ -53,7 +53,7 @@ simplifyProgWithRules simpl rules blockers =
 simplifyFunWithRules :: (MonadFreshNames m, SimplifiableLore lore) =>
                         SimpleOps lore
                      -> RuleBook (SimpleM lore)
-                     -> HoistBlockers (SimpleM lore)
+                     -> HoistBlockers lore
                      -> FunDef lore
                      -> m (FunDef lore)
 simplifyFunWithRules simpl rules blockers =
@@ -64,7 +64,7 @@ simplifyFunWithRules simpl rules blockers =
 simplifyLambdaWithRules :: (MonadFreshNames m, HasScope lore m, SimplifiableLore lore) =>
                            SimpleOps lore
                         -> RuleBook (SimpleM lore)
-                        -> HoistBlockers (SimpleM lore)
+                        -> HoistBlockers lore
                         -> Lambda lore
                         -> Maybe [SubExp]
                         -> [Maybe VName]
@@ -77,7 +77,7 @@ simplifyLambdaWithRules simpl rules blockers lam nes =
 simplifyStmsWithRules :: (MonadFreshNames m, HasScope lore m, SimplifiableLore lore) =>
                              SimpleOps lore
                           -> RuleBook (SimpleM lore)
-                          -> HoistBlockers (SimpleM lore)
+                          -> HoistBlockers lore
                           -> [Stm lore]
                           -> m [Stm lore]
 simplifyStmsWithRules simpl rules blockers bnds =

diff --git a/src/Futhark/Optimise/Simplifier/Engine.hs b/src/Futhark/Optimise/Simplifier/Engine.hs
@@ -116,26 +116,26 @@ instance Monoid (Need lore) where
   Need b1 f1 c1 `mappend` Need b2 f2 c2 = Need (b1 <> b2) (f1 <> f2) (c1 <> c2)
   mempty = Need [] UT.empty mempty
 
-data HoistBlockers m = HoistBlockers
-                       { blockHoistPar :: BlockPred (Lore m)
-                         -- ^ Blocker for hoisting out of parallel loops.
-                       , blockHoistSeq :: BlockPred (Lore m)
-                         -- ^ Blocker for hoisting out of sequential loops.
-                       , getArraySizes :: Stm (Lore m) -> Names
-                         -- ^ gets the sizes of arrays from a binding.
-                       , isAllocation  :: Stm (Lore m) -> Bool
-                       }
-
-noExtraHoistBlockers :: HoistBlockers m
+data HoistBlockers lore = HoistBlockers
+                          { blockHoistPar :: BlockPred (Wise lore)
+                            -- ^ Blocker for hoisting out of parallel loops.
+                          , blockHoistSeq :: BlockPred (Wise lore)
+                            -- ^ Blocker for hoisting out of sequential loops.
+                          , getArraySizes :: Stm (Wise lore) -> Names
+                            -- ^ gets the sizes of arrays from a binding.
+                          , isAllocation  :: Stm (Wise lore) -> Bool
+                          }
+
+noExtraHoistBlockers :: HoistBlockers lore
 noExtraHoistBlockers = HoistBlockers neverBlocks neverBlocks (const S.empty) (const False)
 
-data Env m = Env { envRules         :: RuleBook m
-                 , envHoistBlockers :: HoistBlockers m
-                 }
+data Env lore = Env { envRules         :: RuleBook (SimpleM lore)
+                    , envHoistBlockers :: HoistBlockers lore
+                    }
 
 emptyEnv :: RuleBook (SimpleM lore)
-         -> HoistBlockers (SimpleM lore)
-         -> Env (SimpleM lore)
+         -> HoistBlockers lore
+         -> Env lore
 emptyEnv rules blockers =
   Env { envRules = rules
       , envHoistBlockers = blockers
@@ -174,13 +174,13 @@ bindableSimpleOps = SimpleOps mkExpAttrS' mkBodyS' mkLetNamesS'
 
 newtype SimpleM lore a =
   SimpleM (RWS
-           (SimpleOps lore, Env (SimpleM lore)) -- Reader
+           (SimpleOps lore, Env lore) -- Reader
            (Need (Wise lore))                             -- Writer
            (State (SimpleM lore), VNameSource)       -- State
            a)
   deriving (Applicative, Functor, Monad,
             MonadWriter (Need (Wise lore)),
-            MonadReader (SimpleOps lore, Env (SimpleM lore)),
+            MonadReader (SimpleOps lore, Env lore),
             MonadState (State (SimpleM lore), VNameSource))
 
 instance MonadFreshNames (SimpleM lore) where
@@ -223,7 +223,7 @@ instance SimplifiableLore lore => MonadBinder (SimpleM lore) where
 
 runSimpleM :: SimpleM lore a
            -> SimpleOps lore
-           -> Env (SimpleM lore)
+           -> Env lore
            -> VNameSource
            -> ((a, Bool), VNameSource)
 runSimpleM (SimpleM m) simpl env src =
@@ -238,7 +238,7 @@ subSimpleM :: (SimplifiableLore lore,
                RetType outerlore ~ RetType lore,
                BranchType outerlore ~ BranchType lore) =>
               SimpleOps lore
-           -> Env (SimpleM lore)
+           -> Env lore
            -> ST.SymbolTable (Wise outerlore)
            -> SimpleM lore a
            -> m (a, Bool, [Stm (Wise lore)])
@@ -250,7 +250,7 @@ subSimpleM simpl env outer_vtable m = do
   putNameSource src'
   return (x, stateChanged s, needStms need)
 
-askEngineEnv :: SimpleM lore (Env (SimpleM lore))
+askEngineEnv :: SimpleM lore (Env lore)
 askEngineEnv = snd <$> ask
 tellNeed :: Need (Wise lore) -> SimpleM lore ()
 tellNeed = tell
@@ -283,7 +283,7 @@ collectCerts m = passNeed $ do
   return ((x, needCerts need),
           const need { needCerts = mempty })
 
-asksEngineEnv :: (Env (SimpleM lore) -> a) -> SimpleM lore a
+asksEngineEnv :: (Env lore -> a) -> SimpleM lore a
 asksEngineEnv f = f <$> askEngineEnv
 
 getsEngineState :: (State (SimpleM lore) -> a) -> SimpleM lore a

diff --git a/src/Futhark/Optimise/Simplifier/Simplify.hs b/src/Futhark/Optimise/Simplifier/Simplify.hs
@@ -29,7 +29,7 @@ import Futhark.Tools (intraproceduralTransformation)
 simplifyProg :: (MonadFreshNames m, Engine.SimplifiableLore lore) =>
                 Engine.SimpleOps lore
              -> RuleBook (Engine.SimpleM lore)
-             -> Engine.HoistBlockers (Engine.SimpleM lore)
+             -> Engine.HoistBlockers lore
              -> Prog lore
              -> m (Prog (Engine.Wise lore))
 simplifyProg simpl rules blockers =
@@ -43,7 +43,7 @@ simplifyProg simpl rules blockers =
 simplifyFun :: (MonadFreshNames m, Engine.SimplifiableLore lore) =>
                 Engine.SimpleOps lore
              -> RuleBook (Engine.SimpleM lore)
-             -> Engine.HoistBlockers (Engine.SimpleM lore)
+             -> Engine.HoistBlockers lore
              -> FunDef lore
              -> m (FunDef (Engine.Wise lore))
 simplifyFun simpl rules blockers =
@@ -55,7 +55,7 @@ simplifyFun simpl rules blockers =
 simplifyLambda :: (MonadFreshNames m, HasScope lore m, Engine.SimplifiableLore lore) =>
                   Engine.SimpleOps lore
                -> RuleBook (Engine.SimpleM lore)
-               -> Engine.HoistBlockers (Engine.SimpleM lore)
+               -> Engine.HoistBlockers lore
                -> Lambda lore -> Maybe [SubExp] -> [Maybe VName]
                -> m (Lambda (Engine.Wise lore))
 simplifyLambda simpl rules blockers orig_lam nes args = do
@@ -70,7 +70,7 @@ simplifyLambda simpl rules blockers orig_lam nes args = do
 simplifyStms :: (MonadFreshNames m, HasScope lore m, Engine.SimplifiableLore lore) =>
                 Engine.SimpleOps lore
              -> RuleBook (Engine.SimpleM lore)
-             -> Engine.HoistBlockers (Engine.SimpleM lore)
+             -> Engine.HoistBlockers lore
              -> [Stm lore]
              -> m [Stm (Engine.Wise lore)]
 simplifyStms simpl rules blockers orig_bnds = do
@@ -83,7 +83,7 @@ simplifyStms simpl rules blockers orig_bnds = do
   where env = Engine.emptyEnv rules blockers
 
 loopUntilConvergence :: (MonadFreshNames m, Engine.SimplifiableLore lore) =>
-                        Engine.Env (Engine.SimpleM lore)
+                        Engine.Env lore
                      -> Engine.SimpleOps lore
                      -> (a -> Engine.SimpleM lore b)
                      -> (b -> a)

diff --git a/src/Futhark/Representation/ExplicitMemory/Simplify.hs b/src/Futhark/Representation/ExplicitMemory/Simplify.hs
@@ -74,11 +74,11 @@ isAlloc0 :: Op lore ~ MemOp op => AST.Stm lore -> Bool
 isAlloc0 (Let _ _ (Op Alloc{})) = True
 isAlloc0 _                      = False
 
-inKernelEnv :: Engine.Env (Engine.SimpleM InKernel)
+inKernelEnv :: Engine.Env InKernel
 inKernelEnv = Engine.emptyEnv inKernelRules blockers
 
 blockers ::  (ExplicitMemorish lore, Op lore ~ MemOp op) =>
-             Simplifier.HoistBlockers (Engine.SimpleM lore)
+             Simplifier.HoistBlockers lore
 blockers = Engine.HoistBlockers {
     Engine.blockHoistPar = isAlloc
   , Engine.blockHoistSeq = isResultAlloc

diff --git a/src/Futhark/Representation/Kernels/Simplify.hs b/src/Futhark/Representation/Kernels/Simplify.hs
@@ -62,7 +62,7 @@ simplifyKernelOp :: (Engine.SimplifiableLore lore,
                      SameScope lore outerlore,
                      RetType lore ~ RetType outerlore,
                      BranchType lore ~ BranchType outerlore) =>
-                    Engine.SimpleOps lore -> Engine.Env (Engine.SimpleM lore)
+                    Engine.SimpleOps lore -> Engine.Env lore
                  -> Kernel lore -> Engine.SimpleM outerlore (Kernel (Wise lore))
 simplifyKernelOp ops env (Kernel desc space ts kbody) = do
   space' <- Engine.simplify space
@@ -112,7 +112,7 @@ mkWiseKernelBody attr bnds res =
         resValue (ConcatReturns _ _ _ _ v) = Var v
         resValue (KernelInPlaceReturn v) = Var v
 
-inKernelEnv :: Engine.Env (Engine.SimpleM InKernel)
+inKernelEnv :: Engine.Env InKernel
 inKernelEnv = Engine.emptyEnv inKernelRules noExtraHoistBlockers
 
 instance Engine.Simplifiable SplitOrdering where