-- {-# LANGUAGE #-}

-- DatatypeContexts: misfeature




-- lowlevel interface of Sys
module SSM (SSM(..), ssmSer, ssmPar, ssmPure,
           ) where

{-

The Sys data type abstracts systems (sequence operators) governed by
update equations and initial conditons.

Causality refers to the principle that the operator cannot use
"future" sequence data.

The code is split in two parts: low-level composition operations and
abstrac data type + class instances.



1. Primitives & compositions
----------------------------

Composing Sys is like composing functions, placing them in
series linking the output of one to input of another.  The state
inputs/outputs of both Sys are bundled in parallel.

Note that state is *private*.  It is not threaded between both
elements that are composed, i.e. this is not a State Monad.

-}

-- NOTE: The arrow instance relies on the fact that at least the I/O
-- tupling are (,) so using a different class for Cons is probably not
-- a good idea.

-- Implement update composition (ud) and state product (sp)
-- separately, then combine in SSM data ops.

udSer :: Monad m =>
          ((s1, b)     -> m (s1, c)) ->
          ((s2, a)     -> m (s2, b)) ->
          ((s1,s2), a) -> m ((s1,s2), c)
              
udSer f g = fg where
  fg ((s1,s2), a) = do
    (s2', b) <- g (s2, a)
    (s1', c) <- f (s1, b)
    return ((s1',s2'), c)
{-

Another way to compose operators is to take their product, placing
them in parallel.

-}
  
udPar :: Monad m =>
          ((s1, a)         -> m (s1, c)) ->
          ((s2, b)         -> m (s2, d)) ->
          ((s1,s2), (a,b)) -> m ((s1,s2), (c,d))
udPar f g = fg where          
  fg ((s1,s2), (a,b)) = do
    (s1',c) <- f (s1, a)
    (s2',d) <- g (s2, b)
    return ((s1',s2'), (c,d))
    
{-

Lifting pure functions.  A pure function is an Sys with void
state.

-}

udPure :: Monad m => (a -> b) -> ((), a) -> m ((), b)
udPure f ((), a) = return ((), f a)




-- State product operations are represented in terms of these two
-- functions.  To keep things simple we just use binary tuples hidden
-- in the monad.
sp :: Monad m => m a -> m b -> m (a, b)
ma `sp` mb = do
  a <- ma
  b <- mb
  return $ (a,b)
   
        
-- Data structure wrapping.  Like Sys, but no data hiding.
data SSM m s i o = SSM ((s, i) -> m (s, o)) (m s)

-- Some generalized Arrow behaviour (SSM includes extra "growing" state parameter).
ssmSer (SSM f f0) (SSM g g0) = SSM (f `udSer` g) (f0 `sp` g0)
ssmPar (SSM f f0) (SSM g g0) = SSM (f `udPar` g) (f0 `sp` g0)
ssmPure f = SSM (udPure f) (return ())