Finally merged the list of warnings into CompState rather than having its own StateT monad

Main.hs

@@ -188,8 +188,8 @@ main = do
   -- Run the compiler.
   v <- runPassM initState operation
   case v of
-    (Left e, _, ws) -> showWarnings ws >> dieIO e
+    (Left e, cs) -> showWarnings (csWarnings cs) >> dieIO e
-    (Right r, _, ws) -> showWarnings ws
+    (Right r, cs) -> showWarnings (csWarnings cs)
 
 removeFiles :: [FilePath] -> IO ()
 removeFiles = mapM_ (\file -> catch (removeFile file) doNothing)

backends/GenerateCTest.hs

@@ -110,7 +110,7 @@ evalCGen :: CGen () -> GenOps -> CompState -> IO (Either Errors.ErrorReport [Str
 evalCGen act ops state = evalCGen' (runReaderT act ops) state
 
 evalCGen' :: CGen' () -> CompState -> IO (Either Errors.ErrorReport [String])
-evalCGen' act state = runPassM state pass >>* (\(x,_,_) -> x)
+evalCGen' act state = runPassM state pass >>* fst
   where
     pass = execStateT act (Left []) >>* (\(Left x) -> x)
 

common/OccamEDSL.hs

@@ -375,7 +375,7 @@ testOccamPassWarn str check code pass
         (exp, expS) = runState expm emptyState
         (inp, inpS) = runState inpm emptyState
         pass' = pass {passCode = \x -> do y <- passCode pass x
-                                          b <- lift (lift get) >>* check
+                                          b <- lift get >>* (check . csWarnings)
                                           when (not b) $
                                             dieP emptyMeta $ str ++ " warnings not as expected"
                                           return y}

common/TestHarness.hs

@@ -60,7 +60,7 @@ defaultState fr = emptyState {csUsageChecking = True, csFrontend = fr}
 -- | Tests if compiling the given source gives any errors.
 -- If there are errors, they are returned.  Upon success, Nothing is returned
 testOccam :: String -> IO (Maybe String)
-testOccam source = do (result,_,_) <- runPassM (defaultState FrontendOccam) compilation
+testOccam source = do (result,_) <- runPassM (defaultState FrontendOccam) compilation
                       return $ case result of
                                  Left (_,err) -> Just err
                                  Right _  -> Nothing
@@ -70,7 +70,7 @@ testOccam source = do (result,_,_) <- runPassM (defaultState FrontendOccam) comp
                   >>= runPasses (getPassList $ defaultState FrontendOccam)
 
 testRain :: String -> IO (Maybe String)
-testRain  source = do (result,_,_) <- runPassM (defaultState FrontendRain) compilation
+testRain  source = do (result,_) <- runPassM (defaultState FrontendRain) compilation
                       return $ case result of
                                  Left (_,err) -> Just err
                                  Right _  -> Nothing

common/TestUtils.hs

@@ -497,13 +497,13 @@ runPass :: (Data b, TestMonad m r) =>
   Pass -> b                            -- ^ The actual pass.
   -> CompState                       -- ^ The state to use to run the pass.
   -> m (CompState, Either ErrorReport b) -- ^ The resultant state, and either an error or the successful outcome of the pass.
-runPass actualPass src startState = liftM (\(x,y,_) -> (y,x)) $
+runPass actualPass src startState = liftM revPair $
   runIO (runPassM startState $ passCode actualPass src)
 
 runPass' :: TestMonad m r =>
   PassM b -> CompState -> m (CompState, Either ErrorReport b)
 runPass' actualPass startState
-  = runIO (runPassM startState actualPass) >>* \(x,y,_) -> (y,x)
+  = runIO (runPassM startState actualPass) >>* revPair
 
 -- | A test that runs a given AST pass and checks that it succeeds.
 testPass ::

data/CompState.hs

@@ -31,7 +31,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 
 import qualified AST as A
-import Errors (Die, dieP, ErrorReport, Warn, WarningType(..), warnP)
+import Errors (Die, dieP, ErrorReport, Warn, WarningType(..), warnP, WarningReport)
 import Metadata
 import OrdAST ()
 import UnifyType
@@ -125,7 +125,8 @@ data CompState = CompState {
     csParProcs :: Set A.Name,
     csUnifyLookup :: Map UnifyIndex UnifyValue,
     csUnifyPairs :: [(UnifyValue, UnifyValue)],
-    csUnifyId :: Int
+    csUnifyId :: Int,
+    csWarnings :: [WarningReport]
   }
   deriving (Data, Typeable)
 
@@ -165,7 +166,8 @@ emptyState = CompState {
     csParProcs = Set.empty,
     csUnifyLookup = Map.empty,
     csUnifyPairs = [],
-    csUnifyId = 0
+    csUnifyId = 0,
+    csWarnings = []
   }
 
 -- | Class of monads which keep a CompState.

pass/Pass.hs

@@ -37,13 +37,14 @@ import TreeUtils
 import Utils
 
 -- | The monad in which AST-mangling passes operate.
-type PassM = ErrorT ErrorReport (StateT CompState (StateT [WarningReport]  IO))
+type PassM = ErrorT ErrorReport (StateT CompState IO)
 
 instance Die PassM where
   dieReport = throwError
 
 instance Warn PassM where
-  warnReport w = lift $ lift $ modify (++ [w])
+  warnReport w = lift $ modify $
+    \cs -> cs { csWarnings = csWarnings cs ++ [w] }
 
 -- | The type of a pass function.
 -- This is as generic as possible. Passes are used on 'A.AST' in normal use,
@@ -81,12 +82,9 @@ instance Ord Property where
 instance Show Property where
   show = propName
 
-runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState, [WarningReport])
+runPassM :: CompState -> PassM a -> IO (Either ErrorReport a, CompState)
 runPassM cs pass
-    = liftM flatten $ flip runStateT [] $ flip runStateT cs $ runErrorT pass
+    =  flip runStateT cs $ runErrorT pass
-  where
-    flatten :: ((a, b), c) -> (a, b, c)
-    flatten ((x, y), z) = (x, y, z)
 
 enablePassesWhen :: (CompState -> Bool) -> [Pass] -> [Pass]
 enablePassesWhen f