{-# LANGUAGE ScopedTypeVariables, ApplicativeDo, Rank2Types #-}
{-# LANGUAGE TupleSections #-}
module RetroClash.Utils
    ( withResetEnableGen
    , withEnableGen

    , withStart

    , Polarity(..), Active, active, IsActive(..)
    , toActiveDyn

    , bitwise
    , parity
    , half
    , halfIndex

    , bvShiftL
    , bvShiftR

    , (.==)
    , (==.)
    , (./=)
    , (/=.)
    , (.>)
    , (.>=)
    , (.<)
    , (.<=)
    , (<=.)

    , (.!!.)
    , (.!!)
    , (!!.)

    , changed
    , integrate
    , debounce

    , riseEveryWhen
    , oscillateWhen

    , oneHot
    , roundRobin

    , countFromTo
    , nextIdx, prevIdx
    , succIdx, predIdx
    , moreIdx, lessIdx

    , mealyState
    , mealyStateB

    , mooreState
    , mooreStateB

    , enable
    , guardA
    , muxA
    , (.<|>.)
    , (.|>.)
    , (|>.)
    , (.<|.)
    , (.<|)
    , muxMaybe

    , packWrite
    , noWrite
    , withWrite
    , singlePort
    , unbraid

    , shifterL
    , shifterR
    ) where

import Clash.Prelude
import RetroClash.Clock
import Data.Maybe (fromMaybe)
import Control.Monad (guard)
import Control.Monad.State
import qualified Data.Foldable as F
import Data.Monoid

withResetEnableGen
    :: (KnownDomain dom)
    => (HiddenClockResetEnable dom => r)
    -> Clock dom -> r
withResetEnableGen :: forall (dom :: Domain) r.
KnownDomain dom =>
(HiddenClockResetEnable dom => r) -> Clock dom -> r
withResetEnableGen HiddenClockResetEnable dom => r
board Clock dom
clk = Clock dom
-> Reset dom
-> Enable dom
-> (HiddenClockResetEnable dom => r)
-> r
forall (dom :: Domain) r.
KnownDomain dom =>
Clock dom
-> Reset dom
-> Enable dom
-> (HiddenClockResetEnable dom => r)
-> r
withClockResetEnable Clock dom
clk Reset dom
forall (dom :: Domain). KnownDomain dom => Reset dom
resetGen Enable dom
forall (dom :: Domain). Enable dom
enableGen r
HiddenClockResetEnable dom => r
board

withEnableGen
    :: (KnownDomain dom)
    => (HiddenClockResetEnable dom => r)
    -> Clock dom -> Reset dom -> r
withEnableGen :: forall (dom :: Domain) r.
KnownDomain dom =>
(HiddenClockResetEnable dom => r) -> Clock dom -> Reset dom -> r
withEnableGen HiddenClockResetEnable dom => r
board Clock dom
clk Reset dom
rst = Clock dom
-> Reset dom
-> Enable dom
-> (HiddenClockResetEnable dom => r)
-> r
forall (dom :: Domain) r.
KnownDomain dom =>
Clock dom
-> Reset dom
-> Enable dom
-> (HiddenClockResetEnable dom => r)
-> r
withClockResetEnable Clock dom
clk Reset dom
rst Enable dom
forall (dom :: Domain). Enable dom
enableGen r
HiddenClockResetEnable dom => r
board

oneHot :: forall n. (KnownNat n) => Index n -> Vec n Bool
oneHot :: forall (n :: Nat). KnownNat n => Index n -> Vec n Bool
oneHot = Vec n Bool -> Vec n Bool
forall (n :: Nat) a. Vec n a -> Vec n a
reverse (Vec n Bool -> Vec n Bool)
-> (Index n -> Vec n Bool) -> Index n -> Vec n Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unsigned n -> Vec n Bool
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce (Unsigned n -> Vec n Bool)
-> (Index n -> Unsigned n) -> Index n -> Vec n Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => Int -> a
bit @(Unsigned n) (Int -> Unsigned n) -> (Index n -> Int) -> Index n -> Unsigned n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

changed :: (HiddenClockResetEnable dom, Eq a, NFDataX a) => a -> Signal dom a -> Signal dom Bool
changed :: forall (dom :: Domain) a.
(HiddenClockResetEnable dom, Eq a, NFDataX a) =>
a -> Signal dom a -> Signal dom Bool
changed a
x0 Signal dom a
x = Signal dom a
x Signal dom a -> Signal dom a -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
./=. a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register a
x0 Signal dom a
x

integrate
    :: (Monoid a, NFDataX a, HiddenClockResetEnable dom)
    => Signal dom Bool -> Signal dom a -> Signal dom a
integrate :: forall a (dom :: Domain).
(Monoid a, NFDataX a, HiddenClockResetEnable dom) =>
Signal dom Bool -> Signal dom a -> Signal dom a
integrate Signal dom Bool
clear Signal dom a
x = Signal dom a
acc
  where
    acc :: Signal dom a
acc = a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register a
forall a. Monoid a => a
mempty (Signal dom a -> Signal dom a) -> Signal dom a -> Signal dom a
forall a b. (a -> b) -> a -> b
$ Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
clear Signal dom a
x (Signal dom a -> Signal dom a) -> Signal dom a -> Signal dom a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> Signal dom a -> Signal dom (a -> a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom a
acc Signal dom (a -> a) -> Signal dom a -> Signal dom a
forall a b. Signal dom (a -> b) -> Signal dom a -> Signal dom b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Signal dom a
x

debounce
    :: forall ps a dom. (Eq a, NFDataX a, HiddenClockResetEnable dom, KnownNat (ClockDivider dom ps))
    => SNat ps -> a -> Signal dom a -> Signal dom a
debounce :: forall (ps :: Nat) a (dom :: Domain).
(Eq a, NFDataX a, HiddenClockResetEnable dom,
 KnownNat (ClockDivider dom ps)) =>
SNat ps -> a -> Signal dom a -> Signal dom a
debounce SNat ps
SNat a
start Signal dom a
this = a -> Signal dom Bool -> Signal dom a -> Signal dom a
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn a
start Signal dom Bool
stable Signal dom a
this
  where
    counter :: Signal dom (Index (ClockDivider dom ps))
counter = Index (ClockDivider dom ps)
-> Signal dom (Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register (Index (ClockDivider dom ps)
0 :: Index (ClockDivider dom ps)) Signal dom (Index (ClockDivider dom ps))
counterNext
    counterNext :: Signal dom (Index (ClockDivider dom ps))
counterNext = Signal dom Bool
-> Signal dom (Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (a -> Signal dom a -> Signal dom Bool
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, Eq a, NFDataX a) =>
a -> Signal dom a -> Signal dom Bool
changed a
start Signal dom a
this) Signal dom (Index (ClockDivider dom ps))
0 (Index (ClockDivider dom ps) -> Index (ClockDivider dom ps)
forall a. (Eq a, Enum a, Bounded a) => a -> a
moreIdx (Index (ClockDivider dom ps) -> Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index (ClockDivider dom ps))
counter)
    stable :: Signal dom Bool
stable = Signal dom (Index (ClockDivider dom ps))
counterNext Signal dom (Index (ClockDivider dom ps))
-> Signal dom (Index (ClockDivider dom ps)) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
.==. Index (ClockDivider dom ps)
-> Signal dom (Index (ClockDivider dom ps))
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Index (ClockDivider dom ps)
forall a. Bounded a => a
maxBound

roundRobin
    :: forall n dom a. (KnownNat n, HiddenClockResetEnable dom)
    => Signal dom Bool
    -> (Signal dom (Vec n Bool), Signal dom (Index n))
roundRobin :: forall (n :: Nat) (dom :: Domain) a.
(KnownNat n, HiddenClockResetEnable dom) =>
Signal dom Bool -> (Signal dom (Vec n Bool), Signal dom (Index n))
roundRobin Signal dom Bool
next = (Signal dom (Vec n Bool)
selector, Signal dom (Index n)
i)
  where
    i :: Signal dom (Index n)
i = Index n
-> Signal dom Bool -> Signal dom (Index n) -> Signal dom (Index n)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn (Index n
0 :: Index n) Signal dom Bool
next (Signal dom (Index n) -> Signal dom (Index n))
-> Signal dom (Index n) -> Signal dom (Index n)
forall a b. (a -> b) -> a -> b
$ Index n -> Index n
forall a. (Eq a, Enum a, Bounded a) => a -> a
nextIdx (Index n -> Index n)
-> Signal dom (Index n) -> Signal dom (Index n)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
i
    selector :: Signal dom (Vec n Bool)
selector = Index n -> Vec n Bool
forall (n :: Nat). KnownNat n => Index n -> Vec n Bool
oneHot (Index n -> Vec n Bool)
-> Signal dom (Index n) -> Signal dom (Vec n Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
i

data Polarity = High | Low
    deriving (Int -> Polarity -> ShowS
[Polarity] -> ShowS
Polarity -> String
(Int -> Polarity -> ShowS)
-> (Polarity -> String) -> ([Polarity] -> ShowS) -> Show Polarity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Polarity -> ShowS
showsPrec :: Int -> Polarity -> ShowS
$cshow :: Polarity -> String
show :: Polarity -> String
$cshowList :: [Polarity] -> ShowS
showList :: [Polarity] -> ShowS
Show, Polarity -> Polarity -> Bool
(Polarity -> Polarity -> Bool)
-> (Polarity -> Polarity -> Bool) -> Eq Polarity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Polarity -> Polarity -> Bool
== :: Polarity -> Polarity -> Bool
$c/= :: Polarity -> Polarity -> Bool
/= :: Polarity -> Polarity -> Bool
Eq)

newtype Active (p :: Polarity) = MkActive{ forall (p :: Polarity). Active p -> Bit
activeLevel :: Bit }
    deriving (Int -> Active p -> ShowS
[Active p] -> ShowS
Active p -> String
(Int -> Active p -> ShowS)
-> (Active p -> String) -> ([Active p] -> ShowS) -> Show (Active p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: Polarity). Int -> Active p -> ShowS
forall (p :: Polarity). [Active p] -> ShowS
forall (p :: Polarity). Active p -> String
$cshowsPrec :: forall (p :: Polarity). Int -> Active p -> ShowS
showsPrec :: Int -> Active p -> ShowS
$cshow :: forall (p :: Polarity). Active p -> String
show :: Active p -> String
$cshowList :: forall (p :: Polarity). [Active p] -> ShowS
showList :: [Active p] -> ShowS
Show, Active p -> Active p -> Bool
(Active p -> Active p -> Bool)
-> (Active p -> Active p -> Bool) -> Eq (Active p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: Polarity). Active p -> Active p -> Bool
$c== :: forall (p :: Polarity). Active p -> Active p -> Bool
== :: Active p -> Active p -> Bool
$c/= :: forall (p :: Polarity). Active p -> Active p -> Bool
/= :: Active p -> Active p -> Bool
Eq, Eq (Active p)
Eq (Active p) =>
(Active p -> Active p -> Ordering)
-> (Active p -> Active p -> Bool)
-> (Active p -> Active p -> Bool)
-> (Active p -> Active p -> Bool)
-> (Active p -> Active p -> Bool)
-> (Active p -> Active p -> Active p)
-> (Active p -> Active p -> Active p)
-> Ord (Active p)
Active p -> Active p -> Bool
Active p -> Active p -> Ordering
Active p -> Active p -> Active p
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (p :: Polarity). Eq (Active p)
forall (p :: Polarity). Active p -> Active p -> Bool
forall (p :: Polarity). Active p -> Active p -> Ordering
forall (p :: Polarity). Active p -> Active p -> Active p
$ccompare :: forall (p :: Polarity). Active p -> Active p -> Ordering
compare :: Active p -> Active p -> Ordering
$c< :: forall (p :: Polarity). Active p -> Active p -> Bool
< :: Active p -> Active p -> Bool
$c<= :: forall (p :: Polarity). Active p -> Active p -> Bool
<= :: Active p -> Active p -> Bool
$c> :: forall (p :: Polarity). Active p -> Active p -> Bool
> :: Active p -> Active p -> Bool
$c>= :: forall (p :: Polarity). Active p -> Active p -> Bool
>= :: Active p -> Active p -> Bool
$cmax :: forall (p :: Polarity). Active p -> Active p -> Active p
max :: Active p -> Active p -> Active p
$cmin :: forall (p :: Polarity). Active p -> Active p -> Active p
min :: Active p -> Active p -> Active p
Ord, (forall x. Active p -> Rep (Active p) x)
-> (forall x. Rep (Active p) x -> Active p) -> Generic (Active p)
forall x. Rep (Active p) x -> Active p
forall x. Active p -> Rep (Active p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: Polarity) x. Rep (Active p) x -> Active p
forall (p :: Polarity) x. Active p -> Rep (Active p) x
$cfrom :: forall (p :: Polarity) x. Active p -> Rep (Active p) x
from :: forall x. Active p -> Rep (Active p) x
$cto :: forall (p :: Polarity) x. Rep (Active p) x -> Active p
to :: forall x. Rep (Active p) x -> Active p
Generic, HasCallStack => String -> Active p
Active p -> Bool
Active p -> ()
Active p -> Active p
(HasCallStack => String -> Active p)
-> (Active p -> Bool)
-> (Active p -> Active p)
-> (Active p -> ())
-> NFDataX (Active p)
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
forall (p :: Polarity). HasCallStack => String -> Active p
forall (p :: Polarity). Active p -> Bool
forall (p :: Polarity). Active p -> ()
forall (p :: Polarity). Active p -> Active p
$cdeepErrorX :: forall (p :: Polarity). HasCallStack => String -> Active p
deepErrorX :: HasCallStack => String -> Active p
$chasUndefined :: forall (p :: Polarity). Active p -> Bool
hasUndefined :: Active p -> Bool
$censureSpine :: forall (p :: Polarity). Active p -> Active p
ensureSpine :: Active p -> Active p
$crnfX :: forall (p :: Polarity). Active p -> ()
rnfX :: Active p -> ()
NFDataX, KnownNat (BitSize (Active p))
KnownNat (BitSize (Active p)) =>
(Active p -> BitVector (BitSize (Active p)))
-> (BitVector (BitSize (Active p)) -> Active p)
-> BitPack (Active p)
BitVector (BitSize (Active p)) -> Active p
Active p -> BitVector (BitSize (Active p))
forall a.
KnownNat (BitSize a) =>
(a -> BitVector (BitSize a))
-> (BitVector (BitSize a) -> a) -> BitPack a
forall (p :: Polarity). KnownNat (BitSize (Active p))
forall (p :: Polarity). BitVector (BitSize (Active p)) -> Active p
forall (p :: Polarity). Active p -> BitVector (BitSize (Active p))
$cpack :: forall (p :: Polarity). Active p -> BitVector (BitSize (Active p))
pack :: Active p -> BitVector (BitSize (Active p))
$cunpack :: forall (p :: Polarity). BitVector (BitSize (Active p)) -> Active p
unpack :: BitVector (BitSize (Active p)) -> Active p
BitPack)

active :: Bit -> Active p
active :: forall (p :: Polarity). Bit -> Active p
active = Bit -> Active p
forall (p :: Polarity). Bit -> Active p
MkActive

toActiveDyn :: Polarity -> Bool -> Bit
toActiveDyn :: Polarity -> Bool -> Bit
toActiveDyn Polarity
High = Bool -> Bit
boolToBit
toActiveDyn Polarity
Low = Bit -> Bit
forall a. Bits a => a -> a
complement (Bit -> Bit) -> (Bool -> Bit) -> Bool -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bit
boolToBit

fromActiveDyn :: Polarity -> Bit -> Bool
fromActiveDyn :: Polarity -> Bit -> Bool
fromActiveDyn Polarity
High = Bit -> Bool
bitToBool
fromActiveDyn Polarity
Low = Bit -> Bool
bitToBool (Bit -> Bool) -> (Bit -> Bit) -> Bit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bit -> Bit
forall a. Bits a => a -> a
complement

class IsActive p where
    fromActive :: Active p -> Bool
    toActive :: Bool -> Active p

instance IsActive High where
    fromActive :: Active 'High -> Bool
fromActive = Polarity -> Bit -> Bool
fromActiveDyn Polarity
High (Bit -> Bool) -> (Active 'High -> Bit) -> Active 'High -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Active 'High -> Bit
forall (p :: Polarity). Active p -> Bit
activeLevel
    toActive :: Bool -> Active 'High
toActive = Bit -> Active 'High
forall (p :: Polarity). Bit -> Active p
MkActive (Bit -> Active 'High) -> (Bool -> Bit) -> Bool -> Active 'High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polarity -> Bool -> Bit
toActiveDyn Polarity
High

instance IsActive Low where
    fromActive :: Active 'Low -> Bool
fromActive = Polarity -> Bit -> Bool
fromActiveDyn Polarity
Low (Bit -> Bool) -> (Active 'Low -> Bit) -> Active 'Low -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Active 'Low -> Bit
forall (p :: Polarity). Active p -> Bit
activeLevel
    toActive :: Bool -> Active 'Low
toActive = Bit -> Active 'Low
forall (p :: Polarity). Bit -> Active p
MkActive (Bit -> Active 'Low) -> (Bool -> Bit) -> Bool -> Active 'Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polarity -> Bool -> Bit
toActiveDyn Polarity
Low

infix 4 ==.
(==.) :: (Eq a, Functor f) => a -> f a -> f Bool
a
x ==. :: forall a (f :: Type -> Type).
(Eq a, Functor f) =>
a -> f a -> f Bool
==. f a
fy = (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fy

infix 4 .==
(.==) :: (Eq a, Functor f) => f a -> a -> f Bool
f a
fx .== :: forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
.== a
y = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 /=.
(/=.) :: (Eq a, Functor f) => a -> f a -> f Bool
a
x /=. :: forall a (f :: Type -> Type).
(Eq a, Functor f) =>
a -> f a -> f Bool
/=. f a
fy = (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fy

infix 4 ./=
(./=) :: (Eq a, Functor f) => f a -> a -> f Bool
f a
fx ./= :: forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
./= a
y = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 .>
(.>) :: (Ord a, Functor f) => f a -> a -> f Bool
f a
fx .> :: forall a (f :: Type -> Type).
(Ord a, Functor f) =>
f a -> a -> f Bool
.> a
y = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 .>=
(.>=) :: (Ord a, Functor f) => f a -> a -> f Bool
f a
fx .>= :: forall a (f :: Type -> Type).
(Ord a, Functor f) =>
f a -> a -> f Bool
.>= a
y = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 .<
(.<) :: (Ord a, Functor f) => f a -> a -> f Bool
f a
fx .< :: forall a (f :: Type -> Type).
(Ord a, Functor f) =>
f a -> a -> f Bool
.< a
y = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 .<=
(.<=) :: (Ord a, Functor f) => f a -> a -> f Bool
f a
fx .<= :: forall a (f :: Type -> Type).
(Ord a, Functor f) =>
f a -> a -> f Bool
.<= a
y = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx

infix 4 <=.
(<=.) :: (Ord a, Functor f) => a -> f a -> f Bool
a
x <=. :: forall a (f :: Type -> Type).
(Ord a, Functor f) =>
a -> f a -> f Bool
<=. f a
fy = (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) (a -> Bool) -> f a -> f Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fy

(.!!.) :: (KnownNat n, Enum i, Applicative f) => f (Vec n a) -> f i -> f a
.!!. :: forall (n :: Nat) i (f :: Type -> Type) a.
(KnownNat n, Enum i, Applicative f) =>
f (Vec n a) -> f i -> f a
(.!!.) = (Vec n a -> i -> a) -> f (Vec n a) -> f i -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Vec n a -> i -> a
forall (n :: Nat) i a. (KnownNat n, Enum i) => Vec n a -> i -> a
(!!)

(!!.) :: (KnownNat n, Enum i, Functor f) => Vec n a -> f i -> f a
Vec n a
xs !!. :: forall (n :: Nat) i (f :: Type -> Type) a.
(KnownNat n, Enum i, Functor f) =>
Vec n a -> f i -> f a
!!. f i
i = (Vec n a
xs Vec n a -> i -> a
forall (n :: Nat) i a. (KnownNat n, Enum i) => Vec n a -> i -> a
!!) (i -> a) -> f i -> f a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f i
i

(.!!) :: (KnownNat n, Enum i, Functor f) => f (Vec n a) -> i -> f a
f (Vec n a)
xs .!! :: forall (n :: Nat) i (f :: Type -> Type) a.
(KnownNat n, Enum i, Functor f) =>
f (Vec n a) -> i -> f a
.!! i
i = (Vec n a -> i -> a
forall (n :: Nat) i a. (KnownNat n, Enum i) => Vec n a -> i -> a
!! i
i) (Vec n a -> a) -> f (Vec n a) -> f a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Vec n a)
xs

countFromTo :: (Eq a, Enum a, NFDataX a, HiddenClockResetEnable dom) => a -> a -> Signal dom Bool -> Signal dom a
countFromTo :: forall a (dom :: Domain).
(Eq a, Enum a, NFDataX a, HiddenClockResetEnable dom) =>
a -> a -> Signal dom Bool -> Signal dom a
countFromTo a
from a
to Signal dom Bool
tick = Signal dom a
counter
  where
    counter :: Signal dom a
counter = a -> Signal dom Bool -> Signal dom a -> Signal dom a
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn a
from Signal dom Bool
tick (Signal dom a -> Signal dom a) -> Signal dom a -> Signal dom a
forall a b. (a -> b) -> a -> b
$ Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Signal dom a
counter Signal dom a -> Signal dom a -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
.==. a -> Signal dom a
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
to) (a -> Signal dom a
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
from) (a -> a
forall a. Enum a => a -> a
succ (a -> a) -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom a
counter)

nextIdx :: (Eq a, Enum a, Bounded a) => a -> a
nextIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> a
nextIdx = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
minBound (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx

prevIdx :: (Eq a, Enum a, Bounded a) => a -> a
prevIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> a
prevIdx = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
maxBound (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
predIdx

moreIdx :: (Eq a, Enum a, Bounded a) => a -> a
moreIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> a
moreIdx = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
maxBound (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx

lessIdx :: (Eq a, Enum a, Bounded a) => a -> a
lessIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> a
lessIdx = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
minBound (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
predIdx

succIdx :: (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound = Maybe a
forall a. Maybe a
Nothing
          | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Enum a => a -> a
succ a
x

predIdx :: (Eq a, Enum a, Bounded a) => a -> Maybe a
predIdx :: forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
predIdx a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound = Maybe a
forall a. Maybe a
Nothing
          | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Enum a => a -> a
pred a
x

mealyState
   :: (HiddenClockResetEnable dom, NFDataX s)
   => (i -> State s o) -> s -> (Signal dom i -> Signal dom o)
mealyState :: forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(i -> State s o) -> s -> Signal dom i -> Signal dom o
mealyState i -> State s o
f = (s -> i -> (s, o)) -> s -> Signal dom i -> Signal dom o
forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(s -> i -> (s, o)) -> s -> Signal dom i -> Signal dom o
mealy s -> i -> (s, o)
step
  where
    step :: s -> i -> (s, o)
step s
s i
x = let (o
y, s
s') = State s o -> s -> (o, s)
forall s a. State s a -> s -> (a, s)
runState (i -> State s o
f i
x) s
s in (s
s', o
y)

mealyStateB
    :: (HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o)
    => (i -> State s o) -> s -> (Unbundled dom i -> Unbundled dom o)
mealyStateB :: forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o) =>
(i -> State s o) -> s -> Unbundled dom i -> Unbundled dom o
mealyStateB i -> State s o
f s
s0 = Signal dom o -> Unbundled dom o
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
forall (dom :: Domain). Signal dom o -> Unbundled dom o
unbundle (Signal dom o -> Unbundled dom o)
-> (Unbundled dom i -> Signal dom o)
-> Unbundled dom i
-> Unbundled dom o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> State s o) -> s -> Signal dom i -> Signal dom o
forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(i -> State s o) -> s -> Signal dom i -> Signal dom o
mealyState i -> State s o
f s
s0 (Signal dom i -> Signal dom o)
-> (Unbundled dom i -> Signal dom i)
-> Unbundled dom i
-> Signal dom o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unbundled dom i -> Signal dom i
forall a (dom :: Domain).
Bundle a =>
Unbundled dom a -> Signal dom a
forall (dom :: Domain). Unbundled dom i -> Signal dom i
bundle

mooreState
    :: (HiddenClockResetEnable dom, NFDataX s)
    => (i -> State s ()) -> (s -> o) -> s -> (Signal dom i -> Signal dom o)
mooreState :: forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(i -> State s ()) -> (s -> o) -> s -> Signal dom i -> Signal dom o
mooreState i -> State s ()
step = (s -> i -> s) -> (s -> o) -> s -> Signal dom i -> Signal dom o
forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(s -> i -> s) -> (s -> o) -> s -> Signal dom i -> Signal dom o
moore s -> i -> s
step'
  where
    step' :: s -> i -> s
step' s
s i
x = State s () -> s -> s
forall s a. State s a -> s -> s
execState (i -> State s ()
step i
x) s
s

mooreStateB
    :: (HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o)
    => (i -> State s ()) -> (s -> o) -> s -> (Unbundled dom i -> Unbundled dom o)
mooreStateB :: forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o) =>
(i -> State s ())
-> (s -> o) -> s -> Unbundled dom i -> Unbundled dom o
mooreStateB i -> State s ()
step s -> o
out s
s0 = Signal dom o -> Unbundled dom o
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
forall (dom :: Domain). Signal dom o -> Unbundled dom o
unbundle (Signal dom o -> Unbundled dom o)
-> (Unbundled dom i -> Signal dom o)
-> Unbundled dom i
-> Unbundled dom o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> State s ()) -> (s -> o) -> s -> Signal dom i -> Signal dom o
forall (dom :: Domain) s i o.
(HiddenClockResetEnable dom, NFDataX s) =>
(i -> State s ()) -> (s -> o) -> s -> Signal dom i -> Signal dom o
mooreState i -> State s ()
step s -> o
out s
s0 (Signal dom i -> Signal dom o)
-> (Unbundled dom i -> Signal dom i)
-> Unbundled dom i
-> Signal dom o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unbundled dom i -> Signal dom i
forall a (dom :: Domain).
Bundle a =>
Unbundled dom a -> Signal dom a
forall (dom :: Domain). Unbundled dom i -> Signal dom i
bundle

enable :: (Applicative f) => f Bool -> f a -> f (Maybe a)
enable :: forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f (Maybe a)
enable f Bool
en f a
x = f Bool -> f (Maybe a) -> f (Maybe a) -> f (Maybe a)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux f Bool
en (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

guardA :: (Applicative f, Alternative m) => f Bool -> f (m a) -> f (m a)
guardA :: forall (f :: Type -> Type) (m :: Type -> Type) a.
(Applicative f, Alternative m) =>
f Bool -> f (m a) -> f (m a)
guardA f Bool
en f (m a)
x = f Bool -> f (m a) -> f (m a) -> f (m a)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux f Bool
en f (m a)
x (m a -> f (m a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: Type -> Type) a. Alternative f => f a
empty)

packWrite :: addr -> Maybe val -> Maybe (addr, val)
packWrite :: forall addr val. addr -> Maybe val -> Maybe (addr, val)
packWrite addr
addr Maybe val
val = (addr
addr,) (val -> (addr, val)) -> Maybe val -> Maybe (addr, val)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe val
val

withWrite :: (Applicative f) => f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr))
withWrite :: forall (f :: Type -> Type) addr wr.
Applicative f =>
f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr))
withWrite = (Maybe addr -> Maybe wr -> Maybe (addr, Maybe wr))
-> f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr))
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Maybe addr -> Maybe wr -> Maybe (addr, Maybe wr))
 -> f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr)))
-> (Maybe addr -> Maybe wr -> Maybe (addr, Maybe wr))
-> f (Maybe addr)
-> f (Maybe wr)
-> f (Maybe (addr, Maybe wr))
forall a b. (a -> b) -> a -> b
$ \Maybe addr
addr Maybe wr
wr -> (,Maybe wr
wr) (addr -> (addr, Maybe wr)) -> Maybe addr -> Maybe (addr, Maybe wr)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe addr
addr

noWrite :: (Applicative f) => f (Maybe addr) -> f (Maybe (addr, Maybe wr))
noWrite :: forall (f :: Type -> Type) addr wr.
Applicative f =>
f (Maybe addr) -> f (Maybe (addr, Maybe wr))
noWrite f (Maybe addr)
addr = f (Maybe addr)
addr f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr))
forall (f :: Type -> Type) addr wr.
Applicative f =>
f (Maybe addr) -> f (Maybe wr) -> f (Maybe (addr, Maybe wr))
`withWrite` Maybe wr -> f (Maybe wr)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe wr
forall a. Maybe a
Nothing

singlePort :: (Applicative f) => (f addr -> f (Maybe (addr, wr)) -> r) -> (f addr -> f (Maybe wr) -> r)
singlePort :: forall (f :: Type -> Type) addr wr r.
Applicative f =>
(f addr -> f (Maybe (addr, wr)) -> r)
-> f addr -> f (Maybe wr) -> r
singlePort f addr -> f (Maybe (addr, wr)) -> r
mem f addr
addr f (Maybe wr)
wr = f addr -> f (Maybe (addr, wr)) -> r
mem f addr
addr (addr -> Maybe wr -> Maybe (addr, wr)
forall addr val. addr -> Maybe val -> Maybe (addr, val)
packWrite (addr -> Maybe wr -> Maybe (addr, wr))
-> f addr -> f (Maybe wr -> Maybe (addr, wr))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f addr
addr f (Maybe wr -> Maybe (addr, wr))
-> f (Maybe wr) -> f (Maybe (addr, wr))
forall a b. f (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f (Maybe wr)
wr)

unbraid
    :: (KnownNat n, KnownNat k, 1 <= n, 1 <= (n * 2 ^ k), (CLog 2 (2 ^ k)) ~ k, (CLog 2 (n * 2 ^ k)) ~ (CLog 2 n + k))
    => Maybe (Index (n * 2 ^ k))
    -> Vec (2 ^ k) (Maybe (Index n))
unbraid :: forall (n :: Nat) (k :: Nat).
(KnownNat n, KnownNat k, 1 <= n, 1 <= (n * (2 ^ k)),
 CLog 2 (2 ^ k) ~ k, CLog 2 (n * (2 ^ k)) ~ (CLog 2 n + k)) =>
Maybe (Index (n * (2 ^ k))) -> Vec (2 ^ k) (Maybe (Index n))
unbraid Maybe (Index (n * (2 ^ k)))
Nothing = Maybe (Index n) -> Vec (2 ^ k) (Maybe (Index n))
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat Maybe (Index n)
forall a. Maybe a
Nothing
unbraid (Just Index (n * (2 ^ k))
addr) = (Index (2 ^ k) -> Maybe (Index n))
-> Vec (2 ^ k) (Index (2 ^ k)) -> Vec (2 ^ k) (Maybe (Index n))
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map (\Index (2 ^ k)
k -> Index n
addr' Index n -> Maybe () -> Maybe (Index n)
forall a b. a -> Maybe b -> Maybe a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Index (2 ^ k)
sel Index (2 ^ k) -> Index (2 ^ k) -> Bool
forall a. Eq a => a -> a -> Bool
== Index (2 ^ k)
k)) Vec (2 ^ k) (Index (2 ^ k))
forall (n :: Nat). KnownNat n => Vec n (Index n)
indicesI
  where
    (Index n
addr', Index (2 ^ k)
sel) = Index (n * (2 ^ k)) -> (Index n, Index (2 ^ k))
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce Index (n * (2 ^ k))
addr

muxA :: (Foldable t, Alternative m, Applicative f) => t (f (m a)) -> f (m a)
muxA :: forall (t :: Type -> Type) (m :: Type -> Type) (f :: Type -> Type)
       a.
(Foldable t, Alternative m, Applicative f) =>
t (f (m a)) -> f (m a)
muxA = (Alt m a -> m a) -> f (Alt m a) -> f (m a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Alt m a -> m a
forall {k} (f :: k -> Type) (a :: k). Alt f a -> f a
getAlt (f (Alt m a) -> f (m a))
-> (t (f (m a)) -> f (Alt m a)) -> t (f (m a)) -> f (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap f (Alt m a) -> f (Alt m a)
forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap f (Alt m a) -> f (Alt m a))
-> (t (f (m a)) -> Ap f (Alt m a)) -> t (f (m a)) -> f (Alt m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (m a) -> Ap f (Alt m a)) -> t (f (m a)) -> Ap f (Alt m a)
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (f (Alt m a) -> Ap f (Alt m a)
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (f (Alt m a) -> Ap f (Alt m a))
-> (f (m a) -> f (Alt m a)) -> f (m a) -> Ap f (Alt m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> Alt m a) -> f (m a) -> f (Alt m a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap m a -> Alt m a
forall {k} (f :: k -> Type) (a :: k). f a -> Alt f a
Alt)

infixl 3 .<|>.
(.<|>.) :: (Applicative f, Alternative m) => f (m a) -> f (m a) -> f (m a)
.<|>. :: forall (f :: Type -> Type) (m :: Type -> Type) a.
(Applicative f, Alternative m) =>
f (m a) -> f (m a) -> f (m a)
(.<|>.) = (m a -> m a -> m a) -> f (m a) -> f (m a) -> f (m a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
(<|>)

infix 2 .<|., .<|, |>., .|>.

(.<|.) :: (Applicative f) => f (Maybe a) -> f a -> f a
.<|. :: forall (f :: Type -> Type) a.
Applicative f =>
f (Maybe a) -> f a -> f a
(.<|.) = (f a -> f (Maybe a) -> f a) -> f (Maybe a) -> f a -> f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip f a -> f (Maybe a) -> f a
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f (Maybe a) -> f a
(.|>.)

(.<|) :: (Applicative f) => f (Maybe a) -> a -> f a
.<| :: forall (f :: Type -> Type) a.
Applicative f =>
f (Maybe a) -> a -> f a
(.<|) = (a -> f (Maybe a) -> f a) -> f (Maybe a) -> a -> f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> f (Maybe a) -> f a
forall (f :: Type -> Type) a.
Applicative f =>
a -> f (Maybe a) -> f a
(|>.)

(.|>.) :: (Applicative f) => f a -> f (Maybe a) -> f a
.|>. :: forall (f :: Type -> Type) a.
Applicative f =>
f a -> f (Maybe a) -> f a
(.|>.) = f a -> f (Maybe a) -> f a
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f (Maybe a) -> f a
muxMaybe

(|>.) :: (Applicative f) => a -> f (Maybe a) -> f a
a
x |>. :: forall (f :: Type -> Type) a.
Applicative f =>
a -> f (Maybe a) -> f a
|>. f (Maybe a)
fmx = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> f (Maybe a) -> f a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe a)
fmx

muxMaybe :: (Applicative f) => f a -> f (Maybe a) -> f a
muxMaybe :: forall (f :: Type -> Type) a.
Applicative f =>
f a -> f (Maybe a) -> f a
muxMaybe = (a -> Maybe a -> a) -> f a -> f (Maybe a) -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe

withStart :: (HiddenClockResetEnable dom) => a -> Signal dom a -> Signal dom a
withStart :: forall (dom :: Domain) a.
HiddenClockResetEnable dom =>
a -> Signal dom a -> Signal dom a
withStart a
x0 = Signal dom Bool -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Bool -> Signal dom Bool -> Signal dom Bool
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register Bool
True (Signal dom Bool -> Signal dom Bool)
-> Signal dom Bool -> Signal dom Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Signal dom Bool
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False) (a -> Signal dom a
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x0)

bitwise :: (BitPack a) => (BitVector (BitSize a) -> BitVector (BitSize a)) -> (a -> a)
bitwise :: forall a.
BitPack a =>
(BitVector (BitSize a) -> BitVector (BitSize a)) -> a -> a
bitwise BitVector (BitSize a) -> BitVector (BitSize a)
f = BitVector (BitSize a) -> a
forall a. BitPack a => BitVector (BitSize a) -> a
unpack (BitVector (BitSize a) -> a)
-> (a -> BitVector (BitSize a)) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector (BitSize a) -> BitVector (BitSize a)
f (BitVector (BitSize a) -> BitVector (BitSize a))
-> (a -> BitVector (BitSize a)) -> a -> BitVector (BitSize a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BitVector (BitSize a)
forall a. BitPack a => a -> BitVector (BitSize a)
pack

parity :: forall a n. (BitPack a, BitSize a ~ (n + 1)) => a -> Bit
parity :: forall a (n :: Nat). (BitPack a, BitSize a ~ (n + 1)) => a -> Bit
parity = (Bit -> Bit -> Bit) -> Vec (n + 1) Bit -> Bit
forall (n :: Nat) a. (a -> a -> a) -> Vec (n + 1) a -> a
fold Bit -> Bit -> Bit
forall a. Bits a => a -> a -> a
xor (Vec (n + 1) Bit -> Bit) -> (a -> Vec (n + 1) Bit) -> a -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce @_ @(Vec (BitSize a) Bit)

half :: (Bits a) => a -> a
half :: forall a. Bits a => a -> a
half a
x = a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1

halfIndex
    :: (KnownNat n, 1 <= (2 * n), (CLog 2 (2 * n)) ~ (CLog 2 n + 1))
    => Index (2 * n)
    -> Index n
halfIndex :: forall (n :: Nat).
(KnownNat n, 1 <= (2 * n), CLog 2 (2 * n) ~ (CLog 2 n + 1)) =>
Index (2 * n) -> Index n
halfIndex = (Index n, Bit) -> Index n
forall a b. (a, b) -> a
fst ((Index n, Bit) -> Index n)
-> (Index (2 * n) -> (Index n, Bit)) -> Index (2 * n) -> Index n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce @_ @(_, Bit)

bvShiftL :: (KnownNat n) => BitVector n -> Bit -> (Bit, BitVector n)
bvShiftL :: forall (n :: Nat).
KnownNat n =>
BitVector n -> Bit -> (Bit, BitVector n)
bvShiftL BitVector n
xs Bit
x = (BitVector n, Bit) -> (Bit, BitVector n)
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce (BitVector n
xs, Bit
x)

bvShiftR :: (KnownNat n) => Bit -> BitVector n -> (BitVector n, Bit)
bvShiftR :: forall (n :: Nat).
KnownNat n =>
Bit -> BitVector n -> (BitVector n, Bit)
bvShiftR Bit
x BitVector n
xs = (Bit, BitVector n) -> (BitVector n, Bit)
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce (Bit
x, BitVector n
xs)

riseEveryWhen
    :: forall n dom. (HiddenClockResetEnable dom, KnownNat n)
    => SNat n -> Signal dom Bool -> Signal dom Bool
riseEveryWhen :: forall (n :: Nat) (dom :: Domain).
(HiddenClockResetEnable dom, KnownNat n) =>
SNat n -> Signal dom Bool -> Signal dom Bool
riseEveryWhen SNat n
n Signal dom Bool
trigger = Bool -> Signal dom Bool -> Signal dom Bool
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a, Bounded a, Eq a) =>
a -> Signal dom a -> Signal dom Bool
isRising Bool
False (Signal dom Bool -> Signal dom Bool)
-> Signal dom Bool -> Signal dom Bool
forall a b. (a -> b) -> a -> b
$ Signal dom (Index n)
cnt Signal dom (Index n) -> Signal dom (Index n) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
.==. Index n -> Signal dom (Index n)
forall a. a -> Signal dom a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Index n
forall a. Bounded a => a
maxBound
  where
    cnt :: Signal dom (Index n)
cnt = Index n
-> Signal dom Bool -> Signal dom (Index n) -> Signal dom (Index n)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn (Index n
0 :: Index n) Signal dom Bool
trigger (Index n -> Index n
forall a. (Eq a, Enum a, Bounded a) => a -> a
nextIdx (Index n -> Index n)
-> Signal dom (Index n) -> Signal dom (Index n)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index n)
cnt)

oscillateWhen
    :: (HiddenClockResetEnable dom)
    => Bool -> Signal dom Bool -> Signal dom Bool
oscillateWhen :: forall (dom :: Domain).
HiddenClockResetEnable dom =>
Bool -> Signal dom Bool -> Signal dom Bool
oscillateWhen Bool
init Signal dom Bool
trigger = Signal dom Bool
r
  where
    r :: Signal dom Bool
r = Bool -> Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn Bool
init Signal dom Bool
trigger (Signal dom Bool -> Signal dom Bool)
-> Signal dom Bool -> Signal dom Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
r

shifterL
    :: (BitPack a, HiddenClockResetEnable dom)
    => Signal dom (Maybe a)
    -> Signal dom Bool
    -> Signal dom Bit
shifterL :: forall a (dom :: Domain).
(BitPack a, HiddenClockResetEnable dom) =>
Signal dom (Maybe a) -> Signal dom Bool -> Signal dom Bit
shifterL Signal dom (Maybe a)
load Signal dom Bool
tick = BitVector (BitSize a) -> Bit
forall a. BitPack a => a -> Bit
msb (BitVector (BitSize a) -> Bit)
-> Signal dom (BitVector (BitSize a)) -> Signal dom Bit
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector (BitSize a))
next
  where
    r :: Signal dom (BitVector (BitSize a))
r = BitVector (BitSize a)
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register BitVector (BitSize a)
0 Signal dom (BitVector (BitSize a))
next

    next :: Signal dom (BitVector (BitSize a))
next = [Signal dom (Maybe (BitVector (BitSize a)))]
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (t :: Type -> Type) (m :: Type -> Type) (f :: Type -> Type)
       a.
(Foldable t, Alternative m, Applicative f) =>
t (f (m a)) -> f (m a)
muxA
        [ (a -> BitVector (BitSize a))
-> Maybe a -> Maybe (BitVector (BitSize a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BitVector (BitSize a)
forall a. BitPack a => a -> BitVector (BitSize a)
pack (Maybe a -> Maybe (BitVector (BitSize a)))
-> Signal dom (Maybe a)
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe a)
load
        , Signal dom Bool
-> Signal dom (BitVector (BitSize a))
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f (Maybe a)
enable Signal dom Bool
tick (Signal dom (BitVector (BitSize a))
 -> Signal dom (Maybe (BitVector (BitSize a))))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (Maybe (BitVector (BitSize a)))
forall a b. (a -> b) -> a -> b
$ (BitVector (BitSize a) -> Int -> BitVector (BitSize a)
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) (BitVector (BitSize a) -> BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector (BitSize a))
r
        ] Signal dom (Maybe (BitVector (BitSize a)))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (f :: Type -> Type) a.
Applicative f =>
f (Maybe a) -> f a -> f a
.<|.
        Signal dom (BitVector (BitSize a))
r

shifterR
    :: (BitPack a, HiddenClockResetEnable dom)
    => Signal dom (Maybe a)
    -> Signal dom Bool
    -> Signal dom Bit
shifterR :: forall a (dom :: Domain).
(BitPack a, HiddenClockResetEnable dom) =>
Signal dom (Maybe a) -> Signal dom Bool -> Signal dom Bit
shifterR Signal dom (Maybe a)
load Signal dom Bool
tick = BitVector (BitSize a) -> Bit
forall a. BitPack a => a -> Bit
lsb (BitVector (BitSize a) -> Bit)
-> Signal dom (BitVector (BitSize a)) -> Signal dom Bit
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector (BitSize a))
next
  where
    r :: Signal dom (BitVector (BitSize a))
r = BitVector (BitSize a)
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register BitVector (BitSize a)
0 Signal dom (BitVector (BitSize a))
next

    next :: Signal dom (BitVector (BitSize a))
next = [Signal dom (Maybe (BitVector (BitSize a)))]
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (t :: Type -> Type) (m :: Type -> Type) (f :: Type -> Type)
       a.
(Foldable t, Alternative m, Applicative f) =>
t (f (m a)) -> f (m a)
muxA
        [ (a -> BitVector (BitSize a))
-> Maybe a -> Maybe (BitVector (BitSize a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BitVector (BitSize a)
forall a. BitPack a => a -> BitVector (BitSize a)
pack (Maybe a -> Maybe (BitVector (BitSize a)))
-> Signal dom (Maybe a)
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe a)
load
        , Signal dom Bool
-> Signal dom (BitVector (BitSize a))
-> Signal dom (Maybe (BitVector (BitSize a)))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f (Maybe a)
enable Signal dom Bool
tick (Signal dom (BitVector (BitSize a))
 -> Signal dom (Maybe (BitVector (BitSize a))))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (Maybe (BitVector (BitSize a)))
forall a b. (a -> b) -> a -> b
$ (BitVector (BitSize a) -> Int -> BitVector (BitSize a)
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (BitVector (BitSize a) -> BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector (BitSize a))
r
        ] Signal dom (Maybe (BitVector (BitSize a)))
-> Signal dom (BitVector (BitSize a))
-> Signal dom (BitVector (BitSize a))
forall (f :: Type -> Type) a.
Applicative f =>
f (Maybe a) -> f a -> f a
.<|.
        Signal dom (BitVector (BitSize a))
r