    --  Compiler Toolkit: compiler state management
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 2 November 95
    --
    --  Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:45 $
    --
    --  Copyright (c) [1995..1999] Manuel M. T. Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This module forms the interface to the state base of the compiler. It is
    --  used by all modules that are not directly involved in implementing the
    --  state base. It provides a state transformer that is capable of doing I/O
    --  and provides facilities such as error handling and compiler switch
    --  management.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  * The monad `PreCST' is reexported abstractly.
    --
    --  * Errors are dumped to `stdout' to facilitate communication with other
    --    processes (see `Interact').
    --
    --- TODO ----------------------------------------------------------------------
    --

    module State (-- the PreCST monad
                  --
                  PreCST,                                      -- reexport ABSTRACT
                  nop, yield, (+>=), (+>), fixCST,             -- reexport
                  throwExc, fatal, catchExc, fatalsHandledBy,  -- reexport lifted
                  readCST, writeCST, transCST, run, runCST,
                  StateTrans.MVar,                             -- reexport
                  newMV, readMV, assignMV,                     -- reexport lifted
                  --
                  -- reexport compiler I/O
                  --
                  module CIO,
                  liftIO,
                  --
                  -- identification
                  --
                  getId,
                  --
                  -- error management
                  --
                  raise, raiseWarning, raiseError, raiseFatal, showErrors,
                  errorsPresent,
                  --
                  -- extra state management
                  --
                  readExtra, updExtra,
                  --
                  -- name supplies
                  --
                  getNameSupply)
    where

    import Data.Ix
    import Control.Monad       (when)
    import Data.List        (sort)

    import BaseVersion (version, copyright, disclaimer)
    import Config      (errorLimit)
    import Position    (Position)
    import UNames      (NameSupply,
                        rootSupply, splitSupply)
    import StateTrans  (STB,
                        readBase, transBase, runSTB)
    import qualified
           StateTrans  (interleave, throwExc, fatal, catchExc, fatalsHandledBy,
                        MVar, newMV, readMV, assignMV)
    import StateBase   (PreCST(..), ErrorState(..), BaseState(..),
                        nop, yield, (+>=), (+>), fixCST,
                        unpackCST, readCST, writeCST, transCST,
                        liftIO)
    import CIO
    import Errors      (ErrorLvl(..), Error, makeError, errorLvl, showError)

    -- state used in the whole compiler
    -- --------------------------------

    -- initialization
    --
    --  * it gets the version information and the initial extra state as arguments
    --
    initialBaseState        :: (String, String, String) -> e -> BaseState e
    initialBaseState :: (String, String, String) -> e -> BaseState e
    initialBaseState vcd :: (String, String, String)
    vcd es :: e
    es  = BaseState :: forall e.
    (String, String, String)
    -> (String, String, String)
    -> ErrorState
    -> [NameSupply]
    -> e
    -> BaseState e
    BaseState {
                                 idTKBS :: (String, String, String)
    idTKBS     = (String
    version, String
    copyright, String
    disclaimer),
                                 idBS :: (String, String, String)
    idBS       = (String, String, String)
    vcd,
                                 errorsBS :: ErrorState
    errorsBS   = ErrorState
    initialErrorState,
                                 suppliesBS :: [NameSupply]
    suppliesBS = NameSupply -> [NameSupply]
    splitSupply NameSupply
    rootSupply,
                                 extraBS :: e
    extraBS    = e
    es
                            }

    -- executing state transformers
    -- ----------------------------

    -- initiate a complete run of the ToolKit represented by a PreCST with a void
    -- generic component (type `()') (EXPORTED)
    --
    --  * fatals errors are explicitly caught and reported (instead of letting them
    --   through to the runtime system)
    --
    run            :: (String, String, String) -> e -> PreCST e () a -> IO a
    run :: (String, String, String) -> e -> PreCST e () a -> IO a
    run vcd :: (String, String, String)
    vcd es :: e
    es cst :: PreCST e () a
    cst  = STB (BaseState e) () a -> BaseState e -> () -> IO a
    forall bs gs a. STB bs gs a -> bs -> gs -> IO a
    runSTB STB (BaseState e) () a
    m ((String, String, String) -> e -> BaseState e
    forall e. (String, String, String) -> e -> BaseState e
    initialBaseState (String, String, String)
    vcd e
    es) ()
      where
        m :: STB (BaseState e) () a
    m = PreCST e () a -> STB (BaseState e) () a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST (
              PreCST e () a
    cst
              PreCST e () a -> (IOError -> PreCST e () a) -> PreCST e () a
    forall e s a.
    PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    `fatalsHandledBy` \err :: IOError
    err ->
                String -> PreCST e () ()
    forall e s. String -> PreCST e s ()
    putStrCIO ("Uncaught fatal error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IOError -> String
    forall a. Show a => a -> String
    show IOError
    err)    PreCST e () () -> PreCST e () a -> PreCST e () a
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                ExitCode -> PreCST e () a
    forall e s a. ExitCode -> PreCST e s a
    exitWithCIO (Int -> ExitCode
    ExitFailure 1)
            )

    -- run a PreCST in the context of another PreCST (EXPORTED)
    --
    -- the generic state of the enclosing PreCST is preserved while the
    -- computation of the PreCST passed as an argument is interleaved in the
    -- execution of the enclosing one
    --
    runCST     :: PreCST e s a -> s -> PreCST e s' a
    runCST :: PreCST e s a -> s -> PreCST e s' a
    runCST m :: PreCST e s a
    m s :: s
    s  = STB (BaseState e) s' a -> PreCST e s' a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s' a -> PreCST e s' a)
    -> STB (BaseState e) s' a -> PreCST e s' a
    forall a b. (a -> b) -> a -> b
    $ STB (BaseState e) s a -> s -> STB (BaseState e) s' a
    forall bs gs' a gs. STB bs gs' a -> gs' -> STB bs gs a
    StateTrans.interleave (PreCST e s a -> STB (BaseState e) s a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST PreCST e s a
    m) s
    s

    -- exception handling
    -- ------------------

    -- throw an exception with the given tag and message (EXPORTED)
    --
    throwExc       :: String -> String -> PreCST e s a
    throwExc :: String -> String -> PreCST e s a
    throwExc s1 :: String
    s1 s2 :: String
    s2  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> STB (BaseState e) s a -> PreCST e s a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> STB (BaseState e) s a
    forall bs gs a. String -> String -> STB bs gs a
    StateTrans.throwExc String
    s1 String
    s2

    -- raise a fatal user-defined error (EXPORTED)
    --
    --  * such an error my be caught and handled using `fatalsHandeledBy'
    --
    fatal :: String -> PreCST e s a
    fatal :: String -> PreCST e s a
    fatal  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> (String -> STB (BaseState e) s a) -> String -> PreCST e s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> STB (BaseState e) s a
    forall bs gs a. String -> STB bs gs a
    StateTrans.fatal

    -- the given state transformer is executed and exceptions with the given tag
    -- are caught using the provided handler, which expects to get the exception
    -- message (EXPORTED)
    --
    --  * the state observed by the exception handler is *modified* by the failed
    --   state transformer upto the point where the exception was thrown (this
    --   semantics is the only reasonable when it should be possible to use
    --   updating for maintaining the state)
    --
    catchExc     :: PreCST e s a
                 -> (String, String -> PreCST e s a)
                 -> PreCST e s a
    catchExc :: PreCST e s a -> (String, String -> PreCST e s a) -> PreCST e s a
    catchExc m :: PreCST e s a
    m (s :: String
    s, h :: String -> PreCST e s a
    h)  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> STB (BaseState e) s a -> PreCST e s a
    forall a b. (a -> b) -> a -> b
    $ STB (BaseState e) s a
    -> (String, String -> STB (BaseState e) s a)
    -> STB (BaseState e) s a
    forall bs gs a.
    STB bs gs a -> (String, String -> STB bs gs a) -> STB bs gs a
    StateTrans.catchExc (PreCST e s a -> STB (BaseState e) s a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST PreCST e s a
    m) (String
    s, PreCST e s a -> STB (BaseState e) s a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST (PreCST e s a -> STB (BaseState e) s a)
    -> (String -> PreCST e s a) -> String -> STB (BaseState e) s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PreCST e s a
    h)

    -- given a state transformer that may raise fatal errors and an error handler
    -- for fatal errors, execute the state transformer and apply the error handler
    -- when a fatal error occurs (EXPORTED)
    --
    --  * fatal errors are IO monad errors and errors raised by `fatal' as well as
    --   uncaught exceptions
    --
    --  * the base and generic state observed by the error handler is *in contrast
    --   to `catch'* the state *before* the state transformer is applied
    --
    fatalsHandledBy :: PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    fatalsHandledBy :: PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    fatalsHandledBy m :: PreCST e s a
    m h :: IOError -> PreCST e s a
    h  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> STB (BaseState e) s a -> PreCST e s a
    forall a b. (a -> b) -> a -> b
    $ STB (BaseState e) s a
    -> (IOError -> STB (BaseState e) s a) -> STB (BaseState e) s a
    forall bs gs a.
    STB bs gs a -> (IOError -> STB bs gs a) -> STB bs gs a
    StateTrans.fatalsHandledBy STB (BaseState e) s a
    m' IOError -> STB (BaseState e) s a
    h'
                           where
                             m' :: STB (BaseState e) s a
    m' = PreCST e s a -> STB (BaseState e) s a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST PreCST e s a
    m
                             h' :: IOError -> STB (BaseState e) s a
    h' = PreCST e s a -> STB (BaseState e) s a
    forall e s a. PreCST e s a -> STB (BaseState e) s a
    unpackCST (PreCST e s a -> STB (BaseState e) s a)
    -> (IOError -> PreCST e s a) -> IOError -> STB (BaseState e) s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOError -> PreCST e s a
    h

    -- mutable variables
    -- -----------------

    -- lifted mutable variable functions (EXPORTED)
    --

    newMV :: a -> PreCST e s (StateTrans.MVar a)
    newMV :: a -> PreCST e s (MVar a)
    newMV  = STB (BaseState e) s (MVar a) -> PreCST e s (MVar a)
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s (MVar a) -> PreCST e s (MVar a))
    -> (a -> STB (BaseState e) s (MVar a)) -> a -> PreCST e s (MVar a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> STB (BaseState e) s (MVar a)
    forall a bs gs. a -> STB bs gs (MVar a)
    StateTrans.newMV

    readMV :: StateTrans.MVar a -> PreCST e s a
    readMV :: MVar a -> PreCST e s a
    readMV  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> (MVar a -> STB (BaseState e) s a) -> MVar a -> PreCST e s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar a -> STB (BaseState e) s a
    forall a bs gs. MVar a -> STB bs gs a
    StateTrans.readMV

    assignMV     :: StateTrans.MVar a -> a -> PreCST e s ()
    assignMV :: MVar a -> a -> PreCST e s ()
    assignMV m :: MVar a
    m a :: a
    a  = STB (BaseState e) s () -> PreCST e s ()
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s () -> PreCST e s ())
    -> STB (BaseState e) s () -> PreCST e s ()
    forall a b. (a -> b) -> a -> b
    $ MVar a -> a -> STB (BaseState e) s ()
    forall a bs gs. MVar a -> a -> STB bs gs ()
    StateTrans.assignMV MVar a
    m a
    a

    -- read identification
    -- -------------------

    -- read identification information (EXPORT)
    --
    getId :: PreCST e s (String, String, String)
    getId :: PreCST e s (String, String, String)
    getId  = STB (BaseState e) s (String, String, String)
    -> PreCST e s (String, String, String)
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s (String, String, String)
     -> PreCST e s (String, String, String))
    -> STB (BaseState e) s (String, String, String)
    -> PreCST e s (String, String, String)
    forall a b. (a -> b) -> a -> b
    $
             (BaseState e -> (String, String, String))
    -> STB (BaseState e) s (String, String, String)
    forall bs a gs. (bs -> a) -> STB bs gs a
    readBase (BaseState e -> (String, String, String)
    forall e. BaseState e -> (String, String, String)
    idBS)

    -- manipulating the error state
    -- ----------------------------

    -- the lowest level of errors is `WarningErr', but it is meaningless as long as
    -- the the list of errors is empty
    --
    initialErrorState :: ErrorState
    initialErrorState :: ErrorState
    initialErrorState  = ErrorLvl -> Int -> [Error] -> ErrorState
    ErrorState ErrorLvl
    WarningErr 0 []

    -- raise an error (EXPORTED)
    --
    --  * a fatal error is reported immediately; see `raiseFatal'
    --
    raise     :: Error -> PreCST e s ()
    raise :: Error -> PreCST e s ()
    raise err :: Error
    err  = case Error -> ErrorLvl
    errorLvl Error
    err of
                   WarningErr  -> Error -> PreCST e s ()
    forall e s. Error -> PreCST e s ()
    raise0 Error
    err
                   ErrorErr    -> Error -> PreCST e s ()
    forall e s. Error -> PreCST e s ()
    raise0 Error
    err
                   FatalErr    -> String -> Error -> PreCST e s ()
    forall e s a. String -> Error -> PreCST e s a
    raiseFatal0 "Generic fatal error." Error
    err

    -- raise a warning (see `raiseErr') (EXPORTED)
    --
    raiseWarning         :: Position -> [String] -> PreCST e s ()
    raiseWarning :: Position -> [String] -> PreCST e s ()
    raiseWarning pos :: Position
    pos msg :: [String]
    msg  = Error -> PreCST e s ()
    forall e s. Error -> PreCST e s ()
    raise0 (ErrorLvl -> Position -> [String] -> Error
    makeError ErrorLvl
    WarningErr Position
    pos [String]
    msg)

    -- raise an error (see `raiseErr') (EXPORTED)
    --
    raiseError         :: Position -> [String] -> PreCST e s ()
    raiseError :: Position -> [String] -> PreCST e s ()
    raiseError pos :: Position
    pos msg :: [String]
    msg  = Error -> PreCST e s ()
    forall e s. Error -> PreCST e s ()
    raise0 (ErrorLvl -> Position -> [String] -> Error
    makeError ErrorLvl
    ErrorErr Position
    pos [String]
    msg)

    -- raise a fatal compilation error (EXPORTED)
    --
    --  * the error is together with the up-to-now accumulated errors are reported
    --   as part of the error message of the fatal error exception
    --
    --  * the current thread of control is discarded and control is passed to the
    --   innermost handler for fatal errors
    --
    --  * the first argument must contain a short description of the error, while
    --   the second and third argument are like the two arguments to `raise'
    --
    raiseFatal                :: String -> Position -> [String] -> PreCST e s a
    raiseFatal :: String -> Position -> [String] -> PreCST e s a
    raiseFatal short :: String
    short pos :: Position
    pos long :: [String]
    long  = String -> Error -> PreCST e s a
    forall e s a. String -> Error -> PreCST e s a
    raiseFatal0 String
    short (ErrorLvl -> Position -> [String] -> Error
    makeError ErrorLvl
    FatalErr Position
    pos [String]
    long)

    -- raise a fatal error; internal version that gets an abstract error
    --
    raiseFatal0           :: String -> Error -> PreCST e s a
    raiseFatal0 :: String -> Error -> PreCST e s a
    raiseFatal0 short :: String
    short err :: Error
    err  = do
                               Error -> PreCST e s ()
    forall e s. Error -> PreCST e s ()
    raise0 Error
    err
                               String
    errmsgs <- PreCST e s String
    forall e s. PreCST e s String
    showErrors
                               String -> PreCST e s a
    forall e s a. String -> PreCST e s a
    fatal (String
    short String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    errmsgs)

    -- raise an error; internal version, doesn't check whether the error is fatal
    --
    --  * the error is entered into the compiler state and a fatal error is
    --   triggered if the `errorLimit' is reached
    --
    raise0     :: Error -> PreCST e s ()
    raise0 :: Error -> PreCST e s ()
    raise0 err :: Error
    err  = do
                    Int
    noOfErrs <- STB (BaseState e) s Int -> PreCST e s Int
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s Int -> PreCST e s Int)
    -> STB (BaseState e) s Int -> PreCST e s Int
    forall a b. (a -> b) -> a -> b
    $ (BaseState e -> (BaseState e, Int)) -> STB (BaseState e) s Int
    forall bs a gs. (bs -> (bs, a)) -> STB bs gs a
    transBase BaseState e -> (BaseState e, Int)
    forall e. BaseState e -> (BaseState e, Int)
    doRaise
                    Bool -> PreCST e s () -> PreCST e s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    noOfErrs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    errorLimit) (PreCST e s () -> PreCST e s ()) -> PreCST e s () -> PreCST e s ()
    forall a b. (a -> b) -> a -> b
    $ do
                      String
    errmsgs <- PreCST e s String
    forall e s. PreCST e s String
    showErrors
                      String -> PreCST e s ()
    forall e s a. String -> PreCST e s a
    fatal ("Error limit of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    errorLimit
                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " errors has been reached.\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    errmsgs)
      where
        doRaise    :: BaseState e -> (BaseState e, Int)
        doRaise :: BaseState e -> (BaseState e, Int)
    doRaise bs :: BaseState e
    bs  = let
                        lvl :: ErrorLvl
    lvl                        = Error -> ErrorLvl
    errorLvl Error
    err
                        ErrorState wlvl :: ErrorLvl
    wlvl no :: Int
    no errs :: [Error]
    errs    = BaseState e -> ErrorState
    forall e. BaseState e -> ErrorState
    errorsBS BaseState e
    bs
                        wlvl' :: ErrorLvl
    wlvl'                      = ErrorLvl -> ErrorLvl -> ErrorLvl
    forall a. Ord a => a -> a -> a
    max ErrorLvl
    wlvl ErrorLvl
    lvl
                        no' :: Int
    no'                        = Int
    no Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + if ErrorLvl
    lvl ErrorLvl -> ErrorLvl -> Bool
    forall a. Ord a => a -> a -> Bool
    > ErrorLvl
    WarningErr
                                                          then 1 else 0
                        errs' :: [Error]
    errs'                      = Error
    err Error -> [Error] -> [Error]
    forall a. a -> [a] -> [a]
    : [Error]
    errs
                      in
                        (BaseState e
    bs {errorsBS :: ErrorState
    errorsBS = (ErrorLvl -> Int -> [Error] -> ErrorState
    ErrorState ErrorLvl
    wlvl' Int
    no' [Error]
    errs')}, Int
    no')

    -- yield a string containing the collected error messages (EXPORTED)
    --
    --  * the error state is reset in this process
    --
    showErrors :: PreCST e s String
    showErrors :: PreCST e s String
    showErrors  = STB (BaseState e) s String -> PreCST e s String
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s String -> PreCST e s String)
    -> STB (BaseState e) s String -> PreCST e s String
    forall a b. (a -> b) -> a -> b
    $ do
                    ErrorState wlvl :: ErrorLvl
    wlvl no :: Int
    no errs :: [Error]
    errs <- (BaseState e -> (BaseState e, ErrorState))
    -> STB (BaseState e) s ErrorState
    forall bs a gs. (bs -> (bs, a)) -> STB bs gs a
    transBase BaseState e -> (BaseState e, ErrorState)
    forall e. BaseState e -> (BaseState e, ErrorState)
    extractErrs
                    String -> STB (BaseState e) s String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> STB (BaseState e) s String)
    -> String -> STB (BaseState e) s String
    forall a b. (a -> b) -> a -> b
    $ ((String -> String) -> (String -> String) -> String -> String)
    -> (String -> String) -> [String -> String] -> String -> String
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) String -> String
    forall a. a -> a
    id ((String -> String -> String) -> [String] -> [String -> String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String -> String
    showString ([Error] -> [String]
    errsToStrs [Error]
    errs)) ""
                  where
                    extractErrs    :: BaseState e -> (BaseState e, ErrorState)
                    extractErrs :: BaseState e -> (BaseState e, ErrorState)
    extractErrs bs :: BaseState e
    bs  = (BaseState e
    bs {errorsBS :: ErrorState
    errorsBS = ErrorState
    initialErrorState},
                                       BaseState e -> ErrorState
    forall e. BaseState e -> ErrorState
    errorsBS BaseState e
    bs)

                    errsToStrs      :: [Error] -> [String]
                    errsToStrs :: [Error] -> [String]
    errsToStrs errs :: [Error]
    errs  = ((Error -> String) -> [Error] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Error -> String
    showError ([Error] -> [String])
    -> ([Error] -> [Error]) -> [Error] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Error] -> [Error]
    forall a. Ord a => [a] -> [a]
    sort) [Error]
    errs

    -- inquire if there was already an error of at least level `ErrorErr' raised
    -- (EXPORTED)
    --
    errorsPresent :: PreCST e s Bool
    errorsPresent :: PreCST e s Bool
    errorsPresent  = STB (BaseState e) s Bool -> PreCST e s Bool
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s Bool -> PreCST e s Bool)
    -> STB (BaseState e) s Bool -> PreCST e s Bool
    forall a b. (a -> b) -> a -> b
    $ do
                       ErrorState wlvl :: ErrorLvl
    wlvl no :: Int
    no _ <- (BaseState e -> ErrorState) -> STB (BaseState e) s ErrorState
    forall bs a gs. (bs -> a) -> STB bs gs a
    readBase BaseState e -> ErrorState
    forall e. BaseState e -> ErrorState
    errorsBS
                       Bool -> STB (BaseState e) s Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> STB (BaseState e) s Bool)
    -> Bool -> STB (BaseState e) s Bool
    forall a b. (a -> b) -> a -> b
    $ ErrorLvl
    wlvl ErrorLvl -> ErrorLvl -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ErrorLvl
    ErrorErr

    -- manipulating the extra state
    -- ----------------------------

    -- apply a reader function to the extra state and yield the reader's result
    -- (EXPORTED)
    --
    readExtra    :: (e -> a) -> PreCST e s a
    readExtra :: (e -> a) -> PreCST e s a
    readExtra rf :: e -> a
    rf  = STB (BaseState e) s a -> PreCST e s a
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s a -> PreCST e s a)
    -> STB (BaseState e) s a -> PreCST e s a
    forall a b. (a -> b) -> a -> b
    $ (BaseState e -> a) -> STB (BaseState e) s a
    forall bs a gs. (bs -> a) -> STB bs gs a
    readBase (\bs :: BaseState e
    bs ->
                            (e -> a
    rf (e -> a) -> (BaseState e -> e) -> BaseState e -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BaseState e -> e
    forall e. BaseState e -> e
    extraBS) BaseState e
    bs
                          )

    -- apply an update function to the extra state (EXPORTED)
    --
    updExtra    :: (e -> e) -> PreCST e s ()
    updExtra :: (e -> e) -> PreCST e s ()
    updExtra uf :: e -> e
    uf  = STB (BaseState e) s () -> PreCST e s ()
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s () -> PreCST e s ())
    -> STB (BaseState e) s () -> PreCST e s ()
    forall a b. (a -> b) -> a -> b
    $ (BaseState e -> (BaseState e, ())) -> STB (BaseState e) s ()
    forall bs a gs. (bs -> (bs, a)) -> STB bs gs a
    transBase (\bs :: BaseState e
    bs ->
                           let
                             es :: e
    es = BaseState e -> e
    forall e. BaseState e -> e
    extraBS BaseState e
    bs
                           in
                           (BaseState e
    bs {extraBS :: e
    extraBS = e -> e
    uf e
    es}, ())
                         )

    -- name supplies
    -- -------------

    -- Get a name supply out of the base state (EXPORTED)
    --
    getNameSupply :: PreCST e s NameSupply
    getNameSupply :: PreCST e s NameSupply
    getNameSupply  = STB (BaseState e) s NameSupply -> PreCST e s NameSupply
    forall e s a. STB (BaseState e) s a -> PreCST e s a
    CST (STB (BaseState e) s NameSupply -> PreCST e s NameSupply)
    -> STB (BaseState e) s NameSupply -> PreCST e s NameSupply
    forall a b. (a -> b) -> a -> b
    $ (BaseState e -> (BaseState e, NameSupply))
    -> STB (BaseState e) s NameSupply
    forall bs a gs. (bs -> (bs, a)) -> STB bs gs a
    transBase (\bs :: BaseState e
    bs ->
                             let
                               supply :: NameSupply
    supply : supplies :: [NameSupply]
    supplies = BaseState e -> [NameSupply]
    forall e. BaseState e -> [NameSupply]
    suppliesBS BaseState e
    bs
                             in
                             (BaseState e
    bs {suppliesBS :: [NameSupply]
    suppliesBS = [NameSupply]
    supplies}, NameSupply
    supply)
                           )