{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Clash.Intel.DDR
( altddioIn
, altddioOut
)
where
import GHC.Stack (HasCallStack, withFrozenCallStack)
import Clash.Annotations.Primitive (hasBlackBox)
import Clash.Explicit.Prelude
import Clash.Explicit.DDR
altddioIn
:: forall fast fPeriod edge reset init polarity slow m deviceFamily
. ( HasCallStack
, KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity)
, KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity)
, KnownNat m )
=> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m,BitVector m)
altddioIn :: forall (fast :: Domain) (fPeriod :: Nat) (edge :: ActiveEdge)
(reset :: ResetKind) (init :: InitBehavior)
(polarity :: ResetPolarity) (slow :: Domain) (m :: Nat)
(deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast ('DomainConfiguration fast fPeriod edge reset init polarity),
KnownConfiguration
slow
('DomainConfiguration slow (2 * fPeriod) edge reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
altddioIn =
case forall (dom :: Domain) (edge :: ActiveEdge).
(KnownDomain dom, DomainActiveEdge dom ~ edge) =>
SActiveEdge edge
activeEdge @slow of
SActiveEdge edge
SRising ->
(HasCallStack =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m))
-> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
forall (fast :: Domain) (fPeriod :: Nat) (reset :: ResetKind)
(init :: InitBehavior) (polarity :: ResetPolarity) (slow :: Domain)
(m :: Nat) (deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast
('DomainConfiguration fast fPeriod 'Rising reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) 'Rising reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
altddioIn#
SActiveEdge edge
SFalling ->
String
-> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
forall a. HasCallStack => String -> a
clashCompileError
String
"altddioIn: Primitive only supports rising active edge"
altddioIn#
:: ( HasCallStack
, KnownConfiguration fast ('DomainConfiguration fast fPeriod 'Rising reset init polarity)
, KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) 'Rising reset init polarity)
, KnownNat m )
=> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m,BitVector m)
altddioIn# :: forall (fast :: Domain) (fPeriod :: Nat) (reset :: ResetKind)
(init :: InitBehavior) (polarity :: ResetPolarity) (slow :: Domain)
(m :: Nat) (deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast
('DomainConfiguration fast fPeriod 'Rising reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) 'Rising reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
altddioIn# SSymbol deviceFamily
SSymbol Clock slow
clk Reset slow
rst Enable slow
en = (HasCallStack =>
Clock slow
-> Reset slow
-> Enable slow
-> BitVector m
-> BitVector m
-> BitVector m
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m))
-> Clock slow
-> Reset slow
-> Enable slow
-> BitVector m
-> BitVector m
-> BitVector m
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack =>
Clock slow
-> Reset slow
-> Enable slow
-> BitVector m
-> BitVector m
-> BitVector m
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
Clock slow
-> Reset slow
-> Enable slow
-> BitVector m
-> BitVector m
-> BitVector m
-> Signal fast (BitVector m)
-> Signal slow (BitVector m, BitVector m)
forall a (slow :: Domain) (fast :: Domain) (fPeriod :: Nat)
(polarity :: ResetPolarity) (edge :: ActiveEdge)
(reset :: ResetKind) (init :: InitBehavior).
(HasCallStack, NFDataX a,
KnownConfiguration
fast ('DomainConfiguration fast fPeriod edge reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) edge reset init polarity)) =>
Clock slow
-> Reset slow
-> Enable slow
-> a
-> a
-> a
-> Signal fast a
-> Signal slow (a, a)
ddrIn# Clock slow
clk Reset slow
rst Enable slow
en BitVector m
0 BitVector m
0 BitVector m
0
{-# CLASH_OPAQUE altddioIn# #-}
{-# ANN altddioIn# hasBlackBox #-}
altddioOut
:: forall fast fPeriod edge reset init polarity slow m deviceFamily
. ( HasCallStack
, KnownConfiguration fast ('DomainConfiguration fast fPeriod edge reset init polarity)
, KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) edge reset init polarity)
, KnownNat m )
=> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m,BitVector m)
-> Signal fast (BitVector m)
altddioOut :: forall (fast :: Domain) (fPeriod :: Nat) (edge :: ActiveEdge)
(reset :: ResetKind) (init :: InitBehavior)
(polarity :: ResetPolarity) (slow :: Domain) (m :: Nat)
(deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast ('DomainConfiguration fast fPeriod edge reset init polarity),
KnownConfiguration
slow
('DomainConfiguration slow (2 * fPeriod) edge reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m, BitVector m)
-> Signal fast (BitVector m)
altddioOut SSymbol deviceFamily
devFam Clock slow
clk Reset slow
rst Enable slow
en =
case forall (dom :: Domain) (edge :: ActiveEdge).
(KnownDomain dom, DomainActiveEdge dom ~ edge) =>
SActiveEdge edge
activeEdge @slow of
SActiveEdge edge
SRising ->
(Signal slow (BitVector m)
-> Signal slow (BitVector m) -> Signal fast (BitVector m))
-> (Signal slow (BitVector m), Signal slow (BitVector m))
-> Signal fast (BitVector m)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((HasCallStack =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m))
-> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
forall (fast :: Domain) (fPeriod :: Nat) (reset :: ResetKind)
(init :: InitBehavior) (polarity :: ResetPolarity) (slow :: Domain)
(m :: Nat) (deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast
('DomainConfiguration fast fPeriod 'Rising reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) 'Rising reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
altddioOut# SSymbol deviceFamily
devFam Clock slow
clk Reset slow
rst Enable slow
en) ((Signal slow (BitVector m), Signal slow (BitVector m))
-> Signal fast (BitVector m))
-> (Signal slow (BitVector m, BitVector m)
-> (Signal slow (BitVector m), Signal slow (BitVector m)))
-> Signal slow (BitVector m, BitVector m)
-> Signal fast (BitVector m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal slow (BitVector m, BitVector m)
-> (Signal slow (BitVector m), Signal slow (BitVector m))
Signal slow (BitVector m, BitVector m)
-> Unbundled slow (BitVector m, BitVector m)
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
forall (dom :: Domain).
Signal dom (BitVector m, BitVector m)
-> Unbundled dom (BitVector m, BitVector m)
unbundle
SActiveEdge edge
SFalling ->
String
-> Signal slow (BitVector m, BitVector m)
-> Signal fast (BitVector m)
forall a. HasCallStack => String -> a
clashCompileError
String
"altddioOut: Primitive only supports rising active edge"
altddioOut#
:: ( HasCallStack
, KnownConfiguration fast ('DomainConfiguration fast fPeriod 'Rising reset init polarity)
, KnownConfiguration slow ('DomainConfiguration slow (2*fPeriod) 'Rising reset init polarity)
, KnownNat m )
=> SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
altddioOut# :: forall (fast :: Domain) (fPeriod :: Nat) (reset :: ResetKind)
(init :: InitBehavior) (polarity :: ResetPolarity) (slow :: Domain)
(m :: Nat) (deviceFamily :: Domain).
(HasCallStack,
KnownConfiguration
fast
('DomainConfiguration fast fPeriod 'Rising reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) 'Rising reset init polarity),
KnownNat m) =>
SSymbol deviceFamily
-> Clock slow
-> Reset slow
-> Enable slow
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
altddioOut# SSymbol deviceFamily
SSymbol Clock slow
clk Reset slow
rst Enable slow
en = Clock slow
-> Reset slow
-> Enable slow
-> BitVector m
-> Signal slow (BitVector m)
-> Signal slow (BitVector m)
-> Signal fast (BitVector m)
forall a (fast :: Domain) (fPeriod :: Nat) (edge :: ActiveEdge)
(reset :: ResetKind) (init :: InitBehavior)
(polarity :: ResetPolarity) (slow :: Domain).
(HasCallStack, NFDataX a,
KnownConfiguration
fast ('DomainConfiguration fast fPeriod edge reset init polarity),
KnownConfiguration
slow
('DomainConfiguration
slow (2 * fPeriod) edge reset init polarity)) =>
Clock slow
-> Reset slow
-> Enable slow
-> a
-> Signal slow a
-> Signal slow a
-> Signal fast a
ddrOut# Clock slow
clk Reset slow
rst Enable slow
en BitVector m
0
{-# CLASH_OPAQUE altddioOut# #-}
{-# ANN altddioOut# hasBlackBox #-}