From 9066d4112b59f1f566b4a10ae9a9aa55bcfe9d41 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Tue, 3 Jun 2008 16:30:10 +0000
Subject: [PATCH] Removed all the PassR and PassMR stuff, now we just have Pass
 and PassM

---
 checks/Check.hs  |  2 +-
 pass/Pass.hs     | 34 ++++++++--------------------------
 pass/PassList.hs |  6 +++---
 3 files changed, 12 insertions(+), 30 deletions(-)

diff --git a/checks/Check.hs b/checks/Check.hs
index 5e218e4..dcd36eb 100644
--- a/checks/Check.hs
+++ b/checks/Check.hs
@@ -44,7 +44,7 @@ import UsageCheckAlgorithms
 import UsageCheckUtils
 import Utils
 
-usageCheckPass :: A.AST -> PassMR A.AST
+usageCheckPass :: A.AST -> PassM A.AST
 usageCheckPass t = do g' <- buildFlowGraph labelFunctions t
                       (g, roots) <- case g' of
                         Left err -> dieP (findMeta t) err
diff --git a/pass/Pass.hs b/pass/Pass.hs
index 5b90c94..b9be228 100644
--- a/pass/Pass.hs
+++ b/pass/Pass.hs
@@ -20,11 +20,11 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module Pass where
 
 import Control.Monad.Error
-import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Generics
 import Data.List
+import Data.Ord
 import qualified Data.Set as Set
 import System.IO
 
@@ -38,20 +38,13 @@ import Utils
 
 -- | The monad in which AST-mangling passes operate.
 type PassM = ErrorT ErrorReport (StateT CompState (StateT [WarningReport]  IO))
-type PassMR = ErrorT ErrorReport (ReaderT CompState (StateT [WarningReport]  IO))
 
 instance Die PassM where
   dieReport = throwError
 
-instance Die PassMR where
-  dieReport = throwError
-  
 instance Warn PassM where
   warnReport w = lift $ lift $ modify (++ [w])
 
-instance Warn PassMR where
-  warnReport w = lift $ lift $ modify (++ [w])
-
 -- | The type of a pass function.
 -- This is as generic as possible. Passes are used on 'A.AST' in normal use,
 -- but for explicit descent and testing it's useful to be able to run them
@@ -59,46 +52,35 @@ instance Warn PassMR where
 type PassType = (forall s. Data s => s -> PassM s)
 
 -- | A description of an AST-mangling pass.
-data Monad m => Pass_ m = Pass {
+data Pass = Pass {
     passCode :: PassType
   , passName :: String
   , passPre :: Set.Set Property
   , passPost :: Set.Set Property
   , passEnabled :: CompState -> Bool
-  }
+}
 
-instance Monad m => Eq (Pass_ m) where
+instance Eq Pass where
   x == y = passName x == passName y
 
-instance Monad m => Ord (Pass_ m) where
-  compare x y = compare (passName x) (passName y)
-
-type Pass = Pass_ PassM
-type PassR = Pass_ PassMR
+instance Ord Pass where
+  compare = comparing passName
 
 -- | A property that can be asserted and tested against the AST.
 data Property = Property {
     propName :: String
-  , propCheck :: A.AST -> PassMR ()
+  , propCheck :: A.AST -> PassM ()
   }
 
 instance Eq Property where
   x == y = propName x == propName y
 
 instance Ord Property where
-  compare x y = compare (propName x) (propName y)
+  compare = comparing propName
 
 instance Show Property where
   show = propName
 
-runPassR :: (A.AST -> PassMR A.AST) -> (A.AST -> PassM A.AST)
-runPassR p t
-    =  do st <- get
-          (r, w) <- liftIO $ flip runStateT [] $ runReaderT (runErrorT (p t)) st
-          case r of
-            Left err -> throwError err
-            Right result -> mapM_ warnReport w >> return result
-
 runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState, [WarningReport])
 runPassM cs pass
     = liftM flatten $ flip runStateT [] $ flip runStateT cs $ runErrorT pass
diff --git a/pass/PassList.hs b/pass/PassList.hs
index 5b0ae18..eac1546 100644
--- a/pass/PassList.hs
+++ b/pass/PassList.hs
@@ -51,7 +51,7 @@ commonPasses opts = concat $
   [ enablePassesWhen ((== FrontendOccam) . csFrontend) simplifyTypes
   , enablePassesWhen csUsageChecking
     [pass "Usage checking" Prop.agg_namesDone [Prop.parUsageChecked]
-      (passOnlyOnAST "usageCheckPass" $ runPassR usageCheckPass)]
+      (passOnlyOnAST "usageCheckPass" usageCheckPass)]
   -- If usage checking is turned off, the pass list will break unless we insert this dummy item:
   , enablePassesWhen (not . csUsageChecking)
     [pass "Usage checking turned OFF" Prop.agg_namesDone [Prop.parUsageChecked]
@@ -122,10 +122,10 @@ calculatePassList
         checks = [pass ("[" ++ propName prop ++ "]")
                        []
                        []
-                       (passOnlyOnAST "prop" $ runPassR $ checkProp prop)
+                       (passOnlyOnAST "prop" $ checkProp prop)
                   | prop <- Set.toList props]
 
-        checkProp :: Property -> A.AST -> PassMR A.AST
+        checkProp :: Property -> A.AST -> PassM A.AST
         checkProp prop ast = propCheck prop ast >> return ast
 
 -- | If something isn't right, it gives back a list containing a single pass