Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove KnownDomain preparation #2590

Merged
merged 6 commits into from
Nov 2, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
ADDED: You can now use ~PERIOD, ~ISSYNC, ~ISINITDEFINED and ~ACTIVEEDGE
on arguments of type Clock,Reset,Enable,ClockN and DiffClock.

CHANGED: unsafeToReset and invertReset now have a KnownDomain constraint
This was done in preparation for [Remove KnownDomain #2589](https://github.com/clash-lang/clash-compiler/pull/2589)
Original file line number Diff line number Diff line change
Expand Up @@ -178,7 +178,7 @@ dcFifoBBTF DcConfig{..} bbCtx
let domty = DSL.ety knownDomainWrite
in case stripVoid domty of
N.KnownDomain _ _ _ Synchronous _ _ ->
DSL.unsafeToActiveHigh "wr_rst_high" domty wRst
DSL.unsafeToActiveHigh "wr_rst_high" wRst
N.KnownDomain _ _ _ Asynchronous _ _ ->
error $
show 'dcFifoTF <> ": dcFifo only supports synchronous resets"
Expand All @@ -190,7 +190,7 @@ dcFifoBBTF DcConfig{..} bbCtx
let domty = DSL.ety knownDomainRead
in case stripVoid domty of
N.KnownDomain _ _ _ Synchronous _ _ ->
DSL.unsafeToActiveHigh "rd_rst_high" domty rRst
DSL.unsafeToActiveHigh "rd_rst_high" rRst
N.KnownDomain _ _ _ Asynchronous _ _ ->
error $
show 'dcFifoTF <> ": dcFifo only supports synchronous resets"
Expand Down
1 change: 0 additions & 1 deletion clash-lib/clash-lib.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -359,7 +359,6 @@ executable static-files
docopt ^>= 0.7,
extra,
filepath
Other-Modules: Paths_clash_lib
GHC-Options: -Wall -Wcompat
default-language: Haskell2010
if impl(ghc >= 9.2.0)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,6 @@
name: Clash.Signal.Internal.unsafeToReset
kind: Expression
type: 'unsafeToReset ::
Signal dom Bool -> Reset dom'
template: ~ARG[0]
KnownDomain dom => Signal dom Bool -> Reset dom'
template: ~ARG[1]
workInfo: Never
4 changes: 2 additions & 2 deletions clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -230,6 +230,6 @@
name: Clash.Signal.Internal.unsafeToReset
kind: Declaration
type: 'unsafeToReset ::
Signal dom Bool -> Reset dom'
template: ~RESULT <= '1' when ~ARG[0] = true else '0';
KnownDomain dom => Signal dom Bool -> Reset dom'
template: ~RESULT <= '1' when ~ARG[1] = true else '0';
workInfo: Never
134 changes: 82 additions & 52 deletions clash-lib/src/Clash/Netlist/BlackBox/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,15 +57,15 @@ import Text.Read (readEither)
import Text.Trifecta.Result hiding (Err)

import Clash.Backend
(Backend (..), Usage (..), AggressiveXOptBB(..), RenderEnums(..))
(Backend (..), DomainMap, Usage (..), AggressiveXOptBB(..), RenderEnums(..))
import Clash.Netlist.BlackBox.Parser
import Clash.Netlist.BlackBox.Types
import Clash.Netlist.Types
(BlackBoxContext (..), Expr (..), HWType (..), Literal (..), Modifier (..),
Declaration(BlackBoxD))
import qualified Clash.Netlist.Id as Id
import qualified Clash.Netlist.Types as N
import Clash.Netlist.Util (typeSize, isVoid, stripVoid)
import Clash.Netlist.Util (typeSize, isVoid, stripAttributes, stripVoid)
import Clash.Signal.Internal
(ResetKind(..), ResetPolarity(..), InitBehavior(..), VDomainConfiguration (..))
import Clash.Util
Expand Down Expand Up @@ -185,10 +185,11 @@ verifyBlackBoxContext bbCtx (N.BBTemplate t) =
Just n ->
case indexMaybe (bbInputs bbCtx) n of
Just _ -> Nothing
Nothing ->
Just ( "Blackbox required at least " ++ show (n+1)
++ " arguments, but only " ++ show (length (bbInputs bbCtx))
++ " were passed." )
Nothing -> do
let str = fromJust (fmap Text.unpack (getAp $ prettyElem e))
Just ( "Blackbox used \"" ++ str ++ "\""
++ ", but only " ++ show (length (bbInputs bbCtx))
++ " arguments were passed." )

extractLiterals :: BlackBoxContext
-> [Expr]
Expand Down Expand Up @@ -492,20 +493,20 @@ renderElem b (IF c t f) = do
syn <- hdlSyn
enums <- renderEnums
xOpt <- aggressiveXOptBB
let c' = check (coerce xOpt) iw hdl syn enums c
c' <- check (coerce xOpt) iw hdl syn enums c
if c' > 0 then renderTemplate b t else renderTemplate b f
where
check :: Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element -> Int
check :: Backend backend => Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element -> State backend Int
check xOpt iw hdl syn enums c' = case c' of
(Size e) -> typeSize (lineToType b [e])
(Length e) -> case lineToType b [e] of
(Size e) -> pure $ typeSize (lineToType b [e])
(Length e) -> pure $ case lineToType b [e] of
(Vector n _) -> n
Void (Just (Vector n _)) -> n
(MemBlob n _) -> n
Void (Just (MemBlob n _)) -> n
_ -> 0 -- HACK: So we can test in splitAt if one of the
-- vectors in the tuple had a zero length
(Lit n) -> case bbInputs b !! n of
(Lit n) -> pure $ case bbInputs b !! n of
(l,_,_)
| Literal _ l' <- l ->
case l' of
Expand Down Expand Up @@ -533,16 +534,16 @@ renderElem b (IF c t f) = do
, [Literal _ (NumLit j)] <- extractLiterals bbCtx
-> fromInteger j
k -> error $ $(curLoc) ++ ("IF: LIT must be a numeric lit:" ++ show k)
(Depth e) -> case lineToType b [e] of
(Depth e) -> pure $ case lineToType b [e] of
(RTree n _) -> n
_ -> error $ $(curLoc) ++ "IF: treedepth of non-tree type"
IW64 -> if iw == 64 then 1 else 0
(HdlSyn s) -> if s == syn then 1 else 0
(IsVar n) -> let (e,_,_) = bbInputs b !! n
IW64 -> pure $ if iw == 64 then 1 else 0
(HdlSyn s) -> pure $ if s == syn then 1 else 0
(IsVar n) -> pure $ let (e,_,_) = bbInputs b !! n
in case e of
Identifier _ Nothing -> 1
_ -> 0
(IsLit n) -> let (e,_,_) = bbInputs b !! n
(IsLit n) -> pure $ let (e,_,_) = bbInputs b !! n
in case e of
DataCon {} -> 1
Literal {} -> 1
Expand All @@ -556,13 +557,13 @@ renderElem b (IF c t f) = do
RenderEnums True -> 1
RenderEnums False -> 0
isScalar _ _ = 0
in isScalar hdl ty
in pure $ isScalar hdl ty

(IsUndefined n) ->
(IsUndefined n) -> pure $
let (e, _, _) = bbInputs b !! n
in if xOpt && checkUndefined e then 1 else 0

(IsActiveEnable n) ->
(IsActiveEnable n) -> pure $
let (e, ty, _) = bbInputs b !! n in
case ty of
Enable _ ->
Expand All @@ -584,52 +585,81 @@ renderElem b (IF c t f) = do
_ ->
error $ $(curLoc) ++ "IsActiveEnable: Expected Bool or Enable, not: " ++ show ty

(ActiveEdge edgeRequested n) ->
let (_, ty, _) = bbInputs b !! n in
case stripVoid ty of
KnownDomain _ _ edgeActual _ _ _ ->
(ActiveEdge edgeRequested n) -> do
let (_, ty, _) = bbInputs b !! n
domConf <- getDomainConf ty
case domConf of
VDomainConfiguration _ _ edgeActual _ _ _ -> pure $
if edgeRequested == edgeActual then 1 else 0
_ ->
error $ $(curLoc) ++ "ActiveEdge: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty

(IsSync n) ->
let (_, ty, _) = bbInputs b !! n in
case stripVoid ty of
KnownDomain _ _ _ Synchronous _ _ -> 1
KnownDomain _ _ _ Asynchronous _ _ -> 0
_ -> error $ $(curLoc) ++ "IsSync: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty

(IsInitDefined n) ->
let (_, ty, _) = bbInputs b !! n in
case stripVoid ty of
KnownDomain _ _ _ _ Defined _ -> 1
KnownDomain _ _ _ _ Unknown _ -> 0
_ -> error $ $(curLoc) ++ "IsInitDefined: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty

(IsActiveHigh n) ->
let (_, ty, _) = bbInputs b !! n in
case stripVoid ty of
KnownDomain _ _ _ _ _ ActiveHigh -> 1
KnownDomain _ _ _ _ _ ActiveLow -> 0
_ -> error $ $(curLoc) ++ "IsActiveHigh: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty

(StrCmp [Text t1] n) ->

(IsSync n) -> do
let (_, ty, _) = bbInputs b !! n
domConf <- getDomainConf ty
case domConf of
VDomainConfiguration _ _ _ Synchronous _ _ -> pure 1
VDomainConfiguration _ _ _ Asynchronous _ _ -> pure 0

(IsInitDefined n) -> do
let (_, ty, _) = bbInputs b !! n
domConf <- getDomainConf ty
case domConf of
VDomainConfiguration _ _ _ _ Defined _ -> pure 1
VDomainConfiguration _ _ _ _ Unknown _ -> pure 0

(IsActiveHigh n) -> do
let (_, ty, _) = bbInputs b !! n
domConf <- getDomainConf ty
case domConf of
VDomainConfiguration _ _ _ _ _ ActiveHigh -> pure 1
VDomainConfiguration _ _ _ _ _ ActiveLow -> pure 0

(StrCmp [Text t1] n) -> pure $
let (e,_,_) = bbInputs b !! n
in case exprToString e of
Just t2
| t1 == Text.pack t2 -> 1
| otherwise -> 0
Nothing -> error $ $(curLoc) ++ "Expected a string literal: " ++ show e
(And es) -> if all (/=0) (map (check xOpt iw hdl syn enums) es)
(And es) -> do
es' <- mapM (check xOpt iw hdl syn enums) es
pure $ if all (/=0) es'
then 1
else 0
CmpLE e1 e2 -> if check xOpt iw hdl syn enums e1 <= check xOpt iw hdl syn enums e2
then 1
else 0
CmpLE e1 e2 -> do
v1 <- check xOpt iw hdl syn enums e1
v2 <- check xOpt iw hdl syn enums e2
if v1 <= v2
then pure 1
else pure 0
_ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGTH, LIT, DEPTH, IW64, VIVADO, OTHERSYN, ISVAR, ISLIT, ISUNDEFINED, ISACTIVEENABLE, ACTIVEEDGE, ISSYNC, ISINITDEFINED, ISACTIVEHIGH, STRCMP, AND, ISSCALAR or CMPLE."
++ "\nGot: " ++ show c'
renderElem b e = fmap const (renderTag b e)

getDomainConf :: (Backend backend, HasCallStack) => HWType -> State backend VDomainConfiguration
getDomainConf = generalGetDomainConf domainConfigurations

generalGetDomainConf
:: forall m. (Monad m, HasCallStack)
=> (m DomainMap) -- ^ a way to get the `DomainMap`
-> HWType -> m VDomainConfiguration
generalGetDomainConf getDomainMap ty = case (snd . stripAttributes . stripVoid) ty of
KnownDomain dom period activeEdge resetKind initBehavior resetPolarity ->
pure $ VDomainConfiguration (Data.Text.unpack dom) (fromIntegral period) activeEdge resetKind initBehavior resetPolarity

Clock dom -> go dom
ClockN dom -> go dom
Reset dom -> go dom
Enable dom -> go dom
Product _DiffClock _ [Clock dom,_clkN] -> go dom
t -> error $ "Don't know how to get a Domain out of HWType: " <> show t
where
go :: HasCallStack => N.DomainName -> m VDomainConfiguration
go dom = do
doms <- getDomainMap
case HashMap.lookup dom doms of
Nothing -> error $ "Can't find domain " <> show dom <> ". Please report an issue at https://github.com/clash-lang/clash-compiler/issues."
Just conf -> pure conf

parseFail :: Text -> BlackBoxTemplate
parseFail t = case runParse t of
Failure errInfo ->
Expand Down
33 changes: 19 additions & 14 deletions clash-lib/src/Clash/Primitives/DSL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -118,8 +118,8 @@ import Clash.Annotations.Primitive (HDL (..), Primitive (..))
import Clash.Annotations.SynthesisAttributes (Attr)
import Clash.Backend hiding (Usage, fromBV, toBV)
import Clash.Backend.VHDL (VHDLState)
import Clash.Explicit.Signal (ResetPolarity(..))
import Clash.Netlist.BlackBox.Util (exprToString, renderElem)
import Clash.Explicit.Signal (ResetPolarity(..), vResetPolarity)
import Clash.Netlist.BlackBox.Util (exprToString, getDomainConf, renderElem)
import Clash.Netlist.BlackBox.Types
(BlackBoxTemplate, Element(Component, Text), Decl(..))
import qualified Clash.Netlist.Id as Id
Expand Down Expand Up @@ -204,6 +204,17 @@ instance Backend backend => HasIdentifierSet (BlockState backend) where
instance HasUsageMap backend => HasUsageMap (BlockState backend) where
usageMap = bsBackend.usageMap

liftToBlockState
:: forall backend a. Backend backend
=> State backend a -> State (BlockState backend) a
liftToBlockState (StateT f) = StateT g
where
g :: BlockState backend -> Identity (a, BlockState backend)
g sbsIn = do
let sIn = _bsBackend sbsIn
(res,sOut) <- f sIn
pure (res, sbsIn{_bsBackend = sOut})

-- | A typed expression.
data TExpr = TExpr
{ ety :: HWType
Expand Down Expand Up @@ -1012,32 +1023,26 @@ unsafeToActiveHigh
:: Backend backend
=> Text
-- ^ Name hint
-> HWType
-- ^ 'KnownDomain'
-> TExpr
-- ^ Reset signal
-> State (BlockState backend) TExpr
unsafeToActiveHigh nm dom rExpr =
case extrResetPolarity dom of
unsafeToActiveHigh nm rExpr = do
resetLevel <- vResetPolarity <$> liftToBlockState (getDomainConf (ety rExpr))
case resetLevel of
ActiveHigh -> pure rExpr
ActiveLow -> notExpr nm rExpr

extrResetPolarity :: HWType -> ResetPolarity
extrResetPolarity (Void (Just (KnownDomain _ _ _ _ _ p))) = p
extrResetPolarity p = error ("Internal error: expected KnownDomain, got: " <> show p)

-- | Massage a reset to work as active-low reset.
unsafeToActiveLow
:: Backend backend
=> Text
-- ^ Name hint
-> HWType
-- ^ 'KnownDomain'
-> TExpr
-- ^ Reset signal
-> State (BlockState backend) TExpr
unsafeToActiveLow nm dom rExpr =
case extrResetPolarity dom of
unsafeToActiveLow nm rExpr = do
resetLevel <- vResetPolarity <$> liftToBlockState (getDomainConf (ety rExpr))
case resetLevel of
ActiveLow -> pure rExpr
ActiveHigh -> notExpr nm rExpr

Expand Down
8 changes: 4 additions & 4 deletions clash-lib/src/Clash/Primitives/Intel/ClockGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,9 +36,9 @@ import qualified Prettyprinter.Interpolate as I
data Variant = Altpll | AlteraPll

hdlUsed :: [Int]
hdlUsed = [ knownDomIn, clk, rst ]
hdlUsed = [ clk, rst ]
where
knownDomIn
_knownDomIn
:< _clocksClass
:< _clocksCxt
:< _numOutClocks
Expand Down Expand Up @@ -81,7 +81,7 @@ hdlTemplate ::
BlackBoxContext ->
State s Doc
hdlTemplate variant bbCtx
| [ knownDomIn
| [ _knownDomIn
, _clocksClass
, _clocksCxt
, _numOutClocks
Expand Down Expand Up @@ -110,7 +110,7 @@ hdlTemplate variant bbCtx

DSL.declarationReturn bbCtx (stdName variant <> "_block") $ do

rstHigh <- DSL.unsafeToActiveHigh "reset" (DSL.ety knownDomIn) rst
rstHigh <- DSL.unsafeToActiveHigh "reset" rst
pllOuts <- DSL.declareN "pllOut" pllOutTys
locked <- DSL.declare "locked" Bit
pllLock <- DSL.boolFromBit "pllLock" locked
Expand Down
4 changes: 2 additions & 2 deletions clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ clockWizardTemplate
-> BlackBoxContext
-> State s Doc
clockWizardTemplate isDifferential bbCtx
| [ knownDomIn
| [ _knownDomIn
, _clocksClass
, _clocksCxt
, _numOutClocks
Expand All @@ -79,7 +79,7 @@ clockWizardTemplate isDifferential bbCtx
clkWizInstName <- Id.makeBasic $ fromMaybe "clk_wiz" $ bbCtxName bbCtx
DSL.declarationReturn bbCtx blockName $ do

rstHigh <- DSL.unsafeToActiveHigh "reset" (DSL.ety knownDomIn) rst
rstHigh <- DSL.unsafeToActiveHigh "reset" rst
pllOuts <- DSL.declareN "pllOut" pllOutTys
locked <- DSL.declare "locked" Bit
pllLock <- DSL.boolFromBit "pllLock" locked
Expand Down
5 changes: 3 additions & 2 deletions clash-prelude/src/Clash/Signal/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1279,7 +1279,8 @@ unsafeFromReset (Reset r) = r
-- __NB__: You probably want to use 'unsafeFromActiveLow' or
-- 'unsafeFromActiveHigh'.
unsafeToReset
:: Signal dom Bool
:: KnownDomain dom
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The KnownDomain constraint is unused. Isn't GHC technically allowed to prune it?

Copy link
Member

@DigitalBrains1 DigitalBrains1 Oct 25, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that's okay here. As I understand it, this is purely to make the API change now already for 1.8.0 so we can change the implementation later on. So only the user-facing API is what matters here, GHC can prune it without problems. Once the underlying code changes, the constraint will be needed, and it will no longer be pruned.

Huh. Even in general I think it's okay if it is pruned. The constraint is only needed in Haskell, and GHC can do what it wants as long as the code continues to work. We worry about stuff being pruned because we'd like to access it during HDL generation, but HDL generation doesn't need the KnownDomain for this function, it's a wire, nothing more.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, yes, you're right

=> Signal dom Bool
-> Reset dom
unsafeToReset r = Reset r
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
Expand Down Expand Up @@ -1359,7 +1360,7 @@ unsafeFromActiveLow r =
SActiveLow -> r

-- | Invert reset signal
invertReset :: Reset dom -> Reset dom
invertReset :: KnownDomain dom => Reset dom -> Reset dom
invertReset = unsafeToReset . fmap not . unsafeFromReset

infixr 2 .||.
Expand Down
Loading
Loading