module Language.KansasLava.Protocols.AckBox where
import Language.KansasLava.Rep
import Language.KansasLava.Signal
import Language.KansasLava.Types
import Language.KansasLava.Protocols.Enabled
import Language.KansasLava.Protocols.Types
import Language.KansasLava.Protocols.Patch
import Language.KansasLava.Utils
import Language.KansasLava.Probes
import Data.Maybe as Maybe
import qualified Prelude
import Prelude hiding (tail, lookup)
toAckBox :: (Rep a, Clock c, sig ~ Signal c)
=> Patch [Maybe a] (sig (Enabled a))
() (sig Ack)
toAckBox = toAckBox' []
toAckBox' :: (Rep a, Clock c, sig ~ Signal c)
=> [Int]
-> Patch [Maybe a] (sig (Enabled a))
() (sig Ack)
toAckBox' pauses ~(ys,ack) = ((),toS (fn ys (fromS ack) pauses))
where
fn xs ys' [] = fn xs ys' (repeat 0)
fn (x:xs) ys' (0:ps) = x :
case (x,ys') of
(_,Nothing:_) -> error "toAckBox: bad protocol state (1)"
(Just _,Just (Ack True) :rs) -> fn xs rs ps
(Just _,Just (Ack False):rs) -> fn (x:xs) rs (0:ps)
(Nothing,Just _:rs) -> fn xs rs ps
(_,[]) -> error "toAckBox: can't handle empty list of values to receive"
fn (x:xs) rs (p:ps) = Nothing :
case x of
Nothing -> fn xs (Prelude.tail rs) (pred p:ps)
Just {} -> fn (x:xs) (Prelude.tail rs) (pred p:ps)
fn [] ys' ps = fn (Prelude.repeat Nothing) ys' ps
fromAckBox :: forall a c sig . (Rep a, Clock c, sig ~ Signal c)
=> Patch (sig (Enabled a)) [Maybe a]
(sig Ack) ()
fromAckBox = fromAckBox' []
fromAckBox' :: forall a c sig . (Rep a, Clock c, sig ~ Signal c)
=> [Int]
-> Patch (sig (Enabled a)) [Maybe a]
(sig Ack) ()
fromAckBox' pauses ~(inp,_) = (toS (map fst internal), map snd internal)
where
internal = fn (fromS inp) pauses
fn :: [Maybe (Enabled a)] -> [Int] -> [(Ack,Maybe a)]
fn xs [] = fn xs (repeat 0)
fn (Nothing:_) _ = error "found an unknown value in AckBox input"
fn (Just Nothing:xs) ps = (Ack False,Nothing) : fn xs ps
fn (Just (Just v):xs) (0:ps) = (Ack True,Just v) : fn xs ps
fn (_:xs) (p:ps) = (Ack False,Nothing) : fn xs (pred p:ps)
fn [] _ = error "fromAckBox: ack sequences should never end"
enabledToAckBox :: (Rep a, Clock c, sig ~ Signal c)
=> Patch (sig (Enabled a)) (sig (Enabled a))
() (sig Ack)
enabledToAckBox ~(inp,ack) = ((),res)
where
res = register Nothing
$ cASE [ (isEnabled inp,inp)
, (fromAck ack, disabledS)
] res
ackBoxToEnabled :: (Rep a, Clock c, sig ~ Signal c)
=> Patch (sig (Enabled a)) (sig (Enabled a))
(sig Ack) ()
ackBoxToEnabled ~(inp,_) = (toAck ack,out)
where
out = inp
ack = isEnabled inp
shallowAckBoxBridge :: forall sig c a . (Rep a, Clock c, sig ~ Signal c, Show a)
=> ([Int],[Int])
-> Patch (sig (Enabled a)) (sig (Enabled a))
(sig Ack) (sig Ack)
shallowAckBoxBridge (lhsF,rhsF) = patch
where
patch = fromAckBox' lhsF $$ toAckBox' rhsF
probeAckBoxP :: forall sig a c . (Rep a, Clock c, sig ~ Signal c)
=> String
-> Patch (sig (Enabled a)) (sig (Enabled a))
(sig Ack) (sig Ack)
probeAckBoxP probeName ~(inp, ack_in) = (ack_out, out)
where
out = inp
(_, ack_out) = unpack probed
probed :: sig (Enabled a, Ack)
probed = probeS probeName $ pack (inp, ack_in)
runAckBoxP :: forall sig c a b . (c ~ CLK, sig ~ Signal c, Rep a, Rep b)
=> Patch (sig (Enabled a)) (sig (Enabled b))
(sig Ack) (sig Ack)
-> [a] -> [b]
runAckBoxP p as = [ b | Just b <- bs' ]
where
as' = map Just as
bs' = runP (outputP as' $$ toAckBox $$ globalClockP $$ p $$ fromAckBox)
sinkAckP :: forall a c sig . (Rep a, Clock c, sig ~ Signal c)
=> Patch (sig (Enabled a)) ()
(sig Ack) ()
sinkAckP ~(inp, ()) = (toAck ack, ())
where
(ack,_) = unpack inp
alwaysAckP :: forall a c sig . (Rep a, Clock c, sig ~ Signal c)
=> a
-> Patch () (sig (Enabled a))
() (sig Ack)
alwaysAckP baseVal ~((), _) = ((), out)
where
out = packEnabled high (pureS baseVal)
neverAckP :: forall a c sig . (Rep a, Clock c, sig ~ Signal c)
=> Patch () (sig (Enabled a))
() (sig Ack)
neverAckP (_,_) = ((),disabledS)