module Language.Atom.Common
(
Timer
, timer
, startTimer
, startTimerIf
, timerDone
, oneShotRise
, oneShotFall
, debounce
, lookupTable
, linear
, hysteresis
, Channel (..)
, channel
, writeChannel
, readChannel
) where
import Data.Word
import Language.Atom.Language
data Timer = Timer (V Word64)
timer :: Name -> Atom Timer
timer name = do
timer' <- word64 name 0
return $ Timer timer'
startTimer :: Timer
-> E Word64
-> Atom ()
startTimer t = startTimerIf t true
startTimerIf :: Timer
-> E Bool
-> E Word64
-> Atom ()
startTimerIf (Timer t) a time = t <== mux a (clock + time) (value t)
timerDone :: Timer -> E Bool
timerDone (Timer t) = value t <=. clock
oneShotRise :: E Bool -> Atom (E Bool)
oneShotRise a = do
last' <- bool "last" False
last' <== a
return $ a &&. not_ (value last')
oneShotFall :: E Bool -> Atom (E Bool)
oneShotFall = oneShotRise . not_
debounce :: Name
-> E Word64
-> E Word64
-> Bool
-> E Bool
-> Atom (E Bool)
debounce name onTime offTime init' a = atom name $ do
lst <- bool "last" init'
out <- bool "out" init'
timer' <- timer "timer"
atom "on" $ do
cond $ a &&. not_ (value lst)
startTimer timer' onTime
lst <== a
atom "off" $ do
cond $ not_ a &&. value lst
startTimer timer' offTime
lst <== a
atom "set" $ do
cond $ a ==. value lst
cond $ timerDone timer'
out <== value lst
return $ value out
lookupTable :: FloatingE a => [(E a, E a)]
-> E a
-> E a
lookupTable table x = mux (x >=. x1) y1 $ foldl f y0 table'
where
(_, y0) = head table
(x1, y1) = last table
table' = zip (init table) (tail table)
f a ((a0,b0),(a1,b1)) = mux (x >=. a0) interp a
where
slope = (b1 b0) / (a1 a0)
interp = (x a0) * slope + b0
linear :: FloatingE a => (E a, E a)
-> (E a, E a)
-> E a
-> E a
linear (x1, y1) (x2, y2) a = slope * a + inter
where
slope = (y2 y1) / (x2 x1)
inter = y1 slope * x1
hysteresis :: OrdE a => E a
-> E a
-> E a
-> Atom (E Bool)
hysteresis a b u = do
s <- bool "s" False
s <== (mux (u >. max') true $ mux (u <. min') false $ value s)
return $ value s
where
min' = min_ a b
max' = max_ a b
data Channel a = Channel a (V Bool)
channel :: a -> Atom (Channel a)
channel a = do
hasData <- bool "hasData" False
return $ Channel a hasData
writeChannel :: Channel a -> Atom ()
writeChannel (Channel _ hasData) = do
cond $ not_ $ value hasData
hasData <== true
readChannel :: Channel a -> Atom a
readChannel (Channel a hasData) = do
cond $ value hasData
hasData <== false
return a