{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP

-- | Synchronous stream transformers as Mealy machines

module ConCat.Synchronous where

import Prelude hiding (id,(.),curry,uncurry,const,scanl)
import Data.Function (fix)
import Data.Tuple (swap)

import ConCat.Misc ((:*))
import ConCat.Category

-- | Synchronous stream transformer represented as Mealy machine.
data Mealy con a b = forall s. con s => Mealy (a :* s -> b :* s) s

-- TODO: generalize from (->) to other categories

-- | Semantic function
sapply :: Mealy con a b -> [a] -> [b]
sapply :: forall (con :: * -> Constraint) a b. Mealy con a b -> [a] -> [b]
sapply (Mealy (a :* s) -> b :* s
h s
s0) = s -> [a] -> [b]
go s
s0
  where
    go :: s -> [a] -> [b]
go s
_ []     = []
    go s
s (a
a:[a]
as) = b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs
      where (b
b,s
s') = (a :* s) -> b :* s
h (a
a,s
s)
            bs :: [b]
bs     = s -> [a] -> [b]
go s
s' [a]
as

type CartCon con = (con (), OpCon (:*) (Sat con))

arr :: con () => (a -> b) -> Mealy con a b
arr :: forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> b
f = ((a :* ()) -> b :* ()) -> () -> Mealy con a b
forall (con :: * -> Constraint) a b s.
con s =>
((a :* s) -> b :* s) -> s -> Mealy con a b
Mealy ((a -> b) -> (a :* ()) -> b :* ()
forall a a' b.
Ok3 (->) a b a' =>
(a -> a') -> Prod (->) a b -> Prod (->) a' b
forall (k :: * -> * -> *) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (->) a b) (Prod (->) a' b)
first a -> b
f) ()

-- State transition function
type X s a b = a :* s -> b :* s

-- Combine Mealy machines
op2 :: forall con a b c d e f. CartCon con
    => (forall s t. (con s, con t) => X s a b -> X t c d -> X (s :* t) e f) 
    -> (Mealy con a b -> Mealy con c d -> Mealy con  e f) 
op2 :: forall (con :: * -> Constraint) a b c d e f.
CartCon con =>
(forall s t.
 (con s, con t) =>
 X s a b -> X t c d -> X (s :* t) e f)
-> Mealy con a b -> Mealy con c d -> Mealy con e f
op2 forall s t. (con s, con t) => X s a b -> X t c d -> X (s :* t) e f
op (Mealy ((a :* s) -> b :* s
f :: a :* s -> b :* s) s
s0) (Mealy ((c :* s) -> d :* s
g :: c :* t -> d :* t) s
t0) =
  ((e :* (s :* s)) -> f :* (s :* s)) -> (s :* s) -> Mealy con e f
forall (con :: * -> Constraint) a b s.
con s =>
((a :* s) -> b :* s) -> s -> Mealy con a b
Mealy ((a :* s) -> b :* s
f ((a :* s) -> b :* s)
-> ((c :* s) -> d :* s) -> (e :* (s :* s)) -> f :* (s :* s)
forall s t. (con s, con t) => X s a b -> X t c d -> X (s :* t) e f
`op` (c :* s) -> d :* s
g) (s
s0,s
t0) (Con (Sat con (s :* s)) => Mealy con e f)
-> ((Sat con s && Sat con s) |- Sat con (s :* s)) -> Mealy con e f
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> *) (a :: k) (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
forall (op :: * -> * -> *) (con :: * -> *) a b.
OpCon op con =>
(con a && con b) |- con (op a b)
inOp @(:*) @(Sat con) @s @t

instance CartCon con => Category (Mealy con) where
  id :: forall a. Ok (Mealy con) a => Mealy con a a
id = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall a. Ok (->) a => a -> a
forall (k :: * -> * -> *) a. (Category k, Ok k a) => k a a
id
  . :: forall b c a.
Ok3 (Mealy con) a b c =>
Mealy con b c -> Mealy con a b -> Mealy con a c
(.) = (forall s t.
 (con s, con t) =>
 X s b c -> X t a b -> X (s :* t) a c)
-> Mealy con b c -> Mealy con a b -> Mealy con a c
forall (con :: * -> Constraint) a b c d e f.
CartCon con =>
(forall s t.
 (con s, con t) =>
 X s a b -> X t c d -> X (s :* t) e f)
-> Mealy con a b -> Mealy con c d -> Mealy con e f
op2 ((b, s) -> (c, s))
-> ((a, t) -> (b, t)) -> (a, (s, t)) -> (c, (s, t))
forall s t. (con s, con t) => X s b c -> X t a b -> X (s :* t) a c
forall {a} {b} {a} {a} {a} {b} {b}.
((a, b) -> (a, a))
-> ((a, b) -> (a, b)) -> (a, (b, b)) -> (a, (a, b))
(.@)
   where
     ((a, b) -> (a, a)
g .@ :: ((a, b) -> (a, a))
-> ((a, b) -> (a, b)) -> (a, (b, b)) -> (a, (a, b))
.@ (a, b) -> (a, b)
f) (a
a,(b
t,b
s)) = (a
c,(a
t',b
s'))
      where
        (a
b,b
s') = (a, b) -> (a, b)
f (a
a,b
s)
        (a
c,a
t') = (a, b) -> (a, a)
g (a
b,b
t)
  {-# INLINE id #-}
  {-# INLINE (.) #-}

instance CartCon con => MonoidalPCat (Mealy con) where
  *** :: forall a b c d.
Ok4 (Mealy con) a b c d =>
Mealy con a c
-> Mealy con b d
-> Mealy con (Prod (Mealy con) a b) (Prod (Mealy con) c d)
(***) = (forall s t.
 (con s, con t) =>
 X s a c
 -> X t b d
 -> X (s :* t) (Prod (Mealy con) a b) (Prod (Mealy con) c d))
-> Mealy con a c
-> Mealy con b d
-> Mealy con (Prod (Mealy con) a b) (Prod (Mealy con) c d)
forall (con :: * -> Constraint) a b c d e f.
CartCon con =>
(forall s t.
 (con s, con t) =>
 X s a b -> X t c d -> X (s :* t) e f)
-> Mealy con a b -> Mealy con c d -> Mealy con e f
op2 ((a, s) -> (c, s))
-> ((b, t) -> (d, t))
-> (Prod (Mealy con) a b, (s, t))
-> (Prod (Mealy con) c d, (s, t))
forall s t.
(con s, con t) =>
X s a c
-> X t b d
-> X (s :* t) (Prod (Mealy con) a b) (Prod (Mealy con) c d)
forall {a} {b} {a} {a} {a} {b} {b} {b}.
((a, b) -> (a, a))
-> ((a, b) -> (b, b)) -> ((a, a), (b, b)) -> ((a, b), (a, b))
(***@)
   where
     ((a, b) -> (a, a)
f ***@ :: ((a, b) -> (a, a))
-> ((a, b) -> (b, b)) -> ((a, a), (b, b)) -> ((a, b), (a, b))
***@ (a, b) -> (b, b)
g) ((a
a,a
b),(b
s,b
t)) = ((a
c,b
d),(a
s',b
t'))
      where
        (a
c,a
s') = (a, b) -> (a, a)
f (a
a,b
s)
        (b
d,b
t') = (a, b) -> (b, b)
g (a
b,b
t)
  {-# INLINE (***) #-}

instance CartCon con => BraidedPCat (Mealy con) where
  swapP :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con (Prod (Mealy con) a b) (Prod (Mealy con) b a)
swapP = (Prod (Mealy con) a b -> Prod (Mealy con) b a)
-> Mealy con (Prod (Mealy con) a b) (Prod (Mealy con) b a)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a b -> Prod (Mealy con) b a
forall a b.
Ok2 (->) a b =>
Prod (Mealy con) a b -> Prod (Mealy con) b a
forall (k :: * -> * -> *) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (Mealy con) a b) (Prod (Mealy con) b a)
swapP

instance CartCon con => ProductCat (Mealy con) where
  exl :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con (Prod (Mealy con) a b) a
exl = (Prod (Mealy con) a b -> a) -> Mealy con (Prod (Mealy con) a b) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a b -> a
forall a b. Ok2 (->) a b => Prod (Mealy con) a b -> a
forall (k :: * -> * -> *) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (Mealy con) a b) a
exl
  exr :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con (Prod (Mealy con) a b) b
exr = (Prod (Mealy con) a b -> b) -> Mealy con (Prod (Mealy con) a b) b
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a b -> b
forall a b. Ok2 (->) a b => Prod (Mealy con) a b -> b
forall (k :: * -> * -> *) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (Mealy con) a b) b
exr
  dup :: forall a. Ok (Mealy con) a => Mealy con a (Prod (Mealy con) a a)
dup = (a -> Prod (Mealy con) a a) -> Mealy con a (Prod (Mealy con) a a)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> Prod (Mealy con) a a
forall a. Ok (->) a => a -> Prod (Mealy con) a a
forall (k :: * -> * -> *) a.
(ProductCat k, Ok k a) =>
k a (Prod (Mealy con) a a)
dup
  -- (&&&) = op2 (&&&@)
  --  where
  --    (f &&&@ g) (a,(s,t)) = ((c,d),(s',t'))
  --     where
  --       (c,s') = f (a,s)
  --       (d,t') = g (a,t)
  {-# INLINE exl #-}
  {-# INLINE exr #-}
  -- {-# INLINE (&&&) #-}

instance CartCon con => TerminalCat (Mealy con) where
  it :: forall a. Ok (Mealy con) a => Mealy con a ()
it = (a -> ()) -> Mealy con a ()
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> ()
forall a. Ok (->) a => a -> ()
forall (k :: * -> * -> *) a. (TerminalCat k, Ok k a) => k a ()
it

instance CartCon con => UnitCat (Mealy con)

instance CartCon con => MonoidalSCat (Mealy con) where
  +++ :: forall a b c d.
Ok4 (Mealy con) a b c d =>
Mealy con c a
-> Mealy con d b
-> Mealy con (Coprod (Mealy con) c d) (Coprod (Mealy con) a b)
(+++) = (forall s t.
 (con s, con t) =>
 X s c a
 -> X t d b
 -> X (s :* t) (Coprod (Mealy con) c d) (Coprod (Mealy con) a b))
-> Mealy con c a
-> Mealy con d b
-> Mealy con (Coprod (Mealy con) c d) (Coprod (Mealy con) a b)
forall (con :: * -> Constraint) a b c d e f.
CartCon con =>
(forall s t.
 (con s, con t) =>
 X s a b -> X t c d -> X (s :* t) e f)
-> Mealy con a b -> Mealy con c d -> Mealy con e f
op2 ((c, s) -> (a, s))
-> ((d, t) -> (b, t))
-> (Coprod (Mealy con) c d, (s, t))
-> (Coprod (Mealy con) a b, (s, t))
forall s t.
(con s, con t) =>
X s c a
-> X t d b
-> X (s :* t) (Coprod (Mealy con) c d) (Coprod (Mealy con) a b)
forall {a} {a} {a} {a} {b} {b}.
((a, a) -> (a, a))
-> ((a, b) -> (b, b))
-> (Either a a, (a, b))
-> (Either a b, (a, b))
(+++@)
   where
     ((a, a) -> (a, a)
f +++@ :: ((a, a) -> (a, a))
-> ((a, b) -> (b, b))
-> (Either a a, (a, b))
-> (Either a b, (a, b))
+++@ (a, b) -> (b, b)
_) (Left  a
a,(a
s,b
t)) = (a -> Either a b
forall a b. a -> Either a b
Left  a
c,(a
s',b
t)) where (a
c,a
s') = (a, a) -> (a, a)
f (a
a,a
s)
     ((a, a) -> (a, a)
_ +++@ (a, b) -> (b, b)
g) (Right a
b,(a
s,b
t)) = (b -> Either a b
forall a b. b -> Either a b
Right b
d,(a
s,b
t')) where (b
d,b
t') = (a, b) -> (b, b)
g (a
b,b
t)
  {-# INLINE (+++) #-}

instance CartCon con => BraidedSCat (Mealy con) where
  swapS :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con (Coprod (Mealy con) a b) (Coprod (Mealy con) b a)
swapS = (Coprod (Mealy con) a b -> Coprod (Mealy con) b a)
-> Mealy con (Coprod (Mealy con) a b) (Coprod (Mealy con) b a)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Coprod (Mealy con) a b -> Coprod (Mealy con) b a
forall a b.
Ok2 (->) a b =>
Coprod (Mealy con) a b -> Coprod (Mealy con) b a
forall (k :: * -> * -> *) a b.
(BraidedSCat k, Ok2 k a b) =>
k (Coprod (Mealy con) a b) (Coprod (Mealy con) b a)
swapS

instance CartCon con => CoproductCat (Mealy con) where
  inl :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con a (Coprod (Mealy con) a b)
inl = (a -> Coprod (Mealy con) a b)
-> Mealy con a (Coprod (Mealy con) a b)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> Coprod (Mealy con) a b
forall a b. Ok2 (->) a b => a -> Coprod (Mealy con) a b
forall (k :: * -> * -> *) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod (Mealy con) a b)
inl
  inr :: forall a b.
Ok2 (Mealy con) a b =>
Mealy con b (Coprod (Mealy con) a b)
inr = (b -> Coprod (Mealy con) a b)
-> Mealy con b (Coprod (Mealy con) a b)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr b -> Coprod (Mealy con) a b
forall a b. Ok2 (->) a b => b -> Coprod (Mealy con) a b
forall (k :: * -> * -> *) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod (Mealy con) a b)
inr
  jam :: forall a. Ok (Mealy con) a => Mealy con (Coprod (Mealy con) a a) a
jam = (Coprod (Mealy con) a a -> a)
-> Mealy con (Coprod (Mealy con) a a) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Coprod (Mealy con) a a -> a
forall a. Ok (->) a => Coprod (Mealy con) a a -> a
forall (k :: * -> * -> *) a.
(CoproductCat k, Ok k a) =>
k (Coprod (Mealy con) a a) a
jam
  -- (|||) = op2 (|||@)
  --  where
  --    (f |||@ _) (Left  a,(s,t)) = (c,(s',t)) where (c,s') = f (a,s)
  --    (_ |||@ g) (Right b,(s,t)) = (c,(s,t')) where (c,t') = g (b,t)
  {-# INLINE inl #-}
  {-# INLINE inr #-}
  -- {-# INLINE (|||) #-}

instance CartCon con => ConstCat (Mealy con) b where const :: forall a.
Ok (Mealy con) a =>
ConstObj (Mealy con) b -> Mealy con a (ConstObj (Mealy con) b)
const ConstObj (Mealy con) b
b = (a -> ConstObj (Mealy con) b)
-> Mealy con a (ConstObj (Mealy con) b)
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr (ConstObj (Mealy con) b -> a -> ConstObj (Mealy con) b
forall a.
Ok (->) a =>
ConstObj (Mealy con) b -> a -> ConstObj (Mealy con) b
forall (k :: * -> * -> *) b a.
(ConstCat k (ConstObj k b), Ok k a) =>
ConstObj k b -> k a (ConstObj k b)
const ConstObj (Mealy con) b
b)

instance CartCon con => BoolCat (Mealy con) where
  notC :: Mealy con (BoolOf (Mealy con)) (BoolOf (Mealy con))
notC = (BoolOf (Mealy con) -> BoolOf (Mealy con))
-> Mealy con (BoolOf (Mealy con)) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr BoolOf (Mealy con) -> BoolOf (Mealy con)
forall (k :: * -> * -> *).
BoolCat k =>
k (BoolOf (Mealy con)) (BoolOf (Mealy con))
notC
  andC :: Mealy
  con
  (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
andC = (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
 -> BoolOf (Mealy con))
-> Mealy
     con
     (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
     (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
-> BoolOf (Mealy con)
forall (k :: * -> * -> *).
BoolCat k =>
k (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
andC
  orC :: Mealy
  con
  (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
orC  = (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
 -> BoolOf (Mealy con))
-> Mealy
     con
     (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
     (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
-> BoolOf (Mealy con)
forall (k :: * -> * -> *).
BoolCat k =>
k (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
orC
  xorC :: Mealy
  con
  (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
xorC = (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
 -> BoolOf (Mealy con))
-> Mealy
     con
     (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
     (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con))
-> BoolOf (Mealy con)
forall (k :: * -> * -> *).
BoolCat k =>
k (Prod (Mealy con) (BoolOf (Mealy con)) (BoolOf (Mealy con)))
  (BoolOf (Mealy con))
xorC

instance (CartCon con, Eq a) => EqCat (Mealy con) a where
  equal :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
equal    = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
equal
  notEqual :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
notEqual = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
notEqual

instance (CartCon con, Ord a) => OrdCat (Mealy con) a where
  lessThan :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
lessThan           = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
lessThan
  greaterThan :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
greaterThan        = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
greaterThan
  lessThanOrEqual :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
lessThanOrEqual    = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
lessThanOrEqual
  greaterThanOrEqual :: Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
greaterThanOrEqual = (Prod (Mealy con) a a -> BoolOf (Mealy con))
-> Mealy con (Prod (Mealy con) a a) (BoolOf (Mealy con))
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> BoolOf (Mealy con)
forall (k :: * -> * -> *) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Mealy con))
greaterThanOrEqual

instance (CartCon con, Enum a) => EnumCat (Mealy con) a where
  succC :: Mealy con a a
succC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. EnumCat k a => k a a
succC
  predC :: Mealy con a a
predC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. EnumCat k a => k a a
predC

instance (CartCon con, Num a) => NumCat (Mealy con) a where
  negateC :: Mealy con a a
negateC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. NumCat k a => k a a
negateC
  addC :: Mealy con (Prod (Mealy con) a a) a
addC    = (Prod (Mealy con) a a -> a) -> Mealy con (Prod (Mealy con) a a) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> a
forall (k :: * -> * -> *) a. NumCat k a => k (Prod k a a) a
addC
  subC :: Mealy con (Prod (Mealy con) a a) a
subC    = (Prod (Mealy con) a a -> a) -> Mealy con (Prod (Mealy con) a a) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> a
forall (k :: * -> * -> *) a. NumCat k a => k (Prod k a a) a
subC
  mulC :: Mealy con (Prod (Mealy con) a a) a
mulC    = (Prod (Mealy con) a a -> a) -> Mealy con (Prod (Mealy con) a a) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> a
forall (k :: * -> * -> *) a. NumCat k a => k (Prod k a a) a
mulC
  powIC :: Ok (Mealy con) Int => Mealy con (Prod (Mealy con) a Int) a
powIC   = (Prod (Mealy con) a Int -> a)
-> Mealy con (Prod (Mealy con) a Int) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a Int -> a
forall (k :: * -> * -> *) a.
(NumCat k a, Ok k Int) =>
k (Prod k a Int) a
powIC

instance (CartCon con, Fractional a) => FractionalCat (Mealy con) a where
  recipC :: Mealy con a a
recipC  = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FractionalCat k a => k a a
recipC
  divideC :: Mealy con (Prod (Mealy con) a a) a
divideC = (Prod (Mealy con) a a -> a) -> Mealy con (Prod (Mealy con) a a) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) a a -> a
forall (k :: * -> * -> *) a. FractionalCat k a => k (Prod k a a) a
divideC

instance (CartCon con, Floating a) => FloatingCat (Mealy con) a where
  expC :: Mealy con a a
expC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FloatingCat k a => k a a
expC
  logC :: Mealy con a a
logC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FloatingCat k a => k a a
logC
  cosC :: Mealy con a a
cosC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FloatingCat k a => k a a
cosC
  sinC :: Mealy con a a
sinC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FloatingCat k a => k a a
sinC
  sqrtC :: Mealy con a a
sqrtC = (a -> a) -> Mealy con a a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> a
forall (k :: * -> * -> *) a. FloatingCat k a => k a a
sqrtC

instance (CartCon con, RealFracCat (->) a b) => RealFracCat (Mealy con) a b where
  floorC :: Mealy con a b
floorC    = (a -> b) -> Mealy con a b
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> b
forall (k :: * -> * -> *) a b. RealFracCat k a b => k a b
floorC
  ceilingC :: Mealy con a b
ceilingC  = (a -> b) -> Mealy con a b
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> b
forall (k :: * -> * -> *) a b. RealFracCat k a b => k a b
ceilingC
  truncateC :: Mealy con a b
truncateC = (a -> b) -> Mealy con a b
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> b
forall (k :: * -> * -> *) a b. RealFracCat k a b => k a b
truncateC
 
instance (CartCon con, BottomCat (->) a b) => BottomCat (Mealy con) a b where
  bottomC :: Mealy con a b
bottomC = (a -> b) -> Mealy con a b
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> b
forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (b :: k1).
BottomCat k2 a b =>
k2 a b
bottomC

instance CartCon con => IfCat (Mealy con) a where
  ifC :: IfT (Mealy con) a
ifC = (Prod (Mealy con) (BoolOf (Mealy con)) (Prod (Mealy con) a a) -> a)
-> IfT (Mealy con) a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr Prod (Mealy con) (BoolOf (Mealy con)) (Prod (Mealy con) a a) -> a
forall (k :: * -> * -> *) a. IfCat k a => IfT k a
ifC

-- instance (HasRep a, r ~ Rep a) => (CartCon con, RepCat (Mealy con) a r where
--   reprC = arr reprC
--   abstC = arr abstC

instance (CartCon con, RepCat (->) a r) => RepCat (Mealy con) a r where
  reprC :: Mealy con a r
reprC = (a -> r) -> Mealy con a r
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr a -> r
forall {k} (k1 :: k -> k -> *) (a :: k) (r :: k).
RepCat k1 a r =>
k1 a r
reprC
  abstC :: Mealy con r a
abstC = (r -> a) -> Mealy con r a
forall (con :: * -> Constraint) a b.
con () =>
(a -> b) -> Mealy con a b
arr r -> a
forall {k} (k1 :: k -> k -> *) (a :: k) (r :: k).
RepCat k1 a r =>
k1 r a
abstC

--     • Illegal instance declaration for ‘RepCat (Mealy con) a r’
--         The coverage condition fails in class ‘RepCat’
--           for functional dependency: ‘a -> r’
--         Reason: lhs type ‘a’ does not determine rhs type ‘r’
--         Un-determined variable: r
--         Using UndecidableInstances might help

{--------------------------------------------------------------------
    Other operations
--------------------------------------------------------------------}

delay :: con a => a -> Mealy con a a
delay :: forall (con :: * -> Constraint) a. con a => a -> Mealy con a a
delay = ((a :* a) -> a :* a) -> a -> Mealy con a a
forall (con :: * -> Constraint) a b s.
con s =>
((a :* s) -> b :* s) -> s -> Mealy con a b
Mealy (a :* a) -> a :* a
forall a b. (a, b) -> (b, a)
swap

scanl :: con b => (b -> a -> b) -> b -> Mealy con a b
scanl :: forall (con :: * -> Constraint) b a.
con b =>
(b -> a -> b) -> b -> Mealy con a b
scanl b -> a -> b
op = ((a :* b) -> b :* b) -> b -> Mealy con a b
forall (con :: * -> Constraint) a b s.
con s =>
((a :* s) -> b :* s) -> s -> Mealy con a b
Mealy (\ (a
a,b
b) -> b -> b :* b
forall a. Ok (->) a => a -> Prod (Mealy con) a a
forall (k :: * -> * -> *) a.
(ProductCat k, Ok k a) =>
k a (Prod (Mealy con) a a)
dup (b
b b -> a -> b
`op` a
a))
{-# INLINE scanl #-}

scan :: (Monoid m, con m) => Mealy con m m
scan :: forall m (con :: * -> Constraint).
(Monoid m, con m) =>
Mealy con m m
scan = (m -> m -> m) -> m -> Mealy con m m
forall (con :: * -> Constraint) b a.
con b =>
(b -> a -> b) -> b -> Mealy con a b
scanl m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
forall a. Monoid a => a
mempty

{--------------------------------------------------------------------
    
--------------------------------------------------------------------}

type Stream = []  -- infinite-only. To do: use real streams.

newtype StreamX a b = StreamX (Stream a -> Stream b)

fixSX :: StreamX (a :* b) b -> StreamX a b
fixSX :: forall a b. StreamX (a :* b) b -> StreamX a b
fixSX (StreamX Stream (a :* b) -> Stream b
h) = (Stream a -> Stream b) -> StreamX a b
forall a b. (Stream a -> Stream b) -> StreamX a b
StreamX (\ Stream a
as -> (Stream b -> Stream b) -> Stream b
forall a. (a -> a) -> a
fix (\ Stream b
bs -> Stream (a :* b) -> Stream b
h (Stream a
as Stream a -> Stream b -> Stream (a :* b)
forall a b. [a] -> [b] -> [(a, b)]
`zip` Stream b
bs)))
-- fixSX (StreamX h) = StreamX (\ as -> let bs = h (as `zip` bs) in bs)

-- fixMealy :: forall a b. Mealy (a :* b) b -> Mealy a b
-- fixMealy (Mealy h s0) = Mealy (k t0)
--  where
--    ...

-- h :: (a :* b) :* s -> b :* s
--   =~ a -> (b :* s -> b :* s)

-- k :: a :* s -> b :* s
   



{--------------------------------------------------------------------
    Examples
--------------------------------------------------------------------}

fibL2 :: Num a => [a]
fibL2 :: forall a. Num a => [a]
fibL2 = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) [a]
forall a. Num a => [a]
fibL2 ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
forall a. Num a => [a]
fibL2)

fibL3 :: Num a => [a]
fibL3 :: forall a. Num a => [a]
fibL3 = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) (a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
forall a. Num a => [a]
fibL3) [a]
forall a. Num a => [a]
fibL3