Copyright | (C) 2021 QBayLogic B.V. |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | QBayLogic B.V. <devops@qbaylogic.com> |
Safe Haskell | None |
Language | Haskell2010 |
Utilities for wrapping counters consisting of multiple individual counters
Documentation
Counter
is a class that composes multiple counters
into a single one. It is similar to odometers found in olds cars,
once all counters reach their maximum they reset to zero - i.e. odometer
rollover. See countSucc
and countPred
for API usage examples.
Example use case: when driving a monitor through VGA you would like to keep track at least two counters: one counting a horizontal position, and one vertical. Perhaps a fancy VGA driver would also like to keep track of the number of drawn frames. To do so, the three counters are setup with different types. On each round of the horizontal counter the vertical counter should be increased. On each round of the vertical counter the frame counter should be increased. With this class you could simply use the type:
(FrameCount, VerticalCount, HorizontalCount)
and have countSucc
work as described.
NB: This class exposes four functions countMin
, countMax
,
countSuccOverflow
, and countPredOverflow
. These functions are considered
an internal API. Users are encouraged to use countSucc
and countPred
.
Instances
KnownNat n => Counter (BitVector n) Source # | |
(1 <= n, KnownNat n) => Counter (Index n) Source # | |
KnownNat n => Counter (Unsigned n) Source # | |
KnownNat n => Counter (Signed n) Source # | |
(Counter a, Counter b) => Counter (Either a b) Source # | Counter instance that flip-flops between
|
(Counter a0, Counter a1) => Counter (a0, a1) Source # | Counters on tuples increment from right-to-left. This makes sense from the perspective of LSB/MSB; MSB is on the left-hand-side and LSB is on the right-hand-side in other Clash types.
NB: The documentation only shows the instances up to 3-tuples. By
default, instances up to and including 12-tuples will exist. If the flag
|
Defined in Clash.Class.Counter.Internal | |
(Counter a0, Counter a1, Counter a2) => Counter (a0, a1, a2) Source # | |
Defined in Clash.Class.Counter.Internal |
countSucc :: Counter a => a -> a Source #
Successor of a counter.
Examples:
>>>
type T = (Unsigned 2, Unsigned 2)
>>>
countSucc @T (1, 1)
(1,2)>>>
countSucc @T (1, 2)
(1,3)>>>
countSucc @T (1, 3)
(2,0)>>>
countSucc @T (3, 3)
(0,0)>>>
countSucc @(Index 9, Index 2) (0, 1)
(1,0)>>>
countSucc @(Either (Index 9) (Index 9)) (Left 8)
Right 0
countPred :: Counter a => a -> a Source #
Predecessor of a counter
Examples:
>>>
type T = (Unsigned 2, Unsigned 2)
>>>
countPred @T (1, 2)
(1,1)>>>
countPred @T (1, 3)
(1,2)>>>
countPred @T (2, 0)
(1,3)>>>
countPred @T (0, 0)
(3,3)>>>
countPred @(Index 9, Index 2) (1, 0)
(0,1)>>>
countPred @(Either (Index 9) (Index 9)) (Right 0)
Left 8