I was just playing around with Data.Machine.Mealy, when I discovered some strange behavior with >>=.

Given this code:

module TestCase where

import Control.Arrow
import Data.Machine.Mealy

step :: i -> Mealy i o -> Mealy i o
step i m = snd $ runMealy m i

apply :: i -> Mealy i o -> o
apply i m = fst $ runMealy m i

applyTwice :: i -> Mealy i o -> o
applyTwice i = apply i . step i

testOK, testHang :: String
testOK   = applyTwice (1 :: Int) (arr show)
testHang = applyTwice (1 :: Int) (arr show >>= return)

Evaluating testOK results in "1", the expected result. But trying testHang – which according to the monad laws, should be the same as testOK – results in an infinite loop. The really weird thing is, if I only step the machine once (i.e. use apply instead of applyTwice) it finishes immediately. If I replace arr show with another machine of the same type, it hangs as well.

Do you have any idea why this happens? I'm using GHC 7.4.1 on Ubuntu 12.04, with machines 0.1.2.

I think something like this should work, with a saner name, but I haven't tested it. I don't know if something like this is available for plans; PlanT confuses the heck out of me.

fob :: forall m k o s . Monad m => s -> MachineT (StateT s m) k o -> MachineT m k o
fob s (MachineT m) = MachineT $ do
  (stp, s') <- runStateT m s
  case stp of
    Stop -> return Stop
    Yield o m' -> return $ Yield o (fob s' m')
    Await f k q -> return $ Await (fob s' . f) k (fob s' q)

The documentation for Plan reads

A Plan k o a is a specification for a pure Machine, that reads inputs selected by k with types based on i

When i does not appear in the type signature of Plan

Retracing some paths in Process Algebra defines a trace/feedback operator for Mealy machines that connects an output back to an input. This is like ArrowLoop but with a sum instead of a product. It can be implemented like this:

trace :: forall e a b. Mealy (Either e a) (Either e b) -> Mealy a b
trace m0 = Mealy $ \x -> go m0 (Right x)
  where
    go :: Mealy (Either e a) (Either e b) -> Either e a -> (b, Mealy a b)
    go (Mealy f) x = case f x of
      (Left e, m) -> go m (Left e)
      (Right y, m) -> (y, trace m)

Maybe this would be useful for other machines as well.

https://www.fpcomplete.com/user/edwardk/moore/for-less

This would give us Moore machines with a more efficient mapping operation for one, and all of the recent improvements could be ported over.

There doesn't seem to be a nice built-in way to compose tees at present, unless I'm missing something. One possibility might be to do something really simple, like

data GenT j k c =
  Gentle (j c) | Goner (k c)

Then GenT (Is a) (T een ager) should be a three-way T, I believe.

This is an informal pull request, because I've created my commits against v0.4.1 in a new 0.4.1 branch which doesn't exist in your repo, so I can't create a proper pull request.

Please see https://github.com/greenrd/machines/tree/0.4.1

I have two commits there, one fixing a bug relating to repeatedly, and the other relating to fanout - both bugs cause machines to not stop when they should. Well, I'm sure the fanout one is a bug, anyway; I haven't actually verified that the repeatedly change fixes a bug, but it makes sense to me.

Would it be possible to add instances for the classes provided by the mmorph package?
Also, having instances for the exceptions package classes, and monad-control for PlanTwould be great! These classes would make complex data processing scenarios a lot easier.

I ran into a nasty bug today where I repeatedly invoked an action lifted to a PlanT but forgot to yield it. This surely would not have happened if repeatedly had insisted that my plan return (). The same applies to construct, and likely some other functions. I don't know how large the performance impact would be of requiring () <$ for any plan of the wrong type, but it's a price I'd personally be willing to pay most of the time.

There is no bundled result type for a Machine separate from the type being emitted.

Such a thing might be useful, but it might not pay its way in terms of complexity as well.

Given an action producing a machine, we can make a machine. I don't actually know if this is useful, but it struck me as a bit surprising.

holdOn :: Monad m => m (MachineT m k o) -> MachineT m k o
holdOn m = MachineT $ m >>= runMachineT

If we can produce a machine from a bit of input, we can make a machine. This is useful for starting up an Attoparsec parser to parse a ByteString source incrementally—Attoparsec needs a non-empty ByteString to get going.

initialize :: (Category k, Monad m) => (i -> MachineT m (k i) o) -> MachineT m (k i) o
initialize f = encased $ Await f id stopped

There's another version available that may be a bit too general/awkward, but then again may not be.

initialize' :: Monad m => k t -> (t -> MachineT m k o) -> MachineT m k o
initialize' kt f = encased $ Await f kt stopped

I am intrigued by this package and to what extent I could use it to implement a state machine. However, I find myself a bit stuck here not knowing how to proceed and with little or no examples to draw ideas.

instance MonadWriter w m => MonadWriter w (Plan k i o m)

would be nice to have.

Can we have it?

From @pchiusano:

The Plan monad is the same as the List-like monad for Machine itself! Or, put another way, you don't need two different variable types; the output type of the machine is the only variable you need:

zip = repeatedly $ do 
  a <- await L
  b <- await R
  emit (a,b)

-- emit one value, then halt, this is also the definition of return
emit :: a -> Machine f a
emit a = Emit a Halt

-- await and return a single value
await :: f a -> Machine f a
await req = Await req emit Halt Halt

L :: a -> T a b b
R :: b -> T a b a

repeatedly a = let t = repeatedly a in a <> t

It seems that the current examples are all about processing some input homogeneously. Can there be an example of a more complicated use case where for example, a file header is read and the content of the header determines how the rest of the file is processed? Is such processing possible with machines?

For example:
The file header is a Word8 n followed by n (Word8, Word8) pairs (x, y). After that the rest of the file is processed byte-by-byte: If some byte b matches any x, the corresponding yis output. Otherwise, b is output.

It now hits a very pretty Dropbox 404 page.

The Is type from the Data.Machine.Is module isn't necessary with :~: being in base, is it?

Both are quite basic and useful on their own without the whole facade of abstractions like Source/Pipe/Plan/Process, which this package is primarily focused on. So how about extracting them into a dedicated and more focused library?

I think these probably deserve to exist. Here's how it goes for Moore machines (I didn't try to figure out a Monad instance since even if it exists it seems unlikely to be that useful):

Moore

class AutomatonM f where
    autoM :: Monad m => f m a b -> ProcessT m a b

data Moorish m a b = Moorish b (a -> m (Moorish m a b))

instance AutomatonM Moorish where
    autoM = construct . moorishToPlanT

moorishToPlanT :: Monad m => Moorish m a b -> PlanT (Is a) b m q
moorishToPlanT (Moorish b f) =
    do
      yield b
      a <- await
      foo <- lift $ f a
      moorishToPlanT foo

-- TODO This can be derived in GHC 7.10, yielding a Functor m constraint
instance Monad m => Functor (Moorish m a) where
    fmap f (Moorish b step) = Moorish (f b) (liftM (fmap f) . step)

instance Monad m => Applicative (Moorish m a) where
    pure x = blah
        where
          blah = Moorish x (\_ -> return blah)

    Moorish f stepf <*> Moorish x stepx =
        Moorish (f x) (\a -> ((<*>) `liftM` stepf a) `ap` stepx a)

instance Monad m => Profunctor (Moorish m) where
    rmap = fmap
    lmap f (Moorish x step) = Moorish x (liftM (lmap f) . step . f)

instance Monad m => Comonad (Moorish m a) where
    extract = copoint
    extend f w@(Moorish _ step) = Moorish (f w) (\i -> step i >>= return . extend f)

instance Monad m => ComonadApply (Moorish m a) where
    (<@>) = (<*>)

instance Monad m => Pointed (Moorish m a) where
    point a = loop where loop = Moorish a (const . return $ loop)

instance Copointed (Moorish m a) where
    copoint (Moorish x _) = x

This function:

testLocal :: [Int]
testLocal =
  execWriter . flip runReaderT 1 . runT_ . construct . local (+ 1) $ do
    r <- ask
    tell [r]
    yield r
    r' <- ask
    tell [r']

evaluates to [2,1]; i.e. local only applies to the first ask.

The problem is that in the definition of local:

  local f m = PlanT $ \kp ke kr kf -> local f (runPlanT m kp ke kr kf)

base monad's local is only applied to the outermost monadic layer produced. That is, since r in PlanT is specialized to Step k o (MachineT m k o) in construct, the ‘result’ of the computation can actually contain other layers of the base monad within it, which are unaffected by local. Thus, second ask in the example above produces the original environment, since it is ‘hidden’ within the Yield constructor.

We should probably relax them quite a bit.

This evaluates to [1]:

testListen :: [Int]
testListen =
  execWriter . runT_ . construct $ do
    (_, w) <- listen $ tell [1]
    tell w

while the same function sans runT . construct (i.e. working directly on WriterT) evaluates to [1,1].

Likewise, with pass, this evaluates to [1]:

testPass :: [Int]
testPass =
  execWriter . runT_ . construct . pass $ do
    tell [1]
    pure ((), const [])

while the WriterT version evaluates to [].

I've grouped them in a single issue since the cause is very similar. In the definitions of listen and pass (with some manual inlining)

  listen m = PlanT $ \kp ke kr kf -> runPlanT m (\x -> kp =<< listen (return x)) ke kr kf

  pass m = PlanT $ \kp ke kr kf -> runPlanT m (\x -> kp =<< pass (return x)) ke kr kf

both listen and pass from the base monad are applied to return x, which has mempty as its accumulated writer state. So listen now always returns mempty, and pass only operates on mempty, leaving actual state accumulated in the provided action unchanged.

It may be too late to replace it, but runT doesn't seem to be good for much other than debugging. I suspect the most sensible general purpose version is

runTS :: (Monad m, Semigroup b) => MachineT m k b -> m (Maybe b)

runT could be written in terms of runTS in a few different ways, either first mapping (:| []) over it and then reversing the result, or doing some trick or other with Endo; then at the end Maybe (NonEmpty a) gets turned into [a].

runTS itself can be defined in terms of fold1 and an even more basic machine runner that runs a machine until it produces an output, then stop it. Return that output; if the machine stopped with no output, return Nothing.

From @atzeus:

Hi Ed!

I was thinking about what you asked me at ICFP, about plans being machines, and I think I solved it: Plan = Machine!

As far as I can tell, there is no problem with associativity with the (~>) operator, which recurses on both arguments. Hence I think there are only problems with mplus and >>=, which I think can be solved by the following reasoning:

Machines are an instance of the Free MonadPlus, which is (inefficiently) defined as follows:

newtype FreePlus f a = FreePlus { getFreePlus :: [IFree f a] }
data IFree f a = Pure a
               | Impure (f (FreePlus f a))

instance Functor f => Monad (FreePlus f) where
  return = FreePlus . (\x -> [x]) . Pure              
  (FreePlus m) >>= g = FreePlus $ concatMap bind m where
     bind (Pure x) = getFreePlus (g x)
     bind (Impure f) = [ Impure $ fmap (>>= g) f ]

instance Functor f => MonadPlus (FreePlus f) where
  mzero = FreePlus []
  mplus (FreePlus l) (FreePlus r) = FreePlus (l ++ r)

Machines are defined in terms of the free monadplus as follows:

data MachineF i o a = AwaitF (i -> a) a | YieldF o a deriving Functor
type Machine i o a = FreePlus (MachineF i o) a

stop :: Machine i o a
stop = mzero

await :: Machine i o i
await = FreePlus $ [Impure $ AwaitF return stop ]

yield :: o -> Machine i o ()
yield x = FreePlus $ [Impure $ YieldF x (return ()) ]

... etc...

Now to get rid of the associativity problems of >>= and mplus, swap out the data structure for [IFree f a] and binding for more efficient ones.

Straightforwardly applying reflection without remorse gives: (TA is

import qualified Data.TASequence.FastCatQueue as TA
import Control.Monad
import Control.Applicative hiding (empty)
import Data.Sequence
import Data.Foldable
import Prelude hiding (foldl)


newtype FCP f a b = FCP (a -> FreePlus f b)
type FMPExp f a b = TA.FastTCQueue (FCP f) a b
newtype FreePlus f a = FreePlus { getFreePlus :: Seq (IFree f a) }
data IFree f a = 
   forall x. FMP (FreePlusView f x) (FMPExp f x a)
data FreePlusView f a   = Pure a 
                        | Impure (f (FreePlus f a))

bind :: FreePlus f a -> FMPExp f a b -> FreePlus f b
bind (FreePlus m) f = FreePlus $ fmap (`bindi` f) m

bindi :: IFree f a -> FMPExp f a b -> IFree f b
bindi (FMP m r) f = FMP m (r TA.>< f)

instance Monad (FreePlus f) where
  return x = FreePlus (singleton (FMP (Pure x) TA.tempty))
  m >>= f = bind m (TA.tsingleton (FCP f))

instance MonadPlus (FreePlus f) where
  mzero = FreePlus empty
  mplus l r = FreePlus (getFreePlus l >< getFreePlus r)

fromView :: Seq (FreePlusView f a) -> FreePlus f a
fromView m = FreePlus (fmap (\x -> FMP x TA.tempty) m)

toView :: Functor f => FreePlus f a -> Seq (FreePlusView f a)
toView (FreePlus m) = foldl (><) empty $ fmap down m where
  down (FMP h t) = 
   case h of
    Pure x -> 
     case TA.tviewl t of
        TA.TAEmptyL -> singleton (Pure x)
        FCP hc TA.:< tc -> toView (bind (hc x) tc)
    Impure f -> singleton $ Impure (fmap (`bind` t) f) 

However, now >>= is linear in the number of choices, which might be wasteful if most choices are thrown away. We can make the whole thing a bit more "lazy" by representing the choices/binds tree as follows:

import qualified Data.TASequence.FastCatQueue as TA
import Control.Monad
import Control.Applicative hiding (empty)
import Data.Sequence
import Data.Foldable
import Prelude hiding (foldl)

newtype FCP f a b = FCP (a -> FreePlus f b)
type FMPExp f a b = TA.FastTCQueue (FCP f) a b

data FreePlus f a = forall x. FreePlus (Seq (FreePlus f x)) (FMPExp f x a)
                  | FImpure (f (FreePlus f a)) --leaf
                  | FPure a -- leaf

bind :: FreePlus f a -> FMPExp f a b -> FreePlus f b
bind (FreePlus m r) f = FreePlus m (r TA.>< f)
bind m f = case TA.tviewl f of
             TA.TAEmptyL -> m
             _         -> FreePlus (singleton m) f


instance Monad (FreePlus f) where
  return = FPure
  m >>= f = bind m (TA.tsingleton $ FCP f)

instance MonadPlus (FreePlus f) where
  mzero = FreePlus empty TA.tempty
  mplus x@(FreePlus ml cl) y@(FreePlus mr cr) = 
    case (TA.tviewl cl, TA.tviewl cr) of
                   (TA.TAEmptyL, TA.TAEmptyL) -> FreePlus (ml >< mr) TA.tempty
                   _ -> FreePlus (singleton x |> y) TA.tempty
  mplus x y = FreePlus (singleton x |> y) TA.tempty

data ChoicesView f a = MZero
                     | MPlus (EffectView f a) (FreePlus f a)

data EffectView f a = Pure a 
                    | Impure (f (FreePlus f a))

fromView :: ChoicesView f a -> FreePlus f a
fromView MZero = mzero
fromView (MPlus x y) = fromEffView x `mplus` y

fromEffView (Pure a) = FPure a
fromEffView (Impure f) = FImpure f


toView :: Functor f => FreePlus f a -> ChoicesView f a
toView (FPure x) = MPlus (Pure x) mzero
toView (FImpure x) = MPlus (Impure x) mzero
toView (FreePlus m f) = 
   case viewl m of
     EmptyL -> MZero
     h :< t -> 
      case toView h of
        MZero -> toView (FreePlus t f)
        MPlus ch ct -> 
         let rest = FreePlus (ct <| t) f
         in case ch of
             Impure x -> MPlus (Impure (fmap (`bind` f) x)) rest
             Pure x   -> case TA.tviewl f of
                           TA.TAEmptyL -> MPlus (Pure x) rest
                           FCP hc TA.:< tc -> toView $ bind (hc x) tc `mplus` rest 

I have not tested the above code, but it does compile :)

As to if this is fast enough, that depends on the choice of (type-aligned and non-typealigned) datastructures. I also have a dirty trick to use regular sequence datastructures (such as Data.Seq) as a type-aligned sequence datastructure. This can help if the regular datastructure is already very optimized and you don't want to reimplement it :)

https://github.com/atzeus/reflectionwithoutremorse/blob/master/Data/LiftSequence.hs

Some inlining of the sequence datastructures into the FreeMonadPlus and/or inline the MachineF might also help.

Let me know if this helps and/or if you have any questions!

No intrinsic notion of left-overs is handled by the API.

This could be considered both a strength and a curse.

foldlT still seems to leak some space, and strictly applying o to f b seems to solve this (e.g. f b $! o). I can submit a PR if desired.

foldlT :: Monad m => (b -> o -> b) -> b -> M.MachineT m k o -> m b
foldlT f = go
  where
    go !b m = do
      step <- M.runMachineT m
      case step of
        M.Stop -> return b
        M.Yield o m' -> go (f b $! o) m'
        M.Await _ _ m' -> go b m'

I want to write a groupBy function with Machines.
I asked this question on reddit a while ago:
http://www.reddit.com/r/haskell/comments/2ejzst/streaming_tabseparated_logfile_analysis_with/
I am interested in using Machines for the same purpose, given that the Plan language
feels similar to Python's iterators.

But for now, all I want is to write a "groupBy" function similar to Data.List.groupBy
that doesn't emit lists (and hold each group in memory.) I figure it should
have a type signature something like the below, i.e. a list of 'iterators'
to be executed sequentially

{-# LANGUAGE FlexibleContexts #-}
module Main where

import Prelude hiding (id, (.))
import Control.Category
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.IO.Class

import Data.Machine
import Data.Machine.Plan
import Data.Machine.Process
import Data.Machine.Source

groupBy :: Monad m => (a -> Bool) -> SourceT m (ProcessT m a a)
groupBy = undefined

I don't know how to implement that groupBy machine, so instead,
Here's a simpler process, in which each group is just a single element.

singletons :: Monad m => SourceT m (ProcessT m a a)
singletons = repeatedly (yield . construct $ await >>= yield)

I also want to concatenate my iterators back together.
I'm not sure how to do this without using runT: is there a better way?
Also, I copied the type from GHCi, I couldn't get it a simpler one to work

concatenating :: (MonadTrans (PlanT (k (MachineT m k1 o)) o), Category k, Monad m)
              => MachineT m (k (MachineT m k1 o)) o
concatenating = repeatedly $ do 
  m <- await
  xs <- (lift . runT) m
  mapM_ yield xs

What is the best way to write these functions? Do they already exist in Machines?
additionally, would the semantics be the same as Python's groupBy, where evaluating
the next group will force the previous group's iterator to be exhausted (i.e., you
don't get bits of the previous group in the current group?)

Incidentally, I am having problems getting GHC to recognise the MonadTrans and MonadIO
instance for PlanT and (MonadIO m => PlanT m) when I import Data.Machine: is that a
bug, or am I doing something wrong?

Can you release a version of machines that works with distributive-0.5.*?

Currently, <*> is defined as ap. After inlining and beta reduction, this becomes

ps <*> qs = PlanT $ \ret yi aw st ->
  runPlanT ps
    (\p -> (runPlanT qs (ret . p) yi aw st)) yi aw st

My guess is that the inliner would treat this simplified form better, but my intuition in these matters is only partially developed. Any thoughts?

runHead :: (Functor f, Monad f) => MachineT f k b -> f b
runHead src = head <$> runT src

If I understand the situation properly, this should work just fine as applied in the example, but it seems a terrible example in and of itself. Aside from the partiality problem, my understanding is that runT accumulates a list whether the list is ever used or not. The right thing, presumably, is to build a machine that passes the first result through to the end.

It might be nice to mention in Data.Machine.Process that for any monad m, ProcessT m forms a category with identity echo and composition <~. It might even make sense to offer a newtype wrapper to get the Category instance.

I'm playing a bit with the library and I noticed that the current definition for takingJusts would work also with a ProcessT m (Maybe a) a type.

Is there a particular reason why the current API restrict it to Process?

Wow, this is really similar to my BSc thesis:

• http://hackage.haskell.org/package/Etage
• http://hackage.haskell.org/package/Etage-Graph

src/Data/Machine/MooreT.hs:29:1: warning: [-Wunused-imports]
    The import of ‘Control.Applicative’ is redundant
      except perhaps to import instances from ‘Control.Applicative’
    To import instances alone, use: import Control.Applicative()
   |
29 | import Control.Applicative
   | ^^^^^^^^^^^^^^^^^^^^^^^^^^

src/Data/Machine/MooreT.hs:132:3: warning: [-Wnoncanonical-monoid-instances]
    Noncanonical ‘mappend’ definition detected
    in the instance declaration for ‘Monoid (MooreT m a b)’.
    Define as ‘mappend = (<>)’

cc @RyanGlScott @davean

The corresponding package on hackage hasn't been updated for a while. I saw the package version here is 0.4 but the latest one on hackage remains 0.2.5. Could you upload a newer version to hackage?

Thank you!

The Documentation for Plan/Machine seems to talk about a parameter i, which doesn't exist any more. This was absorbed into k. Talk about i are assuming k = (Is i).

An Alternative is supposed to be a monoid, but

*Data.Machine.Concurrent Data.Machine> runT . construct $ ((await :: Plan (Is ()) () ()) <|> liftIO (hPutStrLn stderr "Closing Chan")) <|> liftIO (hPutStrLn stderr "Waiting")
Waiting
[]
*Data.Machine.Concurrent Data.Machine> runT . construct $ (await :: Plan (Is ()) () ()) <|> (liftIO (hPutStrLn stderr "Closing Chan") <|> liftIO (hPutStrLn stderr "Waiting"))
Closing Chan
[]

It is somewhat inconvenient that the API requires k in MachineT m k i o to have two parameters, and that i just gets passed to k.

Giving it up means giving up the Category for Machine. But we could replace that instance with other combinators.

> let m1 = unfoldMealy (\s a -> (a + s, a + s)) 0
> let mf = unfoldMealy (\s a -> (\b -> a + s + b), a + s)) 0
> cosieve (mf <*> m1) $ 1 :| [2,3]
12
> cosieve (mf `ap` m1) $ 1 :| [2.3]
9

<*> and ap are supposed to be the same.

I personally like to use these constructors when working with Mealys:

accumulateFunction :: ((a,acc) -> (b,acc)) -> acc -> Mealy a b
{-| accumulateFunction takes a function from a value and an accumulator (e.g. just a sum
    value or an evolving set of parameters for some model) to a value and an accumulator.
    The accumulator is then looped back into the function, returning a Mealy from a to
    b, which updates the accumulator every time step. -}
accumulateFunction f acc = Mealy $ \a ->
    let (b,acc') = f (a,acc)
    in (b,accumulateFunction f acc')

accumulateMealy :: acc -> Mealy (a,acc) (b,acc) -> Mealy a b
{-| accumulateMealy takes a Mealy with an accumulating parameter and loops it. -}
accumulateMealy acc0 crc0 =
    accumulateFunction f (acc0,crc0)
    where f (a,(acc,Mealy cf)) =
              let ((b,acc'),crc') = cf (a,acc)
              in  (b,(acc',crc'))

parallelizeMealys :: [Mealy a b] -> Mealy [a] [b]
{-| Turns a list of circuits into a circuit over lists, bound by the power of parMap rseq. -}
parallelizeMealys crcs = Mealy $ \as ->
    let (bs,crcs') = unzip $ parZip crcs as
    in  (bs, parallelizeMealys crcs')
    where parZip [] [] = []
          parZip (crc:crcs) (a:as) =
              let (b,crc') = runMealy crc a
              in  b `par` (b,crc') : parZip crcs as
          parZip _ _ = error "Parallel circuit does not match size of input"

The first one I now realize is simply the unfoldMealy function, but the other two may be of interest.

The second is essentially equivalent to ArrowLoop, but doesn't require the arrow loop instance, and is, I find, easier to work with.

The last is pretty self explanatory, but in email with ekmett he mentioned that he doesn't like the usage of lists to represent the fixed lengths involved, which is certainly fair enough. If a better solution to that could be found, I think it would a very nice tool for the library to have.

edit: use haskell syntax hilighting

We talked about them briefly in #5.

It isn't entirely clear how they'd work, but it'd be nice to have a composable vocabulary for input languages.

Currently,

-- | Run a machine with no input until it stops, then behave as another machine..
starve :: Monad m => ProcessT m a b -> MachineT m k b -> MachineT m k b
starve m cont = MachineT $ runMachineT m >>= \v -> case v of
  Stop            -> runMachineT cont -- Continue with cont instead of stopping
  Yield o r       -> return $ Yield o (starve r cont)
  Await _ Refl r  -> runMachineT (starve r cont)

There is no need to use the Refl, and thus no need to restrict the machine to be a ProcessT.

starve :: Monad m => MachineT m _k b -> MachineT m k b -> MachineT m k b
starve m cont = MachineT $ runMachineT m >>= \v -> case v of
  Stop            -> runMachineT cont -- Continue with cont instead of stopping
  Yield o r       -> return $ Yield o (starve r cont)
  Await _ _ r  -> runMachineT (starve r cont)

If there's actually some reason to force that argument, of course, we could go with

  Await _ !_ r  -> runMachineT (starve r cont)

Can I switch to an existential in the CPS'd function for Plan like I did in the ADT for Machine to remove the need for the FlexibleInstances for (k i)?