-- arrow class
class Arrow r where
arr :: (a -> b) -> r a b
(>>>) :: r a b -> r b c -> r a c
first :: r a b -> r (a,c) (b,c)
-- function arrow is the first example
instance Arrow (->) where
arr f = f
f >>> g = g . f
first f (a, c) = (f a, c)
-- stream functions
data ListF a b = LF ([a] -> [b])
instance Arrow ListF where
arr f = LF (map f)
LF lf >>> LF lg = LF (lg . lf)
first (LF lf) = LF (\ ps -> let as = map fst ps
cs = map snd ps
in zip (lf as) cs)
summationLF :: ListF Double Double
summationLF = LF sum
where sum (a : as) = a : map (a +) (sum as)
differenceLF :: ListF Double Double
differenceLF = LF diff
where diff as = zipWith (-) as (0 : as)
-- machines - a better way to implement stream functions
data Mach a b = M (a -> (Mach a b, b))
instance Arrow Mach where
arr f = M (\ a -> (arr f, f a))
M mf >>> M mg = M (\ a ->
let (mf', b) = mf a
(mg', c) = mg b
in (mf' >>> mg', c))
first (M mf) = M (\ (a, c) ->
let (mf', b) = mf a
in (first mf', (b, c)))
summation :: Mach Double Double
summation = summation' 0
summation' :: Double -> Mach Double Double
summation' s = M (\ a -> let s' = s + a
in (summation' s', s'))
difference :: Mach Double Double
difference = difference' 0
difference' :: Double -> Mach Double Double
difference' a' = M (\ a -> (difference' a, a - a'))
delay :: Mach a a
delay = delay' undefined
delay' :: a -> Mach a a
delay' a' = M (\ a -> (delay' a, a'))
switch :: Mach a (b, Maybe e) -> (e -> Mach a b) -> Mach a b
switch (M mf) g = M (\ a -> let (mf', (b, mbe)) = mf a
in case mbe of
Nothing -> (switch mf' g, b)
Just e ->(g e, b))
-- running a machine
runMach :: (Read a, Show b) => Mach a b -> IO ()
runMach (M mf) =
do a <- readLn
let (mf', b) = mf a
print b
runMach mf'
test:: Mach Double Double
test = arr (const 1)
test1:: Mach Double Double
test1 = arr (+2)