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)