Remove unnecessary ErrorTCompat

This abstraction was added to support building with GHC 7.10 (which
uses Control.Monad.Except) and older versions (which still used
Control.Monad.Error), without having to introduce CPP directives
everywhere.  Since we no longer support those earlier GHC versions,
there is no need for this API.

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]

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)

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])

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

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

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: " ++

src/comp/IInlineFmt.hs

@@ -8,15 +8,15 @@ 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)
 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',

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
 

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

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

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

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,15 +1873,15 @@ 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
 
     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 $