module Lava.Generic where

import Lava.Signal
import Lava.Sequent
import Lava.Error

import Lava.LavaRandom
  ( Rnd
  , split
  , next
  )

import Data.List
  ( transpose
  )

----------------------------------------------------------------
-- Struct

data Struct a
  = Compound [Struct a]
  | Object a
 deriving (Struct a -> Struct a -> Bool
(Struct a -> Struct a -> Bool)
-> (Struct a -> Struct a -> Bool) -> Eq (Struct a)
forall a. Eq a => Struct a -> Struct a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Struct a -> Struct a -> Bool
$c/= :: forall a. Eq a => Struct a -> Struct a -> Bool
== :: Struct a -> Struct a -> Bool
$c== :: forall a. Eq a => Struct a -> Struct a -> Bool
Eq, Int -> Struct a -> ShowS
[Struct a] -> ShowS
Struct a -> String
(Int -> Struct a -> ShowS)
-> (Struct a -> String) -> ([Struct a] -> ShowS) -> Show (Struct a)
forall a. Show a => Int -> Struct a -> ShowS
forall a. Show a => [Struct a] -> ShowS
forall a. Show a => Struct a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Struct a] -> ShowS
$cshowList :: forall a. Show a => [Struct a] -> ShowS
show :: Struct a -> String
$cshow :: forall a. Show a => Struct a -> String
showsPrec :: Int -> Struct a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Struct a -> ShowS
Show)

flatten :: Struct a -> [a]
flatten :: Struct a -> [a]
flatten (Object a :: a
a)    = [a
a]
flatten (Compound ss :: [Struct a]
ss) = (Struct a -> [a]) -> [Struct a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Struct a -> [a]
forall a. Struct a -> [a]
flatten [Struct a]
ss

transStruct :: Struct [a] -> [Struct a]
transStruct :: Struct [a] -> [Struct a]
transStruct (Object as :: [a]
as)   = (a -> Struct a) -> [a] -> [Struct a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Struct a
forall a. a -> Struct a
Object [a]
as
transStruct (Compound ss :: [Struct [a]]
ss) =
  ([Struct a] -> Struct a) -> [[Struct a]] -> [Struct a]
forall a b. (a -> b) -> [a] -> [b]
map [Struct a] -> Struct a
forall a. [Struct a] -> Struct a
Compound ([[Struct a]] -> [Struct a])
-> ([Struct [a]] -> [[Struct a]]) -> [Struct [a]] -> [Struct a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Struct a]] -> [[Struct a]]
forall a. [[a]] -> [[a]]
transpose ([[Struct a]] -> [[Struct a]])
-> ([Struct [a]] -> [[Struct a]]) -> [Struct [a]] -> [[Struct a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Struct [a] -> [Struct a]) -> [Struct [a]] -> [[Struct a]]
forall a b. (a -> b) -> [a] -> [b]
map Struct [a] -> [Struct a]
forall a. Struct [a] -> [Struct a]
transStruct ([Struct [a]] -> [Struct a]) -> [Struct [a]] -> [Struct a]
forall a b. (a -> b) -> a -> b
$ [Struct [a]]
ss

-- structural operations

instance Functor Struct where
  fmap :: (a -> b) -> Struct a -> Struct b
fmap f :: a -> b
f (Object a :: a
a)    = b -> Struct b
forall a. a -> Struct a
Object (a -> b
f a
a)
  fmap f :: a -> b
f (Compound xs :: [Struct a]
xs) = [Struct b] -> Struct b
forall a. [Struct a] -> Struct a
Compound ((Struct a -> Struct b) -> [Struct a] -> [Struct b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Struct a -> Struct b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Struct a]
xs)

instance Sequent Struct where
  sequent :: Struct (m a) -> m (Struct a)
sequent (Object m :: m a
m) =
    do a
a <- m a
m
       Struct a -> m (Struct a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Struct a
forall a. a -> Struct a
Object a
a)

  sequent (Compound xs :: [Struct (m a)]
xs) =
    do [Struct a]
as <- [m (Struct a)] -> m [Struct a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Struct (m a) -> m (Struct a)
forall (s :: * -> *) (m :: * -> *) a.
(Sequent s, Monad m) =>
s (m a) -> m (s a)
sequent Struct (m a)
x | Struct (m a)
x <- [Struct (m a)]
xs ]
       Struct a -> m (Struct a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Struct a] -> Struct a
forall a. [Struct a] -> Struct a
Compound [Struct a]
as)

----------------------------------------------------------------
-- Generic datatypes

class Generic a where
  struct    :: a -> Struct Symbol
  construct :: Struct Symbol -> a

instance Generic Symbol where
  struct :: Symbol -> Struct Symbol
struct    s :: Symbol
s          = Symbol -> Struct Symbol
forall a. a -> Struct a
Object Symbol
s
  construct :: Struct Symbol -> Symbol
construct (Object s :: Symbol
s) = Symbol
s

instance Generic (Signal a) where
  struct :: Signal a -> Struct Symbol
struct    (Signal s :: Symbol
s) = Symbol -> Struct Symbol
forall a. a -> Struct a
Object Symbol
s
  construct :: Struct Symbol -> Signal a
construct (Object s :: Symbol
s) = Symbol -> Signal a
forall a. Symbol -> Signal a
Signal Symbol
s

instance Generic () where
  struct :: () -> Struct Symbol
struct    ()            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound []
  construct :: Struct Symbol -> ()
construct (Compound []) = ()

instance Generic a => Generic [a] where
  struct :: [a] -> Struct Symbol
struct    xs :: [a]
xs            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound ((a -> Struct Symbol) -> [a] -> [Struct Symbol]
forall a b. (a -> b) -> [a] -> [b]
map a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct [a]
xs)
  construct :: Struct Symbol -> [a]
construct (Compound xs :: [Struct Symbol]
xs) = (Struct Symbol -> a) -> [Struct Symbol] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct [Struct Symbol]
xs

instance (Generic a, Generic b) => Generic (a,b) where
  struct :: (a, b) -> Struct Symbol
struct    (a :: a
a,b :: b
b)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b]
  construct :: Struct Symbol -> (a, b)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b)

instance (Generic a, Generic b, Generic c) => Generic (a,b,c) where
  struct :: (a, b, c) -> Struct Symbol
struct    (a :: a
a,b :: b
b,c :: c
c)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b, c -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct c
c]
  construct :: Struct Symbol -> (a, b, c)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b,c :: Struct Symbol
c]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b, Struct Symbol -> c
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
c)

instance (Generic a, Generic b, Generic c, Generic d) => Generic (a,b,c,d) where
  struct :: (a, b, c, d) -> Struct Symbol
struct    (a :: a
a,b :: b
b,c :: c
c,d :: d
d)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b, c -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct c
c, d -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct d
d]
  construct :: Struct Symbol -> (a, b, c, d)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b,c :: Struct Symbol
c,d :: Struct Symbol
d]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b, Struct Symbol -> c
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
c, Struct Symbol -> d
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
d)

instance (Generic a, Generic b, Generic c, Generic d, Generic e) => Generic (a,b,c,d,e) where
  struct :: (a, b, c, d, e) -> Struct Symbol
struct    (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b, c -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct c
c, d -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct d
d, e -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct e
e]
  construct :: Struct Symbol -> (a, b, c, d, e)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b,c :: Struct Symbol
c,d :: Struct Symbol
d,e :: Struct Symbol
e]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b, Struct Symbol -> c
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
c, Struct Symbol -> d
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
d, Struct Symbol -> e
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
e)

instance (Generic a, Generic b, Generic c, Generic d, Generic e, Generic f) => Generic (a,b,c,d,e,f) where
  struct :: (a, b, c, d, e, f) -> Struct Symbol
struct    (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b, c -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct c
c, d -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct d
d, e -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct e
e, f -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct f
f]
  construct :: Struct Symbol -> (a, b, c, d, e, f)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b,c :: Struct Symbol
c,d :: Struct Symbol
d,e :: Struct Symbol
e,f :: Struct Symbol
f]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b, Struct Symbol -> c
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
c, Struct Symbol -> d
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
d, Struct Symbol -> e
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
e, Struct Symbol -> f
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
f)

instance (Generic a, Generic b, Generic c, Generic d, Generic e, Generic f, Generic g) => Generic (a,b,c,d,e,f,g) where
  struct :: (a, b, c, d, e, f, g) -> Struct Symbol
struct    (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f,g :: g
g)            = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a, b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct b
b, c -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct c
c, d -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct d
d, e -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct e
e, f -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct f
f, g -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct g
g]
  construct :: Struct Symbol -> (a, b, c, d, e, f, g)
construct (Compound [a :: Struct Symbol
a,b :: Struct Symbol
b,c :: Struct Symbol
c,d :: Struct Symbol
d,e :: Struct Symbol
e,f :: Struct Symbol
f,g :: Struct Symbol
g]) = (Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
a, Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
b, Struct Symbol -> c
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
c, Struct Symbol -> d
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
d, Struct Symbol -> e
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
e, Struct Symbol -> f
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
f, Struct Symbol -> g
forall a. Generic a => Struct Symbol -> a
construct Struct Symbol
g)

----------------------------------------------------------------
-- Ops

data Ops
  = Ops { Ops -> Symbol -> Symbol -> Signal Bool
equalSymbol :: Symbol -> Symbol -> Signal Bool
        , Ops -> Symbol -> Symbol -> Symbol
delaySymbol :: Symbol -> Symbol -> Symbol
        , Ops -> Signal Bool -> (Symbol, Symbol) -> Symbol
ifSymbol    :: Signal Bool -> (Symbol, Symbol) -> Symbol
        , Ops -> String -> Symbol
varSymbol   :: String -> Symbol
        , Ops -> Symbol
zeroSymbol  :: Symbol
        }

opsBool :: Ops
opsBool :: Ops
opsBool =
  Ops :: (Symbol -> Symbol -> Signal Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Signal Bool -> (Symbol, Symbol) -> Symbol)
-> (String -> Symbol)
-> Symbol
-> Ops
Ops { equalSymbol :: Symbol -> Symbol -> Signal Bool
equalSymbol = \x :: Symbol
x y :: Symbol
y     -> Signal Bool -> Signal Bool -> Signal Bool
equalBool (Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
x) (Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
y)
      , delaySymbol :: Symbol -> Symbol -> Symbol
delaySymbol = \x :: Symbol
x y :: Symbol
y     -> Signal Bool -> Symbol
forall a. Signal a -> Symbol
unSignal (Signal Bool -> Symbol) -> Signal Bool -> Symbol
forall a b. (a -> b) -> a -> b
$ Signal Bool -> Signal Bool -> Signal Bool
delayBool (Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
x) (Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
y)
      , ifSymbol :: Signal Bool -> (Symbol, Symbol) -> Symbol
ifSymbol    = \c :: Signal Bool
c (x :: Symbol
x,y :: Symbol
y) -> Signal Bool -> Symbol
forall a. Signal a -> Symbol
unSignal (Signal Bool -> Symbol) -> Signal Bool -> Symbol
forall a b. (a -> b) -> a -> b
$ Signal Bool -> (Signal Bool, Signal Bool) -> Signal Bool
ifBool Signal Bool
c  (Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
x,  Symbol -> Signal Bool
forall a. Symbol -> Signal a
Signal Symbol
y)
      , varSymbol :: String -> Symbol
varSymbol   = \s :: String
s       -> S Symbol -> Symbol
symbol (String -> S Symbol
forall s. String -> S s
VarBool String
s)
      , zeroSymbol :: Symbol
zeroSymbol  =             S Symbol -> Symbol
symbol (Bool -> S Symbol
forall s. Bool -> S s
Bool Bool
False)
      }

opsInt :: Ops
opsInt :: Ops
opsInt =
  Ops :: (Symbol -> Symbol -> Signal Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Signal Bool -> (Symbol, Symbol) -> Symbol)
-> (String -> Symbol)
-> Symbol
-> Ops
Ops { equalSymbol :: Symbol -> Symbol -> Signal Bool
equalSymbol = \x :: Symbol
x y :: Symbol
y     -> Signal Int -> Signal Int -> Signal Bool
equalInt (Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
x) (Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
y)
      , delaySymbol :: Symbol -> Symbol -> Symbol
delaySymbol = \x :: Symbol
x y :: Symbol
y     -> Signal Int -> Symbol
forall a. Signal a -> Symbol
unSignal (Signal Int -> Symbol) -> Signal Int -> Symbol
forall a b. (a -> b) -> a -> b
$ Signal Int -> Signal Int -> Signal Int
delayInt (Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
x) (Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
y)
      , ifSymbol :: Signal Bool -> (Symbol, Symbol) -> Symbol
ifSymbol    = \c :: Signal Bool
c (x :: Symbol
x,y :: Symbol
y) -> Signal Any -> Symbol
forall a. Signal a -> Symbol
unSignal (Signal Any -> Symbol) -> Signal Any -> Symbol
forall a b. (a -> b) -> a -> b
$ Signal Bool -> (Signal Int, Signal Int) -> Signal Any
forall a. Signal Bool -> (Signal Int, Signal Int) -> Signal a
ifInt Signal Bool
c  (Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
x,  Symbol -> Signal Int
forall a. Symbol -> Signal a
Signal Symbol
y)
      , varSymbol :: String -> Symbol
varSymbol   = \s :: String
s       -> S Symbol -> Symbol
symbol (String -> S Symbol
forall s. String -> S s
VarInt String
s)
      , zeroSymbol :: Symbol
zeroSymbol  =             S Symbol -> Symbol
symbol (Int -> S Symbol
forall s. Int -> S s
Int 0)
      }

unSignal :: Signal a -> Symbol
unSignal :: Signal a -> Symbol
unSignal (Signal s :: Symbol
s) = Symbol
s

ops :: Symbol -> Ops
ops :: Symbol -> Ops
ops s :: Symbol
s =
  case Symbol -> S Symbol
unsymbol Symbol
s of
    Bool b :: Bool
b         -> Ops
opsBool
    Inv s :: Symbol
s          -> Ops
opsBool
    And xs :: [Symbol]
xs         -> Ops
opsBool
    Or xs :: [Symbol]
xs          -> Ops
opsBool
    Xor xs :: [Symbol]
xs         -> Ops
opsBool

    Int n :: Int
n          -> Ops
opsInt
    Neg s :: Symbol
s          -> Ops
opsInt
    Div s1 :: Symbol
s1 s2 :: Symbol
s2      -> Ops
opsInt
    Mod s1 :: Symbol
s1 s2 :: Symbol
s2      -> Ops
opsInt
    Plus xs :: [Symbol]
xs        -> Ops
opsInt
    Times xs :: [Symbol]
xs       -> Ops
opsInt
    Gte x :: Symbol
x y :: Symbol
y        -> Ops
opsBool
    Equal xs :: [Symbol]
xs       -> Ops
opsBool
    If x :: Symbol
x y :: Symbol
y z :: Symbol
z       -> Ops
opsInt

    DelayBool s :: Symbol
s s' :: Symbol
s' -> Ops
opsBool
    DelayInt  s :: Symbol
s s' :: Symbol
s' -> Ops
opsInt
    VarBool s :: String
s      -> Ops
opsBool
    VarInt  s :: String
s      -> Ops
opsInt

----------------------------------------------------------------
-- generic definitions

equal :: Generic a => (a, a) -> Signal Bool
equal :: (a, a) -> Signal Bool
equal (x :: a
x, y :: a
y) = Struct Symbol -> Struct Symbol -> Signal Bool
eq (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
x) (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
y)
 where
  eq :: Struct Symbol -> Struct Symbol -> Signal Bool
eq (Object a :: Symbol
a)    (Object b :: Symbol
b)    = Ops -> Symbol -> Symbol -> Signal Bool
equalSymbol (Symbol -> Ops
ops Symbol
a) Symbol
a Symbol
b
  eq (Compound as :: [Struct Symbol]
as) (Compound bs :: [Struct Symbol]
bs) = [Struct Symbol] -> [Struct Symbol] -> Signal Bool
eqs [Struct Symbol]
as [Struct Symbol]
bs
  eq _             _             = Signal Bool
low

  eqs :: [Struct Symbol] -> [Struct Symbol] -> Signal Bool
eqs []     []     = Signal Bool
high
  eqs (a :: Struct Symbol
a:as :: [Struct Symbol]
as) (b :: Struct Symbol
b:bs :: [Struct Symbol]
bs) = [Signal Bool] -> Signal Bool
andl [Struct Symbol -> Struct Symbol -> Signal Bool
eq Struct Symbol
a Struct Symbol
b, [Struct Symbol] -> [Struct Symbol] -> Signal Bool
eqs [Struct Symbol]
as [Struct Symbol]
bs]
  eqs _      _      = Signal Bool
low

delay :: Generic a => a -> a -> a
delay :: a -> a -> a
delay x :: a
x y :: a
y = Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct (Struct Symbol -> Struct Symbol -> Struct Symbol
del (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
x) (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
y))
 where
  del :: Struct Symbol -> Struct Symbol -> Struct Symbol
del (Object a :: Symbol
a)    ~(Object b :: Symbol
b)    = Symbol -> Struct Symbol
forall a. a -> Struct a
Object (Ops -> Symbol -> Symbol -> Symbol
delaySymbol (Symbol -> Ops
ops Symbol
a) Symbol
a Symbol
b)
  del (Compound as :: [Struct Symbol]
as) ~(Compound bs :: [Struct Symbol]
bs) = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound ((Struct Symbol -> Struct Symbol -> Struct Symbol)
-> [Struct Symbol] -> [Struct Symbol] -> [Struct Symbol]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
lazyZipWith Struct Symbol -> Struct Symbol -> Struct Symbol
del [Struct Symbol]
as [Struct Symbol]
bs)
  del _             _              = Error -> Struct Symbol
forall a. Error -> a
wrong Error
Lava.Error.IncompatibleStructures

zeroify :: Generic a => a -> a
zeroify :: a -> a
zeroify x :: a
x = Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct (Struct Symbol -> Struct Symbol
zero (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
x))
 where
  zero :: Struct Symbol -> Struct Symbol
zero (Object a :: Symbol
a)    = Symbol -> Struct Symbol
forall a. a -> Struct a
Object (Ops -> Symbol
zeroSymbol (Symbol -> Ops
ops Symbol
a))
  zero (Compound as :: [Struct Symbol]
as) = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [ Struct Symbol -> Struct Symbol
zero Struct Symbol
a | Struct Symbol
a <- [Struct Symbol]
as ]

symbolize :: Generic a => String -> a -> a
symbolize :: String -> a -> a
symbolize s :: String
s x :: a
x = Struct Symbol -> a
forall a. Generic a => Struct Symbol -> a
construct (String -> Struct Symbol -> Struct Symbol
sym String
s (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
x))
 where
  sym :: String -> Struct Symbol -> Struct Symbol
sym s :: String
s (Object a :: Symbol
a)    = Symbol -> Struct Symbol
forall a. a -> Struct a
Object (Ops -> String -> Symbol
varSymbol (Symbol -> Ops
ops Symbol
a) String
s)
  sym s :: String
s (Compound as :: [Struct Symbol]
as) = [Struct Symbol] -> Struct Symbol
forall a. [Struct a] -> Struct a
Compound [ String -> Struct Symbol -> Struct Symbol
sym (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i) Struct Symbol
a
                                 | (a :: Struct Symbol
a,i :: Integer
i) <- [Struct Symbol]
as [Struct Symbol] -> [Integer] -> [(Struct Symbol, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [0..]
                                 ]

pickSymbol :: Generic a => String -> a -> Symbol
pickSymbol :: String -> a -> Symbol
pickSymbol s :: String
s a :: a
a = [Int] -> Struct Symbol -> Symbol
forall p. [Int] -> Struct p -> p
pick (String -> [Int]
forall a. Read a => String -> [a]
numbers String
s) (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
a)
 where
  pick :: [Int] -> Struct p -> p
pick _      (Object a :: p
a)    = p
a
  pick (n :: Int
n:ns :: [Int]
ns) (Compound as :: [Struct p]
as) = [Int] -> Struct p -> p
pick [Int]
ns ([Struct p]
as [Struct p] -> Int -> Struct p
forall a. [a] -> Int -> a
!! Int
n)

  numbers :: String -> [a]
numbers ('_':s :: String
s) = String -> a
forall a. Read a => String -> a
read String
s1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: String -> [a]
numbers String
s2
   where
    s1 :: String
s1 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '_') String
s
    s2 :: String
s2 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '_') String
s

----------------------------------------------------------------
-- Constructive

class ConstructiveSig a where
  zeroSig   :: Signal a
  varSig    :: String -> Signal a
  randomSig :: Rnd -> Signal a

class Generic a => Constructive a where
  zero   :: a
  var    :: String -> a
  random :: Rnd -> a

zeroList :: Constructive a => Int -> [a]
zeroList :: Int -> [a]
zeroList n :: Int
n = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
forall a. Constructive a => a
zero

varList :: Constructive a => Int -> String -> [a]
varList :: Int -> String -> [a]
varList n :: Int
n s :: String
s = [ String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [0..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)] ]

randomList :: Constructive a => Int -> Rnd -> [a]
randomList :: Int -> Rnd -> [a]
randomList n :: Int
n rnd :: Rnd
rnd = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [ Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd' | Rnd
rnd' <- Rnd -> [Rnd]
splitRndList Rnd
rnd ]

splitRndList :: Rnd -> [Rnd]
splitRndList :: Rnd -> [Rnd]
splitRndList rnd :: Rnd
rnd = Rnd
rnd1 Rnd -> [Rnd] -> [Rnd]
forall a. a -> [a] -> [a]
: Rnd -> [Rnd]
splitRndList Rnd
rnd2 where (rnd1 :: Rnd
rnd1, rnd2 :: Rnd
rnd2) = Rnd -> (Rnd, Rnd)
forall g. RandomGen g => g -> (g, g)
split Rnd
rnd

valRnd :: Rnd -> Int
valRnd :: Rnd -> Int
valRnd rnd :: Rnd
rnd = Int
i where (i :: Int
i, _) = Rnd -> (Int, Rnd)
forall g. RandomGen g => g -> (Int, g)
next Rnd
rnd

-- instances

instance ConstructiveSig Bool where
  zeroSig :: Signal Bool
zeroSig       = Signal Bool
low
  varSig :: String -> Signal Bool
varSig        = String -> Signal Bool
varBool
  randomSig :: Rnd -> Signal Bool
randomSig rnd :: Rnd
rnd = [Signal Bool] -> Signal Bool
forall (t :: * -> *) b. (Foldable t, Generic b) => t b -> b
looping (Int -> [Signal Bool] -> [Signal Bool]
forall a. Int -> [a] -> [a]
take Int
n [ Rnd -> Signal Bool
bit Rnd
rnd' | Rnd
rnd' <- Rnd -> [Rnd]
splitRndList Rnd
rnd2 ])
   where
    (rnd1 :: Rnd
rnd1,rnd2 :: Rnd
rnd2) = Rnd -> (Rnd, Rnd)
forall g. RandomGen g => g -> (g, g)
split Rnd
rnd
    n :: Int
n           = 30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Rnd -> Int
valRnd Rnd
rnd1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 10)
    bit :: Rnd -> Signal Bool
bit rnd :: Rnd
rnd     = Bool -> Signal Bool
bool (Int -> Bool
forall a. Integral a => a -> Bool
even (Rnd -> Int
valRnd Rnd
rnd))
    looping :: t b -> b
looping xs :: t b
xs  = b
out where out :: b
out = (b -> b -> b) -> b -> t b -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> b -> b
forall a. Generic a => a -> a -> a
delay b
out t b
xs

instance ConstructiveSig Int where
  zeroSig :: Signal Int
zeroSig     = Int -> Signal Int
int 0
  varSig :: String -> Signal Int
varSig      = String -> Signal Int
varInt
  randomSig :: Rnd -> Signal Int
randomSig rnd :: Rnd
rnd = [Signal Int] -> Signal Int
forall (t :: * -> *) b. (Foldable t, Generic b) => t b -> b
looping (Int -> [Signal Int] -> [Signal Int]
forall a. Int -> [a] -> [a]
take Int
n [ Rnd -> Signal Int
num Rnd
rnd' | Rnd
rnd' <- Rnd -> [Rnd]
splitRndList Rnd
rnd2 ])
   where
    (rnd1 :: Rnd
rnd1,rnd2 :: Rnd
rnd2) = Rnd -> (Rnd, Rnd)
forall g. RandomGen g => g -> (g, g)
split Rnd
rnd
    n :: Int
n           = 30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Rnd -> Int
valRnd Rnd
rnd1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 10)
    num :: Rnd -> Signal Int
num rnd :: Rnd
rnd     = Int -> Signal Int
int (20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Rnd -> Int
valRnd Rnd
rnd Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 20))
    looping :: t b -> b
looping xs :: t b
xs  = b
out where out :: b
out = (b -> b -> b) -> b -> t b -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> b -> b
forall a. Generic a => a -> a -> a
delay b
out t b
xs

instance ConstructiveSig a => Constructive (Signal a) where
  zero :: Signal a
zero   = Signal a
forall a. ConstructiveSig a => Signal a
zeroSig
  var :: String -> Signal a
var    = String -> Signal a
forall a. ConstructiveSig a => String -> Signal a
varSig
  random :: Rnd -> Signal a
random = Rnd -> Signal a
forall a. ConstructiveSig a => Rnd -> Signal a
randomSig

instance Constructive () where
  zero :: ()
zero       = ()
  var :: String -> ()
var s :: String
s      = ()
  random :: Rnd -> ()
random rnd :: Rnd
rnd = ()

instance (Constructive a, Constructive b)
      => Constructive (a, b) where
  zero :: (a, b)
zero       = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero)
  var :: String -> (a, b)
var s :: String
s      = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"))
  random :: Rnd -> (a, b)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2)
   where (rnd1 :: Rnd
rnd1, rnd2 :: Rnd
rnd2) = Rnd -> (Rnd, Rnd)
forall g. RandomGen g => g -> (g, g)
split Rnd
rnd

instance (Constructive a, Constructive b, Constructive c)
      => Constructive (a, b, c) where
  zero :: (a, b, c)
zero     = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero, c
forall a. Constructive a => a
zero)
  var :: String -> (a, b, c)
var s :: String
s    = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"), String -> c
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_3"))
  random :: Rnd -> (a, b, c)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2, Rnd -> c
forall a. Constructive a => Rnd -> a
random Rnd
rnd3)
   where (rnd1 :: Rnd
rnd1: rnd2 :: Rnd
rnd2 : rnd3 :: Rnd
rnd3 : _) = Rnd -> [Rnd]
splitRndList Rnd
rnd

instance (Constructive a, Constructive b, Constructive c, Constructive d)
      => Constructive (a, b, c, d) where
  zero :: (a, b, c, d)
zero     = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero, c
forall a. Constructive a => a
zero, d
forall a. Constructive a => a
zero)
  var :: String -> (a, b, c, d)
var s :: String
s    = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"), String -> c
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_3"), String -> d
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_4"))
  random :: Rnd -> (a, b, c, d)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2, Rnd -> c
forall a. Constructive a => Rnd -> a
random Rnd
rnd3, Rnd -> d
forall a. Constructive a => Rnd -> a
random Rnd
rnd4)
   where (rnd1 :: Rnd
rnd1: rnd2 :: Rnd
rnd2 : rnd3 :: Rnd
rnd3 : rnd4 :: Rnd
rnd4 : _) = Rnd -> [Rnd]
splitRndList Rnd
rnd

instance (Constructive a, Constructive b, Constructive c, Constructive d, Constructive e)
      => Constructive (a, b, c, d, e) where
  zero :: (a, b, c, d, e)
zero     = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero, c
forall a. Constructive a => a
zero, d
forall a. Constructive a => a
zero, e
forall a. Constructive a => a
zero)
  var :: String -> (a, b, c, d, e)
var s :: String
s    = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"), String -> c
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_3"), String -> d
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_4"), String -> e
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_5"))
  random :: Rnd -> (a, b, c, d, e)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2, Rnd -> c
forall a. Constructive a => Rnd -> a
random Rnd
rnd3, Rnd -> d
forall a. Constructive a => Rnd -> a
random Rnd
rnd4, Rnd -> e
forall a. Constructive a => Rnd -> a
random Rnd
rnd5)
   where (rnd1 :: Rnd
rnd1: rnd2 :: Rnd
rnd2 : rnd3 :: Rnd
rnd3 : rnd4 :: Rnd
rnd4 : rnd5 :: Rnd
rnd5 : _) = Rnd -> [Rnd]
splitRndList Rnd
rnd

instance (Constructive a, Constructive b, Constructive c, Constructive d, Constructive e, Constructive f)
      => Constructive (a, b, c, d, e, f) where
  zero :: (a, b, c, d, e, f)
zero     = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero, c
forall a. Constructive a => a
zero, d
forall a. Constructive a => a
zero, e
forall a. Constructive a => a
zero, f
forall a. Constructive a => a
zero)
  var :: String -> (a, b, c, d, e, f)
var s :: String
s    = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"), String -> c
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_3"), String -> d
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_4"), String -> e
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_5"), String -> f
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_6"))
  random :: Rnd -> (a, b, c, d, e, f)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2, Rnd -> c
forall a. Constructive a => Rnd -> a
random Rnd
rnd3, Rnd -> d
forall a. Constructive a => Rnd -> a
random Rnd
rnd4, Rnd -> e
forall a. Constructive a => Rnd -> a
random Rnd
rnd5, Rnd -> f
forall a. Constructive a => Rnd -> a
random Rnd
rnd6)
   where (rnd1 :: Rnd
rnd1: rnd2 :: Rnd
rnd2 : rnd3 :: Rnd
rnd3 : rnd4 :: Rnd
rnd4 : rnd5 :: Rnd
rnd5 : rnd6 :: Rnd
rnd6 : _) = Rnd -> [Rnd]
splitRndList Rnd
rnd

instance (Constructive a, Constructive b, Constructive c, Constructive d, Constructive e, Constructive f, Constructive g)
      => Constructive (a, b, c, d, e, f, g) where
  zero :: (a, b, c, d, e, f, g)
zero     = (a
forall a. Constructive a => a
zero, b
forall a. Constructive a => a
zero, c
forall a. Constructive a => a
zero, d
forall a. Constructive a => a
zero, e
forall a. Constructive a => a
zero, f
forall a. Constructive a => a
zero, g
forall a. Constructive a => a
zero)
  var :: String -> (a, b, c, d, e, f, g)
var s :: String
s    = (String -> a
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_1"), String -> b
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_2"), String -> c
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_3"), String -> d
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_4"), String -> e
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_5"), String -> f
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_6"), String -> g
forall a. Constructive a => String -> a
var (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_7"))
  random :: Rnd -> (a, b, c, d, e, f, g)
random rnd :: Rnd
rnd = (Rnd -> a
forall a. Constructive a => Rnd -> a
random Rnd
rnd1, Rnd -> b
forall a. Constructive a => Rnd -> a
random Rnd
rnd2, Rnd -> c
forall a. Constructive a => Rnd -> a
random Rnd
rnd3, Rnd -> d
forall a. Constructive a => Rnd -> a
random Rnd
rnd4, Rnd -> e
forall a. Constructive a => Rnd -> a
random Rnd
rnd5, Rnd -> f
forall a. Constructive a => Rnd -> a
random Rnd
rnd6, Rnd -> g
forall a. Constructive a => Rnd -> a
random Rnd
rnd7)
   where (rnd1 :: Rnd
rnd1: rnd2 :: Rnd
rnd2 : rnd3 :: Rnd
rnd3 : rnd4 :: Rnd
rnd4 : rnd5 :: Rnd
rnd5 : rnd6 :: Rnd
rnd6 : rnd7 :: Rnd
rnd7 : _) = Rnd -> [Rnd]
splitRndList Rnd
rnd

----------------------------------------------------------------
-- Finite

class ConstructiveSig a => FiniteSig a where
  domainSig :: [Signal a]

class Constructive a => Finite a where
  domain :: [a]

domainList :: Finite a => Int -> [[a]]
domainList :: Int -> [[a]]
domainList 0 = [[]]
domainList n :: Int
n = [ a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as | a
a <- [a]
forall a. Finite a => [a]
domain, [a]
as <- Int -> [[a]]
forall a. Finite a => Int -> [[a]]
domainList (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) ]

-- instances

instance FiniteSig Bool where
  domainSig :: [Signal Bool]
domainSig = [Signal Bool
low, Signal Bool
high]

instance FiniteSig a => Finite (Signal a) where
  domain :: [Signal a]
domain = [Signal a]
forall a. FiniteSig a => [Signal a]
domainSig

instance Finite () where
  domain :: [()]
domain = [ () ]

instance (Finite a, Finite b)
      => Finite (a, b) where
  domain :: [(a, b)]
domain = [ (a
a,b
b) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain ]

instance (Finite a, Finite b, Finite c)
      => Finite (a, b, c) where
  domain :: [(a, b, c)]
domain = [ (a
a,b
b,c
c) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain, c
c <- [c]
forall a. Finite a => [a]
domain ]

instance (Finite a, Finite b, Finite c, Finite d)
      => Finite (a, b, c, d) where
  domain :: [(a, b, c, d)]
domain = [ (a
a,b
b,c
c,d
d) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain, c
c <- [c]
forall a. Finite a => [a]
domain, d
d <- [d]
forall a. Finite a => [a]
domain ]

instance (Finite a, Finite b, Finite c, Finite d, Finite e)
      => Finite (a, b, c, d, e) where
  domain :: [(a, b, c, d, e)]
domain = [ (a
a,b
b,c
c,d
d,e
e) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain, c
c <- [c]
forall a. Finite a => [a]
domain, d
d <- [d]
forall a. Finite a => [a]
domain, e
e <- [e]
forall a. Finite a => [a]
domain ]

instance (Finite a, Finite b, Finite c, Finite d, Finite e, Finite f)
      => Finite (a, b, c, d, e, f) where
  domain :: [(a, b, c, d, e, f)]
domain = [ (a
a,b
b,c
c,d
d,e
e,f
f) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain, c
c <- [c]
forall a. Finite a => [a]
domain, d
d <- [d]
forall a. Finite a => [a]
domain, e
e <- [e]
forall a. Finite a => [a]
domain, f
f <- [f]
forall a. Finite a => [a]
domain ]

instance (Finite a, Finite b, Finite c, Finite d, Finite e, Finite f, Finite g)
      => Finite (a, b, c, d, e, f, g) where
  domain :: [(a, b, c, d, e, f, g)]
domain = [ (a
a,b
b,c
c,d
d,e
e,f
f,g
g) | a
a <- [a]
forall a. Finite a => [a]
domain, b
b <- [b]
forall a. Finite a => [a]
domain, c
c <- [c]
forall a. Finite a => [a]
domain, d
d <- [d]
forall a. Finite a => [a]
domain, e
e <- [e]
forall a. Finite a => [a]
domain, f
f <- [f]
forall a. Finite a => [a]
domain, g
g <- [g]
forall a. Finite a => [a]
domain ]

----------------------------------------------------------------
-- Choice

class Choice a where
  ifThenElse :: Signal Bool -> (a, a) -> a

-- instances

instance Choice Symbol where
  ifThenElse :: Signal Bool -> (Symbol, Symbol) -> Symbol
ifThenElse cond :: Signal Bool
cond (x :: Symbol
x, y :: Symbol
y) = Ops -> Signal Bool -> (Symbol, Symbol) -> Symbol
ifSymbol (Symbol -> Ops
ops Symbol
x) Signal Bool
cond (Symbol
x, Symbol
y)

instance Choice (Signal a) where
  ifThenElse :: Signal Bool -> (Signal a, Signal a) -> Signal a
ifThenElse cond :: Signal Bool
cond (Signal x :: Symbol
x, Signal y :: Symbol
y) =
    Symbol -> Signal a
forall a. Symbol -> Signal a
Signal (Signal Bool -> (Symbol, Symbol) -> Symbol
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (Symbol
x, Symbol
y))

instance Choice () where
  ifThenElse :: Signal Bool -> ((), ()) -> ()
ifThenElse cond :: Signal Bool
cond (_, _) = ()

instance Choice a => Choice [a] where
  ifThenElse :: Signal Bool -> ([a], [a]) -> [a]
ifThenElse cond :: Signal Bool
cond (xs :: [a]
xs, ys :: [a]
ys) =
    (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
strongZipWith (((a, a) -> a) -> a -> a -> a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond)) [a]
xs [a]
ys

instance (Choice a, Choice b) => Choice (a,b) where
  ifThenElse :: Signal Bool -> ((a, b), (a, b)) -> (a, b)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2),(y1 :: a
y1,y2 :: b
y2)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2))

instance (Choice a, Choice b, Choice c) => Choice (a,b,c) where
  ifThenElse :: Signal Bool -> ((a, b, c), (a, b, c)) -> (a, b, c)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2,x3 :: c
x3),(y1 :: a
y1,y2 :: b
y2,y3 :: c
y3)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2), Signal Bool -> (c, c) -> c
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (c
x3,c
y3))

instance (Choice a, Choice b, Choice c, Choice d) => Choice (a,b,c,d) where
  ifThenElse :: Signal Bool -> ((a, b, c, d), (a, b, c, d)) -> (a, b, c, d)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2,x3 :: c
x3,x4 :: d
x4),(y1 :: a
y1,y2 :: b
y2,y3 :: c
y3,y4 :: d
y4)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2), Signal Bool -> (c, c) -> c
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (c
x3,c
y3), Signal Bool -> (d, d) -> d
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (d
x4,d
y4))

instance (Choice a, Choice b, Choice c, Choice d, Choice e) => Choice (a,b,c,d,e) where
  ifThenElse :: Signal Bool
-> ((a, b, c, d, e), (a, b, c, d, e)) -> (a, b, c, d, e)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2,x3 :: c
x3,x4 :: d
x4,x5 :: e
x5),(y1 :: a
y1,y2 :: b
y2,y3 :: c
y3,y4 :: d
y4,y5 :: e
y5)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2), Signal Bool -> (c, c) -> c
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (c
x3,c
y3), Signal Bool -> (d, d) -> d
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (d
x4,d
y4), Signal Bool -> (e, e) -> e
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (e
x5,e
y5))

instance (Choice a, Choice b, Choice c, Choice d, Choice e, Choice f) => Choice (a,b,c,d,e,f) where
  ifThenElse :: Signal Bool
-> ((a, b, c, d, e, f), (a, b, c, d, e, f)) -> (a, b, c, d, e, f)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2,x3 :: c
x3,x4 :: d
x4,x5 :: e
x5,x6 :: f
x6),(y1 :: a
y1,y2 :: b
y2,y3 :: c
y3,y4 :: d
y4,y5 :: e
y5,y6 :: f
y6)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2), Signal Bool -> (c, c) -> c
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (c
x3,c
y3), Signal Bool -> (d, d) -> d
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (d
x4,d
y4), Signal Bool -> (e, e) -> e
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (e
x5,e
y5),
     Signal Bool -> (f, f) -> f
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (f
x6,f
y6))

instance (Choice a, Choice b, Choice c, Choice d, Choice e, Choice f, Choice g) => Choice (a,b,c,d,e,f,g) where
  ifThenElse :: Signal Bool
-> ((a, b, c, d, e, f, g), (a, b, c, d, e, f, g))
-> (a, b, c, d, e, f, g)
ifThenElse cond :: Signal Bool
cond ((x1 :: a
x1,x2 :: b
x2,x3 :: c
x3,x4 :: d
x4,x5 :: e
x5,x6 :: f
x6,x7 :: g
x7),(y1 :: a
y1,y2 :: b
y2,y3 :: c
y3,y4 :: d
y4,y5 :: e
y5,y6 :: f
y6,y7 :: g
y7)) =
    (Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
x1,a
y1), Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (b
x2,b
y2), Signal Bool -> (c, c) -> c
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (c
x3,c
y3), Signal Bool -> (d, d) -> d
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (d
x4,d
y4), Signal Bool -> (e, e) -> e
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (e
x5,e
y5),
     Signal Bool -> (f, f) -> f
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (f
x6,f
y6), Signal Bool -> (g, g) -> g
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (g
x7,g
y7))

instance Choice b => Choice (a -> b) where
  ifThenElse :: Signal Bool -> (a -> b, a -> b) -> a -> b
ifThenElse cond :: Signal Bool
cond (f :: a -> b
f, g :: a -> b
g) =
    \a :: a
a -> Signal Bool -> (b, b) -> b
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a -> b
f a
a, a -> b
g a
a)

mux :: Choice a => (Signal Bool, (a, a)) -> a
mux :: (Signal Bool, (a, a)) -> a
mux (cond :: Signal Bool
cond, (a :: a
a, b :: a
b)) = Signal Bool -> (a, a) -> a
forall a. Choice a => Signal Bool -> (a, a) -> a
ifThenElse Signal Bool
cond (a
b, a
a)

----------------------------------------------------------------
-- helper functions

strongZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
strongZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
strongZipWith f :: a -> b -> c
f (x :: a
x:xs :: [a]
xs) (y :: b
y:ys :: [b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
strongZipWith a -> b -> c
f [a]
xs [b]
ys
strongZipWith f :: a -> b -> c
f []     []     = []
strongZipWith f :: a -> b -> c
f _      _      = Error -> [c]
forall a. Error -> a
wrong Error
Lava.Error.IncompatibleStructures

lazyZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
lazyZipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
lazyZipWith f :: a -> b -> c
f []     _  = []
lazyZipWith f :: a -> b -> c
f (x :: a
x:xs :: [a]
xs) ys :: [b]
ys = a -> b -> c
f a
x (([b] -> b) -> [b] -> b
forall a p. ([a] -> p) -> [a] -> p
safe [b] -> b
forall a. [a] -> a
head [b]
ys) c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
lazyZipWith a -> b -> c
f [a]
xs (([b] -> [b]) -> [b] -> [b]
forall a p. ([a] -> p) -> [a] -> p
safe [b] -> [b]
forall a. [a] -> [a]
tail [b]
ys)
 where
  safe :: ([a] -> p) -> [a] -> p
safe f :: [a] -> p
f [] = Error -> p
forall a. Error -> a
wrong Error
Lava.Error.IncompatibleStructures
  safe f :: [a] -> p
f xs :: [a]
xs = [a] -> p
f [a]
xs

----------------------------------------------------------------
-- the end.