    module GHC.RTS.Events.Analysis
      ( Machine (..)
      , validate
      , validates
      , simulate
      , Profile (..)
      , profile
      , profileIndexed
      , profileRouted
      , extractIndexed
      , refineM
      , profileM
      , indexM
      , toList
      , toMaybe
      , Process (..)
      , routeM
      )
     where

    import GHC.RTS.Events

    import Data.Map (Map)
    import qualified Data.Map as M
    import Data.Maybe (fromMaybe)

    --------------------------------------------------------------------------------
    -- | This is based on a simple finite state machine hence the names `delta`
    -- for the state transition function.
    -- Since states might be more than simple pattern matched constructors, we
    -- use `finals :: state -> Bool`, rather than `Set state`, to indicate that
    -- the machine is in some final state. Similarly for `alpha`, which
    -- indicates the alphabet of inputs to a machine.
    -- The function `delta` returns `Maybe` values, where `Nothing`
    -- indicates that no valid transition is possible: ie, there has been an
    -- error.
    data Machine s i = Machine
      { forall s i. Machine s i -> s
    initial :: s                 -- ^ Initial state
      , forall s i. Machine s i -> s -> Bool
    final   :: s -> Bool         -- ^ Valid final states
      , forall s i. Machine s i -> i -> Bool
    alpha   :: i -> Bool         -- ^ Valid input alphabet
      , forall s i. Machine s i -> s -> i -> Maybe s
    delta   :: s -> i -> Maybe s -- ^ State transition function
      }

    -- | The `step` function runs a machine in a state against a single input.
    -- The state remains fixed once a final state is encountered. The
    -- result is `Left state input` if some `state` failed for an `ìnput`, and
    -- `Right state` for a successful state.
    step :: Machine s i -> s -> i -> Either (s, i) s
    step :: forall s i. Machine s i -> s -> i -> Either (s, i) s
    step Machine s i
    m s
    s i
    i
      | Machine s i -> s -> Bool
    forall s i. Machine s i -> s -> Bool
    final Machine s i
    m s
    s = s -> Either (s, i) s
    forall a b. b -> Either a b
    Right s
    s
      | Machine s i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s i
    m i
    i = case Machine s i -> s -> i -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s i
    m s
    s i
    i of
          Just s
    s' -> s -> Either (s, i) s
    forall a b. b -> Either a b
    Right s
    s'
          Maybe s
    Nothing -> (s, i) -> Either (s, i) s
    forall a b. a -> Either a b
    Left (s
    s, i
    i)
      | Bool
    otherwise = s -> Either (s, i) s
    forall a b. b -> Either a b
    Right s
    s

    -- | The `validate` function takes a machine and a list of inputs. The machine
    -- is started from its initial state and run against the inputs in turn.
    -- It returns the state and input on failure, and just the state on success.
    validate :: Machine s i -> [i] -> Either (s, i) s
    validate :: forall s i. Machine s i -> [i] -> Either (s, i) s
    validate Machine s i
    m = (Either (s, i) s -> (s -> Either (s, i) s) -> Either (s, i) s)
    -> Either (s, i) s -> [s -> Either (s, i) s] -> Either (s, i) s
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Either (s, i) s -> (s -> Either (s, i) s) -> Either (s, i) s
    forall a b.
    Either (s, i) a -> (a -> Either (s, i) b) -> Either (s, i) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=) (s -> Either (s, i) s
    forall a b. b -> Either a b
    Right (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    m)) ([s -> Either (s, i) s] -> Either (s, i) s)
    -> ([i] -> [s -> Either (s, i) s]) -> [i] -> Either (s, i) s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (i -> s -> Either (s, i) s) -> [i] -> [s -> Either (s, i) s]
    forall a b. (a -> b) -> [a] -> [b]
    map ((s -> i -> Either (s, i) s) -> i -> s -> Either (s, i) s
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Machine s i -> s -> i -> Either (s, i) s
    forall s i. Machine s i -> s -> i -> Either (s, i) s
    step Machine s i
    m))

    -- | This function is similar to `validate`, but outputs each intermediary
    -- state as well. For an incremental version, use `simulate`.
    validates :: Machine s i -> [i] -> [Either (s, i) s]
    validates :: forall s i. Machine s i -> [i] -> [Either (s, i) s]
    validates Machine s i
    m = (Either (s, i) s -> (s -> Either (s, i) s) -> Either (s, i) s)
    -> Either (s, i) s -> [s -> Either (s, i) s] -> [Either (s, i) s]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl Either (s, i) s -> (s -> Either (s, i) s) -> Either (s, i) s
    forall a b.
    Either (s, i) a -> (a -> Either (s, i) b) -> Either (s, i) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=) (s -> Either (s, i) s
    forall a b. b -> Either a b
    Right (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    m)) ([s -> Either (s, i) s] -> [Either (s, i) s])
    -> ([i] -> [s -> Either (s, i) s]) -> [i] -> [Either (s, i) s]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (i -> s -> Either (s, i) s) -> [i] -> [s -> Either (s, i) s]
    forall a b. (a -> b) -> [a] -> [b]
    map ((s -> i -> Either (s, i) s) -> i -> s -> Either (s, i) s
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Machine s i -> s -> i -> Either (s, i) s
    forall s i. Machine s i -> s -> i -> Either (s, i) s
    step Machine s i
    m))

    --------------------------------------------------------------------------------
    -- A Process is a list of successful values, followed by an error if one
    -- occurred. This captures the idea that a computation may produce a list of
    -- elements before possibly failing. This gives us an incremental interface
    -- to data processed from machine transitions.
    data Process e a
      = Done
      | Fail e
      | Prod a (Process e a)
     deriving Int -> Process e a -> ShowS
    [Process e a] -> ShowS
    Process e a -> String
    (Int -> Process e a -> ShowS)
    -> (Process e a -> String)
    -> ([Process e a] -> ShowS)
    -> Show (Process e a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall e a. (Show e, Show a) => Int -> Process e a -> ShowS
    forall e a. (Show e, Show a) => [Process e a] -> ShowS
    forall e a. (Show e, Show a) => Process e a -> String
    $cshowsPrec :: forall e a. (Show e, Show a) => Int -> Process e a -> ShowS
    showsPrec :: Int -> Process e a -> ShowS
    $cshow :: forall e a. (Show e, Show a) => Process e a -> String
    show :: Process e a -> String
    $cshowList :: forall e a. (Show e, Show a) => [Process e a] -> ShowS
    showList :: [Process e a] -> ShowS
    Show

    toList :: Process e a -> [a]
    toList :: forall e a. Process e a -> [a]
    toList (Fail e
    _)    = []
    toList Process e a
    Done        = []
    toList (Prod a
    a Process e a
    as) = a
    a a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Process e a -> [a]
    forall e a. Process e a -> [a]
    toList Process e a
    as

    toMaybe :: Process e a -> Maybe e
    toMaybe :: forall e a. Process e a -> Maybe e
    toMaybe (Fail e
    e)    = e -> Maybe e
    forall a. a -> Maybe a
    Just e
    e
    toMaybe Process e a
    Done        = Maybe e
    forall a. Maybe a
    Nothing
    toMaybe (Prod a
    _ Process e a
    as) = Process e a -> Maybe e
    forall e a. Process e a -> Maybe e
    toMaybe Process e a
    as

    -- | A machine can be analysed while it is accepting input in order to extract
    -- some information. This function takes a machine and a function that extracts
    -- data and produces output. On failure, the machine state and input are
    -- produced. Note that when an input is not in the machine's alphabet,
    -- then there is no transition, and so no output is produced in response
    -- to that input.
    analyse :: Machine s i          -- ^ The machine used
            -> (s -> i -> Maybe o)  -- ^ An extraction function that may produce output
            -> [i]                  -- ^ A list of input
            -> Process (s, i) o     -- ^ A process that produces output
    analyse :: forall s i o.
    Machine s i -> (s -> i -> Maybe o) -> [i] -> Process (s, i) o
    analyse Machine s i
    machine s -> i -> Maybe o
    extract = s -> [i] -> Process (s, i) o
    go (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    machine)
     where
      -- go :: s -> [i] -> Process (s, i) o
      go :: s -> [i] -> Process (s, i) o
    go s
    _ [] = Process (s, i) o
    forall e a. Process e a
    Done
      go s
    s (i
    i:[i]
    is)
        | Machine s i -> s -> Bool
    forall s i. Machine s i -> s -> Bool
    final Machine s i
    machine s
    s = Process (s, i) o
    forall e a. Process e a
    Done
        | Machine s i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s i
    machine i
    i =
            case Machine s i -> s -> i -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s i
    machine s
    s i
    i of
              Maybe s
    Nothing -> (s, i) -> Process (s, i) o
    forall e a. e -> Process e a
    Fail (s
    s, i
    i)
              Just s
    s' ->
                case s -> i -> Maybe o
    extract s
    s i
    i of
                  Maybe o
    Nothing -> s -> [i] -> Process (s, i) o
    go s
    s' [i]
    is
                  Just o
    o  -> o -> Process (s, i) o -> Process (s, i) o
    forall e a. a -> Process e a -> Process e a
    Prod o
    o (s -> [i] -> Process (s, i) o
    go s
    s' [i]
    is)
        | Bool
    otherwise = s -> [i] -> Process (s, i) o
    go s
    s [i]
    is

    -- | Machines sometimes need to operate on coarser input than they are defined
    -- for. This function takes a function that refines input and a machine that
    -- works on refined input, and produces a machine that can work on coarse input.
    refineM :: (i -> j) -> Machine s j -> Machine s i
    refineM :: forall i j s. (i -> j) -> Machine s j -> Machine s i
    refineM i -> j
    refine Machine s j
    machine = Machine
      { initial :: s
    initial = Machine s j -> s
    forall s i. Machine s i -> s
    initial Machine s j
    machine
      , final :: s -> Bool
    final   = Machine s j -> s -> Bool
    forall s i. Machine s i -> s -> Bool
    final Machine s j
    machine
      , alpha :: i -> Bool
    alpha   = Machine s j -> j -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s j
    machine (j -> Bool) -> (i -> j) -> i -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> j
    refine
      , delta :: s -> i -> Maybe s
    delta   = \s
    s -> Machine s j -> s -> j -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s j
    machine s
    s (j -> Maybe s) -> (i -> j) -> i -> Maybe s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> j
    refine
      }

    --------------------------------------------------------------------------------
    -- | This function produces a process that outputs all the states that a
    -- machine goes through.
    simulate :: Machine s i -> [i] -> Process (s, i) (s, i)
    simulate :: forall s i. Machine s i -> [i] -> Process (s, i) (s, i)
    simulate Machine s i
    machine = Machine s i
    -> (s -> i -> Maybe (s, i)) -> [i] -> Process (s, i) (s, i)
    forall s i o.
    Machine s i -> (s -> i -> Maybe o) -> [i] -> Process (s, i) o
    analyse Machine s i
    machine (\s
    s i
    i -> Machine s i -> s -> i -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s i
    machine s
    s i
    i Maybe s -> (s -> Maybe (s, i)) -> Maybe (s, i)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \s
    s' -> (s, i) -> Maybe (s, i)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s
    s', i
    i))

    --------------------------------------------------------------------------------
    -- | A state augmented by Timestamp information is held in `profileState`.
    -- When the state changes, `profileMap` stores a map between each state
    -- and its cumulative time.
    data Profile s = Profile
      { forall s. Profile s -> s
    profileState :: s               -- ^ The current state
      , forall s. Profile s -> Timestamp
    profileTime  :: Timestamp       -- ^ The entry time of the state
      } deriving (Int -> Profile s -> ShowS
    [Profile s] -> ShowS
    Profile s -> String
    (Int -> Profile s -> ShowS)
    -> (Profile s -> String)
    -> ([Profile s] -> ShowS)
    -> Show (Profile s)
    forall s. Show s => Int -> Profile s -> ShowS
    forall s. Show s => [Profile s] -> ShowS
    forall s. Show s => Profile s -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall s. Show s => Int -> Profile s -> ShowS
    showsPrec :: Int -> Profile s -> ShowS
    $cshow :: forall s. Show s => Profile s -> String
    show :: Profile s -> String
    $cshowList :: forall s. Show s => [Profile s] -> ShowS
    showList :: [Profile s] -> ShowS
    Show)

    -- | This function takes a machine and profiles its state.
    profileM :: Ord s
             => (i -> Timestamp)
             -> Machine s i
             -> Machine (Profile s) i
    profileM :: forall s i.
    Ord s =>
    (i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    profileM i -> Timestamp
    timer Machine s i
    machine = Machine
      { initial :: Profile s
    initial = s -> Timestamp -> Profile s
    forall s. s -> Timestamp -> Profile s
    Profile (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    machine) Timestamp
    0
      , final :: Profile s -> Bool
    final   = Machine s i -> s -> Bool
    forall s i. Machine s i -> s -> Bool
    final Machine s i
    machine (s -> Bool) -> (Profile s -> s) -> Profile s -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Profile s -> s
    forall s. Profile s -> s
    profileState
      , alpha :: i -> Bool
    alpha   = Machine s i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s i
    machine
      , delta :: Profile s -> i -> Maybe (Profile s)
    delta   = Profile s -> i -> Maybe (Profile s)
    profileMDelta
      }
     where
      profileMDelta :: Profile s -> i -> Maybe (Profile s)
    profileMDelta (Profile s
    s Timestamp
    _) i
    i = do
        s' <- Machine s i -> s -> i -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s i
    machine s
    s i
    i
        return $ Profile s' (timer i)

    -- | extractProfile returns the state, the time this state was made,
    -- and the time spent in this state.
    extractProfile :: (i -> Timestamp)                -- ^ Extracts current timestamp
                   -> Profile s                       -- ^ A profiled state
                   -> i                               -- ^ Some input
                   -> Maybe (s, Timestamp, Timestamp) -- ^ (state, currentTime, elapsedTime)
    extractProfile :: forall i s.
    (i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    extractProfile i -> Timestamp
    timer Profile s
    p i
    i = (s, Timestamp, Timestamp) -> Maybe (s, Timestamp, Timestamp)
    forall a. a -> Maybe a
    Just (Profile s -> s
    forall s. Profile s -> s
    profileState Profile s
    p, Profile s -> Timestamp
    forall s. Profile s -> Timestamp
    profileTime Profile s
    p, i -> Timestamp
    timer i
    i Timestamp -> Timestamp -> Timestamp
    forall a. Num a => a -> a -> a
    - Profile s -> Timestamp
    forall s. Profile s -> Timestamp
    profileTime Profile s
    p)

    profile :: (Ord s, Eq s)
            => Machine s i       -- ^ A machine to profile
            -> (i -> Timestamp)  -- ^ Converts input to timestamps
            -> [i]               -- ^ The list of input
            -> Process (Profile s, i) (s, Timestamp, Timestamp)
    profile :: forall s i.
    (Ord s, Eq s) =>
    Machine s i
    -> (i -> Timestamp)
    -> [i]
    -> Process (Profile s, i) (s, Timestamp, Timestamp)
    profile Machine s i
    machine i -> Timestamp
    timer =
      Machine (Profile s) i
    -> (Profile s -> i -> Maybe (s, Timestamp, Timestamp))
    -> [i]
    -> Process (Profile s, i) (s, Timestamp, Timestamp)
    forall s i o.
    Machine s i -> (s -> i -> Maybe o) -> [i] -> Process (s, i) o
    analyse ((i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    forall s i.
    Ord s =>
    (i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    profileM i -> Timestamp
    timer Machine s i
    machine)
              ((i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    forall i s.
    (i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    extractProfile i -> Timestamp
    timer)

    profileIndexed :: (Ord k, Ord s, Eq s)
                   => Machine s i
                   -> (i -> Maybe k)
                   -> (i -> Timestamp)
                   -> [i]
                   -> Process (Map k (Profile s), i) (k, (s, Timestamp, Timestamp))
    profileIndexed :: forall k s i.
    (Ord k, Ord s, Eq s) =>
    Machine s i
    -> (i -> Maybe k)
    -> (i -> Timestamp)
    -> [i]
    -> Process (Map k (Profile s), i) (k, (s, Timestamp, Timestamp))
    profileIndexed Machine s i
    machine i -> Maybe k
    index i -> Timestamp
    timer =
      Machine (Map k (Profile s)) i
    -> (Map k (Profile s) -> i -> Maybe (k, (s, Timestamp, Timestamp)))
    -> [i]
    -> Process (Map k (Profile s), i) (k, (s, Timestamp, Timestamp))
    forall s i o.
    Machine s i -> (s -> i -> Maybe o) -> [i] -> Process (s, i) o
    analyse ((i -> Maybe k)
    -> Machine (Profile s) i -> Machine (Map k (Profile s)) i
    forall k i s.
    Ord k =>
    (i -> Maybe k) -> Machine s i -> Machine (Map k s) i
    indexM i -> Maybe k
    index ((i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    forall s i.
    Ord s =>
    (i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    profileM i -> Timestamp
    timer Machine s i
    machine))
              ((Profile s -> i -> Maybe (s, Timestamp, Timestamp))
    -> (i -> Maybe k)
    -> Map k (Profile s)
    -> i
    -> Maybe (k, (s, Timestamp, Timestamp))
    forall k s i o.
    Ord k =>
    (s -> i -> Maybe o)
    -> (i -> Maybe k) -> Map k s -> i -> Maybe (k, o)
    extractIndexed ((i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    forall i s.
    (i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    extractProfile i -> Timestamp
    timer) i -> Maybe k
    index)

    extractIndexed :: Ord k => (s -> i -> Maybe o) -> (i -> Maybe k) -> (Map k s -> i -> Maybe (k, o))
    extractIndexed :: forall k s i o.
    Ord k =>
    (s -> i -> Maybe o)
    -> (i -> Maybe k) -> Map k s -> i -> Maybe (k, o)
    extractIndexed s -> i -> Maybe o
    extract i -> Maybe k
    index Map k s
    m i
    i = do
      k <- i -> Maybe k
    index i
    i
      s <- M.lookup k m
      o <- extract s i
      return (k, o)

    -- | An indexed machine takes a function that multiplexes the input to a key
    -- and then takes a machine description to an indexed machine.
    indexM :: Ord k
           => (i -> Maybe k)        -- ^ An indexing function
           -> Machine s i           -- ^ A machine to index with
           -> Machine (Map k s) i   -- ^ The indexed machine
    indexM :: forall k i s.
    Ord k =>
    (i -> Maybe k) -> Machine s i -> Machine (Map k s) i
    indexM i -> Maybe k
    index Machine s i
    machine = Machine
      { initial :: Map k s
    initial = Map k s
    forall k a. Map k a
    M.empty
      , final :: Map k s -> Bool
    final   = Map k s -> Bool
    forall {b}. b -> Bool
    indexMFinal
      , alpha :: i -> Bool
    alpha   = i -> Bool
    indexMAlpha
      , delta :: Map k s -> i -> Maybe (Map k s)
    delta   = Map k s -> i -> Maybe (Map k s)
    indexMDelta
      }
     where
      -- An indexer never reaches a final state: it is always possible that
      -- an event comes along that is accepted by a machine that is not
      -- yet in in the index.
      --
      -- An alternative view is that the indexer is in a final state if all its
      -- elements are, but this would not allow the creation of new indexes:
      --     indexMFinal m = not (M.null m) && (all (final machine) . M.elems $ m)
      indexMFinal :: b -> Bool
    indexMFinal = Bool -> b -> Bool
    forall a b. a -> b -> a
    const Bool
    False

      -- The alphabet of the indexer is that of its elements.
      indexMAlpha :: i -> Bool
    indexMAlpha = Machine s i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s i
    machine

      -- If the index is not yet in the mapping, we start a new machine in its
      -- initial state. The indexer fails if indexed state fails.
      indexMDelta :: Map k s -> i -> Maybe (Map k s)
    indexMDelta Map k s
    m i
    i = do
        k <- i -> Maybe k
    index i
    i
        let state = s -> Maybe s -> s
    forall a. a -> Maybe a -> a
    fromMaybe (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    machine) (k -> Map k s -> Maybe s
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup k
    k Map k s
    m)
        state' <- delta machine state i
        return $ M.insert k state' m

    profileRouted :: (Ord k, Ord s, Eq s, Eq r)
                  => Machine s i
                  -> Machine r i
                  -> (r -> i -> Maybe k)
                  -> (i -> Timestamp)
                  -> [i]
                  -> Process ((Map k (Profile s), r), i) (k, (s, Timestamp, Timestamp))
    profileRouted :: forall k s r i.
    (Ord k, Ord s, Eq s, Eq r) =>
    Machine s i
    -> Machine r i
    -> (r -> i -> Maybe k)
    -> (i -> Timestamp)
    -> [i]
    -> Process
         ((Map k (Profile s), r), i) (k, (s, Timestamp, Timestamp))
    profileRouted Machine s i
    machine Machine r i
    router r -> i -> Maybe k
    index i -> Timestamp
    timer =
      Machine (Map k (Profile s), r) i
    -> ((Map k (Profile s), r)
        -> i -> Maybe (k, (s, Timestamp, Timestamp)))
    -> [i]
    -> Process
         ((Map k (Profile s), r), i) (k, (s, Timestamp, Timestamp))
    forall s i o.
    Machine s i -> (s -> i -> Maybe o) -> [i] -> Process (s, i) o
    analyse (Machine r i
    -> (r -> i -> Maybe k)
    -> Machine (Profile s) i
    -> Machine (Map k (Profile s), r) i
    forall k r i s.
    Ord k =>
    Machine r i
    -> (r -> i -> Maybe k) -> Machine s i -> Machine (Map k s, r) i
    routeM Machine r i
    router r -> i -> Maybe k
    index ((i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    forall s i.
    Ord s =>
    (i -> Timestamp) -> Machine s i -> Machine (Profile s) i
    profileM i -> Timestamp
    timer Machine s i
    machine))
              ((Profile s -> i -> Maybe (s, Timestamp, Timestamp))
    -> (r -> i -> Maybe k)
    -> (Map k (Profile s), r)
    -> i
    -> Maybe (k, (s, Timestamp, Timestamp))
    forall k s i o r.
    Ord k =>
    (s -> i -> Maybe o)
    -> (r -> i -> Maybe k) -> (Map k s, r) -> i -> Maybe (k, o)
    extractRouted ((i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    forall i s.
    (i -> Timestamp)
    -> Profile s -> i -> Maybe (s, Timestamp, Timestamp)
    extractProfile i -> Timestamp
    timer) r -> i -> Maybe k
    index)

    extractRouted :: Ord k => (s -> i -> Maybe o) -> (r -> i -> Maybe k) -> ((Map k s, r)  -> i -> Maybe (k, o))
    extractRouted :: forall k s i o r.
    Ord k =>
    (s -> i -> Maybe o)
    -> (r -> i -> Maybe k) -> (Map k s, r) -> i -> Maybe (k, o)
    extractRouted s -> i -> Maybe o
    extract r -> i -> Maybe k
    index (Map k s
    m, r
    r) i
    i = do
      k <- r -> i -> Maybe k
    index r
    r i
    i
      s <- M.lookup k m
      o <- extract s i
      return (k, o)

    -- | A machine can be indexed not only by the inputs, but also by the state
    -- of an intermediary routing machine. This is a generalisation of indexM.
    routeM :: (Ord k)
           => Machine r i
           -> (r -> i -> Maybe k)
           -> Machine s i
           -> Machine (Map k s, r) i
    routeM :: forall k r i s.
    Ord k =>
    Machine r i
    -> (r -> i -> Maybe k) -> Machine s i -> Machine (Map k s, r) i
    routeM Machine r i
    router r -> i -> Maybe k
    index Machine s i
    machine = Machine
      { initial :: (Map k s, r)
    initial = (Map k s
    forall k a. Map k a
    M.empty, Machine r i -> r
    forall s i. Machine s i -> s
    initial Machine r i
    router)
      , final :: (Map k s, r) -> Bool
    final   = (Map k s, r) -> Bool
    forall {b}. b -> Bool
    routeMFinal
      , alpha :: i -> Bool
    alpha   = i -> Bool
    routeMAlpha
      , delta :: (Map k s, r) -> i -> Maybe (Map k s, r)
    delta   = (Map k s, r) -> i -> Maybe (Map k s, r)
    routeMDelta
      }
     where
      -- As with indexers, there is no final state.
      routeMFinal :: b -> Bool
    routeMFinal = Bool -> b -> Bool
    forall a b. a -> b -> a
    const Bool
    False

      -- The alphabet is that of the router combined with the machine
      routeMAlpha :: i -> Bool
    routeMAlpha i
    i = Machine r i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine r i
    router i
    i Bool -> Bool -> Bool
    || Machine s i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine s i
    machine i
    i

      routeMDelta :: (Map k s, r) -> i -> Maybe (Map k s, r)
    routeMDelta (Map k s
    m, r
    r) i
    i = do
        r' <- if Machine r i -> i -> Bool
    forall s i. Machine s i -> i -> Bool
    alpha Machine r i
    router i
    i
              then Machine r i -> r -> i -> Maybe r
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine r i
    router r
    r i
    i
              else r -> Maybe r
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    r
        m' <- if alpha machine i
              then case index r' i of
                Just k
    k -> do
                  s' <- Machine s i -> s -> i -> Maybe s
    forall s i. Machine s i -> s -> i -> Maybe s
    delta Machine s i
    machine (s -> Maybe s -> s
    forall a. a -> Maybe a -> a
    fromMaybe (Machine s i -> s
    forall s i. Machine s i -> s
    initial Machine s i
    machine) (k -> Map k s -> Maybe s
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup k
    k Map k s
    m)) i
    i
                  return $ M.insert k s' m
                Maybe k
    Nothing -> Map k s -> Maybe (Map k s)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map k s
    m
              else return m
        return (m', r')