{-# LANGUAGE GADTs #-}{-# LANGUAGE Rank2Types #-}------------------------------------------------------------------------------- |-- Module : Data.Machine.Stack-- Copyright : (C) 2012 Edward Kmett-- License : BSD-style (see the file LICENSE)---- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : provisional-- Portability : GADTs------------------------------------------------------------------------------moduleData.Machine.Stack(Stack (..),stack ,peek ,pop ,push )whereimportData.Machine.Plan importData.Machine.Type -- | This is a simple process type that knows how to push back input.dataStack a r wherePush ::a ->Stack a ()Pop ::Stack a a -- | Peek at the next value in the input stream without consuming itpeek ::Plan (Stack a )b a peek :: forall a b (m :: * -> *). PlanT (Stack a) b m a
peek =doa
a <-PlanT (Stack a) b m a
forall a b (m :: * -> *). PlanT (Stack a) b m a
pop a -> Plan (Stack a) b ()
forall a b. a -> Plan (Stack a) b ()
push a
a a -> PlanT (Stack a) b m a
forall a. a -> PlanT (Stack a) b m a
forall (m :: * -> *) a. Monad m => a -> m a
returna
a {-# INLINABLEpeek #-}-- | Push back into the input streampush ::a ->Plan (Stack a )b ()push :: forall a b. a -> Plan (Stack a) b ()
push a
a =Stack a () -> Plan (Stack a) b ()
forall (k :: * -> *) i o. k i -> Plan k o i
awaits (a -> Stack a ()
forall a. a -> Stack a ()
Push a
a ){-# INLINABLEpush #-}-- | Pop the next value in the input streampop ::Plan (Stack a )b a pop :: forall a b (m :: * -> *). PlanT (Stack a) b m a
pop =Stack a a -> Plan (Stack a) b a
forall (k :: * -> *) i o. k i -> Plan k o i
awaits Stack a a
forall a. Stack a a
Pop {-# INLINABLEpop #-}-- | Stream outputs from one 'Machine' into another with the possibility-- of pushing inputs back.stack ::Monadm =>MachineT m k a ->MachineT m (Stack a )o ->MachineT m k o stack :: forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
stack MachineT m k a
up MachineT m (Stack a) o
down =MachineT m (Stack a) o
-> (Step (Stack a) o (MachineT m (Stack a) o) -> MachineT m k o)
-> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o (k' :: * -> *) o'.
Monad m =>
MachineT m k o
-> (Step k o (MachineT m k o) -> MachineT m k' o')
-> MachineT m k' o'
stepMachine MachineT m (Stack a) o
down ((Step (Stack a) o (MachineT m (Stack a) o) -> MachineT m k o)
 -> MachineT m k o)
-> (Step (Stack a) o (MachineT m (Stack a) o) -> MachineT m k o)
-> MachineT m k o
forall a b. (a -> b) -> a -> b
$\Step (Stack a) o (MachineT m (Stack a) o)
stepD ->caseStep (Stack a) o (MachineT m (Stack a) o)
stepD ofStep (Stack a) o (MachineT m (Stack a) o)
Stop ->MachineT m k o
forall (k :: * -> *) b (m :: * -> *). Monad m => MachineT m k b
stopped Yield o
o MachineT m (Stack a) o
down' ->Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (MachineT m k a
up MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` MachineT m (Stack a) o
down' ))Await t -> MachineT m (Stack a) o
down' (Push a
a )MachineT m (Stack a) o
_->Step k a (MachineT m k a) -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (a -> MachineT m k a -> Step k a (MachineT m k a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
a MachineT m k a
up )MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` t -> MachineT m (Stack a) o
down' ()Await t -> MachineT m (Stack a) o
down' Stack a t
Pop MachineT m (Stack a) o
ffD ->MachineT m k a
-> (Step k a (MachineT m k a) -> MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o (k' :: * -> *) o'.
Monad m =>
MachineT m k o
-> (Step k o (MachineT m k o) -> MachineT m k' o')
-> MachineT m k' o'
stepMachine MachineT m k a
up ((Step k a (MachineT m k a) -> MachineT m k o) -> MachineT m k o)
-> (Step k a (MachineT m k a) -> MachineT m k o) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$\Step k a (MachineT m k a)
stepU ->caseStep k a (MachineT m k a)
stepU ofStep k a (MachineT m k a)
Stop ->MachineT m k a
forall (k :: * -> *) b (m :: * -> *). Monad m => MachineT m k b
stopped MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` MachineT m (Stack a) o
ffD Yield a
o MachineT m k a
up' ->MachineT m k a
up' MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` t -> MachineT m (Stack a) o
down' a
t
o Await t -> MachineT m k a
up' k t
req MachineT m k a
ffU ->Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((t -> MachineT m k o)
-> k t -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
a ->t -> MachineT m k a
up' t
a MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` Step (Stack a) o (MachineT m (Stack a) o) -> MachineT m (Stack a) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Stack a) o (MachineT m (Stack a) o)
stepD )k t
req (MachineT m k a
ffU MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
`stack` Step (Stack a) o (MachineT m (Stack a) o) -> MachineT m (Stack a) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Stack a) o (MachineT m (Stack a) o)
stepD )){-# INLINABLEstack #-}