    --  The HiPar Toolkit: state transformer routines
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 3 March 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 provides basic support for the use of state transformers.
    --  The state transformer is build around the `IO' monad to allow the
    --  manipulation of external state. It encapsulated two separate states with
    --  the intention to use the first one for the omnipresent compiler state
    --  consisting of the accumulated error messages etc. and to use the second as
    --  a generic component that can be used in different ways by the different
    --  phases of the compiler.
    --
    --  The module also supports the use of exceptions and fatal errors.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  * We explicitly do not use any names for the monad types and functions
    --    that are used by either Haskell's `IO' monad or GHC's `ST' monad.  Since
    --    Haskell 1.4, `STB' is an instance of the `Monad' constructor class.
    --
    --  * To integrate the Haskell prelude `IO' monad into our `STB' monad we use
    --    the technique from ``Composing monads'' by Mark P. Jones and Luc
    --    Duponcheel (Report YALEU/DCS/RR-1004) from 1993, Section 8.
    --
    --  * The use of GHC's inplace-update goodies within monads of kind `STB' is
    --    possible, because `IO' is based on `ST' in the GHC.
    --
    --  * In the following, we call the two kinds of state managed by the `STB' the
    --    base state (the omnipresent state of the compiler) and generic state.
    --
    --  * `STB' is a newtype, which requires careful wrapping and unwrapping of its
    --    values in the following definitions.
    --
    --- TODO ----------------------------------------------------------------------
    --
    --  * with constructor classes, the state transformer business can be made
    --    more elegant (they weren't around when this module was initially written)
    --
    --  * it would be possible to maintain the already applied changes to the base
    --    and generic state even in the case of a fatal error, when in `listIO'
    --    every IO operation is encapsulated into a handler that transforms IO
    --    errors into exceptions
    --

    module StateTrans (-- the monad and the generic operations
                       --
                       STB, fixSTB,
                       --
                       -- monad specific operations
                       --
                       readBase, writeBase, transBase, readGeneric, writeGeneric,
                       transGeneric, liftIO, runSTB, interleave,
                       --
                       -- exception handling and fatal errors
                       --
                       throwExc, fatal, catchExc, fatalsHandledBy,
                       --
                       -- mutable variables and arrays
                       --
                       MVar, newMV, readMV, assignMV)
    where

    import Prelude hiding     (catch)

    import Control.Applicative (Applicative(..))
    import Control.Monad      (liftM, ap)
    import Control.Exception  (catch)
    import System.IO  (fixIO)
    import Data.IORef (IORef, newIORef, readIORef, writeIORef)

    import Errors (interr)

    infixr 1 +>=, +>

    -- BEWARE! You enter monad country. Read any of Wadler's or
    -- Launchbury/Peyton-Jones' texts before entering. Otherwise,
    -- your mental health my be in danger.  You have been warned!

    -- state transformer base and its monad operations
    -- -----------------------------------------------

    -- the generic form of a state transformer using the external state represented
    -- by `IO'; `STB' is a abbreviation for state transformer base
    --
    -- the first state component `bs' is provided for the omnipresent compiler
    -- state and the, second, `gs' for the generic component
    --
    -- the third component of the result distinguishes between erroneous and
    -- successful computations where
    --
    --   `Left (tag, msg)' -- stands for an exception identified by `tag' with
    --                        error message `msg', and
    --   `Right a'         -- is a successfully delivered result
    --

    newtype STB bs gs a = STB (bs -> gs -> IO (bs, gs, Either (String, String) a))

    instance Functor (STB bs gs) where
      fmap :: forall a b. (a -> b) -> STB bs gs a -> STB bs gs b
    fmap = (a -> b) -> STB bs gs a -> STB bs gs b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative (STB bs gs) where
      pure :: forall a. a -> STB bs gs a
    pure  = a -> STB bs gs a
    forall a bs gs. a -> STB bs gs a
    yield
      <*> :: forall a b. STB bs gs (a -> b) -> STB bs gs a -> STB bs gs b
    (<*>) = STB bs gs (a -> b) -> STB bs gs a -> STB bs gs b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
      *> :: forall a b. STB bs gs a -> STB bs gs b -> STB bs gs b
    (*>)  = STB bs gs a -> STB bs gs b -> STB bs gs b
    forall bs gs a b. STB bs gs a -> STB bs gs b -> STB bs gs b
    (+>)

    instance Monad (STB bs gs) where
      return :: forall a. a -> STB bs gs a
    return = a -> STB bs gs a
    forall a. a -> STB bs gs a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      >>= :: forall a b. STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    (>>=)  = STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    forall bs gs a b. STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    (+>=)
      >> :: forall a b. STB bs gs a -> STB bs gs b -> STB bs gs b
    (>>)   = STB bs gs a -> STB bs gs b -> STB bs gs b
    forall a b. STB bs gs a -> STB bs gs b -> STB bs gs b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)

    -- the monad's unit
    --
    yield   :: a -> STB bs gs a
    yield :: forall a bs gs. a -> STB bs gs a
    yield a
    a  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs, a -> Either (String, String) a
    forall a b. b -> Either a b
    Right a
    a)

    -- the monad's bind
    --
    --  * exceptions are propagated
    --
    (+>=)   :: STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    STB bs gs a
    m +>= :: forall bs gs a b. STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    +>= a -> STB bs gs b
    k  = let
                 STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' = STB bs gs a
    m
               in
               (bs -> gs -> IO (bs, gs, Either (String, String) b)) -> STB bs gs b
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) b))
     -> STB bs gs b)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) b))
    -> STB bs gs b
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' bs
    bs gs
    gs IO (bs, gs, Either (String, String) a)
    -> ((bs, gs, Either (String, String) a)
        -> IO (bs, gs, Either (String, String) b))
    -> IO (bs, gs, Either (String, String) b)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(bs
    bs', gs
    gs', Either (String, String) a
    res) ->
                         case Either (String, String) a
    res of
                           Left  (String, String)
    exc -> (bs, gs, Either (String, String) b)
    -> IO (bs, gs, Either (String, String) b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs', gs
    gs', (String, String) -> Either (String, String) b
    forall a b. a -> Either a b
    Left (String, String)
    exc)  -- prop exc
                           Right a
    a   -> let
                                          STB bs -> gs -> IO (bs, gs, Either (String, String) b)
    k' = a -> STB bs gs b
    k a
    a
                                        in
                                        bs -> gs -> IO (bs, gs, Either (String, String) b)
    k' bs
    bs' gs
    gs'                   -- cont

    -- bind dropping the result of the first state transformer
    --
    (+>)   :: STB bs gs a -> STB bs gs b -> STB bs gs b
    STB bs gs a
    k +> :: forall bs gs a b. STB bs gs a -> STB bs gs b -> STB bs gs b
    +> STB bs gs b
    m  = STB bs gs a
    k STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    forall bs gs a b. STB bs gs a -> (a -> STB bs gs b) -> STB bs gs b
    +>= STB bs gs b -> a -> STB bs gs b
    forall a b. a -> b -> a
    const STB bs gs b
    m

    -- fixpoint combinator in the monad
    --
    fixSTB   :: (a -> STB bs gs a) -> STB bs gs a
    --
    -- builds on the fixpoint combinator embedded within the IO monad; the
    -- future overall result wrapped into a closure with the function extracting
    -- the user-level result component is used to build the cycle
    --
    fixSTB :: forall a bs gs. (a -> STB bs gs a) -> STB bs gs a
    fixSTB a -> STB bs gs a
    m  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs
                      -> ((bs, gs, Either (String, String) a)
     -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall a. (a -> IO a) -> IO a
    fixIO (\(bs, gs, Either (String, String) a)
    future -> let
                                             STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' = a -> STB bs gs a
    m ((bs, gs, Either (String, String) a) -> a
    forall {a} {b} {a} {b}. (a, b, Either a b) -> b
    extractResult (bs, gs, Either (String, String) a)
    future)
                                           in
                                           bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' bs
    bs gs
    gs)
                where
                  extractResult :: (a, b, Either a b) -> b
    extractResult (a
    _, b
    _, Right b
    r) = b
    r
                  extractResult (a
    _, b
    _, Left a
    _ ) = String -> b
    forall a. String -> a
    interr String
    "StateTrans: fixSTB: \
                                                         \Tried to access result \
                                                         \of unsuccessful \
                                                         \recursive computation!"

    -- generic state manipulation
    -- --------------------------

    -- base state:
    --

    -- given a reader function for the base state, wrap it into an STB monad
    --
    readBase   :: (bs -> a) -> STB bs gs a
    readBase :: forall bs a gs. (bs -> a) -> STB bs gs a
    readBase bs -> a
    f  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs, a -> Either (String, String) a
    forall a b. b -> Either a b
    Right (bs -> a
    f bs
    bs))

    -- given a new base state, inject it into an STB monad
    --
    writeBase     :: bs -> STB bs gs ()
    writeBase :: forall bs gs. bs -> STB bs gs ()
    writeBase bs
    bs'  = (bs -> gs -> IO (bs, gs, Either (String, String) ()))
    -> STB bs gs ()
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) ()))
     -> STB bs gs ())
    -> (bs -> gs -> IO (bs, gs, Either (String, String) ()))
    -> STB bs gs ()
    forall a b. (a -> b) -> a -> b
    $ \bs
    _ gs
    gs -> (bs, gs, Either (String, String) ())
    -> IO (bs, gs, Either (String, String) ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs', gs
    gs, () -> Either (String, String) ()
    forall a b. b -> Either a b
    Right ())

    -- given a transformer function for the base state, wrap it into an STB monad
    --
    transBase   :: (bs -> (bs, a)) -> STB bs gs a
    transBase :: forall bs a gs. (bs -> (bs, a)) -> STB bs gs a
    transBase bs -> (bs, a)
    f  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> let
                                     (bs
    bs', a
    a) = bs -> (bs, a)
    f bs
    bs
                                   in
                                     (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs', gs
    gs, a -> Either (String, String) a
    forall a b. b -> Either a b
    Right a
    a)

    -- generic state:
    --

    -- given a reader function for the generic state, wrap it into an STB monad
    --
    readGeneric   :: (gs -> a) -> STB bs gs a
    readGeneric :: forall gs a bs. (gs -> a) -> STB bs gs a
    readGeneric gs -> a
    f  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs, a -> Either (String, String) a
    forall a b. b -> Either a b
    Right (gs -> a
    f gs
    gs))

    -- given a new generic state, inject it into an STB monad
    --
    writeGeneric     :: gs -> STB bs gs ()
    writeGeneric :: forall gs bs. gs -> STB bs gs ()
    writeGeneric gs
    gs'  = (bs -> gs -> IO (bs, gs, Either (String, String) ()))
    -> STB bs gs ()
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) ()))
     -> STB bs gs ())
    -> (bs -> gs -> IO (bs, gs, Either (String, String) ()))
    -> STB bs gs ()
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    _ -> (bs, gs, Either (String, String) ())
    -> IO (bs, gs, Either (String, String) ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs', () -> Either (String, String) ()
    forall a b. b -> Either a b
    Right ())

    -- given a transformer function for the generic state, wrap it into an STB
    -- monad
    --
    transGeneric   :: (gs -> (gs, a)) -> STB bs gs a
    transGeneric :: forall gs a bs. (gs -> (gs, a)) -> STB bs gs a
    transGeneric gs -> (gs, a)
    f  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> let
                                        (gs
    gs', a
    a) = gs -> (gs, a)
    f gs
    gs
                                      in
                                      (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs', a -> Either (String, String) a
    forall a b. b -> Either a b
    Right a
    a)

    -- interaction with the encapsulated `IO' monad
    -- --------------------------------------------

    -- lifts an `IO' state transformer into `STB'
    --
    liftIO   :: IO a -> STB bs gs a
    liftIO :: forall a bs gs. IO a -> STB bs gs a
    liftIO IO a
    m  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> IO a
    m IO a
    -> (a -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    r -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs, a -> Either (String, String) a
    forall a b. b -> Either a b
    Right a
    r)

    -- given an initial state, executes the `STB' state transformer yielding an
    -- `IO' state transformer that must be placed into the context of the external
    -- IO
    --
    --  * uncaught exceptions become fatal errors
    --
    runSTB         :: STB bs gs a -> bs -> gs -> IO a
    runSTB :: forall bs gs a. STB bs gs a -> bs -> gs -> IO a
    runSTB STB bs gs a
    m bs
    bs gs
    gs  = let
                        STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' = STB bs gs a
    m
                      in
                      bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' bs
    bs gs
    gs IO (bs, gs, Either (String, String) a)
    -> ((bs, gs, Either (String, String) a) -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(bs
    _, gs
    _, Either (String, String) a
    res) ->
                      case Either (String, String) a
    res of
                        Left  (String
    tag, String
    msg) -> let
                                              err :: IOError
    err = String -> IOError
    userError (String
    "Exception `"
                                                               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "': "
                                                               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)
                                            in
                                            IOError -> IO a
    forall a. IOError -> IO a
    ioError IOError
    err
                        Right a
    a          -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- interleave the (complete) execution of an `STB' with another generic state
    -- component into an `STB'
    --
    interleave :: STB bs gs' a -> gs' -> STB bs gs a
    interleave :: forall bs gs' a gs. STB bs gs' a -> gs' -> STB bs gs a
    interleave STB bs gs' a
    m gs'
    gs' = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ let
                               STB bs -> gs' -> IO (bs, gs', Either (String, String) a)
    m' = STB bs gs' a
    m
                             in
                             \bs
    bs gs
    gs
                             -> (bs -> gs' -> IO (bs, gs', Either (String, String) a)
    m' bs
    bs gs'
    gs' IO (bs, gs', Either (String, String) a)
    -> ((bs, gs', Either (String, String) a)
        -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(bs
    bs', gs'
    _, Either (String, String) a
    a) -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs', gs
    gs, Either (String, String) a
    a))

    -- error and exception handling
    -- ----------------------------

    --  * we exploit the `UserError' component of `IOError' for fatal errors
    --
    --  * we distinguish exceptions and user-defined fatal errors
    --
    --   - exceptions are meant to be caught in order to recover the currently
    --     executed operation; they turn into fatal errors if they are not caught;
    --     exceptions are tagged, which allows to deal with multiple kinds of
    --     exceptions at the same time and to handle them differently
    --   - user-defined fatal errors abort the currently executed operation, but
    --     they may be caught at the top-level in order to terminate gracefully or
    --     to invoke another operation; there is no special support for different
    --     handling of different kinds of fatal-errors
    --
    --  * the costs for fatal error handling are already incurred by the `IO' monad;
    --   the costs for exceptions mainly is the case distinction in the definition
    --   of `+>='
    --

    -- throw an exception with the given tag and message (EXPORTED)
    --
    throwExc         :: String -> String -> STB bs gs a
    throwExc :: forall bs gs a. String -> String -> STB bs gs a
    throwExc String
    tag String
    msg  = (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs
    bs, gs
    gs, (String, String) -> Either (String, String) a
    forall a b. a -> Either a b
    Left (String
    tag, String
    msg))

    -- raise a fatal user-defined error (EXPORTED)
    --
    --  * such an error my be caught and handled using `fatalsHandeledBy'
    --
    fatal   :: String -> STB bs gs a
    fatal :: forall bs gs a. String -> STB bs gs a
    fatal String
    s  = IO a -> STB bs gs a
    forall a bs gs. IO a -> STB bs gs a
    liftIO (IOError -> IO a
    forall a. IOError -> IO a
    ioError (String -> IOError
    userError String
    s))

    -- 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 base and generic 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                  :: STB bs gs a
                              -> (String, String -> STB bs gs a)
                              -> STB bs gs a
    catchExc :: forall bs gs a.
    STB bs gs a -> (String, String -> STB bs gs a) -> STB bs gs a
    catchExc STB bs gs a
    m (String
    tag, String -> STB bs gs a
    handler)  =
      (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs
            -> let
                 STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' = STB bs gs a
    m
               in
               bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' bs
    bs gs
    gs IO (bs, gs, Either (String, String) a)
    -> ((bs, gs, Either (String, String) a)
        -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \state :: (bs, gs, Either (String, String) a)
    state@(bs
    bs', gs
    gs', Either (String, String) a
    res) ->
               case Either (String, String) a
    res of
                 Left (String
    tag', String
    msg) -> if (String
    tag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    tag')       -- exception with...
                                     then
                                       let
                                         STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    handler' = String -> STB bs gs a
    handler String
    msg
                                       in
                                       bs -> gs -> IO (bs, gs, Either (String, String) a)
    handler' bs
    bs' gs
    gs'     -- correct tag, catch
                                     else
                                       (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs, gs, Either (String, String) a)
    state         -- wrong tag, rethrow
                 Right a
    _          -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs, gs, Either (String, String) a)
    state           -- no exception

    -- 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 :: STB bs gs a -> (IOError -> STB bs gs a) -> STB bs gs a
    fatalsHandledBy :: forall bs gs a.
    STB bs gs a -> (IOError -> STB bs gs a) -> STB bs gs a
    fatalsHandledBy STB bs gs a
    m IOError -> STB bs gs a
    handler  =
      (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    forall bs gs a.
    (bs -> gs -> IO (bs, gs, Either (String, String) a)) -> STB bs gs a
    STB ((bs -> gs -> IO (bs, gs, Either (String, String) a))
     -> STB bs gs a)
    -> (bs -> gs -> IO (bs, gs, Either (String, String) a))
    -> STB bs gs a
    forall a b. (a -> b) -> a -> b
    $ \bs
    bs gs
    gs
            -> (let
                  STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' = STB bs gs a
    m
                in
                bs -> gs -> IO (bs, gs, Either (String, String) a)
    m' bs
    bs gs
    gs IO (bs, gs, Either (String, String) a)
    -> ((bs, gs, Either (String, String) a)
        -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \state :: (bs, gs, Either (String, String) a)
    state@(bs
    gs', gs
    bs', Either (String, String) a
    res) ->
                case Either (String, String) a
    res of
                  Left  (String
    tag, String
    msg) -> let
                                        err :: IOError
    err = String -> IOError
    userError (String
    "Exception `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tag
                                                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "': " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg)
                                      in
                                      IOError -> IO (bs, gs, Either (String, String) a)
    forall a. IOError -> IO a
    ioError IOError
    err
                  Right a
    a          -> (bs, gs, Either (String, String) a)
    -> IO (bs, gs, Either (String, String) a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (bs, gs, Either (String, String) a)
    state
                )
                IO (bs, gs, Either (String, String) a)
    -> (IOError -> IO (bs, gs, Either (String, String) a))
    -> IO (bs, gs, Either (String, String) a)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` (\IOError
    err -> let
                                   STB bs -> gs -> IO (bs, gs, Either (String, String) a)
    handler' = IOError -> STB bs gs a
    handler IOError
    err
                                 in
                                 bs -> gs -> IO (bs, gs, Either (String, String) a)
    handler' bs
    bs gs
    gs)

    -- list mutable variables and arrays stuff into `STB'; all (EXPORTED)
    -- ------------------------------------------------------------------

    type MVar a   = IORef a

    newMV   :: a -> STB bs gs (MVar a)
    newMV :: forall a bs gs. a -> STB bs gs (MVar a)
    newMV a
    x  = IO (MVar a) -> STB bs gs (MVar a)
    forall a bs gs. IO a -> STB bs gs a
    liftIO (a -> IO (MVar a)
    forall a. a -> IO (IORef a)
    newIORef a
    x)

    readMV    :: MVar a -> STB bs gs a
    readMV :: forall a bs gs. MVar a -> STB bs gs a
    readMV MVar a
    mv  = IO a -> STB bs gs a
    forall a bs gs. IO a -> STB bs gs a
    liftIO (MVar a -> IO a
    forall a. IORef a -> IO a
    readIORef MVar a
    mv)

    assignMV      :: MVar a -> a -> STB bs gs ()
    assignMV :: forall a bs gs. MVar a -> a -> STB bs gs ()
    assignMV MVar a
    mv a
    x  = IO () -> STB bs gs ()
    forall a bs gs. IO a -> STB bs gs a
    liftIO (MVar a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef MVar a
    mv a
    x)