module CLaSH.Signal.Explicit
(
CSignal
, Clock (..)
, veryUnsafeSynchronizer
, fromImplicit
, fromExplicit
, csignal
, cregister
, CPack (..)
, csimulate
, csimulateP
, csample
, csampleN
, cfromList
)
where
import Data.Coerce
import Control.Applicative (Applicative (..), (<$>), liftA2)
import GHC.TypeLits (Nat)
import CLaSH.Bit (Bit)
import CLaSH.Promoted.Nat (snatToInteger)
import CLaSH.Sized.Fixed (Fixed)
import CLaSH.Sized.Signed (Signed)
import CLaSH.Sized.Unsigned (Unsigned)
import CLaSH.Sized.Vector (Vec(..), vmap, vhead, vtail)
import CLaSH.Signal.Implicit
import CLaSH.Signal.Types
cfromList :: [a] -> CSignal t a
cfromList = coerce . fromList
csample :: CSignal t a -> [a]
csample = sample . coerce
csampleN :: Int -> CSignal t a -> [a]
csampleN n = sampleN n . coerce
cregister :: Clock clk -> a -> CSignal clk a -> CSignal clk a
cregister _ i s = coerce (register i (coerce s))
csimulate :: (CSignal clk1 a -> CSignal clk2 b) -> [a] -> [b]
csimulate f = csample . f . cfromList
class CPack a where
type CSignalP (clk :: Nat) a
type CSignalP clk a = CSignal clk a
cpack :: Clock clk -> CSignalP clk a -> CSignal clk a
cunpack :: Clock clk -> CSignal clk a -> CSignalP clk a
csimulateP :: (CPack a, CPack b)
=> Clock clk1
-> Clock clk2
-> (CSignalP clk1 a -> CSignalP clk2 b)
-> [a] -> [b]
csimulateP clk1 clk2 f = csimulate (cpack clk2 . f . cunpack clk1)
instance CPack Bit where
cpack _ = id
cunpack _ = id
instance CPack (Signed n) where
cpack _ = id
cunpack _ = id
instance CPack (Unsigned n) where
cpack _ = id
cunpack _ = id
instance CPack (Fixed frac rep size) where
cpack _ = id
cunpack _ = id
instance CPack Bool where
cpack _ = id
cunpack _ = id
instance CPack Integer where
cpack _ = id
cunpack _ = id
instance CPack Int where
cpack _ = id
cunpack _ = id
instance CPack Float where
cpack _ = id
cunpack _ = id
instance CPack Double where
cpack _ = id
cunpack _ = id
instance CPack () where
cpack _ = id
cunpack _ = id
instance CPack (a,b) where
type CSignalP t (a,b) = (CSignal t a, CSignal t b)
cpack _ = uncurry (liftA2 (,))
cunpack _ tup = (fmap fst tup, fmap snd tup)
instance CPack (a,b,c) where
type CSignalP t (a,b,c) = (CSignal t a, CSignal t b, CSignal t c)
cpack _ (a,b,c) = (,,) <$> a <*> b <*> c
cunpack _ tup = (fmap (\(x,_,_) -> x) tup
,fmap (\(_,x,_) -> x) tup
,fmap (\(_,_,x) -> x) tup
)
instance CPack (a,b,c,d) where
type CSignalP t (a,b,c,d) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d)
cpack _ (a,b,c,d) = (,,,) <$> a <*> b <*> c <*> d
cunpack _ tup = (fmap (\(x,_,_,_) -> x) tup
,fmap (\(_,x,_,_) -> x) tup
,fmap (\(_,_,x,_) -> x) tup
,fmap (\(_,_,_,x) -> x) tup
)
instance CPack (a,b,c,d,e) where
type CSignalP t (a,b,c,d,e) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e)
cpack _ (a,b,c,d,e) = (,,,,) <$> a <*> b <*> c <*> d <*> e
cunpack _ tup = (fmap (\(x,_,_,_,_) -> x) tup
,fmap (\(_,x,_,_,_) -> x) tup
,fmap (\(_,_,x,_,_) -> x) tup
,fmap (\(_,_,_,x,_) -> x) tup
,fmap (\(_,_,_,_,x) -> x) tup
)
instance CPack (a,b,c,d,e,f) where
type CSignalP t (a,b,c,d,e,f) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f)
cpack _ (a,b,c,d,e,f) = (,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f
cunpack _ tup = (fmap (\(x,_,_,_,_,_) -> x) tup
,fmap (\(_,x,_,_,_,_) -> x) tup
,fmap (\(_,_,x,_,_,_) -> x) tup
,fmap (\(_,_,_,x,_,_) -> x) tup
,fmap (\(_,_,_,_,x,_) -> x) tup
,fmap (\(_,_,_,_,_,x) -> x) tup
)
instance CPack (a,b,c,d,e,f,g) where
type CSignalP t (a,b,c,d,e,f,g) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f, CSignal t g)
cpack _ (a,b,c,d,e,f,g) = (,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g
cunpack _ tup = (fmap (\(x,_,_,_,_,_,_) -> x) tup
,fmap (\(_,x,_,_,_,_,_) -> x) tup
,fmap (\(_,_,x,_,_,_,_) -> x) tup
,fmap (\(_,_,_,x,_,_,_) -> x) tup
,fmap (\(_,_,_,_,x,_,_) -> x) tup
,fmap (\(_,_,_,_,_,x,_) -> x) tup
,fmap (\(_,_,_,_,_,_,x) -> x) tup
)
instance CPack (a,b,c,d,e,f,g,h) where
type CSignalP t (a,b,c,d,e,f,g,h) = (CSignal t a, CSignal t b, CSignal t c, CSignal t d, CSignal t e, CSignal t f, CSignal t g, CSignal t h)
cpack _ (a,b,c,d,e,f,g,h) = (,,,,,,,) <$> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h
cunpack _ tup = (fmap (\(x,_,_,_,_,_,_,_) -> x) tup
,fmap (\(_,x,_,_,_,_,_,_) -> x) tup
,fmap (\(_,_,x,_,_,_,_,_) -> x) tup
,fmap (\(_,_,_,x,_,_,_,_) -> x) tup
,fmap (\(_,_,_,_,x,_,_,_) -> x) tup
,fmap (\(_,_,_,_,_,x,_,_) -> x) tup
,fmap (\(_,_,_,_,_,_,x,_) -> x) tup
,fmap (\(_,_,_,_,_,_,_,x) -> x) tup
)
instance CPack (Vec n a) where
type CSignalP t (Vec n a) = Vec n (CSignal t a)
cpack clk vs = mkCSignal (vmap (shead . coerce) vs) (cpack clk (vmap cstail vs))
cunpack _ (CSignal (Nil :- _)) = Nil
cunpack clk vs@(CSignal ((_ :> _) :- _)) = fmap vhead vs :> cunpack clk (fmap vtail vs)
veryUnsafeSynchronizer :: Clock clk1
-> Clock clk2
-> CSignal clk1 a
-> CSignal clk2 a
veryUnsafeSynchronizer (Clock clk1) (Clock clk2) s = s'
where
t1 = fromInteger (snatToInteger clk1)
t2 = fromInteger (snatToInteger clk2)
s' | t1 < t2 = compress t2 t1 s
| t1 > t2 = oversample t1 t2 s
| otherwise = same s
same :: CSignal clk1 a -> CSignal clk2 a
same (CSignal s) = CSignal s
oversample :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a
oversample high low (CSignal (s :- ss)) = CSignal (s :- oversampleS (reverse (repSchedule high low)) ss)
oversampleS :: [Int] -> Signal a -> Signal a
oversampleS sched = oversample' sched
where
oversample' [] s = oversampleS sched s
oversample' (d:ds) (s:-ss) = prefixN d s (oversample' ds ss)
prefixN 0 _ s = s
prefixN n x s = x :- prefixN (n1) x s
compress :: Int -> Int -> CSignal clk1 a -> CSignal clk2 a
compress high low (CSignal s) = CSignal (compressS (repSchedule high low) s)
compressS :: [Int] -> Signal a -> Signal a
compressS sched = compress' sched
where
compress' [] s = compressS sched s
compress' (d:ds) ss@(s :- _) = s :- compress' ds (dropS d ss)
dropS 0 s = s
dropS n (_ :- ss) = dropS (n1) ss
repSchedule :: Int -> Int -> [Int]
repSchedule high low = take low $ repSchedule' low high 1
where
repSchedule' cnt th rep
| cnt < th = repSchedule' (cnt+low) th (rep + 1)
| otherwise = rep : repSchedule' (cnt + low) (th + high) 1
fromImplicit :: Signal a -> CSignal 1000 a
fromImplicit s = CSignal s
fromExplicit :: CSignal 1000 a -> Signal a
fromExplicit (CSignal s) = s