diff --git a/fco2/Main.hs b/fco2/Main.hs index 06a572f..968a122 100644 --- a/fco2/Main.hs +++ b/fco2/Main.hs @@ -86,6 +86,8 @@ compile fn debugAST ast1 debug "}}}" + showWarnings + output <- if psParseOnly optsPS then return $ show ast1 @@ -100,6 +102,8 @@ compile fn return c + showWarnings + case psOutputFile optsPS of "-" -> liftIO $ putStr output file -> diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 6994d54..25658c8 100644 --- a/fco2/ParseState.hs +++ b/fco2/ParseState.hs @@ -27,6 +27,7 @@ data ParseState = ParseState { psNameCounter :: Int, psTypeContext :: [Maybe A.Type], psLoadedFiles :: [String], + psWarnings :: [String], -- Set by passes psNonceCounter :: Int, @@ -55,6 +56,7 @@ emptyState = ParseState { psNameCounter = 0, psTypeContext = [], psLoadedFiles = [], + psWarnings = [], psNonceCounter = 0, psFunctionReturns = [], @@ -79,6 +81,11 @@ lookupName n Just nd -> return nd Nothing -> die $ "cannot find name " ++ A.nameName n +-- | Add a warning. +addWarning :: PSM m => Meta -> String -> m () +addWarning m s = modify (\ps -> ps { psWarnings = msg : psWarnings ps }) + where msg = "Warning: " ++ show m ++ ": " ++ s + -- | Generate a throwaway unique name. makeNonce :: PSM m => String -> m String makeNonce s @@ -89,9 +96,7 @@ makeNonce s -- | Add a pulled item to the collection. addPulled :: PSM m => (A.Process -> A.Process) -> m () -addPulled item - = do ps <- get - put $ ps { psPulledItems = item : psPulledItems ps } +addPulled item = modify (\ps -> ps { psPulledItems = item : psPulledItems ps }) -- | Apply pulled items to a Process. applyPulled :: PSM m => A.Process -> m A.Process diff --git a/fco2/Pass.hs b/fco2/Pass.hs index ef2369e..e23b5aa 100644 --- a/fco2/Pass.hs +++ b/fco2/Pass.hs @@ -38,6 +38,17 @@ verboseMessage n s when (psVerboseLevel ps >= n) $ liftIO $ hPutStrLn stderr s +-- | Print a warning message. +warn :: (PSM m, MonadIO m) => String -> m () +warn = verboseMessage 0 + +-- | Print out any warnings stored. +showWarnings :: (PSM m, MonadIO m) => m () +showWarnings + = do ps <- get + sequence_ $ map warn (psWarnings ps) + put $ ps { psWarnings = [] } + -- | Print a progress message. progress :: (PSM m, MonadIO m) => String -> m () progress = verboseMessage 1