{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Clash.Signal.Internal.Ambiguous
( knownVDomain
, clockPeriod
, activeEdge
, resetKind
, initBehavior
, resetPolarity
) where
import Clash.Signal.Internal
import Clash.Promoted.Nat (SNat)
clockPeriod
:: forall dom period
. (KnownDomain dom, DomainPeriod dom ~ period)
=> SNat period
clockPeriod =
case knownDomain @dom of
SDomainConfiguration _dom period _edge _sync _init _polarity ->
period
{-# NOINLINE clockPeriod #-}
activeEdge
:: forall dom edge
. (KnownDomain dom, DomainActiveEdge dom ~ edge)
=> SActiveEdge edge
activeEdge =
case knownDomain @dom of
SDomainConfiguration _dom _period edge _sync _init _polarity ->
edge
{-# NOINLINE activeEdge #-}
resetKind
:: forall dom sync
. (KnownDomain dom, DomainResetKind dom ~ sync)
=> SResetKind sync
resetKind =
case knownDomain @dom of
SDomainConfiguration _dom _period _edge sync _init _polarity ->
sync
{-# NOINLINE resetKind #-}
initBehavior
:: forall dom init
. (KnownDomain dom, DomainInitBehavior dom ~ init)
=> SInitBehavior init
initBehavior =
case knownDomain @dom of
SDomainConfiguration _dom _period _edge _sync init_ _polarity ->
init_
{-# NOINLINE initBehavior #-}
resetPolarity
:: forall dom polarity
. (KnownDomain dom, DomainResetPolarity dom ~ polarity)
=> SResetPolarity polarity
resetPolarity =
case knownDomain @dom of
SDomainConfiguration _dom _period _edge _sync _init polarity ->
polarity
{-# NOINLINE resetPolarity #-}
knownVDomain
:: forall dom
. KnownDomain dom
=> VDomainConfiguration
knownVDomain =
vDomain (knownDomain @dom)