module Control.Monad.Operational.Reflectable(Program,ProgramView(..), fromView, toView, instr,interpretWithMonad) where
import Data.TASequence.FastCatQueue
import Control.Monad
import Control.Applicative
newtype TermMCont r a b = TC (a -> Program r b)
type TermCExp r a b = FastTCQueue (TermMCont r) a b
data ProgramView r a where
Bind :: r w -> (w -> Program r a) -> ProgramView r a
Return :: a -> ProgramView r a
data Program r a = forall x. Program (ProgramView r x) (TermCExp r x a)
fromView :: ProgramView r a -> Program r a
fromView r = Program r tempty
toView :: Program r a -> ProgramView r a
toView (Program x s) = case x of
Return a -> case tviewl s of
TAEmptyL -> Return a
TC h :< t -> toView $ (h a) <.|| t
Bind t f -> Bind t (\x -> f x <.|| s)
where (<.||) :: Program r a -> TermCExp r a b -> Program r b
(Program x l) <.|| r = Program x (l >< r)
instance Monad (Program r) where
return = fromView . Return
(Program t s) >>= f = Program t (s |> TC f)
instr :: r x -> Program r x
instr r = fromView $ Bind r return
interpretWithMonad :: Monad m => (forall a. r a -> m a) -> Program r b -> m b
interpretWithMonad f = loop where
loop m = case toView m of
Return x -> return x
Bind i c -> f i >>= loop . c
instance Functor (Program r) where
fmap = liftM
instance Applicative (Program r) where
pure = return
(<*>) = ap