module CLaSH.Signal.Explicit
(
CSignal
, Clock (..)
, veryUnsafeSynchronizer
, fromImplicit
, fromExplicit
, csignal
, cregister
, CPack (..)
, csimulate
, csimulateP
, csample
, csampleN
, cfromList
)
where
import Data.Coerce (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
default cpack :: Clock clk -> CSignal clk a -> CSignal clk a
cpack _ s = s
cunpack :: Clock clk -> CSignal clk a -> CSignalP clk a
default cunpack :: Clock clk -> CSignal clk a -> CSignal clk a
cunpack _ s = s
instance CPack Bit
instance CPack (Signed n)
instance CPack (Unsigned n)
instance CPack (Fixed frac rep size)
instance CPack Bool
instance CPack Integer
instance CPack Int
instance CPack Float
instance CPack Double
instance CPack ()
instance CPack (Maybe a)
instance CPack (Either a b)
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)
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)
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