diff --git a/backends/AnalyseAsm.hs b/backends/AnalyseAsm.hs
index f500e2a..9fd1d28 100644
--- a/backends/AnalyseAsm.hs
+++ b/backends/AnalyseAsm.hs
@@ -34,7 +34,7 @@ import Numeric (readDec)
import Text.Printf
import Text.Regex
-import CompState
+import Errors
import Pass
import PrettyShow
diff --git a/common/CompState.hs b/common/CompState.hs
index 02ac5ac..e2da104 100644
--- a/common/CompState.hs
+++ b/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 ()
diff --git a/common/Errors.hs b/common/Errors.hs
index ea63d90..38d87a4 100644
--- a/common/Errors.hs
+++ b/common/Errors.hs
@@ -17,11 +17,12 @@ with this program. If not, see .
-}
-- | 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.
- dieP :: Die m => Meta -> String -> m a
- dieP m s = dieReport (Just m,s)
+-- | Fail, giving a position and an error message.
+dieP :: Die m => Meta -> String -> m a
+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
diff --git a/common/Pass.hs b/common/Pass.hs
index 6ff4387..745c547 100644
--- a/common/Pass.hs
+++ b/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
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index afea471..90a6579 100644
--- a/frontends/ParseOccam.hs
+++ b/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 -- 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)