diff --git a/src/comp/ABinUtil.hs b/src/comp/ABinUtil.hs index cd0bccf63..503a9cd5d 100644 --- a/src/comp/ABinUtil.hs +++ b/src/comp/ABinUtil.hs @@ -9,8 +9,8 @@ module ABinUtil ( import Data.List(nub, partition) import Data.Maybe(isJust, fromJust) import Control.Monad(when) +import Control.Monad.Except(ExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, get, put) -import ErrorTCompat import Version(bscVersionStr) import Backend @@ -19,7 +19,7 @@ import FileIOUtil(readBinaryFileCatch, readBinFilePath) import Util(fromMaybeM) import Error(internalError, EMsg, EMsgs(..), ErrMsg(..), - ErrorHandle, bsError, bsWarning, convErrorTToIO) + ErrorHandle, bsError, bsWarning, convExceptTToIO) import Id(Id, getIdString) import Position(cmdPosition, noPosition, getPosition) import PPrint @@ -63,11 +63,11 @@ type ABinMap = M.Map String FilePath -- -- When linking Verilog, we want to try reading in a .ba hierarchy, -- but fall back to using .v files if it fails. --- Therefore, ErrorT is used to catch errors. Serious failures can +-- Therefore, ExceptT is used to catch errors. Serious failures can -- still be reported immediately, via IO -- such as file version mismatch, -- or read errors, etc. -- -type M = StateT MState (ErrorT EMsgs IO) +type M = StateT MState (ExceptT EMsgs IO) -- monad state data MState = MState { @@ -126,7 +126,7 @@ putHierMap m = get >>= \s -> put (s { m_foundmod_map = m }) getABIHierarchy :: ErrorHandle -> Bool -> [String] -> (Maybe Backend) -> [String] -> String -> [(String, ABin)] -> - ErrorT EMsgs IO + ExceptT EMsgs IO (Id, HierMap, InstModMap, ForeignFuncMap, ABinMap, [String], [(String, (ABinEitherModInfo, String))]) getABIHierarchy errh be_verbose ifc_path backend prim_names topname fabis = do @@ -202,11 +202,11 @@ getABIHierarchy errh be_verbose ifc_path backend prim_names topname fabis = do -- back the abmis with just the success data types assertNoSchedErr :: [(String, (ABinEitherModInfo, String))] -> - ErrorT EMsgs IO + ExceptT EMsgs IO [(String, (ABinModInfo, String))] assertNoSchedErr modinfos_by_name = let assertOne :: (String, (ABinEitherModInfo, String)) -> - ErrorT EMsgs IO + ExceptT EMsgs IO (String, (ABinModInfo, String)) assertOne (name, (eabmi, ver)) = case eabmi of @@ -472,7 +472,7 @@ readAndCheckABin errh backend filename = do -- returns the filename and the contents readAndCheckABinPath :: ErrorHandle -> Bool -> [String] -> (Maybe Backend) -> String -> - (ErrorT EMsgs IO) (Maybe (String, ABin)) + (ExceptT EMsgs IO) (Maybe (String, ABin)) readAndCheckABinPath errh be_verbose path backend mod_name = do let binname = mod_name ++ "." ++ abinSuffix mread <- lift $ readBinFilePath errh noPosition be_verbose binname path @@ -494,7 +494,7 @@ readAndCheckABinPathCatch :: ErrorHandle -> Bool -> [String] -> (Maybe Backend) -> String -> EMsg -> IO (String, ABin) readAndCheckABinPathCatch errh be_verbose path backend mod_name errmsg = do - mabi <- convErrorTToIO errh $ + mabi <- convExceptTToIO errh $ readAndCheckABinPath errh be_verbose path backend mod_name case mabi of Nothing -> bsError errh [errmsg] diff --git a/src/comp/AConv.hs b/src/comp/AConv.hs index ef2982da5..2ea42a585 100644 --- a/src/comp/AConv.hs +++ b/src/comp/AConv.hs @@ -2,8 +2,8 @@ module AConv (aConv, aTypeConv, isLocalAId) where import Util(itos, headOrErr, initOrErr, lastOrErr, log2, concatMapM, makePairs) import qualified Data.Map as M -import ErrorTCompat import Control.Monad(when, liftM, forM, zipWithM) +import Control.Monad.Except(throwError) import Control.Monad.State(StateT, runStateT, gets, get, put) import Control.Monad.Reader(ReaderT, runReaderT, withReaderT, ask) import PPrint(ppReadable, ppString) diff --git a/src/comp/ASchedule.hs b/src/comp/ASchedule.hs index b44191390..71607f32f 100644 --- a/src/comp/ASchedule.hs +++ b/src/comp/ASchedule.hs @@ -19,8 +19,8 @@ import Prelude hiding ((<>)) import Data.List import Data.Maybe -import ErrorTCompat import Control.Monad(when, foldM) +import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, get, put) import System.IO.Unsafe import Debug.Trace(traceM) @@ -355,7 +355,7 @@ csGraphToSchedGraph edges = -- In order to record the warnings during scheduling, we operate on a -- state monad which stores the EMsgs. -type SM = ErrorT EMsgs (StateT SState IO) +type SM = ExceptT EMsgs (StateT SState IO) data SState = SState { sm_warnings :: [EMsg], @@ -426,7 +426,7 @@ aSchedule :: ErrorHandle -> Flags -> IO (Either AScheduleErrInfo (AScheduleInfo, APackage)) aSchedule errh flags prefix urgency_pairs pps amod = do let f = aSchedule' errh flags prefix urgency_pairs pps amod - (result, s) <- runStateT (runErrorT f) initSState + (result, s) <- runStateT (runExceptT f) initSState let processWarning e@(pos,msg) = (pos, getErrMsgTag msg, showWarningList [e]) diff --git a/src/comp/Error.hs b/src/comp/Error.hs index 048a11cfc..6c209742c 100644 --- a/src/comp/Error.hs +++ b/src/comp/Error.hs @@ -39,8 +39,8 @@ module Error( -- exit with the same code as a system call that failed exitFailWith, - -- report errors in ErrorT [EMsg] IO - convErrorTToIO, + -- report errors in ExceptT [EMsg] IO + convExceptTToIO, -- used for displaying messages as a string -- (in .ba file, in Verilog dynamic error, in Tcl) @@ -70,8 +70,8 @@ import Data.List(genericLength) import qualified Data.Set as S import System.IO(Handle, hClose, hPutStr, stderr) import System.Exit(exitWith, ExitCode(..)) -import ErrorTCompat import Control.Monad(when) +import Control.Monad.Except(ExceptT, runExceptT) import qualified Control.Exception as CE import Data.IORef import System.IO.Unsafe(unsafePerformIO) @@ -413,15 +413,15 @@ exitOK ref = do -- ------------------------- --- We can't use [EMsg] with ErrorT because it leads to overlapping +-- We can't use [EMsg] with ExceptT because it leads to overlapping -- instance problems. Instead, we will wrap it with a newtype. newtype EMsgs = EMsgs { errmsgs :: [EMsg] } -- ------------------------- -convErrorTToIO :: ErrorHandle -> ErrorT EMsgs IO a -> IO a -convErrorTToIO ref fn = - do mres <- runErrorT fn +convExceptTToIO :: ErrorHandle -> ExceptT EMsgs IO a -> IO a +convExceptTToIO ref fn = + do mres <- runExceptT fn case mres of Left msgs -> bsError ref (errmsgs msgs) Right res -> return res diff --git a/src/comp/ErrorMonad.hs b/src/comp/ErrorMonad.hs index 2e8dde519..067258384 100644 --- a/src/comp/ErrorMonad.hs +++ b/src/comp/ErrorMonad.hs @@ -2,8 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module ErrorMonad(ErrorMonad(..), convErrorMonadToIO) where -import ErrorTCompat import Control.Monad(ap) +import Control.Monad.Except(MonadError, throwError, catchError) #if !defined(__GLASGOW_HASKELL__) || ((__GLASGOW_HASKELL__ >= 800) && (__GLASGOW_HASKELL__ < 808)) import Control.Monad.Fail(MonadFail(..)) #endif diff --git a/src/comp/ErrorTCompat.hs b/src/comp/ErrorTCompat.hs deleted file mode 100644 index b5f7d3811..000000000 --- a/src/comp/ErrorTCompat.hs +++ /dev/null @@ -1,12 +0,0 @@ -module ErrorTCompat ( - ErrorT, - runErrorT, - MonadError(..) -) where - -import Control.Monad.Except - -type ErrorT = ExceptT - -runErrorT :: ErrorT e m a -> m (Either e a) -runErrorT = runExceptT diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 93f4066dd..f2b61dc1e 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -10,8 +10,8 @@ import Prelude hiding ((<>)) #endif import Data.List(nub, (\\), find) -import ErrorTCompat import Control.Monad(when, foldM, filterM, zipWithM, mapAndUnzipM) +import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, gets, get, put) import PFPrint import Position(Position, noPosition, getPositionLine, cmdPosition) @@ -50,7 +50,7 @@ import GenWrapUtils -- ==================== -type GWMonad = StateT GenState (ErrorT EMsgs IO) +type GWMonad = StateT GenState (ExceptT EMsgs IO) data GenState = GenState { @@ -62,7 +62,7 @@ data GenState = GenState runGWMonad :: GWMonad a -> GenState -> IO a runGWMonad f s = do let errh = errHandle s - result <- runErrorT ((runStateT f) s) + result <- runExceptT ((runStateT f) s) case result of Right (res, _) -> return res Left msgs -> bsError errh (errmsgs msgs) @@ -77,7 +77,7 @@ runGWMonadNoFail f s = -- and we don't expect it to fail runGWMonadGetNoFail :: GWMonad a -> GenState -> IO (GenState, a) runGWMonadGetNoFail f s = - do result <- runErrorT ((runStateT f) s) + do result <- runExceptT ((runStateT f) s) case result of Right (res, s2) -> return (s2, res) Left msgs -> internalError ("runGWMonadGetNoFail: " ++ diff --git a/src/comp/IInlineFmt.hs b/src/comp/IInlineFmt.hs index c1b860fca..54c117277 100644 --- a/src/comp/IInlineFmt.hs +++ b/src/comp/IInlineFmt.hs @@ -8,7 +8,7 @@ import Id import Prim import PreIds(idActionValue_, idArrow, tmpVarIds, idAVValue_, idAVAction_, idPrimFmtConcat) import ForeignFunctions -import ErrorTCompat +import Control.Monad.Except(ExceptT, runExceptT) import Control.Monad.State import Error(EMsg, ErrorHandle, bsError) import Position(noPosition) @@ -16,7 +16,7 @@ import CType(TISort(..), StructSubType(..)) import qualified Data.Map as M -- import Debug.Trace(trace) -type F a = StateT (Int, [IDef a]) (ErrorT EMsg (IO)) +type F a = StateT (Int, [IDef a]) (ExceptT EMsg (IO)) newFFCallNo :: (F a) Integer newFFCallNo = do (n, ds) <- get @@ -37,7 +37,7 @@ iInlineFmt errh imod = do let imod_fmt = iInlineFmts imod let ffcallNo = (imod_ffcallNo imod_fmt) let ds = (imod_local_defs imod_fmt) - result <- runErrorT (runStateT (splitFmtsF imod_fmt) (ffcallNo, [])) + result <- runExceptT (runStateT (splitFmtsF imod_fmt) (ffcallNo, [])) case result of Right x@(imod', (ffcallNo', ds')) -> return (imod' {imod_local_defs = ds ++ ds', diff --git a/src/comp/MakeSymTab.hs b/src/comp/MakeSymTab.hs index 793604298..ffbc1043f 100644 --- a/src/comp/MakeSymTab.hs +++ b/src/comp/MakeSymTab.hs @@ -12,8 +12,8 @@ import Prelude hiding ((<>)) #endif import Data.List -import ErrorTCompat import Control.Monad(when) +import Control.Monad.Except(throwError) import qualified Data.Set as S import qualified Data.Map as M diff --git a/src/comp/SimExpand.hs b/src/comp/SimExpand.hs index 027996c22..bbacf1bad 100644 --- a/src/comp/SimExpand.hs +++ b/src/comp/SimExpand.hs @@ -10,7 +10,7 @@ import qualified Data.Set as S import IOUtil(progArgs) import Error (internalError, EMsg, ErrMsg(..), ErrorHandle, bsError, - convErrorTToIO) + convExceptTToIO) import Position (noPosition, getPosition) import PPrint import Flags @@ -66,11 +66,11 @@ simExpand errh flags topname fabis = do let prim_names = map sb_name primBlocks (topmodId, hiermap, instmap, ffuncmap, filemap, _, emodinfos_used_by_name) - <- convErrorTToIO errh $ + <- convExceptTToIO errh $ getABIHierarchy errh (verbose flags) (ifcPath flags) (Just Bluesim) prim_names topname fabis - modinfos_used_by_name <- convErrorTToIO errh $ + modinfos_used_by_name <- convExceptTToIO errh $ assertNoSchedErr emodinfos_used_by_name -- reject top-level modules with always_enabled ifc, if generating diff --git a/src/comp/TIMonad.hs b/src/comp/TIMonad.hs index 2651ee422..82a65564a 100644 --- a/src/comp/TIMonad.hs +++ b/src/comp/TIMonad.hs @@ -43,8 +43,8 @@ import Assump import SymTab import PreIds(idBits, idLiteral, idRealLiteral, idSizedLiteral, idStringLiteral, idNumEq) -import ErrorTCompat import Control.Monad(when) +import Control.Monad.Except(ExceptT, runExceptT, throwError, catchError) import Control.Monad.State(State, StateT, runState, runStateT, lift, gets, get, put, modify) import Data.List(partition) @@ -128,7 +128,7 @@ sizedStackModify (SizedStack size (x:rest)) f = sizedStackModify _ _ = internalError "sizedStackModify: stack underflow" -- state/error monad with bsc error messages and hidden TState -type TI = StateT TStateRecover (ErrorT EMsgs (State TStatePersistent)) +type TI = StateT TStateRecover (ExceptT EMsgs (State TStatePersistent)) -- apply the current substitution to something apSubTI :: (Types a) => a -> TI a @@ -158,7 +158,7 @@ runTI :: Flags -> Bool -> SymTab -> TI a -> (Either [EMsg] a, [WMsg]) runTI flags ai s m = (final_result, tsWarns pState) where (result, pState) = runState error_run (initPersistentState flags ai s) - error_run = (runErrorT (runStateT m initRecoverState)) + error_run = (runExceptT (runStateT m initRecoverState)) rec_errors = tsRecoveredErrors pState final_result = case result of diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index c134743ff..abb46eb99 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -47,7 +47,7 @@ import Flags(Flags(..), verbose) import FlagsDecode(defaultFlags, decodeFlags, adjustFinalFlags, updateFlags, showFlagsLst, showFlagsAllLst, getFlagValueString) import Error(internalError, EMsg, ErrMsg(..), showErrorList, - ErrorHandle, initErrorHandle, convErrorTToIO) + ErrorHandle, initErrorHandle, convExceptTToIO) import Id import PPrint import PVPrint @@ -975,7 +975,7 @@ tclModule ["load",topname] = do ": it is a primitive module") -- getABIHierarchy calls GenABin.readABinFile to read a .ba file (topmodId, hierMap, instModMap, ffuncMap, _, foreign_mods, abmis_by_name) - <- convErrorTToIO globalErrHandle $ + <- convExceptTToIO globalErrHandle $ getABIHierarchy globalErrHandle (verbose flags) (ifcPath flags) (Just gen_backend) prim_names topname [] @@ -3285,13 +3285,13 @@ data IfcField = getIfcHierarchy :: Maybe Id -> [(Id, RawIfcField)] -> Type -> IO [IfcField] getIfcHierarchy instId raw_fields tifc = do - mres <- runErrorT (mgetIfcHierarchy instId raw_fields tifc) + mres <- runExceptT (mgetIfcHierarchy instId raw_fields tifc) case mres of Right res -> return res Left msg -> internalError msg mgetIfcHierarchy :: Maybe Id -> [(Id, RawIfcField)] -> Type -> - ErrorT String IO [IfcField] + ExceptT String IO [IfcField] mgetIfcHierarchy instId raw_fields tifc = do -- use "expandSyn" to avoid getting back "Alias" as the type analysis maifc <- lift $ getTypeAnalysis' (expandSyn tifc) True @@ -3301,7 +3301,7 @@ mgetIfcHierarchy instId raw_fields tifc = do ifc_map = M.fromList raw_fields -- get the AIF for a flattened name - lookupAIF :: Id -> ErrorT String IO RawIfcField + lookupAIF :: Id -> ExceptT String IO RawIfcField lookupAIF i = case (M.lookup i ifc_map) of Just aif -> return aif @@ -3322,10 +3322,10 @@ mgetIfcHierarchy instId raw_fields tifc = do -- get the IfcField for one field getField :: Id -> (Bool, Id, Qual Type, [IfcPragma]) -> - ErrorT String IO IfcField + ExceptT String IO IfcField getField prefix (_, fId, (_ :=> t), _) = getField' prefix fId t - getField' :: Id -> Id -> Type -> ErrorT String IO IfcField + getField' :: Id -> Id -> Type -> ExceptT String IO IfcField getField' prefix fId t = do -- Function for expanding Vectors of subinterfaces -- (or pseudo-interfaces like Clock, Reset, Inout) @@ -3530,7 +3530,7 @@ getSubmodPortInfo mtifc avi = do let defl_ifc_hier = [ (Field fId inf Nothing) | (fId, inf) <- ifc_map ] in case mtifc of Just tifc -> do - mres <- runErrorT $ + mres <- runExceptT $ mgetIfcHierarchy (Just (avi_vname avi)) ifc_map tifc case mres of Right res -> return res diff --git a/src/comp/bsc.hs b/src/comp/bsc.hs index 776d65165..43db1e035 100644 --- a/src/comp/bsc.hs +++ b/src/comp/bsc.hs @@ -20,7 +20,7 @@ import Data.Maybe(isJust, isNothing {-, fromMaybe-}) import Numeric(showOct) import Control.Monad(when, unless, filterM, liftM, foldM) -import ErrorTCompat(runErrorT) +import Control.Monad.Except(runExceptT) import Control.Concurrent(forkIO) import Control.Concurrent.MVar(newEmptyMVar, putMVar, takeMVar) import qualified Control.Exception as CE @@ -1873,7 +1873,7 @@ vLink errh flags topmod_name vfilenames0 afilenames cfilenames = do -- see if .ba files exist for the top-level of this design let prim_names = map sb_name primBlocks - mhier0 <- runErrorT $ + mhier0 <- runExceptT $ getABIHierarchy errh (verbose flags) (ifcPath flags) (Just Verilog) prim_names topmod_name user_abis @@ -1881,7 +1881,7 @@ vLink errh flags topmod_name vfilenames0 afilenames cfilenames = do mhier <- case mhier0 of Left msgs -> return (Left msgs) Right (a, b, c, d, e, f, emodinfos) -> do - mres <- runErrorT (assertNoSchedErr emodinfos) + mres <- runExceptT (assertNoSchedErr emodinfos) case mres of Left msgs -> return (Left msgs) Right modinfos -> return $ diff --git a/src/comp/showrules.hs b/src/comp/showrules.hs index 792662efe..868857728 100644 --- a/src/comp/showrules.hs +++ b/src/comp/showrules.hs @@ -13,7 +13,7 @@ import Id( Id, getIdString, getIdBaseString, getIdQualString import Error(internalError, EMsg, WMsg, ErrMsg(..), ErrorHandle, initErrorHandle, exitOK, exitFail, bsErrorNoExit, bsWarning, - convErrorTToIO) + convExceptTToIO) import Util(separate, headOrErr, fromJustOrErr, unconsOrErr) import IOUtil(getEnvDef) import TopUtils(dfltBluespecDir) @@ -300,9 +300,9 @@ hmain argv = do let prim_names = map sb_name primBlocks when (verbose) $ putStrLn "Reading design data from .ba files..." (_, hier_map, inst_map, _, _, _, abemis_by_name) - <- convErrorTToIO errh $ + <- convExceptTToIO errh $ getABIHierarchy errh verbose ba_path Nothing prim_names top_mod [] - abmis_by_name <- convErrorTToIO errh $ assertNoSchedErr abemis_by_name + abmis_by_name <- convExceptTToIO errh $ assertNoSchedErr abemis_by_name -- analyze design in preparation for VCD interpretation when (verbose) $ putStrLn "Analyzing design structure..."