{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies,
TypeSynonymInstances, FlexibleInstances, GADTs, RankNTypes,
UndecidableInstances #-}
module Language.KansasLava.Protocols.Enabled
(Enabled,
packEnabled, unpackEnabled,
enabledVal, isEnabled,
mapEnabled,
enabledS, disabledS,
registerEnabled
) where
import Language.KansasLava.Signal
import Language.KansasLava.Rep
import Language.KansasLava.Utils
import Language.KansasLava.Types
type Enabled a = Maybe a
mapEnabled :: (Rep a, Rep b, sig ~ Signal clk)
=> (forall clk' . Signal clk' a -> Signal clk' b)
-> sig (Enabled a) -> sig (Enabled b)
mapEnabled f en = pack (en_bool,f en_val)
where (en_bool,en_val) = unpack en
enabledS :: (Rep a, sig ~ Signal clk) => sig a -> sig (Enabled a)
enabledS s = pack (pureS True,s)
disabledS :: (Rep a, sig ~ Signal clk) => sig (Enabled a)
disabledS = pack (pureS False,undefinedS)
packEnabled :: (Rep a, sig ~ Signal clk) => sig Bool -> sig a -> sig (Enabled a)
packEnabled s1 s2 = pack (s1,s2)
unpackEnabled :: (Rep a, sig ~ Signal clk) => sig (Enabled a) -> (sig Bool, sig a)
unpackEnabled = unpack
enabledVal :: (Rep a, sig ~ Signal clk) => sig (Enabled a) -> sig a
enabledVal = snd . unpackEnabled
isEnabled :: (Rep a, sig ~ Signal clk) => sig (Enabled a) -> sig Bool
isEnabled = fst . unpackEnabled
registerEnabled :: (Rep a, Clock clk, sig ~ Signal clk) => a -> sig (Enabled a) -> sig a
registerEnabled a inp = res
where
res = register a
$ cASE [ (isEnabled inp,enabledVal inp)
] res