content: module Signal where
  
  import LogFun
  
  class (Eq a, Show{-was:Text-} a, Num a) => Signal a where
    showSig :: a -> String
  
    zerO, one, initial :: a
  
    tt1 :: TT1 -> a -> a
    tt2 :: TT2 -> a -> a -> a
  
    con10, buf, inv, con11 :: a -> a
  
    con20, and2, nimp,  id21  :: a -> a -> a
    nimp', id22, xor,   or2   :: a -> a -> a
    nor2,  equ2, inv22, imp'  :: a -> a -> a
    inv21, imp,  nand2, con21 :: a -> a -> a
    and3,  or3,  nand3, nor3  :: a -> a -> a -> a
    and4,  or4,  nand4, nor4  :: a -> a -> a -> a -> a
  
    con10 = tt1 tt_con10
    buf   = tt1 tt_id
    inv   = tt1 tt_inv
    con11 = tt1 tt_con11
  
    con20 = tt2 tt_con20
    and2  = tt2 tt_and2
    nimp  = tt2 tt_nimp
    id21  = tt2 tt_id21
    nimp' = tt2 tt_nimp'
    id22  = tt2 tt_id22
    xor   = tt2 tt_xor
    or2   = tt2 tt_or2
    nor2  = tt2 tt_nor2
    equ2  = tt2 tt_equ2
    inv22 = tt2 tt_inv22
    imp'  = tt2 tt_imp'
    inv21 = tt2 tt_inv21
    imp   = tt2 tt_imp
    nand2 = tt2 tt_nand2
    con21 = tt2 tt_con21
  
    and3  a b c = a*b*c
    or3   a b c = a+b+c
    nand3 a b c = nand2 a (nand2 b c)
    nor3  a b c = nor2 a (nor2 b c)
  
    and4  a b c d = (a*b)*(c*d)
    or4   a b c d = (a+b)+(c+d)
    nand4 a b c d = nand2 (nand2 a b) (nand2 c d)
    nor4  a b c d = nor2 (nor2 a b) (nor2 c d)
  
  class (Signal a) => Lattice a where
    bot, top, weakZero, weakOne :: a
    lub  :: a -> a -> a
    pass :: a -> a -> a
  
  class (Signal a) => Static a where
    intToSig :: Int -> a
    sigToInt :: a -> Int
    showStaticSig :: a -> String
  
  class (Signal a) => Dynamic a where
    latch, dff :: a -> a
  
  class (Lattice a, Static a) => Log a where
    dumLog :: a
  
  class (Lattice a, Dynamic a) => Sig a where
    dumSig :: a
  
  data Stream a = Snil | Scons a (Stream a)  deriving (Eq,Show{-was:Text-})
  
  shead :: Stream a -> a
  shead (Scons x xs) = x
  
  stail :: Stream a -> Stream a
  stail (Scons x xs) = xs
  
  snull :: Stream a -> Bool
  snull Snil = True
  snull (Scons x xs) = False
  
  smap :: (a->b) -> Stream a -> Stream b
  smap f Snil = Snil
  smap f (Scons x xs) = Scons (f x) (smap f xs)
  
  stake, sdrop :: Int -> Stream a -> Stream a
  
  stake 0 xs = xs
  --should be: stake (i+1) (Scons x xs) = Scons x (stake i xs)
  stake i (Scons x xs) | i < 0     = error "Signal.stake: < 0"
                       | otherwise = Scons x (stake (i-1) xs)
  
  sdrop 0 xs = xs
  --should be:sdrop (i+1) (Scons x xs) = sdrop i xs
  sdrop i (Scons x xs) | i < 0     = error "Signal.sdrop: < 0"
                       | otherwise = sdrop i xs
  
  smap2 :: (a->b->c) -> Stream a -> Stream b -> Stream c
  smap2 f as bs =
    case as of
      Snil -> Snil
      Scons a as' ->
        case bs of
          Snil -> Snil
          Scons b bs' -> Scons (f a b) (smap2 f as' bs')
  
  srepeat :: (Static a) => a -> Stream a
  srepeat x = xs where xs = Scons x xs
  
  stream :: [a] -> Stream a
  stream [] = Snil
  stream (x:xs) = Scons x (stream xs)
  
  instance (Signal a, Static a) => Dynamic (Stream a) where
    latch xs = Scons initial xs
    dff xs = Scons initial xs
  
  instance (Lattice a, Static a) => Lattice (Stream a) where
    bot      = srepeat bot
    top      = srepeat top
    weakZero = srepeat weakZero
    weakOne  = srepeat weakOne
    lub      = smap2 lub
    pass     = smap2 pass
  
  instance (Signal a, Static a) => Signal (Stream a) where
    zerO = srepeat zerO
    one  = srepeat one
    tt1  = smap . tt1
    tt2  = smap2 . tt2
  
  instance (Lattice a, Static a) => Sig (Stream a) where
    dumSig = bot  -- ??? shouldn't be necessary, check compiler
  
  instance (Static a) => Num (Stream a) where
    (+) = or2
    (*) = and2
    a - b  = xor a b
    negate = inv
    abs    = error "abs not defined for Signals"
    signum = error "signum not defined for Signals"
    fromInteger = error "fromInteger not defined for Signals"
  
  