Tidied up the new code relating to warnings, and moved it all into the Errors module (out of CompState and Pass)

backends/AnalyseAsm.hs

@@ -34,7 +34,7 @@ import Numeric (readDec)
 import Text.Printf
 import Text.Regex
 
-import CompState
+import Errors
 import Pass
 import PrettyShow
 

common/CompState.hs

@@ -31,7 +31,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 
 import qualified AST as A
-import Errors
+import Errors (Die, dieP, ErrorReport)
 import Metadata
 
 -- | Modes that Tock can run in.
@@ -144,10 +144,6 @@ instance (CSMR m, Error e) => CSMR (ErrorT e m) where
 instance (CSMR m, Monoid w) => CSMR (WriterT w m) where
   getCompState = lift getCompState
 
-type WarningReport = (Maybe Meta, String)
-
-class Monad m => Warn m where
-  warnReport :: WarningReport -> m ()
 
 --instance (MonadWriter [WarningReport] m) => Warn m where
 --  warnReport r = tell [r]
@@ -171,18 +167,6 @@ lookupNameOrError n err
 
 --}}}
 
---{{{  warnings
--- | Add a warning with no source position.
-addPlainWarning :: Warn m => String -> m ()
-addPlainWarning msg = warnReport (Nothing, msg)
-  -- modify (\ps -> ps { csWarnings = msg : csWarnings ps })
-
--- | Add a warning.
-addWarning :: Warn m => Meta -> String -> m ()
-addWarning m s = warnReport (Just m, s)
-  -- addPlainWarning $ "Warning: " ++ show m ++ ": " ++ s
---}}}
-
 --{{{  pulled items
 -- | Enter a pulled-items context.
 pushPullContext :: CSM m => m ()

common/Errors.hs

@@ -17,11 +17,12 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
 -- | Error handling and reporting.
-module Errors (checkJust, Die, dieInternal, dieIO, dieP, dieReport, ErrorReport) where
+module Errors (addPlainWarning, addWarning, checkJust, Die(..), dieInternal, dieIO, dieP, ErrorReport, showWarnings, Warn(..), WarningReport) where
 
 import Control.Monad.Error
 import Control.Monad.Trans
 import Data.List
+import System.IO
 import System.IO.Error
 
 import Metadata
@@ -35,9 +36,24 @@ instance Error ErrorReport where
 class Monad m => Die m where
   dieReport :: ErrorReport -> m a
 
-  -- | Fail, giving a position and an error message.
+-- | Fail, giving a position and an error message.
-  dieP :: Die m => Meta -> String -> m a
+dieP :: Die m => Meta -> String -> m a
-  dieP m s = dieReport (Just m,s)
+dieP m s = dieReport (Just m,s)
+
+type WarningReport = (Maybe Meta, String)
+
+class Monad m => Warn m where
+  warnReport :: WarningReport -> m ()
+
+--{{{  warnings
+-- | Add a warning with no source position.
+addPlainWarning :: Warn m => String -> m ()
+addPlainWarning msg = warnReport (Nothing, msg)
+
+-- | Add a warning.
+addWarning :: Warn m => Meta -> String -> m ()
+addWarning m s = warnReport (Just m, s)
+--}}}
 
 -- | Wrapper around error that gives nicer formatting, and prints out context
 --
@@ -81,6 +97,14 @@ dieIO (_,s) = printError s
 printError :: String -> a
 printError s = error $ "Error: " ++ s ++ "\n"
 
+-- | Print out a list of warnings
+showWarnings ::  MonadIO m => [WarningReport] -> m ()
+showWarnings = mapM_ printWarning
+  where
+    printWarning (Just m, s) = liftIO $ hPutStrLn stderr $ show m ++ " " ++ s
+    printWarning (Nothing, s) = liftIO $ hPutStrLn stderr s
+
+
 -- | Fail after an internal error.
 dieInternal :: Monad m => ErrorReport -> m a
 dieInternal (m,s) = error $ "\n\n" ++ (maybe "" show m) ++ "Internal error: " ++ s

common/Pass.hs

@@ -78,18 +78,6 @@ verboseMessage n s
           when (csVerboseLevel ps >= n) $
             liftIO $ hPutStrLn stderr s
 
-{-
--- | Print a warning message.
-warn :: (CSM m, MonadIO m) => String -> m ()
-warn = verboseMessage 0
--}
--- | Print out a list of warnings
-showWarnings ::  MonadIO m => [WarningReport] -> m ()
-showWarnings = mapM_ printWarning
-  where
-    printWarning (Just m, s) = liftIO $ hPutStrLn stderr $ show m ++ " " ++ s
-    printWarning (Nothing, s) = liftIO $ hPutStrLn stderr s
-
 -- | Print a progress message.
 progress :: (CSM m, MonadIO m) => String -> m ()
 progress = verboseMessage 1

frontends/ParseOccam.hs

@@ -44,14 +44,6 @@ import Utils
 --{{{ the parser monad
 type OccParser = GenParser Token ([WarningReport], CompState)
 
--- | Make MonadState functions work in the parser monad.
--- This came from <http://hackage.haskell.org/trac/ghc/ticket/1274> -- which means
--- it'll probably be in a future GHC release anyway.
-{-
-instance MonadState st (GenParser tok st) where
-  get = getState
-  put = setState
--}
 instance CSMR (GenParser tok (a,CompState)) where
   getCompState = getState >>* snd
 
@@ -62,6 +54,7 @@ instance MonadState CompState (GenParser tok (a,CompState)) where
   put st = do (other, _) <- getState
               setState (other, st)
 
+-- The other part of the state is actually the built-up list of warnings:
 instance Warn (GenParser tok ([WarningReport], b)) where
   warnReport w = do (ws, other) <- getState
                     setState (ws ++ [w], other)