{-# LANGUAGE CPP #-}

-- | Methods for traversing programs

module Language.Embedded.Traversal where



import Control.Monad.Operational.Higher

import Control.Monads



-- | Dry (effect-less) interpretation of an instruction. This class is like
-- 'Interp' without the monad parameter, so it cannot have different instances
-- for different monads.
class DryInterp instr
  where
    -- | Dry interpretation of an instruction. This function is like 'interp'
    -- except that it interprets in any monad that can supply fresh variables.
    dryInterp :: MonadSupply m => instr '(m,fs) a -> m a

-- | Interpretation of a program as a combination of dry interpretation and
-- effectful observation
observe_ :: (DryInterp instr, HFunctor instr, MonadSupply m)
    => (forall a . instr '(m,fs) a -> a -> m ())  -- ^ Function for observing instructions
    -> Program instr fs a
    -> m a
observe_ :: (forall a. instr '(m, fs) a -> a -> m ())
-> Program instr fs a -> m a
observe_ forall a. instr '(m, fs) a -> a -> m ()
obs = (forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(HFunctor instr, Monad m) =>
(forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
interpretWithMonad ((forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a)
-> (forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
forall a b. (a -> b) -> a -> b
$ \instr '(m, fs) b
i -> do
    b
a <- instr '(m, fs) b -> m b
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(DryInterp instr, MonadSupply m) =>
instr '(m, fs) a -> m a
dryInterp instr '(m, fs) b
i
    instr '(m, fs) b -> b -> m ()
forall a. instr '(m, fs) a -> a -> m ()
obs instr '(m, fs) b
i b
a
    b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a

-- | Interpretation of a program as a combination of dry interpretation and
-- effectful observation
observe :: (DryInterp instr, HFunctor instr, MonadSupply m)
    => (forall a . instr '(m,fs) a -> a -> m a)  -- ^ Function for observing instructions
    -> Program instr fs a
    -> m a
observe :: (forall a. instr '(m, fs) a -> a -> m a)
-> Program instr fs a -> m a
observe forall a. instr '(m, fs) a -> a -> m a
obs = (forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(HFunctor instr, Monad m) =>
(forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
interpretWithMonad ((forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a)
-> (forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
forall a b. (a -> b) -> a -> b
$ \instr '(m, fs) b
i -> do
    b
a <- instr '(m, fs) b -> m b
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(DryInterp instr, MonadSupply m) =>
instr '(m, fs) a -> m a
dryInterp instr '(m, fs) b
i
    instr '(m, fs) b -> b -> m b
forall a. instr '(m, fs) a -> a -> m a
obs instr '(m, fs) b
i b
a

instance (DryInterp i1, DryInterp i2) => DryInterp (i1 :+: i2)
  where
    dryInterp :: (:+:) i1 i2 '(m, fs) a -> m a
dryInterp (Inl i1 '(m, fs) a
i) = i1 '(m, fs) a -> m a
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(DryInterp instr, MonadSupply m) =>
instr '(m, fs) a -> m a
dryInterp i1 '(m, fs) a
i
    dryInterp (Inr i2 '(m, fs) a
i) = i2 '(m, fs) a -> m a
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(DryInterp instr, MonadSupply m) =>
instr '(m, fs) a -> m a
dryInterp i2 '(m, fs) a
i