content: {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralisedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  module Clash.Class.Counter.Internal where
  
  import Clash.CPP (maxTupleSize)
  
  import Clash.Class.Counter.TH (genTupleInstances)
  import Clash.Sized.BitVector (BitVector, Bit)
  import Clash.Sized.Index (Index)
  import Clash.Sized.Signed (Signed)
  import Clash.Sized.Unsigned (Unsigned)
  import Clash.Sized.Vector as Vec (Vec, repeat, mapAccumR)
  
  import Data.Bifunctor (bimap)
  import Data.Functor.Identity (Identity(..))
  import Data.Int (Int8, Int16, Int32, Int64)
  import Data.Word (Word8, Word16, Word32, Word64)
  import GHC.TypeLits (KnownNat, type (<=))
  
  -- $setup
  -- >>> :m -Prelude
  -- >>> import Clash.Prelude
  -- >>> import Clash.Class.Counter
  -- >>> import Clash.Sized.BitVector (BitVector)
  -- >>> import Clash.Sized.Index (Index)
  -- >>> import Clash.Sized.Signed (Signed)
  -- >>> import Clash.Sized.Unsigned (Unsigned)
  -- >>> import Clash.Sized.Vector (Vec(..), iterate)
  
  -- | t'Clash.Class.Counter.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 'Clash.Class.Counter.countSucc' and 'Clash.Class.Counter.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 'Clash.Class.Counter.countSucc' work as described.
  --
  class Counter a where
    -- | Value counter wraps around to on a 'countSuccOverflow' overflow
    countMin :: a
    default countMin :: Bounded a => a
    countMin = minBound
  
    -- | Value counter wraps around to on a 'countPredOverflow' overflow
    countMax :: a
    default countMax :: Bounded a => a
    countMax = maxBound
  
    -- | Gets the successor of @a@. If it overflows, the first part of the tuple
    -- will be set to True and the second part wraps around to `countMin`.
    countSuccOverflow :: a -> (Bool, a)
    default countSuccOverflow :: (Eq a, Enum a, Bounded a) => a -> (Bool, a)
    countSuccOverflow a
      | a == maxBound = (True, countMin)
      | otherwise = (False, succ a)
  
    -- | Gets the predecessor of @a@. If it underflows, the first part of the tuple
    -- will be set to True and the second part wraps around to `countMax`.
    countPredOverflow :: a -> (Bool, a)
    default countPredOverflow :: (Eq a, Enum a, Bounded a) => a -> (Bool, a)
    countPredOverflow a
      | a == minBound = (True, countMax)
      | otherwise = (False, pred a)
  
  instance (1 <= n, KnownNat n) => Counter (Index n)
  instance KnownNat n => Counter (Unsigned n)
  instance KnownNat n => Counter (Signed n)
  instance KnownNat n => Counter (BitVector n)
  
  -- | @since 1.8.2
  instance Counter Bool
  -- | @since 1.8.2
  instance Counter Bit
  -- | @since 1.8.2
  instance Counter Int
  -- | @since 1.8.2
  instance Counter Int8
  -- | @since 1.8.2
  instance Counter Int16
  -- | @since 1.8.2
  instance Counter Int32
  -- | @since 1.8.2
  instance Counter Int64
  -- | @since 1.8.2
  instance Counter Word
  -- | @since 1.8.2
  instance Counter Word8
  -- | @since 1.8.2
  instance Counter Word16
  -- | @since 1.8.2
  instance Counter Word32
  -- | @since 1.8.2
  instance Counter Word64
  
  -- | @since 1.8.2
  deriving newtype instance Counter a => Counter (Identity a)
  
  -- | 'Nothing' is considered the minimum value, while @'Just' 'countMax'@ is
  -- considered the maximum value.
  --
  -- @since 1.8.2
  instance Counter a => Counter (Maybe a) where
    countMin = Nothing
    countMax = Just countMax
  
    countSuccOverflow = \case
      Nothing -> (False, Just countMin)
      Just a0 ->
        case countSuccOverflow a0 of
          (True, _) -> (True, Nothing)
          (False, a1) -> (False, Just a1)
  
    countPredOverflow = \case
      Nothing -> (True, Just countMax)
      Just a0 ->
        case countPredOverflow a0 of
          (True, _) -> (False, Nothing)
          (False, a1) -> (False, Just a1)
  
  -- | Counter instance that flip-flops between 'Left' and 'Right'. Examples:
  --
  -- >>> type T = Either (Index 2) (Unsigned 2)
  -- >>> countSucc @T (Left 0)
  -- Left 1
  -- >>> countSucc @T (Left 1)
  -- Right 0
  -- >>> countSucc @T (Right 0)
  -- Right 1
  instance (Counter a, Counter b) => Counter (Either a b) where
    countMin = Left countMin
    countMax = Right countMax
  
    countSuccOverflow e =
      case bimap countSuccOverflow countSuccOverflow e of
        Left (overflow, a)  -> (False, if overflow then Right countMin else Left a)
        Right (overflow, b) -> (overflow, if overflow then Left countMin else Right b)
  
    countPredOverflow e =
      case bimap countPredOverflow countPredOverflow e of
        Left (overflow, a)  -> (overflow, if overflow then Right countMax else Left a)
        Right (overflow, b) -> (False, if overflow then Left countMax else Right b)
  
  -- | 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.
  --
  -- >>> type T = (Unsigned 2, Index 2, Index 2)
  -- >>> countSucc @T (0, 0, 0)
  -- (0,0,1)
  -- >>> countSucc @T (0, 0, 1)
  -- (0,1,0)
  -- >>> countSucc @T (0, 1, 0)
  -- (0,1,1)
  -- >>> countSucc @T (0, 1, 1)
  -- (1,0,0)
  --
  -- __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
  -- @large-tuples@ is set instances up to the GHC imposed limit will exist. The
  -- GHC imposed limit is either 62 or 64 depending on the GHC version.
  instance (Counter a0, Counter a1) => Counter (a0, a1) where
    -- a0/a1 instead of a/b to be consistent with TH generated instances
    countMin = (countMin, countMin)
    countMax = (countMax, countMax)
  
    countSuccOverflow (a0, b0) =
      if overflowB
      then (overflowA, (a1, b1))
      else (overflowB, (a0, b1))
     where
      (overflowB, b1) = countSuccOverflow b0
      (overflowA, a1) = countSuccOverflow a0
  
    countPredOverflow (a0, b0) =
      if overflowB
      then (overflowA, (a1, b1))
      else (overflowB, (a0, b1))
     where
      (overflowB, b1) = countPredOverflow b0
      (overflowA, a1) = countPredOverflow a0
  
  genTupleInstances maxTupleSize
  
  rippleR :: (a -> (Bool, a)) -> Vec n a -> (Bool, Vec n a)
  rippleR f = mapAccumR step True
    where
      step carry x = if carry then f x else (False, x)
  
  -- | Counters on vectors increment from right to left.
  --
  -- >>> type T = Vec 2 (Index 10)
  -- >>> countSucc @T (0 :> 0 :> Nil)
  -- 0 :> 1 :> Nil
  -- >>> countSucc @T (0 :> 1 :> Nil)
  -- 0 :> 2 :> Nil
  -- >>> countSucc @T (0 :> 9 :> Nil)
  -- 1 :> 0 :> Nil
  -- >>> iterate (SNat @5) (countSucc @T) (9 :> 8 :> Nil)
  -- (9 :> 8 :> Nil) :> (9 :> 9 :> Nil) :> (0 :> 0 :> Nil) :> (0 :> 1 :> Nil) :> (0 :> 2 :> Nil) :> Nil
  instance (Counter a, KnownNat n, 1 <= n) => Counter (Vec n a) where
      countMin = Vec.repeat countMin
      countMax = Vec.repeat countMax
  
      countSuccOverflow = rippleR countSuccOverflow
      countPredOverflow = rippleR countPredOverflow
  