Automata

Automata.hs

module Automata where

import Prelude hiding (id, (.))
import Control.Category
import Control.Arrow

data Automaton b c = Automaton (b -> (c, Automaton b c))

runA :: [a] -> Automaton a b -> [b]
runA (x:xs) (Automaton f) = let (output, a) = f x in
  output : runA xs a
runA [] _ = []

runningSum :: Automaton Int Int
-- runningSum =  Automaton $ f 0
--  where f s x = ( s+x , Automaton $ f ( s+x ) )
runningSum = acc (+) 0
  
acc :: (a -> b -> b) -> b -> Automaton a b
acc op seed =  Automaton $ f seed
  where f s x = let n = op x s in
                ( n , Automaton $ f n )

delay :: a -> Automaton a a
delay seed = Automaton $ \x -> (seed, delay x)

delayn :: Int -> a -> Automaton a a
delayn 0 seed = id
delayn n seed = delay seed >>> delayn (n-1) seed

delayList :: [a] -> Automaton a a
delayList [] = id
delayList (s:ss) = delayList ss >>> delay s

instance Category Automaton where
  id = arr id
  (Automaton g) . (Automaton f) = Automaton h
    where h x = let (output, f') = f x
                    (output', g') = g output in
                    (output', g' . f')

instance Arrow Automaton where
  arr f = Automaton $ \a -> (f a, arr f)
  first (Automaton f) = Automaton h
    where h (x, y) = let (output, f') = f x in
                  ((output, y), first f' )

line 79 should be returnA -< (top, count), no?