{-|
Copyright  :  (C) 2013-2016, University of Twente,
                  2017-2019, Myrtle Software Ltd
                  2017-2022, Google Inc.,
                  2021-2023, QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
-}

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE Unsafe #-}

{-# OPTIONS_GHC -fplugin=GHC.TypeLits.Extra.Solver #-}
{-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}

-- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c
-- as to why we need this.
{-# OPTIONS_GHC -fno-cpr-anal #-}

{-# OPTIONS_HADDOCK show-extensions not-home #-}

module Clash.Signal.Internal
  ( -- * Datatypes
    Signal(..)
  , head#
  , tail#
    -- * Domains
  , Domain
  , sameDomain
  , KnownDomain(..)
  , KnownConfiguration
  , knownDomainByName
  , ActiveEdge(..)
  , SActiveEdge(..)
  , InitBehavior(..)
  , SInitBehavior(..)
  , ResetKind(..)
  , SResetKind(..)
  , ResetPolarity(..)
  , SResetPolarity(..)
  , DomainConfiguration(..)
  , SDomainConfiguration(..)
  -- ** Configuration type families
  , DomainPeriod
  , DomainActiveEdge
  , DomainResetKind
  , DomainInitBehavior
  , DomainResetPolarity

  , DomainConfigurationPeriod
  , DomainConfigurationActiveEdge
  , DomainConfigurationResetKind
  , DomainConfigurationInitBehavior
  , DomainConfigurationResetPolarity

    -- *** Convenience types

  , HasSynchronousReset
  , HasAsynchronousReset
  , HasDefinedInitialValues

    -- ** Default domains
  , System
  , XilinxSystem
  , IntelSystem
  , vSystem
  , vIntelSystem
  , vXilinxSystem
    -- ** Domain utilities
  , VDomainConfiguration(..)
  , vDomain
  , createDomain
    -- * Clocks
  , Clock (..)
  , ClockN (..)
  , DiffClock (..)
  , hzToPeriod
  , periodToHz
  , ClockAB (..)
  , clockTicks
  , clockTicksEither
    -- ** Enabling
  , Enable(..)
  , toEnable
  , fromEnable
  , enableGen
    -- * Resets
  , Reset(..)
  , unsafeToReset
  , unsafeFromReset
  , unsafeToActiveHigh
  , unsafeToActiveLow
  , unsafeFromActiveHigh
  , unsafeFromActiveLow
  , invertReset
    -- * Basic circuits
  , delay#
  , register#
  , asyncRegister#
  , syncRegister#
  , registerPowerup#
  , mux
    -- * Simulation and testbench functions
  , clockGen
  , tbClockGen
  , Femtoseconds(..)  -- experimental, do not expose in public API
  , fsToHz            -- experimental, do not expose in public API
  , hzToFs            -- experimental, do not expose in public API
  , unFemtoseconds    -- experimental, do not expose in public API
  , mapFemtoseconds   -- experimental, do not expose in public API
  , tbDynamicClockGen -- experimental, do not expose in public API
  , dynamicClockGen   -- experimental, do not expose in public API
  , resetGen
  , resetGenN
    -- * Boolean connectives
  , (.&&.), (.||.)
    -- * Simulation functions (not synthesizable)
  , simulate
    -- ** lazy version
  , simulate_lazy
    -- ** Automaton
  , signalAutomaton
    -- * List \<-\> Signal conversion (not synthesizable)
  , sample
  , sampleN
  , fromList
    -- ** lazy versions
  , sample_lazy
  , sampleN_lazy
  , fromList_lazy
    -- * QuickCheck combinators
  , testFor
    -- * Type classes
    -- ** 'Eq'-like
  , (.==.), (./=.)
    -- ** 'Ord'-like
  , (.<.), (.<=.), (.>=.), (.>.)
    -- ** 'Functor'
  , mapSignal#
    -- ** 'Applicative'
  , signal#
  , appSignal#
    -- ** 'Foldable'
  , foldr#
    -- ** 'Traversable'
  , traverse#
  -- * EXTREMELY EXPERIMENTAL
  , joinSignal#

  -- * Deprecated
  , unsafeFromHighPolarity
  , unsafeFromLowPolarity
  , unsafeToHighPolarity
  , unsafeToLowPolarity
  )
where

import Data.IORef                 (IORef, atomicModifyIORef, newIORef, readIORef)
import Type.Reflection            (Typeable)
import Control.Arrow.Transformer.Automaton
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative        (liftA2)
#endif
import Control.Applicative        (liftA3)
import Control.DeepSeq            (NFData)
import Clash.Annotations.Primitive (hasBlackBox, dontTranslate)
import Data.Binary                (Binary)
import Data.Char                  (isAsciiUpper, isAlphaNum, isAscii)
import Data.Coerce                (coerce)
import Data.Data                  (Data)
import Data.Default.Class         (Default (..))
import Data.Hashable              (Hashable)
import Data.Int                   (Int64)
import Data.Maybe                 (isJust)
import Data.Proxy                 (Proxy(..))
import Data.Ratio                 (Ratio)
import Data.Type.Equality         ((:~:))
import GHC.Generics               (Generic)
import GHC.Stack                  (HasCallStack, withFrozenCallStack)
import GHC.TypeLits               (KnownSymbol, KnownNat, Nat, Symbol, type (<=), sameSymbol)
import Language.Haskell.TH.Syntax -- (Lift (..), Q, Dec)
import Language.Haskell.TH.Compat
import Numeric.Natural            (Natural)
import System.IO.Unsafe           (unsafeInterleaveIO, unsafePerformIO)
import Test.QuickCheck            (Arbitrary (..), CoArbitrary(..), Property,
                                   property)

import Clash.CPP                  (fStrictMapSignal)
import Clash.NamedTypes
import Clash.Promoted.Nat         (SNat (..), snatToNum, snatToNatural)
import Clash.Promoted.Symbol      (SSymbol (..), ssymbolToString)
import Clash.XException
  (NFDataX(..), errorX, isX, deepseqX, defaultSeqX, seqX)

{- $setup
>>> :set -XDataKinds
>>> :set -XMagicHash
>>> :set -XTypeApplications
>>> import Clash.Prelude (SSymbol(..))
>>> import Clash.Signal.Internal
>>> import Clash.Promoted.Nat
>>> import Clash.Promoted.Nat.Literals
>>> import Clash.XException
>>> import Data.Ratio (Ratio)
>>> import Numeric.Natural (Natural)
>>> type System = "System"
>>> let systemClockGen = clockGen @System
>>> let systemResetGen = resetGen @System
>>> import Clash.Explicit.Signal (register)
>>> let registerS = register
>>> let registerA = register
-}

-- * Signal

-- | Determines clock edge memory elements are sensitive to. Not yet
-- implemented.
data ActiveEdge
  -- TODO: Implement in blackboxes:
  = Rising
  -- ^ Elements are sensitive to the rising edge (low-to-high) of the clock.
  | Falling
  -- ^ Elements are sensitive to the falling edge (high-to-low) of the clock.
  deriving (Int -> ActiveEdge -> ShowS
[ActiveEdge] -> ShowS
ActiveEdge -> String
(Int -> ActiveEdge -> ShowS)
-> (ActiveEdge -> String)
-> ([ActiveEdge] -> ShowS)
-> Show ActiveEdge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveEdge] -> ShowS
$cshowList :: [ActiveEdge] -> ShowS
show :: ActiveEdge -> String
$cshow :: ActiveEdge -> String
showsPrec :: Int -> ActiveEdge -> ShowS
$cshowsPrec :: Int -> ActiveEdge -> ShowS
Show, ReadPrec [ActiveEdge]
ReadPrec ActiveEdge
Int -> ReadS ActiveEdge
ReadS [ActiveEdge]
(Int -> ReadS ActiveEdge)
-> ReadS [ActiveEdge]
-> ReadPrec ActiveEdge
-> ReadPrec [ActiveEdge]
-> Read ActiveEdge
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActiveEdge]
$creadListPrec :: ReadPrec [ActiveEdge]
readPrec :: ReadPrec ActiveEdge
$creadPrec :: ReadPrec ActiveEdge
readList :: ReadS [ActiveEdge]
$creadList :: ReadS [ActiveEdge]
readsPrec :: Int -> ReadS ActiveEdge
$creadsPrec :: Int -> ReadS ActiveEdge
Read, ActiveEdge -> ActiveEdge -> Bool
(ActiveEdge -> ActiveEdge -> Bool)
-> (ActiveEdge -> ActiveEdge -> Bool) -> Eq ActiveEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveEdge -> ActiveEdge -> Bool
$c/= :: ActiveEdge -> ActiveEdge -> Bool
== :: ActiveEdge -> ActiveEdge -> Bool
$c== :: ActiveEdge -> ActiveEdge -> Bool
Eq, Eq ActiveEdge
Eq ActiveEdge
-> (ActiveEdge -> ActiveEdge -> Ordering)
-> (ActiveEdge -> ActiveEdge -> Bool)
-> (ActiveEdge -> ActiveEdge -> Bool)
-> (ActiveEdge -> ActiveEdge -> Bool)
-> (ActiveEdge -> ActiveEdge -> Bool)
-> (ActiveEdge -> ActiveEdge -> ActiveEdge)
-> (ActiveEdge -> ActiveEdge -> ActiveEdge)
-> Ord ActiveEdge
ActiveEdge -> ActiveEdge -> Bool
ActiveEdge -> ActiveEdge -> Ordering
ActiveEdge -> ActiveEdge -> ActiveEdge
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
min :: ActiveEdge -> ActiveEdge -> ActiveEdge
$cmin :: ActiveEdge -> ActiveEdge -> ActiveEdge
max :: ActiveEdge -> ActiveEdge -> ActiveEdge
$cmax :: ActiveEdge -> ActiveEdge -> ActiveEdge
>= :: ActiveEdge -> ActiveEdge -> Bool
$c>= :: ActiveEdge -> ActiveEdge -> Bool
> :: ActiveEdge -> ActiveEdge -> Bool
$c> :: ActiveEdge -> ActiveEdge -> Bool
<= :: ActiveEdge -> ActiveEdge -> Bool
$c<= :: ActiveEdge -> ActiveEdge -> Bool
< :: ActiveEdge -> ActiveEdge -> Bool
$c< :: ActiveEdge -> ActiveEdge -> Bool
compare :: ActiveEdge -> ActiveEdge -> Ordering
$ccompare :: ActiveEdge -> ActiveEdge -> Ordering
$cp1Ord :: Eq ActiveEdge
Ord, (forall x. ActiveEdge -> Rep ActiveEdge x)
-> (forall x. Rep ActiveEdge x -> ActiveEdge) -> Generic ActiveEdge
forall x. Rep ActiveEdge x -> ActiveEdge
forall x. ActiveEdge -> Rep ActiveEdge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveEdge x -> ActiveEdge
$cfrom :: forall x. ActiveEdge -> Rep ActiveEdge x
Generic, ActiveEdge -> ()
(ActiveEdge -> ()) -> NFData ActiveEdge
forall a. (a -> ()) -> NFData a
rnf :: ActiveEdge -> ()
$crnf :: ActiveEdge -> ()
NFData, Typeable ActiveEdge
DataType
Constr
Typeable ActiveEdge
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ActiveEdge -> c ActiveEdge)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ActiveEdge)
-> (ActiveEdge -> Constr)
-> (ActiveEdge -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ActiveEdge))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ActiveEdge))
-> ((forall b. Data b => b -> b) -> ActiveEdge -> ActiveEdge)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r)
-> (forall u. (forall d. Data d => d -> u) -> ActiveEdge -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ActiveEdge -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge)
-> Data ActiveEdge
ActiveEdge -> DataType
ActiveEdge -> Constr
(forall b. Data b => b -> b) -> ActiveEdge -> ActiveEdge
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActiveEdge -> c ActiveEdge
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActiveEdge
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ActiveEdge -> u
forall u. (forall d. Data d => d -> u) -> ActiveEdge -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActiveEdge
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActiveEdge -> c ActiveEdge
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActiveEdge)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ActiveEdge)
$cFalling :: Constr
$cRising :: Constr
$tActiveEdge :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
gmapMp :: (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
gmapM :: (forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ActiveEdge -> m ActiveEdge
gmapQi :: Int -> (forall d. Data d => d -> u) -> ActiveEdge -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ActiveEdge -> u
gmapQ :: (forall d. Data d => d -> u) -> ActiveEdge -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ActiveEdge -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActiveEdge -> r
gmapT :: (forall b. Data b => b -> b) -> ActiveEdge -> ActiveEdge
$cgmapT :: (forall b. Data b => b -> b) -> ActiveEdge -> ActiveEdge
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ActiveEdge)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ActiveEdge)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ActiveEdge)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActiveEdge)
dataTypeOf :: ActiveEdge -> DataType
$cdataTypeOf :: ActiveEdge -> DataType
toConstr :: ActiveEdge -> Constr
$ctoConstr :: ActiveEdge -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActiveEdge
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActiveEdge
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActiveEdge -> c ActiveEdge
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActiveEdge -> c ActiveEdge
$cp1Data :: Typeable ActiveEdge
Data, Eq ActiveEdge
Eq ActiveEdge
-> (Int -> ActiveEdge -> Int)
-> (ActiveEdge -> Int)
-> Hashable ActiveEdge
Int -> ActiveEdge -> Int
ActiveEdge -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ActiveEdge -> Int
$chash :: ActiveEdge -> Int
hashWithSalt :: Int -> ActiveEdge -> Int
$chashWithSalt :: Int -> ActiveEdge -> Int
$cp1Hashable :: Eq ActiveEdge
Hashable, Get ActiveEdge
[ActiveEdge] -> Put
ActiveEdge -> Put
(ActiveEdge -> Put)
-> Get ActiveEdge -> ([ActiveEdge] -> Put) -> Binary ActiveEdge
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ActiveEdge] -> Put
$cputList :: [ActiveEdge] -> Put
get :: Get ActiveEdge
$cget :: Get ActiveEdge
put :: ActiveEdge -> Put
$cput :: ActiveEdge -> Put
Binary)

-- | Singleton version of 'ActiveEdge'
data SActiveEdge (edge :: ActiveEdge) where
  SRising  :: SActiveEdge 'Rising
  SFalling :: SActiveEdge 'Falling

instance Show (SActiveEdge edge) where
  show :: SActiveEdge edge -> String
show SActiveEdge edge
SRising = String
"SRising"
  show SActiveEdge edge
SFalling = String
"SFalling"

data ResetKind
  = Asynchronous
  -- ^ Elements respond /asynchronously/ to changes in their reset input. This
  -- means that they do /not/ wait for the next active clock edge, but respond
  -- immediately instead. Common on Intel FPGA platforms.
  | Synchronous
  -- ^ Elements respond /synchronously/ to changes in their reset input. This
  -- means that changes in their reset input won't take effect until the next
  -- active clock edge. Common on Xilinx FPGA platforms.
  deriving (Int -> ResetKind -> ShowS
[ResetKind] -> ShowS
ResetKind -> String
(Int -> ResetKind -> ShowS)
-> (ResetKind -> String)
-> ([ResetKind] -> ShowS)
-> Show ResetKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetKind] -> ShowS
$cshowList :: [ResetKind] -> ShowS
show :: ResetKind -> String
$cshow :: ResetKind -> String
showsPrec :: Int -> ResetKind -> ShowS
$cshowsPrec :: Int -> ResetKind -> ShowS
Show, ReadPrec [ResetKind]
ReadPrec ResetKind
Int -> ReadS ResetKind
ReadS [ResetKind]
(Int -> ReadS ResetKind)
-> ReadS [ResetKind]
-> ReadPrec ResetKind
-> ReadPrec [ResetKind]
-> Read ResetKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetKind]
$creadListPrec :: ReadPrec [ResetKind]
readPrec :: ReadPrec ResetKind
$creadPrec :: ReadPrec ResetKind
readList :: ReadS [ResetKind]
$creadList :: ReadS [ResetKind]
readsPrec :: Int -> ReadS ResetKind
$creadsPrec :: Int -> ReadS ResetKind
Read, ResetKind -> ResetKind -> Bool
(ResetKind -> ResetKind -> Bool)
-> (ResetKind -> ResetKind -> Bool) -> Eq ResetKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetKind -> ResetKind -> Bool
$c/= :: ResetKind -> ResetKind -> Bool
== :: ResetKind -> ResetKind -> Bool
$c== :: ResetKind -> ResetKind -> Bool
Eq, Eq ResetKind
Eq ResetKind
-> (ResetKind -> ResetKind -> Ordering)
-> (ResetKind -> ResetKind -> Bool)
-> (ResetKind -> ResetKind -> Bool)
-> (ResetKind -> ResetKind -> Bool)
-> (ResetKind -> ResetKind -> Bool)
-> (ResetKind -> ResetKind -> ResetKind)
-> (ResetKind -> ResetKind -> ResetKind)
-> Ord ResetKind
ResetKind -> ResetKind -> Bool
ResetKind -> ResetKind -> Ordering
ResetKind -> ResetKind -> ResetKind
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
min :: ResetKind -> ResetKind -> ResetKind
$cmin :: ResetKind -> ResetKind -> ResetKind
max :: ResetKind -> ResetKind -> ResetKind
$cmax :: ResetKind -> ResetKind -> ResetKind
>= :: ResetKind -> ResetKind -> Bool
$c>= :: ResetKind -> ResetKind -> Bool
> :: ResetKind -> ResetKind -> Bool
$c> :: ResetKind -> ResetKind -> Bool
<= :: ResetKind -> ResetKind -> Bool
$c<= :: ResetKind -> ResetKind -> Bool
< :: ResetKind -> ResetKind -> Bool
$c< :: ResetKind -> ResetKind -> Bool
compare :: ResetKind -> ResetKind -> Ordering
$ccompare :: ResetKind -> ResetKind -> Ordering
$cp1Ord :: Eq ResetKind
Ord, (forall x. ResetKind -> Rep ResetKind x)
-> (forall x. Rep ResetKind x -> ResetKind) -> Generic ResetKind
forall x. Rep ResetKind x -> ResetKind
forall x. ResetKind -> Rep ResetKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetKind x -> ResetKind
$cfrom :: forall x. ResetKind -> Rep ResetKind x
Generic, ResetKind -> ()
(ResetKind -> ()) -> NFData ResetKind
forall a. (a -> ()) -> NFData a
rnf :: ResetKind -> ()
$crnf :: ResetKind -> ()
NFData, Typeable ResetKind
DataType
Constr
Typeable ResetKind
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ResetKind -> c ResetKind)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ResetKind)
-> (ResetKind -> Constr)
-> (ResetKind -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ResetKind))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResetKind))
-> ((forall b. Data b => b -> b) -> ResetKind -> ResetKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> ResetKind -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResetKind -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind)
-> Data ResetKind
ResetKind -> DataType
ResetKind -> Constr
(forall b. Data b => b -> b) -> ResetKind -> ResetKind
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetKind -> c ResetKind
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetKind
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ResetKind -> u
forall u. (forall d. Data d => d -> u) -> ResetKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetKind
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetKind -> c ResetKind
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetKind)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResetKind)
$cSynchronous :: Constr
$cAsynchronous :: Constr
$tResetKind :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
gmapMp :: (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
gmapM :: (forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ResetKind -> m ResetKind
gmapQi :: Int -> (forall d. Data d => d -> u) -> ResetKind -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ResetKind -> u
gmapQ :: (forall d. Data d => d -> u) -> ResetKind -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ResetKind -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetKind -> r
gmapT :: (forall b. Data b => b -> b) -> ResetKind -> ResetKind
$cgmapT :: (forall b. Data b => b -> b) -> ResetKind -> ResetKind
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResetKind)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ResetKind)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ResetKind)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetKind)
dataTypeOf :: ResetKind -> DataType
$cdataTypeOf :: ResetKind -> DataType
toConstr :: ResetKind -> Constr
$ctoConstr :: ResetKind -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetKind
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetKind
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetKind -> c ResetKind
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetKind -> c ResetKind
$cp1Data :: Typeable ResetKind
Data, Eq ResetKind
Eq ResetKind
-> (Int -> ResetKind -> Int)
-> (ResetKind -> Int)
-> Hashable ResetKind
Int -> ResetKind -> Int
ResetKind -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ResetKind -> Int
$chash :: ResetKind -> Int
hashWithSalt :: Int -> ResetKind -> Int
$chashWithSalt :: Int -> ResetKind -> Int
$cp1Hashable :: Eq ResetKind
Hashable, Get ResetKind
[ResetKind] -> Put
ResetKind -> Put
(ResetKind -> Put)
-> Get ResetKind -> ([ResetKind] -> Put) -> Binary ResetKind
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ResetKind] -> Put
$cputList :: [ResetKind] -> Put
get :: Get ResetKind
$cget :: Get ResetKind
put :: ResetKind -> Put
$cput :: ResetKind -> Put
Binary)

-- | Singleton version of 'ResetKind'
data SResetKind (resetKind :: ResetKind) where
  SAsynchronous :: SResetKind 'Asynchronous
  -- See 'Asynchronous' ^

  SSynchronous  :: SResetKind 'Synchronous
  -- See 'Synchronous' ^

instance Show (SResetKind reset) where
  show :: SResetKind reset -> String
show SResetKind reset
SAsynchronous = String
"SAsynchronous"
  show SResetKind reset
SSynchronous = String
"SSynchronous"

-- | Determines the value for which a reset line is considered "active"
data ResetPolarity
  = ActiveHigh
  -- ^ Reset is considered active if underlying signal is 'True'.
  | ActiveLow
  -- ^ Reset is considered active if underlying signal is 'False'.
  deriving (ResetPolarity -> ResetPolarity -> Bool
(ResetPolarity -> ResetPolarity -> Bool)
-> (ResetPolarity -> ResetPolarity -> Bool) -> Eq ResetPolarity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetPolarity -> ResetPolarity -> Bool
$c/= :: ResetPolarity -> ResetPolarity -> Bool
== :: ResetPolarity -> ResetPolarity -> Bool
$c== :: ResetPolarity -> ResetPolarity -> Bool
Eq, Eq ResetPolarity
Eq ResetPolarity
-> (ResetPolarity -> ResetPolarity -> Ordering)
-> (ResetPolarity -> ResetPolarity -> Bool)
-> (ResetPolarity -> ResetPolarity -> Bool)
-> (ResetPolarity -> ResetPolarity -> Bool)
-> (ResetPolarity -> ResetPolarity -> Bool)
-> (ResetPolarity -> ResetPolarity -> ResetPolarity)
-> (ResetPolarity -> ResetPolarity -> ResetPolarity)
-> Ord ResetPolarity
ResetPolarity -> ResetPolarity -> Bool
ResetPolarity -> ResetPolarity -> Ordering
ResetPolarity -> ResetPolarity -> ResetPolarity
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
min :: ResetPolarity -> ResetPolarity -> ResetPolarity
$cmin :: ResetPolarity -> ResetPolarity -> ResetPolarity
max :: ResetPolarity -> ResetPolarity -> ResetPolarity
$cmax :: ResetPolarity -> ResetPolarity -> ResetPolarity
>= :: ResetPolarity -> ResetPolarity -> Bool
$c>= :: ResetPolarity -> ResetPolarity -> Bool
> :: ResetPolarity -> ResetPolarity -> Bool
$c> :: ResetPolarity -> ResetPolarity -> Bool
<= :: ResetPolarity -> ResetPolarity -> Bool
$c<= :: ResetPolarity -> ResetPolarity -> Bool
< :: ResetPolarity -> ResetPolarity -> Bool
$c< :: ResetPolarity -> ResetPolarity -> Bool
compare :: ResetPolarity -> ResetPolarity -> Ordering
$ccompare :: ResetPolarity -> ResetPolarity -> Ordering
$cp1Ord :: Eq ResetPolarity
Ord, Int -> ResetPolarity -> ShowS
[ResetPolarity] -> ShowS
ResetPolarity -> String
(Int -> ResetPolarity -> ShowS)
-> (ResetPolarity -> String)
-> ([ResetPolarity] -> ShowS)
-> Show ResetPolarity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetPolarity] -> ShowS
$cshowList :: [ResetPolarity] -> ShowS
show :: ResetPolarity -> String
$cshow :: ResetPolarity -> String
showsPrec :: Int -> ResetPolarity -> ShowS
$cshowsPrec :: Int -> ResetPolarity -> ShowS
Show, ReadPrec [ResetPolarity]
ReadPrec ResetPolarity
Int -> ReadS ResetPolarity
ReadS [ResetPolarity]
(Int -> ReadS ResetPolarity)
-> ReadS [ResetPolarity]
-> ReadPrec ResetPolarity
-> ReadPrec [ResetPolarity]
-> Read ResetPolarity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetPolarity]
$creadListPrec :: ReadPrec [ResetPolarity]
readPrec :: ReadPrec ResetPolarity
$creadPrec :: ReadPrec ResetPolarity
readList :: ReadS [ResetPolarity]
$creadList :: ReadS [ResetPolarity]
readsPrec :: Int -> ReadS ResetPolarity
$creadsPrec :: Int -> ReadS ResetPolarity
Read, (forall x. ResetPolarity -> Rep ResetPolarity x)
-> (forall x. Rep ResetPolarity x -> ResetPolarity)
-> Generic ResetPolarity
forall x. Rep ResetPolarity x -> ResetPolarity
forall x. ResetPolarity -> Rep ResetPolarity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetPolarity x -> ResetPolarity
$cfrom :: forall x. ResetPolarity -> Rep ResetPolarity x
Generic, ResetPolarity -> ()
(ResetPolarity -> ()) -> NFData ResetPolarity
forall a. (a -> ()) -> NFData a
rnf :: ResetPolarity -> ()
$crnf :: ResetPolarity -> ()
NFData, Typeable ResetPolarity
DataType
Constr
Typeable ResetPolarity
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ResetPolarity -> c ResetPolarity)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ResetPolarity)
-> (ResetPolarity -> Constr)
-> (ResetPolarity -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ResetPolarity))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ResetPolarity))
-> ((forall b. Data b => b -> b) -> ResetPolarity -> ResetPolarity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r)
-> (forall u. (forall d. Data d => d -> u) -> ResetPolarity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResetPolarity -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity)
-> Data ResetPolarity
ResetPolarity -> DataType
ResetPolarity -> Constr
(forall b. Data b => b -> b) -> ResetPolarity -> ResetPolarity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPolarity -> c ResetPolarity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPolarity
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ResetPolarity -> u
forall u. (forall d. Data d => d -> u) -> ResetPolarity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPolarity
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPolarity -> c ResetPolarity
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetPolarity)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPolarity)
$cActiveLow :: Constr
$cActiveHigh :: Constr
$tResetPolarity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
gmapMp :: (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
gmapM :: (forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> ResetPolarity -> m ResetPolarity
gmapQi :: Int -> (forall d. Data d => d -> u) -> ResetPolarity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ResetPolarity -> u
gmapQ :: (forall d. Data d => d -> u) -> ResetPolarity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ResetPolarity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResetPolarity -> r
gmapT :: (forall b. Data b => b -> b) -> ResetPolarity -> ResetPolarity
$cgmapT :: (forall b. Data b => b -> b) -> ResetPolarity -> ResetPolarity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPolarity)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ResetPolarity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ResetPolarity)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ResetPolarity)
dataTypeOf :: ResetPolarity -> DataType
$cdataTypeOf :: ResetPolarity -> DataType
toConstr :: ResetPolarity -> Constr
$ctoConstr :: ResetPolarity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPolarity
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ResetPolarity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPolarity -> c ResetPolarity
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ResetPolarity -> c ResetPolarity
$cp1Data :: Typeable ResetPolarity
Data, Eq ResetPolarity
Eq ResetPolarity
-> (Int -> ResetPolarity -> Int)
-> (ResetPolarity -> Int)
-> Hashable ResetPolarity
Int -> ResetPolarity -> Int
ResetPolarity -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ResetPolarity -> Int
$chash :: ResetPolarity -> Int
hashWithSalt :: Int -> ResetPolarity -> Int
$chashWithSalt :: Int -> ResetPolarity -> Int
$cp1Hashable :: Eq ResetPolarity
Hashable, Get ResetPolarity
[ResetPolarity] -> Put
ResetPolarity -> Put
(ResetPolarity -> Put)
-> Get ResetPolarity
-> ([ResetPolarity] -> Put)
-> Binary ResetPolarity
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ResetPolarity] -> Put
$cputList :: [ResetPolarity] -> Put
get :: Get ResetPolarity
$cget :: Get ResetPolarity
put :: ResetPolarity -> Put
$cput :: ResetPolarity -> Put
Binary)

-- | Singleton version of 'ResetPolarity'
data SResetPolarity (polarity :: ResetPolarity) where
  SActiveHigh :: SResetPolarity 'ActiveHigh
  -- See: 'ActiveHigh' ^

  SActiveLow :: SResetPolarity 'ActiveLow
  -- See: 'ActiveLow' ^

instance Show (SResetPolarity polarity) where
  show :: SResetPolarity polarity -> String
show SResetPolarity polarity
SActiveHigh = String
"SActiveHigh"
  show SResetPolarity polarity
SActiveLow = String
"SActiveLow"

data InitBehavior
  = Unknown
  -- ^ Power up value of memory elements is /unknown/.
  | Defined
  -- ^ If applicable, power up value of a memory element is defined. Applies to
  -- 'Clash.Signal.register's for example, but not to
  -- 'Clash.Prelude.BlockRam.blockRam'.
  deriving (Int -> InitBehavior -> ShowS
[InitBehavior] -> ShowS
InitBehavior -> String
(Int -> InitBehavior -> ShowS)
-> (InitBehavior -> String)
-> ([InitBehavior] -> ShowS)
-> Show InitBehavior
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitBehavior] -> ShowS
$cshowList :: [InitBehavior] -> ShowS
show :: InitBehavior -> String
$cshow :: InitBehavior -> String
showsPrec :: Int -> InitBehavior -> ShowS
$cshowsPrec :: Int -> InitBehavior -> ShowS
Show, ReadPrec [InitBehavior]
ReadPrec InitBehavior
Int -> ReadS InitBehavior
ReadS [InitBehavior]
(Int -> ReadS InitBehavior)
-> ReadS [InitBehavior]
-> ReadPrec InitBehavior
-> ReadPrec [InitBehavior]
-> Read InitBehavior
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitBehavior]
$creadListPrec :: ReadPrec [InitBehavior]
readPrec :: ReadPrec InitBehavior
$creadPrec :: ReadPrec InitBehavior
readList :: ReadS [InitBehavior]
$creadList :: ReadS [InitBehavior]
readsPrec :: Int -> ReadS InitBehavior
$creadsPrec :: Int -> ReadS InitBehavior
Read, InitBehavior -> InitBehavior -> Bool
(InitBehavior -> InitBehavior -> Bool)
-> (InitBehavior -> InitBehavior -> Bool) -> Eq InitBehavior
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitBehavior -> InitBehavior -> Bool
$c/= :: InitBehavior -> InitBehavior -> Bool
== :: InitBehavior -> InitBehavior -> Bool
$c== :: InitBehavior -> InitBehavior -> Bool
Eq, Eq InitBehavior
Eq InitBehavior
-> (InitBehavior -> InitBehavior -> Ordering)
-> (InitBehavior -> InitBehavior -> Bool)
-> (InitBehavior -> InitBehavior -> Bool)
-> (InitBehavior -> InitBehavior -> Bool)
-> (InitBehavior -> InitBehavior -> Bool)
-> (InitBehavior -> InitBehavior -> InitBehavior)
-> (InitBehavior -> InitBehavior -> InitBehavior)
-> Ord InitBehavior
InitBehavior -> InitBehavior -> Bool
InitBehavior -> InitBehavior -> Ordering
InitBehavior -> InitBehavior -> InitBehavior
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
min :: InitBehavior -> InitBehavior -> InitBehavior
$cmin :: InitBehavior -> InitBehavior -> InitBehavior
max :: InitBehavior -> InitBehavior -> InitBehavior
$cmax :: InitBehavior -> InitBehavior -> InitBehavior
>= :: InitBehavior -> InitBehavior -> Bool
$c>= :: InitBehavior -> InitBehavior -> Bool
> :: InitBehavior -> InitBehavior -> Bool
$c> :: InitBehavior -> InitBehavior -> Bool
<= :: InitBehavior -> InitBehavior -> Bool
$c<= :: InitBehavior -> InitBehavior -> Bool
< :: InitBehavior -> InitBehavior -> Bool
$c< :: InitBehavior -> InitBehavior -> Bool
compare :: InitBehavior -> InitBehavior -> Ordering
$ccompare :: InitBehavior -> InitBehavior -> Ordering
$cp1Ord :: Eq InitBehavior
Ord, (forall x. InitBehavior -> Rep InitBehavior x)
-> (forall x. Rep InitBehavior x -> InitBehavior)
-> Generic InitBehavior
forall x. Rep InitBehavior x -> InitBehavior
forall x. InitBehavior -> Rep InitBehavior x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitBehavior x -> InitBehavior
$cfrom :: forall x. InitBehavior -> Rep InitBehavior x
Generic, InitBehavior -> ()
(InitBehavior -> ()) -> NFData InitBehavior
forall a. (a -> ()) -> NFData a
rnf :: InitBehavior -> ()
$crnf :: InitBehavior -> ()
NFData, Typeable InitBehavior
DataType
Constr
Typeable InitBehavior
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InitBehavior -> c InitBehavior)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InitBehavior)
-> (InitBehavior -> Constr)
-> (InitBehavior -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InitBehavior))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InitBehavior))
-> ((forall b. Data b => b -> b) -> InitBehavior -> InitBehavior)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InitBehavior -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InitBehavior -> r)
-> (forall u. (forall d. Data d => d -> u) -> InitBehavior -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InitBehavior -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior)
-> Data InitBehavior
InitBehavior -> DataType
InitBehavior -> Constr
(forall b. Data b => b -> b) -> InitBehavior -> InitBehavior
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitBehavior -> c InitBehavior
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitBehavior
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InitBehavior -> u
forall u. (forall d. Data d => d -> u) -> InitBehavior -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitBehavior
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitBehavior -> c InitBehavior
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitBehavior)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InitBehavior)
$cDefined :: Constr
$cUnknown :: Constr
$tInitBehavior :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
gmapMp :: (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
gmapM :: (forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InitBehavior -> m InitBehavior
gmapQi :: Int -> (forall d. Data d => d -> u) -> InitBehavior -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitBehavior -> u
gmapQ :: (forall d. Data d => d -> u) -> InitBehavior -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InitBehavior -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitBehavior -> r
gmapT :: (forall b. Data b => b -> b) -> InitBehavior -> InitBehavior
$cgmapT :: (forall b. Data b => b -> b) -> InitBehavior -> InitBehavior
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InitBehavior)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InitBehavior)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InitBehavior)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitBehavior)
dataTypeOf :: InitBehavior -> DataType
$cdataTypeOf :: InitBehavior -> DataType
toConstr :: InitBehavior -> Constr
$ctoConstr :: InitBehavior -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitBehavior
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitBehavior
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitBehavior -> c InitBehavior
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitBehavior -> c InitBehavior
$cp1Data :: Typeable InitBehavior
Data, Eq InitBehavior
Eq InitBehavior
-> (Int -> InitBehavior -> Int)
-> (InitBehavior -> Int)
-> Hashable InitBehavior
Int -> InitBehavior -> Int
InitBehavior -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InitBehavior -> Int
$chash :: InitBehavior -> Int
hashWithSalt :: Int -> InitBehavior -> Int
$chashWithSalt :: Int -> InitBehavior -> Int
$cp1Hashable :: Eq InitBehavior
Hashable, Get InitBehavior
[InitBehavior] -> Put
InitBehavior -> Put
(InitBehavior -> Put)
-> Get InitBehavior
-> ([InitBehavior] -> Put)
-> Binary InitBehavior
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [InitBehavior] -> Put
$cputList :: [InitBehavior] -> Put
get :: Get InitBehavior
$cget :: Get InitBehavior
put :: InitBehavior -> Put
$cput :: InitBehavior -> Put
Binary)

data SInitBehavior (init :: InitBehavior) where
  SUnknown :: SInitBehavior 'Unknown
  -- See: 'Unknown' ^

  SDefined :: SInitBehavior 'Defined
  -- See: 'Defined' ^

instance Show (SInitBehavior init) where
  show :: SInitBehavior init -> String
show SInitBehavior init
SUnknown = String
"SUnknown"
  show SInitBehavior init
SDefined = String
"SDefined"

-- | A domain with a name (@Domain@). Configures the behavior of various aspects
-- of a circuits. See the documentation of this record's field types for more
-- information on the options.
--
-- See module documentation of "Clash.Explicit.Signal" for more information on
-- how to create custom synthesis domains.
data DomainConfiguration
  = DomainConfiguration
  { DomainConfiguration -> Domain
_name :: Domain
  -- ^ Domain name
  , DomainConfiguration -> Nat
_period :: Nat
  -- ^ Period of clock in /ps/
  , DomainConfiguration -> ActiveEdge
_activeEdge :: ActiveEdge
  -- ^ Active edge of the clock
  , DomainConfiguration -> ResetKind
_resetKind :: ResetKind
  -- ^ Whether resets are synchronous (edge-sensitive) or asynchronous (level-sensitive)
  , DomainConfiguration -> InitBehavior
_initBehavior :: InitBehavior
  -- ^ Whether the initial (or "power up") value of memory elements is
  -- unknown/undefined, or configurable to a specific value
  , DomainConfiguration -> ResetPolarity
_resetPolarity :: ResetPolarity
  -- ^ Whether resets are active high or active low
  }
  deriving (Typeable)

-- | Helper type family for 'DomainPeriod'
type family DomainConfigurationPeriod (config :: DomainConfiguration) :: Nat where
  DomainConfigurationPeriod ('DomainConfiguration name period edge reset init polarity) = period

-- | Helper type family for 'DomainActiveEdge'
type family DomainConfigurationActiveEdge (config :: DomainConfiguration) :: ActiveEdge where
  DomainConfigurationActiveEdge ('DomainConfiguration name period edge reset init polarity) = edge

-- | Helper type family for 'DomainResetKind'
type family DomainConfigurationResetKind (config :: DomainConfiguration) :: ResetKind where
  DomainConfigurationResetKind ('DomainConfiguration name period edge reset init polarity) = reset

-- | Helper type family for 'DomainInitBehavior'
type family DomainConfigurationInitBehavior (config :: DomainConfiguration) :: InitBehavior where
  DomainConfigurationInitBehavior ('DomainConfiguration name period edge reset init polarity) = init

-- | Helper type family for 'DomainResetPolarity'
type family DomainConfigurationResetPolarity (config :: DomainConfiguration) :: ResetPolarity where
  DomainConfigurationResetPolarity ('DomainConfiguration name period edge reset init polarity) = polarity

-- | Convenience type to help to extract a period from a domain. Example usage:
--
-- @
-- myFunc :: (KnownDomain dom, DomainPeriod dom ~ 6000) => ...
-- @
type DomainPeriod (dom :: Domain) =
  DomainConfigurationPeriod (KnownConf dom)

-- | Convenience type to help to extract the active edge from a domain. Example
-- usage:
--
-- @
-- myFunc :: (KnownDomain dom, DomainActiveEdge dom ~ 'Rising) => ...
-- @
type DomainActiveEdge (dom :: Domain) =
  DomainConfigurationActiveEdge (KnownConf dom)

-- | Convenience type to help to extract the reset synchronicity from a
-- domain. Example usage:
--
-- @
-- myFunc :: (KnownDomain dom, DomainResetKind dom ~ 'Synchronous) => ...
-- @
type DomainResetKind (dom :: Domain) =
  DomainConfigurationResetKind (KnownConf dom)

-- | Convenience type to constrain a domain to have synchronous resets. Example
-- usage:
--
-- @
-- myFunc :: HasSynchronousReset dom => ...
-- @
--
-- Using this type implies 'KnownDomain'.
--
-- [Click here for usage hints]("Clash.Explicit.Signal#g:conveniencetypes")
type HasSynchronousReset (dom :: Domain) =
  (KnownDomain dom, DomainResetKind dom ~ 'Synchronous)

-- | Convenience type to constrain a domain to have asynchronous resets. Example
-- usage:
--
-- @
-- myFunc :: HasAsynchronousReset dom => ...
-- @
--
-- Using this type implies 'KnownDomain'.
--
-- [Click here for usage hints]("Clash.Explicit.Signal#g:conveniencetypes")
type HasAsynchronousReset (dom :: Domain) =
  (KnownDomain dom, DomainResetKind dom ~ 'Asynchronous)

-- | Convenience type to help to extract the initial value behavior from a
-- domain. Example usage:
--
-- @
-- myFunc :: (KnownDomain dom, DomainInitBehavior dom ~ 'Defined) => ...
-- @
type DomainInitBehavior (dom :: Domain) =
  DomainConfigurationInitBehavior (KnownConf dom)

-- | Convenience type to constrain a domain to have initial values. Example
-- usage:
--
-- @
-- myFunc :: HasDefinedInitialValues dom => ...
-- @
--
-- Using this type implies 'KnownDomain'.
--
-- Note that there is no @UnknownInitialValues dom@ as a component that works
-- without initial values will also work if it does have them.
--
-- [Click here for usage hints]("Clash.Explicit.Signal#g:conveniencetypes")
type HasDefinedInitialValues (dom :: Domain) =
  (KnownDomain dom, DomainInitBehavior dom ~ 'Defined)

-- | Convenience type to help to extract the reset polarity from a domain.
-- Example usage:
--
-- @
-- myFunc :: (KnownDomain dom, DomainResetPolarity dom ~ 'ActiveHigh) => ...
-- @
type DomainResetPolarity (dom :: Domain) =
  DomainConfigurationResetPolarity (KnownConf dom)

-- | Singleton version of 'DomainConfiguration'
data SDomainConfiguration (dom :: Domain) (conf :: DomainConfiguration) where
  SDomainConfiguration ::
    { SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SSymbol dom
sName :: SSymbol dom
      -- ^ Domain name
    , SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SNat period
sPeriod :: SNat period
    -- ^ Period of clock in /ps/
    , SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SActiveEdge edge
sActiveEdge :: SActiveEdge edge
    -- ^ Active edge of the clock (not yet implemented)
    , SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SResetKind reset
sResetKind :: SResetKind reset
    -- ^ Whether resets are synchronous (edge-sensitive) or asynchronous (level-sensitive)
    , SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SInitBehavior init
sInitBehavior :: SInitBehavior init
    -- ^ Whether the initial (or "power up") value of memory elements is
    -- unknown/undefined, or configurable to a specific value
    , SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SResetPolarity polarity
sResetPolarity :: SResetPolarity polarity
    -- ^ Whether resets are active high or active low
    } -> SDomainConfiguration dom ('DomainConfiguration dom period edge reset init polarity)

deriving instance Show (SDomainConfiguration dom conf)

type KnownConfiguration dom conf = (KnownDomain dom, KnownConf dom ~ conf)

-- | A 'KnownDomain' constraint indicates that a circuit's behavior depends on
-- some properties of a domain. See 'DomainConfiguration' for more information.
class (KnownSymbol dom, KnownNat (DomainPeriod dom)) => KnownDomain (dom :: Domain) where
  type KnownConf dom :: DomainConfiguration
  -- | Returns 'SDomainConfiguration' corresponding to an instance's 'DomainConfiguration'.
  --
  -- Example usage:
  --
  -- >>> knownDomain @System
  -- SDomainConfiguration {sName = SSymbol @"System", sPeriod = SNat @10000, sActiveEdge = SRising, sResetKind = SAsynchronous, sInitBehavior = SDefined, sResetPolarity = SActiveHigh}
  knownDomain :: SDomainConfiguration dom (KnownConf dom)

-- | Version of 'knownDomain' that takes a 'SSymbol'. For example:
--
-- >>> knownDomainByName (SSymbol @"System")
-- SDomainConfiguration {sName = SSymbol @"System", sPeriod = SNat @10000, sActiveEdge = SRising, sResetKind = SAsynchronous, sInitBehavior = SDefined, sResetPolarity = SActiveHigh}
knownDomainByName
  :: forall dom
   . KnownDomain dom
  => SSymbol dom
  -> SDomainConfiguration dom (KnownConf dom)
knownDomainByName :: SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
knownDomainByName =
  SDomainConfiguration dom (KnownConf dom)
-> SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
forall a b. a -> b -> a
const SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain
{-# INLINE knownDomainByName #-}

-- | A /clock/ (and /reset/) dom with clocks running at 100 MHz
instance KnownDomain System where
  type KnownConf System = 'DomainConfiguration System 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh
  knownDomain :: SDomainConfiguration System (KnownConf System)
knownDomain = SSymbol System
-> SNat 10000
-> SActiveEdge 'Rising
-> SResetKind 'Asynchronous
-> SInitBehavior 'Defined
-> SResetPolarity 'ActiveHigh
-> SDomainConfiguration
     System
     ('DomainConfiguration
        System 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh)
forall (dom :: Domain) (period :: Nat) (edge :: ActiveEdge)
       (reset :: ResetKind) (init :: InitBehavior)
       (polarity :: ResetPolarity).
SSymbol dom
-> SNat period
-> SActiveEdge edge
-> SResetKind reset
-> SInitBehavior init
-> SResetPolarity polarity
-> SDomainConfiguration
     dom ('DomainConfiguration dom period edge reset init polarity)
SDomainConfiguration SSymbol System
forall (s :: Domain). KnownSymbol s => SSymbol s
SSymbol SNat 10000
forall (n :: Nat). KnownNat n => SNat n
SNat SActiveEdge 'Rising
SRising SResetKind 'Asynchronous
SAsynchronous SInitBehavior 'Defined
SDefined SResetPolarity 'ActiveHigh
SActiveHigh

-- | System instance with defaults set for Xilinx FPGAs
instance KnownDomain XilinxSystem where
  type KnownConf XilinxSystem = 'DomainConfiguration XilinxSystem 10000 'Rising 'Synchronous 'Defined 'ActiveHigh
  knownDomain :: SDomainConfiguration XilinxSystem (KnownConf XilinxSystem)
knownDomain = SSymbol XilinxSystem
-> SNat 10000
-> SActiveEdge 'Rising
-> SResetKind 'Synchronous
-> SInitBehavior 'Defined
-> SResetPolarity 'ActiveHigh
-> SDomainConfiguration
     XilinxSystem
     ('DomainConfiguration
        XilinxSystem 10000 'Rising 'Synchronous 'Defined 'ActiveHigh)
forall (dom :: Domain) (period :: Nat) (edge :: ActiveEdge)
       (reset :: ResetKind) (init :: InitBehavior)
       (polarity :: ResetPolarity).
SSymbol dom
-> SNat period
-> SActiveEdge edge
-> SResetKind reset
-> SInitBehavior init
-> SResetPolarity polarity
-> SDomainConfiguration
     dom ('DomainConfiguration dom period edge reset init polarity)
SDomainConfiguration SSymbol XilinxSystem
forall (s :: Domain). KnownSymbol s => SSymbol s
SSymbol SNat 10000
forall (n :: Nat). KnownNat n => SNat n
SNat SActiveEdge 'Rising
SRising SResetKind 'Synchronous
SSynchronous SInitBehavior 'Defined
SDefined SResetPolarity 'ActiveHigh
SActiveHigh

-- | System instance with defaults set for Intel FPGAs
instance KnownDomain IntelSystem where
  type KnownConf IntelSystem = 'DomainConfiguration IntelSystem 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh
  knownDomain :: SDomainConfiguration IntelSystem (KnownConf IntelSystem)
knownDomain = SSymbol IntelSystem
-> SNat 10000
-> SActiveEdge 'Rising
-> SResetKind 'Asynchronous
-> SInitBehavior 'Defined
-> SResetPolarity 'ActiveHigh
-> SDomainConfiguration
     IntelSystem
     ('DomainConfiguration
        IntelSystem 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh)
forall (dom :: Domain) (period :: Nat) (edge :: ActiveEdge)
       (reset :: ResetKind) (init :: InitBehavior)
       (polarity :: ResetPolarity).
SSymbol dom
-> SNat period
-> SActiveEdge edge
-> SResetKind reset
-> SInitBehavior init
-> SResetPolarity polarity
-> SDomainConfiguration
     dom ('DomainConfiguration dom period edge reset init polarity)
SDomainConfiguration SSymbol IntelSystem
forall (s :: Domain). KnownSymbol s => SSymbol s
SSymbol SNat 10000
forall (n :: Nat). KnownNat n => SNat n
SNat SActiveEdge 'Rising
SRising SResetKind 'Asynchronous
SAsynchronous SInitBehavior 'Defined
SDefined SResetPolarity 'ActiveHigh
SActiveHigh

-- | Convenience value to allow easy "subclassing" of System domain. Should
-- be used in combination with 'createDomain'. For example, if you just want to
-- change the period but leave all other settings intact use:
--
-- > createDomain vSystem{vName="System10", vPeriod=10}
--
vSystem :: VDomainConfiguration
vSystem :: VDomainConfiguration
vSystem = SDomainConfiguration
  System
  ('DomainConfiguration
     System 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh)
-> VDomainConfiguration
forall (dom :: Domain) (conf :: DomainConfiguration).
SDomainConfiguration dom conf -> VDomainConfiguration
vDomain (KnownDomain System =>
SDomainConfiguration System (KnownConf System)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain @System)

-- | A clock (and reset) dom with clocks running at 100 MHz. Memory elements
-- respond to the rising edge of the clock, and asynchronously to changes in
-- reset signals. It has defined initial values, and active-high resets.
--
-- See module documentation of "Clash.Explicit.Signal" for more information on
-- how to create custom synthesis domains.
type System = ("System" :: Domain)


-- | Convenience value to allow easy "subclassing" of IntelSystem domain. Should
-- be used in combination with 'createDomain'. For example, if you just want to
-- change the period but leave all other settings intact use:
--
-- > createDomain vIntelSystem{vName="Intel10", vPeriod=10}
--
vIntelSystem :: VDomainConfiguration
vIntelSystem :: VDomainConfiguration
vIntelSystem = SDomainConfiguration
  IntelSystem
  ('DomainConfiguration
     IntelSystem 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh)
-> VDomainConfiguration
forall (dom :: Domain) (conf :: DomainConfiguration).
SDomainConfiguration dom conf -> VDomainConfiguration
vDomain (KnownDomain IntelSystem =>
SDomainConfiguration IntelSystem (KnownConf IntelSystem)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain @IntelSystem)

-- | A clock (and reset) dom with clocks running at 100 MHz. Memory elements
-- respond to the rising edge of the clock, and asynchronously to changes in
-- reset signals. It has defined initial values, and active-high resets.
--
-- See module documentation of "Clash.Explicit.Signal" for more information on
-- how to create custom synthesis domains.
type IntelSystem = ("IntelSystem" :: Domain)

-- | Convenience value to allow easy "subclassing" of XilinxSystem domain. Should
-- be used in combination with 'createDomain'. For example, if you just want to
-- change the period but leave all other settings intact use:
--
-- > createDomain vXilinxSystem{vName="Xilinx10", vPeriod=10}
--
vXilinxSystem :: VDomainConfiguration
vXilinxSystem :: VDomainConfiguration
vXilinxSystem = SDomainConfiguration
  XilinxSystem
  ('DomainConfiguration
     XilinxSystem 10000 'Rising 'Synchronous 'Defined 'ActiveHigh)
-> VDomainConfiguration
forall (dom :: Domain) (conf :: DomainConfiguration).
SDomainConfiguration dom conf -> VDomainConfiguration
vDomain (KnownDomain XilinxSystem =>
SDomainConfiguration XilinxSystem (KnownConf XilinxSystem)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain @XilinxSystem)

-- | A clock (and reset) dom with clocks running at 100 MHz. Memory elements
-- respond to the rising edge of the clock, and synchronously to changes in
-- reset signals. It has defined initial values, and active-high resets.
--
-- See module documentation of "Clash.Explicit.Signal" for more information on
-- how to create custom synthesis domains.
type XilinxSystem = ("XilinxSystem" :: Domain)

-- | Same as SDomainConfiguration but allows for easy updates through record update syntax.
-- Should be used in combination with 'vDomain' and 'createDomain'. Example:
--
-- > createDomain (knownVDomain @System){vName="System10", vPeriod=10}
--
-- This duplicates the settings in the 'System' domain, replaces the name and
-- period, and creates an instance for it. As most users often want to update
-- the system domain, a shortcut is available in the form:
--
-- > createDomain vSystem{vName="System10", vPeriod=10}
--
data VDomainConfiguration
  = VDomainConfiguration
  { VDomainConfiguration -> String
vName :: String
  -- ^ Corresponds to '_name' on 'DomainConfiguration'
  , VDomainConfiguration -> Natural
vPeriod :: Natural
  -- ^ Corresponds to '_period' on 'DomainConfiguration'
  , VDomainConfiguration -> ActiveEdge
vActiveEdge :: ActiveEdge
  -- ^ Corresponds to '_activeEdge' on 'DomainConfiguration'
  , VDomainConfiguration -> ResetKind
vResetKind :: ResetKind
  -- ^ Corresponds to '_resetKind' on 'DomainConfiguration'
  , VDomainConfiguration -> InitBehavior
vInitBehavior :: InitBehavior
  -- ^ Corresponds to '_initBehavior' on 'DomainConfiguration'
  , VDomainConfiguration -> ResetPolarity
vResetPolarity :: ResetPolarity
  -- ^ Corresponds to '_resetPolarity' on 'DomainConfiguration'
  }
  deriving (VDomainConfiguration -> VDomainConfiguration -> Bool
(VDomainConfiguration -> VDomainConfiguration -> Bool)
-> (VDomainConfiguration -> VDomainConfiguration -> Bool)
-> Eq VDomainConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VDomainConfiguration -> VDomainConfiguration -> Bool
$c/= :: VDomainConfiguration -> VDomainConfiguration -> Bool
== :: VDomainConfiguration -> VDomainConfiguration -> Bool
$c== :: VDomainConfiguration -> VDomainConfiguration -> Bool
Eq, (forall x. VDomainConfiguration -> Rep VDomainConfiguration x)
-> (forall x. Rep VDomainConfiguration x -> VDomainConfiguration)
-> Generic VDomainConfiguration
forall x. Rep VDomainConfiguration x -> VDomainConfiguration
forall x. VDomainConfiguration -> Rep VDomainConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VDomainConfiguration x -> VDomainConfiguration
$cfrom :: forall x. VDomainConfiguration -> Rep VDomainConfiguration x
Generic, VDomainConfiguration -> ()
(VDomainConfiguration -> ()) -> NFData VDomainConfiguration
forall a. (a -> ()) -> NFData a
rnf :: VDomainConfiguration -> ()
$crnf :: VDomainConfiguration -> ()
NFData, Int -> VDomainConfiguration -> ShowS
[VDomainConfiguration] -> ShowS
VDomainConfiguration -> String
(Int -> VDomainConfiguration -> ShowS)
-> (VDomainConfiguration -> String)
-> ([VDomainConfiguration] -> ShowS)
-> Show VDomainConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VDomainConfiguration] -> ShowS
$cshowList :: [VDomainConfiguration] -> ShowS
show :: VDomainConfiguration -> String
$cshow :: VDomainConfiguration -> String
showsPrec :: Int -> VDomainConfiguration -> ShowS
$cshowsPrec :: Int -> VDomainConfiguration -> ShowS
Show, ReadPrec [VDomainConfiguration]
ReadPrec VDomainConfiguration
Int -> ReadS VDomainConfiguration
ReadS [VDomainConfiguration]
(Int -> ReadS VDomainConfiguration)
-> ReadS [VDomainConfiguration]
-> ReadPrec VDomainConfiguration
-> ReadPrec [VDomainConfiguration]
-> Read VDomainConfiguration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VDomainConfiguration]
$creadListPrec :: ReadPrec [VDomainConfiguration]
readPrec :: ReadPrec VDomainConfiguration
$creadPrec :: ReadPrec VDomainConfiguration
readList :: ReadS [VDomainConfiguration]
$creadList :: ReadS [VDomainConfiguration]
readsPrec :: Int -> ReadS VDomainConfiguration
$creadsPrec :: Int -> ReadS VDomainConfiguration
Read, Get VDomainConfiguration
[VDomainConfiguration] -> Put
VDomainConfiguration -> Put
(VDomainConfiguration -> Put)
-> Get VDomainConfiguration
-> ([VDomainConfiguration] -> Put)
-> Binary VDomainConfiguration
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [VDomainConfiguration] -> Put
$cputList :: [VDomainConfiguration] -> Put
get :: Get VDomainConfiguration
$cget :: Get VDomainConfiguration
put :: VDomainConfiguration -> Put
$cput :: VDomainConfiguration -> Put
Binary)

-- | Convert 'SDomainConfiguration' to 'VDomainConfiguration'. Should be used in combination with
-- 'createDomain' only.
vDomain :: SDomainConfiguration dom conf -> VDomainConfiguration
vDomain :: SDomainConfiguration dom conf -> VDomainConfiguration
vDomain (SDomainConfiguration SSymbol dom
dom SNat period
period SActiveEdge edge
edge SResetKind reset
reset SInitBehavior init
init_ SResetPolarity polarity
polarity) =
  String
-> Natural
-> ActiveEdge
-> ResetKind
-> InitBehavior
-> ResetPolarity
-> VDomainConfiguration
VDomainConfiguration
    (SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom)
    (SNat period -> Natural
forall (n :: Nat). SNat n -> Natural
snatToNatural SNat period
period)
    (case SActiveEdge edge
edge of {SActiveEdge edge
SRising -> ActiveEdge
Rising; SActiveEdge edge
SFalling -> ActiveEdge
Falling})
    (case SResetKind reset
reset of {SResetKind reset
SAsynchronous -> ResetKind
Asynchronous; SResetKind reset
SSynchronous -> ResetKind
Synchronous})
    (case SInitBehavior init
init_ of {SInitBehavior init
SDefined -> InitBehavior
Defined; SInitBehavior init
SUnknown -> InitBehavior
Unknown})
    (case SResetPolarity polarity
polarity of {SResetPolarity polarity
SActiveHigh -> ResetPolarity
ActiveHigh; SResetPolarity polarity
SActiveLow -> ResetPolarity
ActiveLow})

-- TODO: Function might reject valid type names. Figure out what's allowed.
isValidDomainName :: String -> Bool
isValidDomainName :: String -> Bool
isValidDomainName (Char
x:String
xs) = Char -> Bool
isAsciiUpper Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii String
xs Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum String
xs
isValidDomainName String
_ = Bool
False

-- | Convenience method to express new domains in terms of others.
--
-- > createDomain (knownVDomain @System){vName="System10", vPeriod=10}
--
-- This duplicates the settings in the "System" domain, replaces the name and
-- period, and creates an instance for it. As most users often want to update
-- the system domain, a shortcut is available in the form:
--
-- > createDomain vSystem{vName="System10", vPeriod=10}
--
-- The function will create two extra identifiers. The first:
--
-- > type System10 = ..
--
-- You can use that as the dom to Clocks\/Resets\/Enables\/Signals. For example:
-- @Signal System10 Int@. Additionally, it will create a 'VDomainConfiguration' that you can
-- use in later calls to 'createDomain':
--
-- > vSystem10 = knownVDomain @System10
--
-- It will also make @System10@ an instance of 'KnownDomain'.
--
-- If either identifier is already in scope it will not be generated a second time.
-- Note: This can be useful for example when documenting a new domain:
--
-- > -- | Here is some documentation for CustomDomain
-- > type CustomDomain = ("CustomDomain" :: Domain)
-- >
-- > -- | Here is some documentation for vCustomDomain
-- > createDomain vSystem{vName="CustomDomain"}
createDomain :: VDomainConfiguration -> Q [Dec]
createDomain :: VDomainConfiguration -> Q [Dec]
createDomain (VDomainConfiguration String
name Natural
period ActiveEdge
edge ResetKind
reset InitBehavior
init_ ResetPolarity
polarity) =
  if String -> Bool
isValidDomainName String
name then do
    Type
kdType <- [t| KnownDomain $nameT |]
    Type
kcType <- [t| ('DomainConfiguration $nameT $periodT $edgeT $resetKindT $initT $polarityT) |]
    Exp
sDom <- [| SDomainConfiguration SSymbol SNat $edgeE $resetKindE $initE $polarityE |]

    let vNameImpl :: Exp
vNameImpl = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'vDomain) (Exp -> Type -> Exp
AppTypeE (Name -> Exp
VarE 'knownDomain) (TyLit -> Type
LitT (String -> TyLit
StrTyLit String
name)))
        kdImpl :: Dec
kdImpl = Name -> [Clause] -> Dec
FunD 'knownDomain [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
sDom) []]
        kcImpl :: Dec
kcImpl = Name -> [Type] -> Type -> Dec
mkTySynInstD ''KnownConf [TyLit -> Type
LitT (String -> TyLit
StrTyLit String
name)] Type
kcType
        vName' :: Name
vName' = String -> Name
mkName (Char
'v'Char -> ShowS
forall a. a -> [a] -> [a]
:String
name)

    Bool
tySynExists <- Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Name -> Bool) -> Q (Maybe Name) -> Q Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupTypeName String
name
    Bool
vHelperExists <- Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Name -> Bool) -> Q (Maybe Name) -> Q Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupValueName (Char
'v'Char -> ShowS
forall a. a -> [a] -> [a]
:String
name)

    [Dec] -> Q [Dec]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [[Dec]] -> [Dec]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
      [
        [ -- Type synonym (ex: type System = "System")
          Name -> [TyVarBndr] -> Type -> Dec
TySynD (String -> Name
mkName String
name) [] (TyLit -> Type
LitT (String -> TyLit
StrTyLit String
name)  Type -> Type -> Type
`SigT`  Name -> Type
ConT ''Domain)
        | Bool -> Bool
not Bool
tySynExists
        ]

      , [[Dec]] -> [Dec]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
        [ -- vDomain helper (ex: vSystem = vDomain (knownDomain @System))
          [ Name -> Type -> Dec
SigD Name
vName' (Name -> Type
ConT ''VDomainConfiguration)
          , Name -> [Clause] -> Dec
FunD Name
vName' [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
vNameImpl) []]
          ]
        | Bool -> Bool
not Bool
vHelperExists
        ]
      , [ -- KnownDomain instance (ex: instance KnownDomain "System" where ...)
          Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] Type
kdType [Dec
kcImpl, Dec
kdImpl]
        ]
      ]

  else
    String -> Q [Dec]
forall a. HasCallStack => String -> a
error (String
"Domain names should be a valid Haskell type name, not: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
 where

  edgeE :: Q Exp
edgeE =
    Exp -> Q Exp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
    case ActiveEdge
edge of
      ActiveEdge
Rising -> Name -> Exp
ConE 'SRising
      ActiveEdge
Falling -> Name -> Exp
ConE 'SFalling

  resetKindE :: Q Exp
resetKindE =
    Exp -> Q Exp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
    case ResetKind
reset of
      ResetKind
Asynchronous -> Name -> Exp
ConE 'SAsynchronous
      ResetKind
Synchronous -> Name -> Exp
ConE 'SSynchronous

  initE :: Q Exp
initE =
    Exp -> Q Exp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
    case InitBehavior
init_ of
      InitBehavior
Unknown -> Name -> Exp
ConE 'SUnknown
      InitBehavior
Defined -> Name -> Exp
ConE 'SDefined

  polarityE :: Q Exp
polarityE =
    Exp -> Q Exp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
    case ResetPolarity
polarity of
      ResetPolarity
ActiveHigh -> Name -> Exp
ConE 'SActiveHigh
      ResetPolarity
ActiveLow -> Name -> Exp
ConE 'SActiveLow

  nameT :: Q Type
nameT   = Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TyLit -> Type
LitT (String -> TyLit
StrTyLit String
name))
  periodT :: Q Type
periodT = Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TyLit -> Type
LitT (Integer -> TyLit
NumTyLit (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
period)))

  edgeT :: Q Type
edgeT =
    Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$
    case ActiveEdge
edge of
      ActiveEdge
Rising -> Name -> Type
PromotedT 'Rising
      ActiveEdge
Falling -> Name -> Type
PromotedT 'Falling

  resetKindT :: Q Type
resetKindT =
    Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$
    case ResetKind
reset of
      ResetKind
Asynchronous -> Name -> Type
PromotedT 'Asynchronous
      ResetKind
Synchronous -> Name -> Type
PromotedT 'Synchronous

  initT :: Q Type
initT =
    Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$
    case InitBehavior
init_ of
      InitBehavior
Unknown -> Name -> Type
PromotedT 'Unknown
      InitBehavior
Defined -> Name -> Type
PromotedT 'Defined

  polarityT :: Q Type
polarityT =
    Type -> Q Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$
    case ResetPolarity
polarity of
      ResetPolarity
ActiveHigh -> Name -> Type
PromotedT 'ActiveHigh
      ResetPolarity
ActiveLow -> Name -> Type
PromotedT 'ActiveLow


type Domain = Symbol

-- | We either get evidence that this function was instantiated with the same
-- domains, or Nothing.
sameDomain
  :: forall (domA :: Domain) (domB :: Domain)
   . (KnownDomain domA, KnownDomain domB)
  => Maybe (domA :~: domB)
sameDomain :: Maybe (domA :~: domB)
sameDomain = Proxy domA -> Proxy domB -> Maybe (domA :~: domB)
forall (a :: Domain) (b :: Domain).
(KnownSymbol a, KnownSymbol b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameSymbol (Proxy domA
forall k (t :: k). Proxy t
Proxy @domA) (Proxy domB
forall k (t :: k). Proxy t
Proxy @domB)

infixr 5 :-
{- | Clash has synchronous 'Signal's in the form of:

@
'Signal' (dom :: 'Domain') a
@

Where /a/ is the type of the value of the 'Signal', for example /Int/ or /Bool/,
and /dom/ is the /clock-/ (and /reset-/) domain to which the memory elements
manipulating these 'Signal's belong.

The type-parameter, /dom/, is of the kind 'Domain' - a simple string. That
string refers to a single /synthesis domain/. A synthesis domain describes the
behavior of certain aspects of memory elements in it.

* __NB__: \"Bad things\"™  happen when you actually use a clock period of @0@,
so do __not__ do that!
* __NB__: You should be judicious using a clock with period of @1@ as you can
never create a clock that goes any faster!
* __NB__: For the best compatibility make sure your period is divisible by 2,
because some VHDL simulators don't support fractions of picoseconds.
* __NB__: Whether 'System' has good defaults depends on your target platform.
Check out 'IntelSystem' and 'XilinxSystem' too!

Signals have the <https://downloads.haskell.org/ghc/latest/docs/html/users_guide/exts/roles.html type role>

>>> :i Signal
type role Signal nominal representational
...

as it is safe to coerce the underlying value of a signal, but not safe to coerce
a signal between different synthesis domains.

See the module documentation of "Clash.Signal" for more information about
domains.
-}
type role Signal nominal representational
data Signal (dom :: Domain) a
  -- | The constructor, @(':-')@, is __not__ synthesizable.
  = a :- Signal dom a

head# :: Signal dom a -> a
head# :: Signal dom a -> a
head# (a
x' :- Signal dom a
_ )  = a
x'

tail# :: Signal dom a -> Signal dom a
tail# :: Signal dom a -> Signal dom a
tail# (a
_  :- Signal dom a
xs') = Signal dom a
xs'

instance Show a => Show (Signal dom a) where
  show :: Signal dom a -> String
show (a
x :- Signal dom a
xs) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Signal dom a -> String
forall a. Show a => a -> String
show Signal dom a
xs

instance Lift a => Lift (Signal dom a) where
  lift :: Signal dom a -> Q Exp
lift ~(a
x :- Signal dom a
_) = [| signal# x |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Signal dom a -> Q (TExp (Signal dom a))
liftTyped = Signal dom a -> Q (TExp (Signal dom a))
forall a. Lift a => a -> Q (TExp a)
liftTypedFromUntyped
#endif

instance Default a => Default (Signal dom a) where
  def :: Signal dom a
def = a -> Signal dom a
forall a (dom :: Domain). a -> Signal dom a
signal# a
forall a. Default a => a
def

instance Functor (Signal dom) where
  fmap :: (a -> b) -> Signal dom a -> Signal dom b
fmap = (a -> b) -> Signal dom a -> Signal dom b
forall a b (dom :: Domain).
(a -> b) -> Signal dom a -> Signal dom b
mapSignal#

mapSignal# :: forall a b dom. (a -> b) -> Signal dom a -> Signal dom b
mapSignal# :: (a -> b) -> Signal dom a -> Signal dom b
mapSignal# a -> b
f = Signal dom a -> Signal dom b
go
 where
  -- See -fstrict-mapSignal documentation in clash-prelude.cabal
  theSeq :: a -> b -> b
theSeq = if Bool
fStrictMapSignal then a -> b -> b
forall a b. a -> b -> b
seqX else (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
forall a b. a -> b -> a
const
  go :: Signal dom a -> Signal dom b
go ~(xs :: Signal dom a
xs@(a
a :- Signal dom a
as)) = a -> b
f a
a b -> Signal dom b -> Signal dom b
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (a
a a -> Signal dom b -> Signal dom b
forall a b. a -> b -> b
`theSeq` (Signal dom a
xs Signal dom a -> Signal dom b -> Signal dom b
`seq` Signal dom a -> Signal dom b
go Signal dom a
as))
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE mapSignal# #-}
{-# ANN mapSignal# hasBlackBox #-}

instance Applicative (Signal dom) where
  pure :: a -> Signal dom a
pure  = a -> Signal dom a
forall a (dom :: Domain). a -> Signal dom a
signal#
  <*> :: Signal dom (a -> b) -> Signal dom a -> Signal dom b
(<*>) = Signal dom (a -> b) -> Signal dom a -> Signal dom b
forall (dom :: Domain) a b.
Signal dom (a -> b) -> Signal dom a -> Signal dom b
appSignal#

signal# :: a -> Signal dom a
signal# :: a -> Signal dom a
signal# a
a = let s :: Signal dom a
s = a
a a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal dom a
s in Signal dom a
s
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE signal# #-}
{-# ANN signal# hasBlackBox #-}

appSignal# :: Signal dom (a -> b) -> Signal dom a -> Signal dom b
appSignal# :: Signal dom (a -> b) -> Signal dom a -> Signal dom b
appSignal# (a -> b
f :- Signal dom (a -> b)
fs) xs :: Signal dom a
xs@(~(a
a :- Signal dom a
as)) = a -> b
f a
a b -> Signal dom b -> Signal dom b
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (Signal dom a
xs Signal dom a -> Signal dom b -> Signal dom b
`seq` Signal dom (a -> b) -> Signal dom a -> Signal dom b
forall (dom :: Domain) a b.
Signal dom (a -> b) -> Signal dom a -> Signal dom b
appSignal# Signal dom (a -> b)
fs Signal dom a
as) -- See [NOTE: Lazy ap]
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE appSignal# #-}
{-# ANN appSignal# hasBlackBox #-}

instance NFDataX a => NFDataX (Signal domain a) where
  deepErrorX :: String -> Signal domain a
deepErrorX = a -> Signal domain a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Signal domain a)
-> (String -> a) -> String -> Signal domain a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX
  ensureSpine :: Signal domain a -> Signal domain a
ensureSpine Signal domain a
s = case Signal domain a -> Either String (Signal domain a)
forall a. a -> Either String a
isX Signal domain a
s of
    Left String
e -> String -> Signal domain a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
e
    Right (a
a :- Signal domain a
s') -> a -> a
forall a. NFDataX a => a -> a
ensureSpine a
a a -> Signal domain a -> Signal domain a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal domain a -> Signal domain a
forall a. NFDataX a => a -> a
ensureSpine Signal domain a
s'
  hasUndefined :: Signal domain a -> Bool
hasUndefined = String -> Signal domain a -> Bool
forall a. HasCallStack => String -> a
error String
"hasUndefined on (Signal domain a): No sensible implementation exists"
  rnfX :: Signal domain a -> ()
rnfX = String -> Signal domain a -> ()
forall a. HasCallStack => String -> a
error String
"rnfX on (Signal domain a): No sensible implementation exists"

{- NOTE: Lazy ap
Signal's ap, i.e (Applicative.<*>), must be lazy in it's second argument:

> appSignal :: Signal clk (a -> b) -> Signal clk a -> Signal clk b
> appSignal (f :- fs) ~(a :- as) = f a :- appSignal fs as

because some feedback loops, such as the loop described in 'system' in the
example at https://hackage.haskell.org/package/clash-prelude-1.0.0/docs/Clash-Prelude-BlockRam.html,
will lead to "Exception <<loop>>".

However, this "naive" lazy version is _too_ lazy and induces spaceleaks.
The current version:

> appSignal# :: Signal clk (a -> b) -> Signal clk a -> Signal clk b
> appSignal# (f :- fs) xs@(~(a :- as)) = f a :- (xs `seq` appSignal# fs as)

Is lazy enough to handle the earlier mentioned feedback loops, but doesn't leak
(as much) memory like the "naive" lazy version, because the Signal constructor
of the second argument is evaluated as soon as the tail of the result is evaluated.
-}


-- | __WARNING: EXTREMELY EXPERIMENTAL__
--
-- The circuit semantics of this operation are unclear and/or non-existent.
-- There is a good reason there is no 'Monad' instance for 'Signal'.
--
-- Is currently treated as 'id' by the Clash compiler.
joinSignal# :: Signal dom (Signal dom a) -> Signal dom a
joinSignal# :: Signal dom (Signal dom a) -> Signal dom a
joinSignal# ~(Signal dom a
xs :- Signal dom (Signal dom a)
xss) = Signal dom a -> a
forall (dom :: Domain) a. Signal dom a -> a
head# Signal dom a
xs a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal dom (Signal dom a) -> Signal dom a
forall (dom :: Domain) a. Signal dom (Signal dom a) -> Signal dom a
joinSignal# ((Signal dom a -> Signal dom a)
-> Signal dom (Signal dom a) -> Signal dom (Signal dom a)
forall a b (dom :: Domain).
(a -> b) -> Signal dom a -> Signal dom b
mapSignal# Signal dom a -> Signal dom a
forall (dom :: Domain) a. Signal dom a -> Signal dom a
tail# Signal dom (Signal dom a)
xss)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE joinSignal# #-}
{-# ANN joinSignal# hasBlackBox #-}

instance Num a => Num (Signal dom a) where
  + :: Signal dom a -> Signal dom a -> Signal dom a
(+)         = (a -> a -> a) -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  (-)         = (a -> a -> a) -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  * :: Signal dom a -> Signal dom a -> Signal dom a
(*)         = (a -> a -> a) -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
  negate :: Signal dom a -> Signal dom a
negate      = (a -> a) -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  abs :: Signal dom a -> Signal dom a
abs         = (a -> a) -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: Signal dom a -> Signal dom a
signum      = (a -> a) -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Signal dom a
fromInteger = a -> Signal dom a
forall a (dom :: Domain). a -> Signal dom a
signal# (a -> Signal dom a) -> (Integer -> a) -> Integer -> Signal dom a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

-- | __NB__: Not synthesizable
--
-- __NB__: In \"@'foldr' f z s@\":
--
-- * The function @f@ should be /lazy/ in its second argument.
-- * The @z@ element will never be used.
instance Foldable (Signal dom) where
  foldr :: (a -> b -> b) -> b -> Signal dom a -> b
foldr = (a -> b -> b) -> b -> Signal dom a -> b
forall a b (dom :: Domain). (a -> b -> b) -> b -> Signal dom a -> b
foldr#

-- | __NB__: Not synthesizable
--
-- __NB__: In \"@'foldr#' f z s@\":
--
-- * The function @f@ should be /lazy/ in its second argument.
-- * The @z@ element will never be used.
foldr# :: (a -> b -> b) -> b -> Signal dom a -> b
foldr# :: (a -> b -> b) -> b -> Signal dom a -> b
foldr# a -> b -> b
f b
z (a
a :- Signal dom a
s) = a
a a -> b -> b
`f` ((a -> b -> b) -> b -> Signal dom a -> b
forall a b (dom :: Domain). (a -> b -> b) -> b -> Signal dom a -> b
foldr# a -> b -> b
f b
z Signal dom a
s)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE foldr# #-}
{-# ANN foldr# hasBlackBox #-}

instance Traversable (Signal dom) where
  traverse :: (a -> f b) -> Signal dom a -> f (Signal dom b)
traverse = (a -> f b) -> Signal dom a -> f (Signal dom b)
forall (f :: Type -> Type) a b (dom :: Domain).
Applicative f =>
(a -> f b) -> Signal dom a -> f (Signal dom b)
traverse#

traverse# :: Applicative f => (a -> f b) -> Signal dom a -> f (Signal dom b)
traverse# :: (a -> f b) -> Signal dom a -> f (Signal dom b)
traverse# a -> f b
f (a
a :- Signal dom a
s) = b -> Signal dom b -> Signal dom b
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
(:-) (b -> Signal dom b -> Signal dom b)
-> f b -> f (Signal dom b -> Signal dom b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (Signal dom b -> Signal dom b)
-> f (Signal dom b) -> f (Signal dom b)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (a -> f b) -> Signal dom a -> f (Signal dom b)
forall (f :: Type -> Type) a b (dom :: Domain).
Applicative f =>
(a -> f b) -> Signal dom a -> f (Signal dom b)
traverse# a -> f b
f Signal dom a
s
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE traverse# #-}
{-# ANN traverse# hasBlackBox #-}

-- * Clocks, resets, and enables

-- | A signal of booleans, indicating whether a component is enabled. No special
-- meaning is implied, it's up to the component itself to decide how to respond
-- to its enable line. It is used throughout Clash as a global enable signal.
data Enable dom = Enable (Signal dom Bool)

-- | Convert 'Enable' construct to its underlying representation: a signal of
-- bools.
fromEnable :: Enable dom -> Signal dom Bool
fromEnable :: Enable dom -> Signal dom Bool
fromEnable (Enable Signal dom Bool
x) = Signal dom Bool
x
{-# INLINE fromEnable #-}

-- | Convert a signal of bools to an 'Enable' construct
toEnable :: Signal dom Bool -> Enable dom
toEnable :: Signal dom Bool -> Enable dom
toEnable = Signal dom Bool -> Enable dom
forall (dom :: Domain). Signal dom Bool -> Enable dom
Enable
{-# INLINE toEnable #-}

-- | Enable generator for some domain. Is simply always True.
enableGen :: Enable dom
enableGen :: Enable dom
enableGen = Signal dom Bool -> Enable dom
forall (dom :: Domain). Signal dom Bool -> Enable dom
toEnable (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True)

-- | A clock signal belonging to a domain named /dom/.
data Clock (dom :: Domain) = Clock
  { -- | Domain associated with the clock
    Clock dom -> SSymbol dom
clockTag :: SSymbol dom

    -- | Periods of the clock. This is an experimental feature used to simulate
    -- clock frequency correction mechanisms. Currently, all ways to contruct
    -- such a clock are hidden from the public API.
  , Clock dom -> Maybe (Signal dom Femtoseconds)
clockPeriods :: Maybe (Signal dom Femtoseconds)
  }

instance Show (Clock dom) where
  show :: Clock dom -> String
show (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
Nothing) = String
"<Clock: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  show (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
_) = String
"<Dynamic clock: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | The negative or inverted phase of a differential clock signal. HDL
-- generation will treat it the same as 'Clock', except that no @create_clock@
-- command is issued in the SDC file for 'ClockN'. Used in 'DiffClock'.
newtype ClockN (dom :: Domain) = ClockN { ClockN dom -> SSymbol dom
clockNTag :: SSymbol dom }

instance Show (ClockN dom) where
  show :: ClockN dom -> String
show (ClockN SSymbol dom
dom) = String
"<ClockN: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | A differential clock signal belonging to a domain named /dom/. The clock
-- input of a design with such an input has two ports which are in antiphase.
-- The first input is the positive phase, the second the negative phase. When
-- using 'Clash.Annotations.TH.makeTopEntity', the names of the inputs will end
-- in @_p@ and @_n@ respectively.
--
-- To create a differential clock in a test bench, you can use
-- 'Clash.Explicit.Testbench.clockToDiffClock'.
data DiffClock (dom :: Domain) =
  DiffClock ("p" ::: Clock dom) ("n" ::: ClockN dom)

instance Show (DiffClock dom) where
  show :: DiffClock dom -> String
show (DiffClock (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
Nothing) "n" ::: ClockN dom
_) =
    String
"<DiffClock: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  show (DiffClock (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
_) "n" ::: ClockN dom
_) =
    String
"<Dynamic DiffClock: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall (s :: Domain). SSymbol s -> String
ssymbolToString SSymbol dom
dom String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Clock generator for simulations. Do __not__ use this clock generator for
-- the /testBench/ function, use 'tbClockGen' instead.
--
-- To be used like:
--
-- @
-- clkSystem = clockGen @System
-- @
--
-- See 'DomainConfiguration' for more information on how to use synthesis domains.
clockGen
  :: KnownDomain dom
  => Clock dom
clockGen :: Clock dom
clockGen = Signal dom Bool -> Clock dom
forall (testDom :: Domain).
KnownDomain testDom =>
Signal testDom Bool -> Clock testDom
tbClockGen (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True)

-- | Clock generator to be used in the /testBench/ function.
--
-- To be used like:
--
-- @
-- clkSystem en = tbClockGen @System en
-- @
--
-- === __Example__
--
-- @
-- module Example where
--
-- import "Clash.Explicit.Prelude"
-- import "Clash.Explicit.Testbench"
--
-- -- Fast domain: twice as fast as \"Slow\"
-- 'Clash.Explicit.Prelude.createDomain' 'Clash.Explicit.Prelude.vSystem'{vName=\"Fast\", vPeriod=10}
--
-- -- Slow domain: twice as slow as \"Fast\"
-- 'Clash.Explicit.Prelude.createDomain' 'Clash.Explicit.Prelude.vSystem'{vName=\"Slow\", vPeriod=20}
--
-- topEntity
--   :: 'Clock' \"Fast\"
--   -> 'Reset' \"Fast\"
--   -> 'Enable' \"Fast\"
--   -> 'Clock' \"Slow\"
--   -> 'Signal' \"Fast\" (Unsigned 8)
--   -> 'Signal' \"Slow\" (Unsigned 8, Unsigned 8)
-- topEntity clk1 rst1 en1 clk2 i =
--   let h = register clk1 rst1 en1 0 (register clk1 rst1 en1 0 i)
--       l = register clk1 rst1 en1 0 i
--   in  unsafeSynchronizer clk1 clk2 (bundle (h, l))
--
-- testBench
--   :: 'Signal' \"Slow\" Bool
-- testBench = done
--   where
--     testInput      = 'Clash.Explicit.Testbench.stimuliGenerator' clkA1 rstA1 $('Clash.Sized.Vector.listToVecTH' [1::Unsigned 8,2,3,4,5,6,7,8])
--     expectedOutput = 'Clash.Explicit.Testbench.outputVerifier'   clkB2 rstB2 $('Clash.Sized.Vector.listToVecTH' [(0,0) :: (Unsigned 8, Unsigned 8),(1,2),(3,4),(5,6),(7,8)])
--     done           = expectedOutput (topEntity clkA1 rstA1 enableGen clkB2 testInput)
--     notDone        = not \<$\> done
--     clkA1          = 'tbClockGen' \@\"Fast\" (unsafeSynchronizer clkB2 clkA1 notDone)
--     clkB2          = 'tbClockGen' \@\"Slow\" notDone
--     rstA1          = 'Clash.Signal.resetGen' \@\"Fast\"
--     rstB2          = 'Clash.Signal.resetGen' \@\"Slow\"
-- @
tbClockGen
  :: KnownDomain testDom
  => Signal testDom Bool
  -> Clock testDom
tbClockGen :: Signal testDom Bool -> Clock testDom
tbClockGen Signal testDom Bool
done = SSymbol testDom
-> Maybe (Signal testDom Femtoseconds) -> Clock testDom
forall (dom :: Domain).
SSymbol dom -> Maybe (Signal dom Femtoseconds) -> Clock dom
Clock (Signal testDom Bool
done Signal testDom Bool -> SSymbol testDom -> SSymbol testDom
`seq` SSymbol testDom
forall (s :: Domain). KnownSymbol s => SSymbol s
SSymbol) Maybe (Signal testDom Femtoseconds)
forall a. Maybe a
Nothing
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE tbClockGen #-}
{-# ANN tbClockGen hasBlackBox #-}

-- | Femtoseconds expressed as an 'Int64'. Is a newtype to prevent accidental
-- mixups with picoseconds - the unit used in 'DomainConfiguration'.
--
newtype Femtoseconds = Femtoseconds Int64
  -- No 'Integral' instance to prevent accidental picoseconds / femtoseconds mixup
  deriving (Int -> Femtoseconds -> ShowS
[Femtoseconds] -> ShowS
Femtoseconds -> String
(Int -> Femtoseconds -> ShowS)
-> (Femtoseconds -> String)
-> ([Femtoseconds] -> ShowS)
-> Show Femtoseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Femtoseconds] -> ShowS
$cshowList :: [Femtoseconds] -> ShowS
show :: Femtoseconds -> String
$cshow :: Femtoseconds -> String
showsPrec :: Int -> Femtoseconds -> ShowS
$cshowsPrec :: Int -> Femtoseconds -> ShowS
Show, Femtoseconds -> Femtoseconds -> Bool
(Femtoseconds -> Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds -> Bool) -> Eq Femtoseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Femtoseconds -> Femtoseconds -> Bool
$c/= :: Femtoseconds -> Femtoseconds -> Bool
== :: Femtoseconds -> Femtoseconds -> Bool
$c== :: Femtoseconds -> Femtoseconds -> Bool
Eq, (forall x. Femtoseconds -> Rep Femtoseconds x)
-> (forall x. Rep Femtoseconds x -> Femtoseconds)
-> Generic Femtoseconds
forall x. Rep Femtoseconds x -> Femtoseconds
forall x. Femtoseconds -> Rep Femtoseconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Femtoseconds x -> Femtoseconds
$cfrom :: forall x. Femtoseconds -> Rep Femtoseconds x
Generic, HasCallStack => String -> Femtoseconds
Femtoseconds -> Bool
Femtoseconds -> ()
Femtoseconds -> Femtoseconds
(HasCallStack => String -> Femtoseconds)
-> (Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds)
-> (Femtoseconds -> ())
-> NFDataX Femtoseconds
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: Femtoseconds -> ()
$crnfX :: Femtoseconds -> ()
ensureSpine :: Femtoseconds -> Femtoseconds
$censureSpine :: Femtoseconds -> Femtoseconds
hasUndefined :: Femtoseconds -> Bool
$chasUndefined :: Femtoseconds -> Bool
deepErrorX :: String -> Femtoseconds
$cdeepErrorX :: HasCallStack => String -> Femtoseconds
NFDataX, Femtoseconds -> ()
(Femtoseconds -> ()) -> NFData Femtoseconds
forall a. (a -> ()) -> NFData a
rnf :: Femtoseconds -> ()
$crnf :: Femtoseconds -> ()
NFData, Femtoseconds -> Q Exp
Femtoseconds -> Q (TExp Femtoseconds)
(Femtoseconds -> Q Exp)
-> (Femtoseconds -> Q (TExp Femtoseconds)) -> Lift Femtoseconds
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Femtoseconds -> Q (TExp Femtoseconds)
$cliftTyped :: Femtoseconds -> Q (TExp Femtoseconds)
lift :: Femtoseconds -> Q Exp
$clift :: Femtoseconds -> Q Exp
Lift, Eq Femtoseconds
Eq Femtoseconds
-> (Femtoseconds -> Femtoseconds -> Ordering)
-> (Femtoseconds -> Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds -> Bool)
-> (Femtoseconds -> Femtoseconds -> Femtoseconds)
-> (Femtoseconds -> Femtoseconds -> Femtoseconds)
-> Ord Femtoseconds
Femtoseconds -> Femtoseconds -> Bool
Femtoseconds -> Femtoseconds -> Ordering
Femtoseconds -> Femtoseconds -> Femtoseconds
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
min :: Femtoseconds -> Femtoseconds -> Femtoseconds
$cmin :: Femtoseconds -> Femtoseconds -> Femtoseconds
max :: Femtoseconds -> Femtoseconds -> Femtoseconds
$cmax :: Femtoseconds -> Femtoseconds -> Femtoseconds
>= :: Femtoseconds -> Femtoseconds -> Bool
$c>= :: Femtoseconds -> Femtoseconds -> Bool
> :: Femtoseconds -> Femtoseconds -> Bool
$c> :: Femtoseconds -> Femtoseconds -> Bool
<= :: Femtoseconds -> Femtoseconds -> Bool
$c<= :: Femtoseconds -> Femtoseconds -> Bool
< :: Femtoseconds -> Femtoseconds -> Bool
$c< :: Femtoseconds -> Femtoseconds -> Bool
compare :: Femtoseconds -> Femtoseconds -> Ordering
$ccompare :: Femtoseconds -> Femtoseconds -> Ordering
$cp1Ord :: Eq Femtoseconds
Ord)

-- | Strip newtype wrapper 'Femtoseconds'
unFemtoseconds :: Femtoseconds -> Int64
unFemtoseconds :: Femtoseconds -> Int64
unFemtoseconds (Femtoseconds Int64
fs) = Int64
fs

-- | Map 'Int64' fields in 'Femtoseconds'
mapFemtoseconds :: (Int64 -> Int64) -> Femtoseconds -> Femtoseconds
mapFemtoseconds :: (Int64 -> Int64) -> Femtoseconds -> Femtoseconds
mapFemtoseconds Int64 -> Int64
f (Femtoseconds Int64
fs) = Int64 -> Femtoseconds
Femtoseconds (Int64 -> Int64
f Int64
fs)

-- | Clock generator with dynamic clock periods for simulations. This is an
-- experimental feature and hence not part of the public API.
--
-- To be used like:
--
-- @
-- clkSystem = dynamicClockGen @System
-- @
--
-- See 'DomainConfiguration' for more information on how to use synthesis domains.
dynamicClockGen ::
  KnownDomain dom =>
  -- | Clock period in /femto/seconds.
  --
  -- * __NB__: Beware that the periods are given in femtoseconds; this differs
  --           from the usual unit Clash uses to represent period length,
  --           picoseconds.
  --
  -- * __NB__: Beware that not all simulators support femtoseconds. For example,
  --           Vivado's XSIM will round down to nearest picoseconds.
  --
  -- * __NB__: Beware that, by default, Clash will define @`timescale 100fs/100fs@
  --           in its generated Verilog. The latter will make simulators round
  --           time to 100fs. If you rely on more precision you should pass
  --           @-fclash-timescale-precision 1fs@ to Clash.
  Signal dom Femtoseconds ->
  Clock dom
dynamicClockGen :: Signal dom Femtoseconds -> Clock dom
dynamicClockGen Signal dom Femtoseconds
periods = Signal dom Femtoseconds -> Signal dom Bool -> Clock dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Femtoseconds -> Signal dom Bool -> Clock dom
tbDynamicClockGen Signal dom Femtoseconds
periods (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True)

-- | Clock generator with dynamic clock periods for simulations. This is an
-- experimental feature and hence not part of the public API. Like 'tbClockGen'
--
--
-- To be used like:
--
-- @
-- clkSystem = dynamicClockGen @System
-- @
--
-- See 'DomainConfiguration' for more information on how to use synthesis domains.
tbDynamicClockGen ::
  KnownDomain dom =>
  -- | Clock period in /femto/seconds.
  --
  -- * __NB__: Beware that the periods are given in femtoseconds; this differs
  --           from the usual unit Clash uses to represent period length,
  --           picoseconds.
  --
  -- * __NB__: Beware that not all simulators support femtoseconds. For example,
  --           Vivado's XSIM will round down to nearest picoseconds.
  --
  -- * __NB__: Beware that, by default, Clash will define @`timescale 100fs/100fs@
  --           in its generated Verilog. The latter will make simulators round
  --           time to 100fs. If you rely on more precision you should pass
  --           @-fclash-timescale-precision 1fs@ to Clash.
  Signal dom Femtoseconds ->
  Signal dom Bool ->
  Clock dom
tbDynamicClockGen :: Signal dom Femtoseconds -> Signal dom Bool -> Clock dom
tbDynamicClockGen Signal dom Femtoseconds
periods Signal dom Bool
ena =
  SSymbol dom -> Maybe (Signal dom Femtoseconds) -> Clock dom
forall (dom :: Domain).
SSymbol dom -> Maybe (Signal dom Femtoseconds) -> Clock dom
Clock (Signal dom Bool
ena Signal dom Bool -> SSymbol dom -> SSymbol dom
`seq` Signal dom Femtoseconds
periods Signal dom Femtoseconds -> SSymbol dom -> SSymbol dom
`seq` SSymbol dom
forall (s :: Domain). KnownSymbol s => SSymbol s
SSymbol) (Signal dom Femtoseconds -> Maybe (Signal dom Femtoseconds)
forall a. a -> Maybe a
Just Signal dom Femtoseconds
periods)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE tbDynamicClockGen #-}
{-# ANN tbDynamicClockGen hasBlackBox #-}


-- | Reset generator for simulation purposes. Asserts the reset for a single
-- cycle.
--
-- To be used like:
--
-- @
-- rstSystem = resetGen @System
-- @
--
-- See 'Clash.Explicit.Testbench.tbClockGen' for example usage.
--
-- __NB__: While this can be used in the @testBench@ function, it cannot be
-- synthesized to hardware.
resetGen
  :: forall dom
   . KnownDomain dom
  => Reset dom
resetGen :: Reset dom
resetGen = SNat 1 -> Reset dom
forall (dom :: Domain) (n :: Nat).
(KnownDomain dom, 1 <= n) =>
SNat n -> Reset dom
resetGenN (KnownNat 1 => SNat 1
forall (n :: Nat). KnownNat n => SNat n
SNat @1)
{-# INLINE resetGen #-}

-- | Reset generator for simulation purposes. Asserts the reset for the first /n/
-- cycles.
--
-- To be used like:
--
-- @
-- rstSystem5 = resetGen @System d5
-- @
--
-- Example usage:
--
-- >>> sampleN 7 (unsafeToActiveHigh (resetGenN @System d3))
-- [True,True,True,False,False,False,False]
--
-- __NB__: While this can be used in the @testBench@ function, it cannot be
-- synthesized to hardware.
resetGenN
  :: forall dom n
   . (KnownDomain dom, 1 <= n)
  => SNat n
  -- ^ Number of initial cycles to hold reset high
  -> Reset dom
resetGenN :: SNat n -> Reset dom
resetGenN SNat n
n =
  let asserted :: [Bool]
asserted = Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (SNat n -> Int
forall a (n :: Nat). Num a => SNat n -> a
snatToNum SNat n
n) Bool
True in
  Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeFromActiveHigh ([Bool] -> Signal dom Bool
forall a (dom :: Domain). NFDataX a => [a] -> Signal dom a
fromList ([Bool]
asserted [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False))
{-# ANN resetGenN hasBlackBox #-}
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE resetGenN #-}


-- | A reset signal belonging to a domain called /dom/.
--
-- The underlying representation of resets is 'Bool'.
data Reset (dom :: Domain) = Reset (Signal dom Bool)

-- | Non-ambiguous version of 'Clash.Signal.Internal.Ambiguous.resetPolarity'
resetPolarityProxy
  :: forall dom proxy polarity
   . (KnownDomain dom, DomainResetPolarity dom ~ polarity)
  => proxy dom
  -> SResetPolarity polarity
resetPolarityProxy :: proxy dom -> SResetPolarity polarity
resetPolarityProxy proxy dom
_proxy =
  case KnownDomain dom => SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain @dom of
    SDomainConfiguration SSymbol dom
_dom SNat period
_period SActiveEdge edge
_edge SResetKind reset
_sync SInitBehavior init
_init SResetPolarity polarity
polarity ->
      SResetPolarity polarity
SResetPolarity polarity
polarity

-- | Convert a reset to an active high reset. Has no effect if reset is already
-- an active high reset. Is unsafe because it can introduce:
--
-- * <Clash-Explicit-Signal.html#metastability meta-stability>
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeToActiveHigh
  :: forall dom
   . KnownDomain dom
  => Reset dom
  -> Signal dom Bool
unsafeToActiveHigh :: Reset dom -> Signal dom Bool
unsafeToActiveHigh (Reset dom -> Signal dom Bool
forall (dom :: Domain). Reset dom -> Signal dom Bool
unsafeFromReset -> Signal dom Bool
r) =
  case Proxy dom
-> SResetPolarity
     (DomainConfigurationResetPolarity (KnownConf dom))
forall (dom :: Domain) (proxy :: Domain -> Type)
       (polarity :: ResetPolarity).
(KnownDomain dom, DomainResetPolarity dom ~ polarity) =>
proxy dom -> SResetPolarity polarity
resetPolarityProxy (Proxy dom
forall k (t :: k). Proxy t
Proxy @dom) of
    SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveHigh -> Signal dom Bool
r
    SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveLow -> 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
{-# INLINE unsafeToActiveHigh #-}

-- | Convert a reset to an active high reset. Has no effect if reset is already
-- an active high reset. Is unsafe because it can introduce:
--
-- * <Clash-Explicit-Signal.html#metastability meta-stability>
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeToHighPolarity
  :: forall dom
   . KnownDomain dom
  => Reset dom
  -> Signal dom Bool
unsafeToHighPolarity :: Reset dom -> Signal dom Bool
unsafeToHighPolarity = Reset dom -> Signal dom Bool
forall (dom :: Domain).
KnownDomain dom =>
Reset dom -> Signal dom Bool
unsafeToActiveHigh
{-# DEPRECATED unsafeToHighPolarity "Use 'unsafeToActiveHigh' instead. This function will be removed in Clash 1.12." #-}
{-# INLINE unsafeToHighPolarity #-}

-- | Convert a reset to an active low reset. Has no effect if reset is already
-- an active low reset. It is unsafe because it can introduce:
--
-- * <Clash-Explicit-Signal.html#metastability meta-stability>
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeToActiveLow
  :: forall dom
   . KnownDomain dom
  => Reset dom
  -> Signal dom Bool
unsafeToActiveLow :: Reset dom -> Signal dom Bool
unsafeToActiveLow (Reset dom -> Signal dom Bool
forall (dom :: Domain). Reset dom -> Signal dom Bool
unsafeFromReset -> Signal dom Bool
r) =
  case Proxy dom
-> SResetPolarity
     (DomainConfigurationResetPolarity (KnownConf dom))
forall (dom :: Domain) (proxy :: Domain -> Type)
       (polarity :: ResetPolarity).
(KnownDomain dom, DomainResetPolarity dom ~ polarity) =>
proxy dom -> SResetPolarity polarity
resetPolarityProxy (Proxy dom
forall k (t :: k). Proxy t
Proxy @dom) of
    SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveHigh -> 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
    SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveLow -> Signal dom Bool
r
{-# INLINE unsafeToActiveLow #-}

-- | Convert a reset to an active low reset. Has no effect if reset is already
-- an active low reset. It is unsafe because it can introduce:
--
-- * <Clash-Explicit-Signal.html#metastability meta-stability>
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeToLowPolarity
  :: forall dom
   . KnownDomain dom
  => Reset dom
  -> Signal dom Bool
unsafeToLowPolarity :: Reset dom -> Signal dom Bool
unsafeToLowPolarity = Reset dom -> Signal dom Bool
forall (dom :: Domain).
KnownDomain dom =>
Reset dom -> Signal dom Bool
unsafeToActiveLow
{-# DEPRECATED unsafeToLowPolarity "Use 'unsafeToActiveLow' instead. This function will be removed in Clash 1.12." #-}
{-# INLINE unsafeToLowPolarity #-}

-- | 'unsafeFromReset' is unsafe because it can introduce:
--
-- * <Clash-Explicit-Signal.html#metastability meta-stability>
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
--
-- __NB__: You probably want to use 'unsafeToActiveLow' or
-- 'unsafeToActiveHigh'.
unsafeFromReset
  :: Reset dom
  -> Signal dom Bool
unsafeFromReset :: Reset dom -> Signal dom Bool
unsafeFromReset (Reset Signal dom Bool
r) = Signal dom Bool
r
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE unsafeFromReset #-}
{-# ANN unsafeFromReset hasBlackBox #-}

-- | 'unsafeToReset' is unsafe. For asynchronous resets it is unsafe
-- because it can introduce combinatorial loops. In case of synchronous resets
-- it can lead to <Clash-Explicit-Signal.html#metastability meta-stability>
-- issues in the presence of asynchronous resets.
--
-- __NB__: You probably want to use 'unsafeFromActiveLow' or
-- 'unsafeFromActiveHigh'.
unsafeToReset
  :: KnownDomain dom
  => Signal dom Bool
  -> Reset dom
unsafeToReset :: Signal dom Bool -> Reset dom
unsafeToReset Signal dom Bool
r = Signal dom Bool -> Reset dom
forall (dom :: Domain). Signal dom Bool -> Reset dom
Reset Signal dom Bool
r
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE unsafeToReset #-}
{-# ANN unsafeToReset hasBlackBox #-}

-- | Interpret a signal of bools as an active high reset and convert it to
-- a reset signal corresponding to the domain's setting.
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeFromHighPolarity
  :: forall dom
   . KnownDomain dom
  => Signal dom Bool
  -- ^ Reset signal that's 'True' when active, and 'False' when inactive.
  -> Reset dom
unsafeFromHighPolarity :: Signal dom Bool -> Reset dom
unsafeFromHighPolarity = Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeFromActiveHigh
{-# DEPRECATED unsafeFromHighPolarity "Use 'unsafeFromActiveHigh' instead. This function will be removed in Clash 1.12." #-}
{-# INLINE unsafeFromHighPolarity #-}

-- | Interpret a signal of bools as an active high reset and convert it to
-- a reset signal corresponding to the domain's setting.
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeFromActiveHigh
  :: forall dom
   . KnownDomain dom
  => Signal dom Bool
  -- ^ Reset signal that's 'True' when active, and 'False' when inactive.
  -> Reset dom
unsafeFromActiveHigh :: Signal dom Bool -> Reset dom
unsafeFromActiveHigh Signal dom Bool
r =
  Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeToReset (Signal dom Bool -> Reset dom) -> Signal dom Bool -> Reset dom
forall a b. (a -> b) -> a -> b
$
    case Proxy dom
-> SResetPolarity
     (DomainConfigurationResetPolarity (KnownConf dom))
forall (dom :: Domain) (proxy :: Domain -> Type)
       (polarity :: ResetPolarity).
(KnownDomain dom, DomainResetPolarity dom ~ polarity) =>
proxy dom -> SResetPolarity polarity
resetPolarityProxy (Proxy dom
forall k (t :: k). Proxy t
Proxy @dom) of
      SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveHigh -> Signal dom Bool
r
      SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveLow -> 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

-- | Interpret a signal of bools as an active low reset and convert it to
-- a reset signal corresponding to the domain's setting.
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeFromLowPolarity
  :: forall dom
   . KnownDomain dom
  => Signal dom Bool
  -- ^ Reset signal that's 'False' when active, and 'True' when inactive.
  -> Reset dom
unsafeFromLowPolarity :: Signal dom Bool -> Reset dom
unsafeFromLowPolarity = Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeFromActiveLow
{-# DEPRECATED unsafeFromLowPolarity "Use 'unsafeFromActiveLow' instead. This function will be removed in Clash 1.12." #-}
{-# INLINE unsafeFromLowPolarity #-}

-- | Interpret a signal of bools as an active low reset and convert it to
-- a reset signal corresponding to the domain's setting.
--
-- For asynchronous resets it is unsafe because it can cause combinatorial
-- loops. In case of synchronous resets it can lead to
-- <Clash-Explicit-Signal.html#metastability meta-stability> in the presence of
-- asynchronous resets.
unsafeFromActiveLow
  :: forall dom
   . KnownDomain dom
  => Signal dom Bool
  -- ^ Reset signal that's 'False' when active, and 'True' when inactive.
  -> Reset dom
unsafeFromActiveLow :: Signal dom Bool -> Reset dom
unsafeFromActiveLow Signal dom Bool
r =
  Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeToReset (Signal dom Bool -> Reset dom) -> Signal dom Bool -> Reset dom
forall a b. (a -> b) -> a -> b
$
    case Proxy dom
-> SResetPolarity
     (DomainConfigurationResetPolarity (KnownConf dom))
forall (dom :: Domain) (proxy :: Domain -> Type)
       (polarity :: ResetPolarity).
(KnownDomain dom, DomainResetPolarity dom ~ polarity) =>
proxy dom -> SResetPolarity polarity
resetPolarityProxy (Proxy dom
forall k (t :: k). Proxy t
Proxy @dom) of
      SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveHigh -> 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
      SResetPolarity (DomainConfigurationResetPolarity (KnownConf dom))
SActiveLow -> Signal dom Bool
r

-- | Invert reset signal
invertReset :: KnownDomain dom => Reset dom -> Reset dom
invertReset :: Reset dom -> Reset dom
invertReset = Signal dom Bool -> Reset dom
forall (dom :: Domain).
KnownDomain dom =>
Signal dom Bool -> Reset dom
unsafeToReset (Signal dom Bool -> Reset dom)
-> (Reset dom -> Signal dom Bool) -> Reset dom -> Reset dom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Signal dom Bool -> Signal dom Bool)
-> (Reset dom -> Signal dom Bool) -> Reset dom -> Signal dom Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reset dom -> Signal dom Bool
forall (dom :: Domain). Reset dom -> Signal dom Bool
unsafeFromReset

infixr 2 .||.
-- | The above type is a generalization for:
--
-- @
-- __(.||.)__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('||') that returns a 'Clash.Signal.Signal' of 'Bool'
(.||.) :: Applicative f => f Bool -> f Bool -> f Bool
.||. :: f Bool -> f Bool -> f Bool
(.||.) = (Bool -> Bool -> Bool) -> f Bool -> f Bool -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||)

infixr 3 .&&.
-- | The above type is a generalization for:
--
-- @
-- __(.&&.)__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('&&') that returns a 'Clash.Signal.Signal' of 'Bool'
(.&&.) :: Applicative f => f Bool -> f Bool -> f Bool
.&&. :: f Bool -> f Bool -> f Bool
(.&&.) = (Bool -> Bool -> Bool) -> f Bool -> f Bool -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)

-- [Note: register strictness annotations]
--
-- In order to produce the first (current) value of the register's output
-- signal, 'o', we don't need to know the shape of either input (enable or
-- value-in).  This is important, because both values might be produced from
-- the output in a feedback loop, so we can't know their shape (pattern
-- match) them until we have produced output.
--
-- Thus, we use lazy pattern matching to delay inspecting the shape of
-- either argument until output has been produced.
--
-- However, both arguments need to be evaluated to WHNF as soon as possible
-- to avoid a space-leak.  Below, we explicitly reduce the value-in signal
-- using 'seq' as the tail of our output signal is produced.  On the other
-- hand, because the value of the tail depends on the value of the enable
-- signal 'e', it will be forced by the 'if'/'then' statement and we don't
-- need to 'seq' it explicitly.

delay#
  :: forall dom a
   . ( KnownDomain dom
     , NFDataX a )
  => Clock dom
  -> Enable dom
  -> a
  -> Signal dom a
  -> Signal dom a
delay# :: Clock dom -> Enable dom -> a -> Signal dom a -> Signal dom a
delay# (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
_) (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable -> Signal dom Bool
en) a
powerUpVal0 =
    a -> Signal dom Bool -> Signal dom a -> Signal dom a
forall t (dom :: Domain) (dom :: Domain) (dom :: Domain).
NFDataX t =>
t -> Signal dom Bool -> Signal dom t -> Signal dom t
go a
powerUpVal1 Signal dom Bool
en
  where
    powerUpVal1 :: a
    powerUpVal1 :: a
powerUpVal1 =
      case SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
knownDomainByName SSymbol dom
dom of
        SDomainConfiguration SSymbol dom
_dom SNat period
_period SActiveEdge edge
_edge SResetKind reset
_sync SInitBehavior init
SDefined SResetPolarity polarity
_polarity ->
          a
powerUpVal0
        SDomainConfiguration SSymbol dom
_dom SNat period
_period SActiveEdge edge
_edge SResetKind reset
_sync SInitBehavior init
SUnknown SResetPolarity polarity
_polarity ->
          String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"First value of `delay` unknown on domain " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall a. Show a => a -> String
show SSymbol dom
dom)

    go :: t -> Signal dom Bool -> Signal dom t -> Signal dom t
go t
o (Bool
e :- Signal dom Bool
es) as :: Signal dom t
as@(~(t
x :- Signal dom t
xs)) =
      let o' :: t
o' = if Bool
e then t
x else t
o
      -- See [Note: register strictness annotations]
      in  t
o t -> Signal dom t -> Signal dom t
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` t
o t -> Signal dom t -> Signal dom t
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (Signal dom t
as Signal dom t -> Signal dom t -> Signal dom t
`seq` t -> Signal dom Bool -> Signal dom t -> Signal dom t
go t
o' Signal dom Bool
es Signal dom t
xs)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE delay# #-}
{-# ANN delay# hasBlackBox #-}

-- | A register with a power up and reset value. Power up values are not
-- supported on all platforms, please consult the manual of your target platform
-- and check the notes below.
--
-- Xilinx: power up values and reset values MUST be the same. If they are not,
-- the Xilinx tooling __will ignore the reset value__ and use the power up value
-- instead. Source: MIA
--
-- Intel: power up values and reset values MUST be the same. If they are not,
-- the Intel tooling __will ignore the power up value__ and use the reset value
-- instead. Source: https://www.intel.com/content/www/us/en/programmable/support/support-resources/knowledge-base/solutions/rd01072011_91.html
register#
  :: forall dom  a
   . ( KnownDomain dom
     , NFDataX a )
  => Clock dom
  -> Reset dom
  -> Enable dom
  -> a
  -- ^ Power up value
  -> a
  -- ^ Reset value
  -> Signal dom a
  -> Signal dom a
register# :: Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
register# clk :: Clock dom
clk@(Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
_) Reset dom
rst Enable dom
ena a
powerUpVal a
resetVal =
  case SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
knownDomainByName SSymbol dom
dom of
    SDomainConfiguration SSymbol dom
_name SNat period
_period SActiveEdge edge
_edge SResetKind reset
SSynchronous SInitBehavior init
_init SResetPolarity polarity
_polarity ->
      Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
syncRegister# Clock dom
clk Reset dom
rst Enable dom
ena a
powerUpVal a
resetVal
    SDomainConfiguration SSymbol dom
_name SNat period
_period SActiveEdge edge
_edge SResetKind reset
SAsynchronous SInitBehavior init
_init SResetPolarity polarity
_polarity ->
      Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a) =>
Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
asyncRegister# Clock dom
clk Reset dom
rst Enable dom
ena a
powerUpVal a
resetVal
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE register# #-}
{-# ANN register# hasBlackBox #-}

-- | Acts like 'id' if given domain allows powerup values, but returns a
-- value constructed with 'deepErrorX' otherwise.
registerPowerup#
  :: forall dom a
   . ( KnownDomain dom
     , NFDataX a
     , HasCallStack )
  => Clock dom
  -> a
  -> a
registerPowerup# :: Clock dom -> a -> a
registerPowerup# (Clock SSymbol dom
dom Maybe (Signal dom Femtoseconds)
_) a
a =
  case SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SSymbol dom -> SDomainConfiguration dom (KnownConf dom)
knownDomainByName SSymbol dom
dom of
    SDomainConfiguration SSymbol dom
_dom SNat period
_period SActiveEdge edge
_edge SResetKind reset
_sync SInitBehavior init
SDefined SResetPolarity polarity
_polarity -> a
a
    SDomainConfiguration SSymbol dom
_dom SNat period
_period SActiveEdge edge
_edge SResetKind reset
_sync SInitBehavior init
SUnknown SResetPolarity polarity
_polarity ->
      String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX (String
"First value of register undefined on domain " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSymbol dom -> String
forall a. Show a => a -> String
show SSymbol dom
dom)

-- | Version of 'register#' that simulates a register on an asynchronous
-- domain. Is synthesizable.
asyncRegister#
  :: forall dom  a
   . ( KnownDomain dom
     , NFDataX a )
  => Clock dom
  -- ^ Clock signal
  -> Reset dom
  -- ^ Reset signal
  -> Enable dom
  -- ^ Enable signal
  -> a
  -- ^ Power up value
  -> a
  -- ^ Reset value
  -> Signal dom a
  -> Signal dom a
asyncRegister# :: Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
asyncRegister# Clock dom
clk (Reset dom -> Signal dom Bool
forall (dom :: Domain).
KnownDomain dom =>
Reset dom -> Signal dom Bool
unsafeToActiveHigh -> Signal dom Bool
rst) (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable -> Signal dom Bool
ena) a
initVal a
resetVal =
  a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go (Clock dom -> a -> a
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a, HasCallStack) =>
Clock dom -> a -> a
registerPowerup# Clock dom
clk a
initVal) Signal dom Bool
rst Signal dom Bool
ena
 where
  go :: a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go a
o (Bool
r :- Signal dom Bool
rs) enas :: Signal dom Bool
enas@(~(Bool
e :- Signal dom Bool
es)) as :: Signal dom a
as@(~(a
x :- Signal dom a
xs)) =
    let oR :: a
oR = if Bool
r then a
resetVal else a
o
        oE :: a
oE = if Bool
r then a
resetVal else (if Bool
e then a
x else a
o)
        -- [Note: register strictness annotations]
    in  a
o a -> Signal dom a -> Signal dom a
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` a
oR a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (Signal dom a
as Signal dom a -> Signal dom a -> Signal dom a
`seq` Signal dom Bool
enas Signal dom Bool -> Signal dom a -> Signal dom a
`seq` a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go a
oE Signal dom Bool
rs Signal dom Bool
es Signal dom a
xs)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE asyncRegister# #-}
{-# ANN asyncRegister# hasBlackBox #-}

-- | Version of 'register#' that simulates a register on a synchronous
-- domain. Not synthesizable.
syncRegister#
  :: forall dom  a
   . ( KnownDomain dom
     , NFDataX a )
  => Clock dom
  -- ^ Clock signal
  -> Reset dom
  -- ^ Reset signal
  -> Enable dom
  -- ^ Enable signal
  -> a
  -- ^ Power up value
  -> a
  -- ^ Reset value
  -> Signal dom a
  -> Signal dom a
syncRegister# :: Clock dom
-> Reset dom
-> Enable dom
-> a
-> a
-> Signal dom a
-> Signal dom a
syncRegister# Clock dom
clk (Reset dom -> Signal dom Bool
forall (dom :: Domain).
KnownDomain dom =>
Reset dom -> Signal dom Bool
unsafeToActiveHigh -> Signal dom Bool
rst) (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable -> Signal dom Bool
ena) a
initVal a
resetVal =
  a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go (Clock dom -> a -> a
forall (dom :: Domain) a.
(KnownDomain dom, NFDataX a, HasCallStack) =>
Clock dom -> a -> a
registerPowerup# Clock dom
clk a
initVal) Signal dom Bool
rst Signal dom Bool
ena
 where
  go :: a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go a
o rt :: Signal dom Bool
rt@(~(Bool
r :- Signal dom Bool
rs)) enas :: Signal dom Bool
enas@(~(Bool
e :- Signal dom Bool
es)) as :: Signal dom a
as@(~(a
x :- Signal dom a
xs)) =
    let oE :: a
oE = if Bool
e then a
x else a
o
        oR :: a
oR = if Bool
r then a
resetVal else a
oE
        -- [Note: register strictness annotations]
    in  a
o a -> Signal dom a -> Signal dom a
forall a b. NFDataX a => a -> b -> b
`defaultSeqX` a
o a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (Signal dom Bool
rt Signal dom Bool -> Signal dom a -> Signal dom a
`seq` Signal dom Bool
enas Signal dom Bool -> Signal dom a -> Signal dom a
`seq` Signal dom a
as Signal dom a -> Signal dom a -> Signal dom a
`seq` a
-> Signal dom Bool
-> Signal dom Bool
-> Signal dom a
-> Signal dom a
go a
oR Signal dom Bool
rs Signal dom Bool
es Signal dom a
xs)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE syncRegister# #-}
{-# ANN syncRegister# dontTranslate #-}

-- | The above type is a generalization for:
--
-- @
-- __mux__ :: 'Clash.Signal.Signal' 'Bool' -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a
-- @
--
-- A multiplexer. Given "@'mux' b t f@", output @t@ when @b@ is 'True', and @f@
-- when @b@ is 'False'.
mux :: Applicative f => f Bool -> f a -> f a -> f a
mux :: f Bool -> f a -> f a -> f a
mux = (Bool -> a -> a -> a) -> f Bool -> f a -> f a -> f a
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (\Bool
b a
t a
f -> if Bool
b then a
t else a
f)
{-# INLINE mux #-}

infix 4 .==.
-- | The above type is a generalization for:
--
-- @
-- __(.==.)__ :: 'Eq' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('==') that returns a 'Clash.Signal.Signal' of 'Bool'
(.==.) :: (Eq a, Applicative f) => f a -> f a -> f Bool
.==. :: f a -> f a -> f Bool
(.==.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

infix 4 ./=.
-- | The above type is a generalization for:
--
-- @
-- __(./=.)__ :: 'Eq' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('/=') that returns a 'Clash.Signal.Signal' of 'Bool'
(./=.) :: (Eq a, Applicative f) => f a -> f a -> f Bool
./=. :: f a -> f a -> f Bool
(./=.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

infix 4 .<.
-- | The above type is a generalization for:
--
-- @
-- __(.<.)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('<') that returns a 'Clash.Signal.Signal' of 'Bool'
(.<.) :: (Ord a, Applicative f) => f a -> f a -> f Bool
.<. :: f a -> f a -> f Bool
(.<.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

infix 4 .<=.
-- | The above type is a generalization for:
--
-- @
-- __(.<=.)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('GHC.TypeNats.<=') that returns a 'Clash.Signal.Signal' of 'Bool'
(.<=.) :: (Ord a, Applicative f) => f a -> f a -> f Bool
.<=. :: f a -> f a -> f Bool
(.<=.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

infix 4 .>.
-- | The above type is a generalization for:
--
-- @
-- __(.>.)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
-- It is a version of ('>') that returns a 'Clash.Signal.Signal' of 'Bool'
(.>.) :: (Ord a, Applicative f) => f a -> f a -> f Bool
.>. :: f a -> f a -> f Bool
(.>.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)

infix 4 .>=.
-- | The above type is a generalization for:
--
-- @
-- __(.>=.)__ :: 'Ord' a => 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' 'Bool'
-- @
--
--  It is a version of ('>=') that returns a 'Clash.Signal.Signal' of 'Bool'
(.>=.) :: (Ord a, Applicative f) => f a -> f a -> f Bool
.>=. :: f a -> f a -> f Bool
(.>=.) = (a -> a -> Bool) -> f a -> f a -> f Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

instance Fractional a => Fractional (Signal dom a) where
  / :: Signal dom a -> Signal dom a -> Signal dom a
(/)          = (a -> a -> a) -> Signal dom a -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
  recip :: Signal dom a -> Signal dom a
recip        = (a -> a) -> Signal dom a -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Rational -> Signal dom a
fromRational = a -> Signal dom a
forall a (dom :: Domain). a -> Signal dom a
signal# (a -> Signal dom a) -> (Rational -> a) -> Rational -> Signal dom a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

instance Arbitrary a => Arbitrary (Signal dom a) where
  arbitrary :: Gen (Signal dom a)
arbitrary = (a -> Signal dom a -> Signal dom a)
-> Gen a -> Gen (Signal dom a) -> Gen (Signal dom a)
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
(:-) Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen (Signal dom a)
forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary a => CoArbitrary (Signal dom a) where
  coarbitrary :: Signal dom a -> Gen b -> Gen b
coarbitrary Signal dom a
xs Gen b
gen = do
    Int
n <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
    [a] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a. Num a => a -> a
abs Int
n) (Signal dom a -> [a]
forall (f :: Type -> Type) a. Foldable f => f a -> [a]
sample_lazy Signal dom a
xs)) Gen b
gen

-- | The above type is a generalization for:
--
-- @
-- __testFor__ :: 'Int' -> 'Clash.Signal.Signal' Bool -> 'Property'
-- @
--
-- @testFor n s@ tests the signal @s@ for @n@ cycles.
--
-- __NB__: This function is not synthesizable
testFor :: Foldable f => Int -> f Bool -> Property
testFor :: Int -> f Bool -> Property
testFor Int
n = Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> (f Bool -> Bool) -> f Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> (f Bool -> [Bool]) -> f Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
n ([Bool] -> [Bool]) -> (f Bool -> [Bool]) -> f Bool -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Bool -> [Bool]
forall (f :: Type -> Type) a. (Foldable f, NFDataX a) => f a -> [a]
sample

-- * List \<-\> Signal conversion (not synthesizable)

-- | The above type is a generalization for:
--
-- @
-- __sample__ :: 'Clash.Signal.Signal' a -> [a]
-- @
--
-- Get an infinite list of samples from a 'Clash.Signal.Signal'
--
-- The elements in the list correspond to the values of the 'Clash.Signal.Signal'
-- at consecutive clock cycles
--
-- > sample s == [s0, s1, s2, s3, ...
--
-- __NB__: This function is not synthesizable
sample :: (Foldable f, NFDataX a) => f a -> [a]
sample :: f a -> [a]
sample = (a -> [a] -> [a]) -> [a] -> f a -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a [a]
b -> a -> [a] -> [a]
forall a b. NFDataX a => a -> b -> b
deepseqX a
a (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
b)) []

-- | The above type is a generalization for:
--
-- @
-- __sampleN__ :: Int -> 'Clash.Signal.Signal' a -> [a]
-- @
--
-- Get a list of @n@ samples from a 'Clash.Signal.Signal'
--
-- The elements in the list correspond to the values of the 'Clash.Signal.Signal'
-- at consecutive clock cycles
--
-- > sampleN 3 s == [s0, s1, s2]
--
-- __NB__: This function is not synthesizable
sampleN :: (Foldable f, NFDataX a) => Int -> f a -> [a]
sampleN :: Int -> f a -> [a]
sampleN Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (f a -> [a]) -> f a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (f :: Type -> Type) a. (Foldable f, NFDataX a) => f a -> [a]
sample

-- | Create a 'Clash.Signal.Signal' from a list
--
-- Every element in the list will correspond to a value of the signal for one
-- clock cycle.
--
-- >>> sampleN 2 (fromList [1,2,3,4,5])
-- [1,2]
--
-- __NB__: This function is not synthesizable
fromList :: NFDataX a => [a] -> Signal dom a
fromList :: [a] -> Signal dom a
fromList = (a -> Signal dom a -> Signal dom a)
-> Signal dom a -> [a] -> Signal dom a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (\a
a Signal dom a
b -> a -> Signal dom a -> Signal dom a
forall a b. NFDataX a => a -> b -> b
deepseqX a
a (a
a a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal dom a
b)) (String -> Signal dom a
forall a. HasCallStack => String -> a
errorX String
"finite list")

-- * Simulation functions (not synthesizable)

-- | Simulate a (@'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' b@) function
-- given a list of samples of type @a@
--
-- >>> simulate (register systemClockGen resetGen enableGen 8) [1, 1, 2, 3]
-- [8,8,1,2,3...
-- ...
--
-- __NB__: This function is not synthesizable
simulate :: (NFDataX a, NFDataX b) => (Signal dom1 a -> Signal dom2 b) -> [a] -> [b]
simulate :: (Signal dom1 a -> Signal dom2 b) -> [a] -> [b]
simulate Signal dom1 a -> Signal dom2 b
f = Signal dom2 b -> [b]
forall (f :: Type -> Type) a. (Foldable f, NFDataX a) => f a -> [a]
sample (Signal dom2 b -> [b]) -> ([a] -> Signal dom2 b) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal dom1 a -> Signal dom2 b
f (Signal dom1 a -> Signal dom2 b)
-> ([a] -> Signal dom1 a) -> [a] -> Signal dom2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Signal dom1 a
forall a (dom :: Domain). NFDataX a => [a] -> Signal dom a
fromList

-- | The above type is a generalization for:
--
-- @
-- __sample__ :: 'Clash.Signal.Signal' a -> [a]
-- @
--
-- Get an infinite list of samples from a 'Clash.Signal.Signal'
--
-- The elements in the list correspond to the values of the 'Clash.Signal.Signal'
-- at consecutive clock cycles
--
-- > sample s == [s0, s1, s2, s3, ...
--
-- __NB__: This function is not synthesizable
sample_lazy :: Foldable f => f a -> [a]
sample_lazy :: f a -> [a]
sample_lazy = (a -> [a] -> [a]) -> [a] -> f a -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []

-- | The above type is a generalization for:
--
-- @
-- __sampleN__ :: Int -> 'Clash.Signal.Signal' a -> [a]
-- @
--
-- Get a list of @n@ samples from a 'Clash.Signal.Signal'
--
-- The elements in the list correspond to the values of the 'Clash.Signal.Signal'
-- at consecutive clock cycles
--
-- > sampleN 3 s == [s0, s1, s2]
--
-- __NB__: This function is not synthesizable
sampleN_lazy :: Foldable f => Int -> f a -> [a]
sampleN_lazy :: Int -> f a -> [a]
sampleN_lazy Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (f a -> [a]) -> f a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (f :: Type -> Type) a. Foldable f => f a -> [a]
sample_lazy

-- | Create a 'Clash.Signal.Signal' from a list
--
-- Every element in the list will correspond to a value of the signal for one
-- clock cycle.
--
-- >>> sampleN 2 (fromList [1,2,3,4,5] :: Signal System Int)
-- [1,2]
--
-- __NB__: This function is not synthesizable
fromList_lazy :: [a] -> Signal dom a
fromList_lazy :: [a] -> Signal dom a
fromList_lazy = (a -> Signal dom a -> Signal dom a)
-> Signal dom a -> [a] -> Signal dom a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
(:-) (String -> Signal dom a
forall a. HasCallStack => String -> a
error String
"finite list")

-- * Simulation functions (not synthesizable)

-- | Simulate a (@'Clash.Signal.Signal' a -> 'Clash.Signal.Signal' b@) function
-- given a list of samples of type @a@
--
-- >>> simulate (register systemClockGen resetGen enableGen 8) [1, 1, 2, 3]
-- [8,8,1,2,3...
-- ...
--
-- __NB__: This function is not synthesizable
simulate_lazy :: (Signal dom1 a -> Signal dom2 b) -> [a] -> [b]
simulate_lazy :: (Signal dom1 a -> Signal dom2 b) -> [a] -> [b]
simulate_lazy Signal dom1 a -> Signal dom2 b
f = Signal dom2 b -> [b]
forall (f :: Type -> Type) a. Foldable f => f a -> [a]
sample_lazy (Signal dom2 b -> [b]) -> ([a] -> Signal dom2 b) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal dom1 a -> Signal dom2 b
f (Signal dom1 a -> Signal dom2 b)
-> ([a] -> Signal dom1 a) -> [a] -> Signal dom2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Signal dom1 a
forall a (dom :: Domain). [a] -> Signal dom a
fromList_lazy

-- | Calculate the period in __ps__, given a frequency in __Hz__
--
-- I.e., to calculate the clock period for a circuit to run at 240 MHz we get
--
-- >>> hzToPeriod 240e6
-- 4166
--
-- If the value @hzToPeriod@ is applied to is not of the type 'Ratio'
-- 'Natural', you can use @hzToPeriod ('realToFrac' f)@. Note that if @f@ is
-- negative, @realToFrac@ will give an @'Control.Exception.Underflow' ::
-- t'Control.Exception.ArithException'@ without a call stack, making debugging
-- cumbersome.
--
-- Before Clash 1.8, this function always returned a 'Natural'. To get the old
-- behavior of this function, use a type application:
--
-- >>> hzToPeriod @Natural 240e6
-- 4166
--
-- * __NB__: This function is not synthesizable
-- * __NB__: This function is lossy. I.e., @periodToHz . hzToPeriod /= id@.
hzToPeriod :: (HasCallStack, Integral a) => Ratio Natural -> a
hzToPeriod :: Ratio Natural -> a
hzToPeriod Ratio Natural
freq
  | Ratio Natural
freq Ratio Natural -> Ratio Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Ratio Natural
0  = Ratio Natural -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Ratio Natural
1.0 Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Fractional a => a -> a -> a
/ Ratio Natural
freq) Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Fractional a => a -> a -> a
/ Ratio Natural
1e-12)
  | Bool
otherwise = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error String
"Zero frequency"

-- | Calculate the period in __fs__, given a frequency in __Hz__
--
-- I.e., to calculate the clock period for a circuit to run at 240 MHz we get
--
-- >>> hzToFs 240e6
-- Femtoseconds 4166666
--
-- If the value @hzToFs@ is applied to is not of the type 'Ratio' 'Natural', you
-- can use @hzToFs ('realToFrac' f)@. Note that if @f@ is negative, @realToFrac@
-- will give an @'Control.Exception.Underflow' ::
-- t'Control.Exception.ArithException'@ without a call stack, making debugging
-- cumbersome.
--
-- * __NB__: This function is not synthesizable
-- * __NB__: This function is lossy. I.e.,  @fsToHz . hzToFs /= id@.
hzToFs :: HasCallStack => Ratio Natural -> Femtoseconds
hzToFs :: Ratio Natural -> Femtoseconds
hzToFs Ratio Natural
freq
  | Ratio Natural
freq Ratio Natural -> Ratio Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Ratio Natural
0  = Int64 -> Femtoseconds
Femtoseconds (Ratio Natural -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Ratio Natural
1.0 Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Fractional a => a -> a -> a
/ Ratio Natural
freq) Ratio Natural -> Ratio Natural -> Ratio Natural
forall a. Fractional a => a -> a -> a
/ Ratio Natural
1e-15))
  | Bool
otherwise = (HasCallStack => Femtoseconds) -> Femtoseconds
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Femtoseconds) -> Femtoseconds)
-> (HasCallStack => Femtoseconds) -> Femtoseconds
forall a b. (a -> b) -> a -> b
$ String -> Femtoseconds
forall a. HasCallStack => String -> a
error String
"Zero frequency"

-- | Calculate the frequency in __Hz__, given the period in __ps__
--
-- I.e., to calculate the clock frequency of a clock with a period of 5000 ps:
--
-- >>> periodToHz 5000
-- 2.0e8
--
-- Note that if @p@ in @periodToHz ('fromIntegral' p)@ is negative,
-- @fromIntegral@ will give an @'Control.Exception.Underflow' ::
-- t'Control.Exception.ArithException'@ without a call stack, making debugging
-- cumbersome.
--
-- Before Clash 1.8, this function always returned a 'Ratio'
-- 'Natural'. To get the old behavior of this function, use a type application:
--
-- >>> periodToHz @(Ratio Natural) 5000
-- 200000000 % 1
--
-- __NB__: This function is not synthesizable
periodToHz :: (HasCallStack, Fractional a) => Natural -> a
periodToHz :: Natural -> a
periodToHz Natural
period
  | Natural
period Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Rational
1.0 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
period Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1e-12)
  | Bool
otherwise  = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error String
"Zero period"

-- | Calculate the frequency in __Hz__, given the period in __fs__
--
-- I.e., to calculate the clock frequency of a clock with a period of 5000 fs:
--
-- >>> fsToHz (Femtoseconds 5000)
-- 2.0e11
--
-- __NB__: This function is not synthesizable
fsToHz :: (HasCallStack, Fractional a) => Femtoseconds -> a
fsToHz :: Femtoseconds -> a
fsToHz (Femtoseconds Int64
period)
  | Int64
period Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Rational
1.0 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
period Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1e-15)
  | Bool
otherwise  = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error String
"Zero period"

-- | Build an 'Automaton' from a function over 'Signal's.
--
-- __NB__: Consumption of continuation of the 'Automaton' must be affine; that
-- is, you can only apply the continuation associated with a particular element
-- at most once.
signalAutomaton ::
  forall dom a b .
  (Signal dom a -> Signal dom b) -> Automaton (->) a b
signalAutomaton :: (Signal dom a -> Signal dom b) -> Automaton (->) a b
signalAutomaton Signal dom a -> Signal dom b
dut = (a -> (b, Automaton (->) a b)) -> Automaton (->) a b
forall (a :: Type -> Type -> Type) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a -> (b, Automaton (->) a b)) -> Automaton (->) a b)
-> (a -> (b, Automaton (->) a b)) -> Automaton (->) a b
forall a b. (a -> b) -> a -> b
$ \a
input0 -> IO (b, Automaton (->) a b) -> (b, Automaton (->) a b)
forall a. IO a -> a
unsafePerformIO (IO (b, Automaton (->) a b) -> (b, Automaton (->) a b))
-> IO (b, Automaton (->) a b) -> (b, Automaton (->) a b)
forall a b. (a -> b) -> a -> b
$ do
  Signal dom (IORef (Maybe a))
inputRefs <- Maybe a -> IO (Signal dom (IORef (Maybe a)))
forall a (dom :: Domain). a -> IO (Signal dom (IORef a))
infiniteRefList Maybe a
forall a. Maybe a
Nothing
  let inputs :: Signal dom a
inputs = a
input0 a -> Signal dom a -> Signal dom a
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- (IORef (Maybe a) -> a)
-> Signal dom (IORef (Maybe a)) -> Signal dom a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef (Maybe a) -> a
forall a. IORef (Maybe a) -> a
readInput Signal dom (IORef (Maybe a))
inputRefs
      readInput :: IORef (Maybe a) -> a
readInput IORef (Maybe a)
ref = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
        Maybe a
val <- IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
ref
        case Maybe a
val of
          Maybe a
Nothing -> String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"signalAutomaton: non-affine use of continuation"
          Just a
x  -> a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
x

  let go :: Signal dom (IORef (Maybe a))
-> Signal dom b -> IO (b, Automaton (->) a b)
go (IORef (Maybe a)
inRef :- Signal dom (IORef (Maybe a))
inRefs) (b
out :- Signal dom b
rest) = do
        let next :: Automaton (->) a b
            next :: Automaton (->) a b
next = (a -> (b, Automaton (->) a b)) -> Automaton (->) a b
forall (a :: Type -> Type -> Type) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a -> (b, Automaton (->) a b)) -> Automaton (->) a b)
-> (a -> (b, Automaton (->) a b)) -> Automaton (->) a b
forall a b. (a -> b) -> a -> b
$ \a
i -> IO (b, Automaton (->) a b) -> (b, Automaton (->) a b)
forall a. IO a -> a
unsafePerformIO (IO (b, Automaton (->) a b) -> (b, Automaton (->) a b))
-> IO (b, Automaton (->) a b) -> (b, Automaton (->) a b)
forall a b. (a -> b) -> a -> b
$ do
              Maybe a
old <- IORef (Maybe a) -> (Maybe a -> (Maybe a, Maybe a)) -> IO (Maybe a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Maybe a)
inRef (\Maybe a
old -> (a -> Maybe a
forall a. a -> Maybe a
Just a
i,Maybe a
old))
              case Maybe a
old of
                Maybe a
Nothing -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
                Just a
_  -> String -> IO ()
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"signalAutomaton: non-affine use of continuation"
              IO (b, Automaton (->) a b) -> IO (b, Automaton (->) a b)
forall a. IO a -> IO a
unsafeInterleaveIO (Signal dom (IORef (Maybe a))
-> Signal dom b -> IO (b, Automaton (->) a b)
go Signal dom (IORef (Maybe a))
inRefs Signal dom b
rest)
        (b, Automaton (->) a b) -> IO (b, Automaton (->) a b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
out, Automaton (->) a b
next)

  Signal dom (IORef (Maybe a))
-> Signal dom b -> IO (b, Automaton (->) a b)
go Signal dom (IORef (Maybe a))
inputRefs (Signal dom a -> Signal dom b
dut Signal dom a
inputs)
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE signalAutomaton #-}

infiniteRefList :: a -> IO (Signal dom (IORef a))
infiniteRefList :: a -> IO (Signal dom (IORef a))
infiniteRefList a
val = IO (Signal dom (IORef a))
go
 where
  go :: IO (Signal dom (IORef a))
go = do
    Signal dom (IORef a)
rest <- IO (Signal dom (IORef a)) -> IO (Signal dom (IORef a))
forall a. IO a -> IO a
unsafeInterleaveIO IO (Signal dom (IORef a))
go
    IORef a
ref  <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
val
    Signal dom (IORef a) -> IO (Signal dom (IORef a))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IORef a
ref IORef a -> Signal dom (IORef a) -> Signal dom (IORef a)
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Signal dom (IORef a)
rest)

data ClockAB
  -- | Clock edge A produced
  = ClockA
  -- | Clock edge B produced
  | ClockB
  -- | Clock edges coincided
  | ClockAB
  deriving ((forall x. ClockAB -> Rep ClockAB x)
-> (forall x. Rep ClockAB x -> ClockAB) -> Generic ClockAB
forall x. Rep ClockAB x -> ClockAB
forall x. ClockAB -> Rep ClockAB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClockAB x -> ClockAB
$cfrom :: forall x. ClockAB -> Rep ClockAB x
Generic, ClockAB -> ClockAB -> Bool
(ClockAB -> ClockAB -> Bool)
-> (ClockAB -> ClockAB -> Bool) -> Eq ClockAB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockAB -> ClockAB -> Bool
$c/= :: ClockAB -> ClockAB -> Bool
== :: ClockAB -> ClockAB -> Bool
$c== :: ClockAB -> ClockAB -> Bool
Eq, Int -> ClockAB -> ShowS
[ClockAB] -> ShowS
ClockAB -> String
(Int -> ClockAB -> ShowS)
-> (ClockAB -> String) -> ([ClockAB] -> ShowS) -> Show ClockAB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockAB] -> ShowS
$cshowList :: [ClockAB] -> ShowS
show :: ClockAB -> String
$cshow :: ClockAB -> String
showsPrec :: Int -> ClockAB -> ShowS
$cshowsPrec :: Int -> ClockAB -> ShowS
Show, ClockAB -> ()
(ClockAB -> ()) -> NFData ClockAB
forall a. (a -> ()) -> NFData a
rnf :: ClockAB -> ()
$crnf :: ClockAB -> ()
NFData, HasCallStack => String -> ClockAB
ClockAB -> Bool
ClockAB -> ()
ClockAB -> ClockAB
(HasCallStack => String -> ClockAB)
-> (ClockAB -> Bool)
-> (ClockAB -> ClockAB)
-> (ClockAB -> ())
-> NFDataX ClockAB
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: ClockAB -> ()
$crnfX :: ClockAB -> ()
ensureSpine :: ClockAB -> ClockAB
$censureSpine :: ClockAB -> ClockAB
hasUndefined :: ClockAB -> Bool
$chasUndefined :: ClockAB -> Bool
deepErrorX :: String -> ClockAB
$cdeepErrorX :: HasCallStack => String -> ClockAB
NFDataX)

-- | Given two clocks, produce a list of clock ticks indicating which clock
-- (or both) ticked. Can be used in components handling multiple clocks, such
-- as @unsafeSynchronizer@ or dual clock FIFOs.
--
-- If your primitive does not care about coincided clock edges, it should - by
-- convention - replace it by @ClockB:ClockA:@.
clockTicks ::
  (KnownDomain domA, KnownDomain domB) =>
  Clock domA ->
  Clock domB ->
  [ClockAB]
clockTicks :: Clock domA -> Clock domB -> [ClockAB]
clockTicks Clock domA
clkA Clock domB
clkB = Either Int64 (Signal domA Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Either Int64 (Signal domA Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
clockTicksEither (Clock domA -> Either Int64 (Signal domA Int64)
forall (dom :: Domain).
KnownDomain dom =>
Clock dom -> Either Int64 (Signal dom Int64)
toEither Clock domA
clkA) (Clock domB -> Either Int64 (Signal domB Int64)
forall (dom :: Domain).
KnownDomain dom =>
Clock dom -> Either Int64 (Signal dom Int64)
toEither Clock domB
clkB)
 where
  toEither ::
    forall dom.
    KnownDomain dom =>
    Clock dom ->
    Either Int64 (Signal dom Int64)
  toEither :: Clock dom -> Either Int64 (Signal dom Int64)
toEither (Clock SSymbol dom
_ Maybe (Signal dom Femtoseconds)
maybePeriods)
    | Just Signal dom Femtoseconds
periods <- Maybe (Signal dom Femtoseconds)
maybePeriods =
        Signal dom Int64 -> Either Int64 (Signal dom Int64)
forall a b. b -> Either a b
Right (Signal dom Femtoseconds -> Signal dom Int64
forall (dom :: Domain). Signal dom Femtoseconds -> Signal dom Int64
unFemtosecondsSignal Signal dom Femtoseconds
periods)
    | SDomainConfiguration{SNat period
sPeriod :: SNat period
sPeriod :: forall (dom :: Domain) (period :: Nat) (edge :: ActiveEdge)
       (reset :: ResetKind) (init :: InitBehavior)
       (polarity :: ResetPolarity).
SDomainConfiguration
  dom ('DomainConfiguration dom period edge reset init polarity)
-> SNat period
sPeriod} <- KnownDomain dom => SDomainConfiguration dom (KnownConf dom)
forall (dom :: Domain).
KnownDomain dom =>
SDomainConfiguration dom (KnownConf dom)
knownDomain @dom =
        -- Convert to femtoseconds - dynamic clocks use them
        Int64 -> Either Int64 (Signal dom Int64)
forall a b. a -> Either a b
Left (Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* SNat period -> Int64
forall a (n :: Nat). Num a => SNat n -> a
snatToNum SNat period
sPeriod)

  -- Coerce whole signal instead of `fmap coerce` to prevent useless constructor
  -- packing and unpacking.
  unFemtosecondsSignal :: forall dom . Signal dom Femtoseconds -> Signal dom Int64
  unFemtosecondsSignal :: Signal dom Femtoseconds -> Signal dom Int64
unFemtosecondsSignal = Signal dom Femtoseconds -> Signal dom Int64
coerce

-- | Given two clock periods, produce a list of clock ticks indicating which clock
-- (or both) ticked. Can be used in components handling multiple clocks, such
-- as @unsafeSynchronizer@ or dual clock FIFOs.
--
-- If your primitive does not care about coincided clock edges, it should - by
-- convention - replace it by @ClockB:ClockA:@.
clockTicksEither ::
  Either Int64 (Signal domA Int64) ->
  Either Int64 (Signal domB Int64) ->
  [ClockAB]
clockTicksEither :: Either Int64 (Signal domA Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
clockTicksEither Either Int64 (Signal domA Int64)
clkA Either Int64 (Signal domB Int64)
clkB =
  case (Either Int64 (Signal domA Int64)
clkA, Either Int64 (Signal domB Int64)
clkB) of
    (Left  Int64
tA, Left  Int64
tB) | Int64
tA Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
tB -> ClockAB -> [ClockAB]
forall a. a -> [a]
repeat ClockAB
ClockAB
    (Left  Int64
tA, Left  Int64
tB) -> Int64 -> Int64 -> Int64 -> [ClockAB]
goStatic Int64
0 Int64
tA Int64
tB
    (Right Signal domA Int64
tA, Right Signal domB Int64
tB) -> Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
goDynamic Int64
0 Signal domA Int64
tA Signal domB Int64
tB
    (Left  Int64
tA, Right Signal domB Int64
tB) -> Either Int64 (Signal Any Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Either Int64 (Signal domA Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
clockTicksEither (Signal Any Int64 -> Either Int64 (Signal Any Int64)
forall a b. b -> Either a b
Right (Int64 -> Signal Any Int64
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int64
tA)) (Signal domB Int64 -> Either Int64 (Signal domB Int64)
forall a b. b -> Either a b
Right Signal domB Int64
tB)
    (Right Signal domA Int64
tA, Left  Int64
tB) -> Either Int64 (Signal domA Int64)
-> Either Int64 (Signal Any Int64) -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Either Int64 (Signal domA Int64)
-> Either Int64 (Signal domB Int64) -> [ClockAB]
clockTicksEither (Signal domA Int64 -> Either Int64 (Signal domA Int64)
forall a b. b -> Either a b
Right Signal domA Int64
tA) (Signal Any Int64 -> Either Int64 (Signal Any Int64)
forall a b. b -> Either a b
Right (Int64 -> Signal Any Int64
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int64
tB))
 where
  -- Given
  --   tAbsA = absolute time of next active edge of clock A
  --   tAbsB = absolute time of next active edge of clock B
  -- relativeTime is defined as relativeTime = tAbsB - tAbsA
  --
  -- Put differently, relative time 0 points at the next active edge of
  -- clock A, and relativeTime points at the next active edge of clock B.

  goStatic :: Int64 -> Int64 -> Int64 -> [ClockAB]
  goStatic :: Int64 -> Int64 -> Int64 -> [ClockAB]
goStatic Int64
relativeTime Int64
tA Int64
tB =
    case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
relativeTime Int64
0 of
      Ordering
LT -> ClockAB
ClockB  ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Int64 -> Int64 -> [ClockAB]
goStatic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tB)      Int64
tA Int64
tB
      Ordering
EQ -> ClockAB
ClockAB ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Int64 -> Int64 -> [ClockAB]
goStatic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
tA Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tB) Int64
tA Int64
tB
      Ordering
GT -> ClockAB
ClockA  ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Int64 -> Int64 -> [ClockAB]
goStatic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
tA)      Int64
tA Int64
tB

  goDynamic :: Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
  goDynamic :: Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
goDynamic Int64
relativeTime tsA :: Signal domA Int64
tsA@(~(Int64
tA :- Signal domA Int64
tsA0)) tsB :: Signal domB Int64
tsB@(~(Int64
tB :- Signal domB Int64
tsB0)) =
    -- Even though we lazily match on the signal's constructor, this shouldn't
    -- build up a significant chain of chunks as 'relativeTime' gets evaluated
    -- every iteration.
    case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
relativeTime Int64
0 of
      Ordering
LT -> ClockAB
ClockB  ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
goDynamic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tB)      Signal domA Int64
tsA  Signal domB Int64
tsB0
      Ordering
EQ -> ClockAB
ClockAB ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
goDynamic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
tA Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tB) Signal domA Int64
tsA0 Signal domB Int64
tsB0
      Ordering
GT -> ClockAB
ClockA  ClockAB -> [ClockAB] -> [ClockAB]
forall a. a -> [a] -> [a]
: Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
forall (domA :: Domain) (domB :: Domain).
Int64 -> Signal domA Int64 -> Signal domB Int64 -> [ClockAB]
goDynamic (Int64
relativeTime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
tA)      Signal domA Int64
tsA0 Signal domB Int64
tsB