module CLaSH.Signal.Types where
import Data.Coerce (coerce)
import Data.Default (Default (..))
import Control.Applicative (Applicative (..), liftA2)
import GHC.TypeLits (Nat)
import Language.Haskell.TH.Syntax (Lift (..))
import CLaSH.Promoted.Nat (SNat)
infixr 5 :-
data Signal a = a :- Signal a
newtype CSignal (clk :: Nat) a = CSignal (Signal a)
deriving (Show,Default,Lift,Functor,Applicative)
newtype Clock (clk :: Nat) = Clock (SNat clk)
instance Show a => Show (Signal a) where
show (x :- xs) = show x ++ " " ++ show xs
instance Lift a => Lift (Signal a) where
lift ~(x :- _) = [| signal x |]
instance Default a => Default (Signal a) where
def = signal def
signal :: a -> Signal a
signal a = let s = a :- s in s
mapSignal :: (a -> b) -> Signal a -> Signal b
mapSignal f (a :- as) = f a :- mapSignal f as
appSignal :: Signal (a -> b) -> Signal a -> Signal b
appSignal (f :- fs) ~(a :- as) = f a :- appSignal fs as
instance Functor Signal where
fmap = mapSignal
instance Applicative Signal where
pure = signal
(<*>) = appSignal
shead :: Signal a -> a
shead (x :- _) = x
stail :: Signal a -> Signal a
stail (_ :- xs) = xs
mkCSignal :: a -> CSignal clk a -> CSignal clk a
mkCSignal a (CSignal s) = CSignal (a :- s)
cstail :: CSignal t a -> CSignal t a
cstail (CSignal s) = CSignal (stail s)
csignal :: a -> CSignal t a
csignal a = coerce (signal a)
instance Num a => Num (Signal a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = signal . fromInteger
instance Num a => Num (CSignal t a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = csignal . fromInteger