From 02015b0c6dd56a60e491f3d91096feae73453319 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 25 Sep 2023 17:47:18 +0200 Subject: [PATCH 01/27] Cleanup clash-lib.cabal --- clash-lib/clash-lib.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/clash-lib/clash-lib.cabal b/clash-lib/clash-lib.cabal index f4cfe61029..4dd65dc521 100644 --- a/clash-lib/clash-lib.cabal +++ b/clash-lib/clash-lib.cabal @@ -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) From 930f1ce49c5e6f3f0a9e2743e1b4c96cbe29e273 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Fri, 1 Sep 2023 14:45:28 +0200 Subject: [PATCH 02/27] Improve blackbox error message This changes the error when using non-existant arguments in blackboxes from: Blackbox required at least 32 arguments, but only 8 were passed. to the new error: Blackbox used "~ISSYNC[31]" , but only 8 arguments were passed. --- clash-lib/src/Clash/Netlist/BlackBox/Util.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index c79b4ddf2e..f879843d49 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -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] From 280dec1d9d70f90bbf5cac7a268640c098e658cd Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 11 Oct 2023 18:27:38 +0200 Subject: [PATCH 03/27] Refactor Test.Tasty.Clash So it'll be easier to keep the temp directory --- tests/src/Test/Tasty/Clash.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/tests/src/Test/Tasty/Clash.hs b/tests/src/Test/Tasty/Clash.hs index 768f430152..b3ca4a2a61 100644 --- a/tests/src/Test/Tasty/Clash.hs +++ b/tests/src/Test/Tasty/Clash.hs @@ -412,6 +412,9 @@ sbyTests opts@TestOptions {..} parentTmp = singleTest t (SbyVerificationTest expectVerificationFail parentTmp (dir t) t) dir = targetTempPath parentTmp "symbiyosys" +rmTmpDir :: FilePath -> IO () +rmTmpDir = Directory.removeDirectoryRecursive + runTest1 :: String -> TestOptions @@ -419,13 +422,13 @@ runTest1 -> HDL -> TestTree runTest1 modName opts@TestOptions{..} path target = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashTest tmpDir , testGroup "tools" (verifTests tmpDir : hdlTests tmpDir) ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashTest tmpDir = @@ -499,13 +502,13 @@ outputTest' -- one closest to the test. -> TestTree outputTest' modName target extraClashArgs extraGhcArgs path = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashGenHdl tmpDir , clashBuild tmpDir ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashGenHdl workDir = singleTest "clash (gen)" (ClashGenTest { @@ -556,12 +559,12 @@ clashLibTest' -- one closest to the test. -> TestTree clashLibTest' modName target extraGhcArgs path = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashBuild tmpDir ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashBuild workDir = singleTest "clash (exec)" (ClashBinaryTest { From b2d85ebbb09558a3fa0e78cc330073b0f3ebf82d Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Tue, 19 Sep 2023 15:32:10 +0200 Subject: [PATCH 04/27] Split out YAML primitive field custom sorting code --- clash-lib/tools/BlackBoxSorting.hs | 46 +++++++++++++++++ clash-lib/tools/v16-upgrade-primitives.hs | 61 +++-------------------- 2 files changed, 54 insertions(+), 53 deletions(-) create mode 100644 clash-lib/tools/BlackBoxSorting.hs diff --git a/clash-lib/tools/BlackBoxSorting.hs b/clash-lib/tools/BlackBoxSorting.hs new file mode 100644 index 0000000000..68559c1365 --- /dev/null +++ b/clash-lib/tools/BlackBoxSorting.hs @@ -0,0 +1,46 @@ +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.KeyMap as Aeson +import Data.ByteString.Lazy.Search (replace) +import Data.String (IsString) +#endif + +{- NOTE [Sorting YAML object keys] + +'Yaml.encode' encodes object with their keys in alphabetical order. +For readability we like `name` to be at the top, and `type` to be just above `template`. + +We accomplice this here by renaming those keys to something there sorts where +we like them to be. And find-and-replace those temporary names back +in the resulting ByteString. +-} +#if MIN_VERSION_aeson(2,0,0) +keySortingRenames :: IsString str => [(str,str)] +keySortingRenames = + [ ("name", "aaaa_really_should_be_name_but_renamed_to_get_the_sorting_we_like") + , ("type", "really_should_be_type_but_renamed_to_get_the_sorting_we_like") + ] + +customSortOutput :: Aeson.Value -> Aeson.Value +customSortOutput x = case x of + Aeson.Object o -> Aeson.Object $ fmap customSortOutput $ renameKeys $ o + Aeson.Array xs -> Aeson.Array $ fmap customSortOutput xs + _ -> x + where + renameKeys obj = foldl renameKey obj keySortingRenames + renameKey obj (kOld,kNew) = + case Aeson.lookup kOld obj of + Nothing -> obj + Just val -> Aeson.insert kNew val (Aeson.delete kOld obj) + +removeTempKey :: BS.ByteString -> BS.ByteString +removeTempKey inp = BL.toStrict $ foldl go (BL.fromStrict inp) keySortingRenames + where + go bs (orig,temp) = replace temp orig bs + +customYamlEncode :: Aeson.Value -> BS.ByteString +customYamlEncode = removeTempKey . Yaml.encode . customSortOutput +#else +-- < aeson-2.0 stores keys in HashMaps, whose order we can't possibly predict. +customYamlEncode :: Aeson.Value -> BS.ByteString +customYamlEncode = Yaml.encode +#endif diff --git a/clash-lib/tools/v16-upgrade-primitives.hs b/clash-lib/tools/v16-upgrade-primitives.hs index aae23fad47..d319024211 100644 --- a/clash-lib/tools/v16-upgrade-primitives.hs +++ b/clash-lib/tools/v16-upgrade-primitives.hs @@ -7,24 +7,21 @@ module Main where -#if MIN_VERSION_aeson(2,0,0) -import qualified Data.Aeson.KeyMap as Aeson -import Data.ByteString.Lazy.Search (replace) -import Data.String (IsString) -#endif import qualified Data.Aeson.Extra as AesonExtra import qualified Data.Aeson as Aeson import qualified Data.Yaml as Yaml -import qualified Data.ByteString.Lazy as ByteString import qualified Data.Set as Set import Control.Monad (forM_, when) -import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS import System.Directory (removeFile) import System.Environment (getArgs) import System.FilePath.Glob (glob) +#include "BlackBoxSorting.hs" + help :: String help = unlines [ "Convert JSON primitive files into YAML ones. YAML files will be written to " @@ -54,53 +51,11 @@ concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f = fmap concat . mapM f -- | Read file and output YAML ByteString -jsonToYaml :: FilePath -> IO ByteString +jsonToYaml :: FilePath -> IO BS.ByteString jsonToYaml path = do - contents <- ByteString.readFile path + contents <- BL.readFile path let decoded = AesonExtra.decodeOrErrJson path contents - pure . removeTempKey . ByteString.fromStrict . Yaml.encode . customSortOutput $ decoded - -{- NOTE [Sorting YAML object keys] - -'Yaml.encode' encodes object with their keys in alphabetical order. -For readability we like `name` to be at the top, and `type` to be just above `template`. - -We accomplice this here by renaming those keys to something there sorts where -we like them to be. And find-and-replace those temporary names back -in the resulting ByteString. --} -#if MIN_VERSION_aeson(2,0,0) -keySortingRenames :: IsString str => [(str,str)] -keySortingRenames = - [ ("name", "aaaa_really_should_be_name_but_renamed_to_get_the_sorting_we_like") - , ("type", "really_should_be_type_but_renamed_to_get_the_sorting_we_like") - ] - -customSortOutput :: Aeson.Value -> Aeson.Value -customSortOutput x = case x of - Aeson.Object o -> Aeson.Object $ fmap customSortOutput $ renameKeys $ o - Aeson.Array xs -> Aeson.Array $ fmap customSortOutput xs - _ -> x - where - renameKeys obj = foldl renameKey obj keySortingRenames - renameKey obj (kOld,kNew) = - case Aeson.lookup kOld obj of - Nothing -> obj - Just val -> Aeson.insert kNew val (Aeson.delete kOld obj) - -removeTempKey :: ByteString -> ByteString -removeTempKey inp = foldl go inp keySortingRenames - where - go bs (orig,temp) = replace (ByteString.toStrict temp) orig bs -#else --- < aeson-2.0 stores keys in HashMaps, whose order we can't possibly predict. -removeTempKey :: ByteString -> ByteString -removeTempKey = id - -customSortOutput:: Aeson.Value -> Aeson.Value -customSortOutput = id -#endif - + pure . customYamlEncode $ decoded main :: IO () main = do @@ -121,5 +76,5 @@ main = do let newPath = path <> ".yaml" putStrLn $ "Converting " <> path <> ".." decoded <- jsonToYaml path - when doWrite $ ByteString.writeFile newPath decoded + when doWrite $ BS.writeFile newPath decoded when doDelete $ removeFile path From c5f236832032d028e75ad92b43856589bb92ab80 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Tue, 17 Oct 2023 17:09:06 +0200 Subject: [PATCH 05/27] Fix prettyElem bugs It now correctly "escapes" square brackets in the right places. And correctly brackets the second argument of ~SIGD --- clash-lib/src/Clash/Netlist/BlackBox/Util.hs | 43 +++++++++++++------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index f879843d49..f0963f7fd2 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -959,7 +959,7 @@ prettyElem (Lit i) = renderOneLine <$> (string "~LIT" <> brackets (int i)) prettyElem (Const i) = renderOneLine <$> (string "~CONST" <> brackets (int i)) prettyElem (Name i) = renderOneLine <$> (string "~NAME" <> brackets (int i)) prettyElem (ToVar es i) = do - es' <- prettyBlackBox es + es' <- prettySigD es renderOneLine <$> (string "~VAR" <> brackets (string es') <> brackets (int i)) prettyElem (Sym _ i) = renderOneLine <$> (string "~SYM" <> brackets (int i)) prettyElem (Typ Nothing) = return "~TYPO" @@ -1015,7 +1015,7 @@ prettyElem (HdlSyn s) = case s of Vivado -> return "~VIVADO" _ -> return "~OTHERSYN" prettyElem (BV b es e) = do - es' <- prettyBlackBox es + es' <- prettySigD es e' <- prettyBlackBox [e] renderOneLine <$> if b @@ -1040,14 +1040,14 @@ prettyElem (IsSync i) = renderOneLine <$> (string "~ISSYNC" <> brackets (int i)) prettyElem (IsInitDefined i) = renderOneLine <$> (string "~ISINITDEFINED" <> brackets (int i)) prettyElem (StrCmp es i) = do - es' <- prettyBlackBox es + es' <- prettySigD es renderOneLine <$> (string "~STRCMP" <> brackets (string es') <> brackets (int i)) prettyElem (GenSym es i) = do - es' <- prettyBlackBox es + es' <- prettySigD es renderOneLine <$> (string "~GENSYM" <> brackets (string es') <> brackets (int i)) prettyElem (Repeat [es] [i]) = do - es' <- prettyElem es - i' <- prettyElem i + es' <- prettySigD [es] + i' <- prettySigD [i] renderOneLine <$> string "~REPEAT" <> brackets (string es') @@ -1059,27 +1059,42 @@ prettyElem (Repeat es i) = error $ $(curLoc) ++ show i ++ ". Both lists are expected to have a single element." prettyElem (DevNull es) = do - es' <- mapM prettyElem es - renderOneLine <$> (string "~DEVNULL" <> brackets (string $ Text.concat es')) + es' <- prettySigD es + renderOneLine <$> (string "~DEVNULL" <> brackets (string es')) prettyElem (SigD es mI) = do - es' <- prettyBlackBox es + es' <- prettySigD es renderOneLine <$> (maybe (string "~SIGDO" <> brackets (string es')) - (((string "~SIGD" <> brackets (string es')) <>) . int) + (((string "~SIGD" <> brackets (string es')) <>) . brackets . int) mI) prettyElem (Vars i) = renderOneLine <$> (string "~VARS" <> brackets (int i)) prettyElem (OutputUsage n) = renderOneLine <$> (string "~OUTPUTUSAGE" <> brackets (int n)) prettyElem (ArgGen n x) = renderOneLine <$> (string "~ARGN" <> brackets (int n) <> brackets (int x)) prettyElem (Template bbname source) = do - bbname' <- mapM prettyElem bbname - source' <- mapM prettyElem source + bbname' <- prettySigD bbname + source' <- prettySigD source renderOneLine <$> (string "~TEMPLATE" - <> brackets (string $ Text.concat bbname') - <> brackets (string $ Text.concat source')) + <> brackets (string bbname') + <> brackets (string source')) prettyElem CtxName = return "~CTXNAME" + +-- This reverses what Clash.Netlist.Blackbox.Parser.pSigD does +-- ie turn a "[" back into "[\" and "]" back into "\]" +prettySigD :: Monad m + => [Element] + -> Ap m Text +prettySigD bbT = Text.concat <$> mapM prettySigDElem bbT + where + prettySigDElem (Text t) + | t == "[" = return "[\\" + | t == "]" = return "\\]" + | otherwise = return t + prettySigDElem e = prettyElem e + + -- | Recursively walk @Element@, applying @f@ to each element in the tree. walkElement :: (Element -> Maybe a) From 8e7a228d719f0ea5f110e7c16dd92bde8349e98c Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Thu, 7 Sep 2023 17:35:15 +0200 Subject: [PATCH 06/27] Make Element polymorphic in the type used to represent arguments --- .../src/Clash/Netlist/BlackBox/Parser.hs | 14 +-- clash-lib/src/Clash/Netlist/BlackBox/Types.hs | 92 +++++++++---------- clash-lib/src/Clash/Netlist/BlackBox/Util.hs | 90 +++++++++--------- clash-lib/src/Clash/Primitives/GHC/Literal.hs | 10 +- .../src/Data/Text/Prettyprint/Doc/Extra.hs | 4 + 5 files changed, 107 insertions(+), 103 deletions(-) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs b/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs index 77fbad019a..d21c8d0938 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs @@ -34,7 +34,7 @@ pBlackBoxD :: Parser BlackBoxTemplate pBlackBoxD = some pElement -- | Parse a single Template Element -pElement :: Parser Element +pElement :: Parser (Element Int) pElement = pTagD <|> Text <$> pText <|> Text <$> (pack <$> string "~ ") @@ -50,7 +50,7 @@ pEdge = -- | Parse a Declaration or Expression element -pTagD :: Parser Element +pTagD :: Parser (Element Int) pTagD = IF <$> (symbol "~IF" *> pTagE) <*> (spaces *> (string "~THEN" *> pBlackBoxD)) <*> (string "~ELSE" *> option ([Text ""]) pBlackBoxD <* string "~FI") @@ -58,7 +58,7 @@ pTagD = IF <$> (symbol "~IF" *> pTagE) <|> pTagE -- | Parse a Declaration -pDecl :: Parser Decl +pDecl :: Parser (Decl Int) pDecl = Decl <$> (symbol "~INST" *> natural') <*> pure 0 <*> ((:) <$> pOutput <*> many pInput) <* string "~INST" @@ -71,7 +71,7 @@ pInput :: Parser (BlackBoxTemplate,BlackBoxTemplate) pInput = symbol "~INPUT" *> symbol "<=" *> ((,) <$> (pBlackBoxE <* symbol "~") <*> pBlackBoxE) <* symbol "~" -- | Parse an Expression element -pTagE :: Parser Element +pTagE :: Parser (Element Int) pTagE = Result <$ string "~RESULT" <|> ArgGen <$> (string "~ARGN" *> brackets' natural') <*> brackets' natural' <|> Arg <$> (string "~ARG" *> brackets' natural') @@ -144,16 +144,16 @@ pBlackBoxE :: Parser BlackBoxTemplate pBlackBoxE = some pElemE -- | Parse an Expression or Text -pElemE :: Parser Element +pElemE :: Parser (Element Int) pElemE = pTagE <|> Text <$> pText -- | Parse SigD -pSigD :: Parser [Element] +pSigD :: Parser [Element Int] pSigD = some (pTagE <|> (Text (pack "[") <$ (pack <$> string "[\\")) <|> (Text (pack "]") <$ (pack <$> string "\\]")) <|> (Text <$> (pack <$> some (satisfyRange '\000' '\90'))) <|> (Text <$> (pack <$> some (satisfyRange '\94' '\125')))) -pSigDorEmpty :: Parser [Element] +pSigDorEmpty :: Parser [Element Int] pSigDorEmpty = pSigD <|> mempty diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs index 9ba91c8ffe..3f88edc28a 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs @@ -90,7 +90,7 @@ type BlackBoxFunction -- | A BlackBox Template is a List of Elements -- TODO: Add name of function for better error messages -type BlackBoxTemplate = [Element] +type BlackBoxTemplate = [Element Int] -- | Elements of a blackbox context. If you extend this list, make sure to -- update the following functions: @@ -104,110 +104,110 @@ type BlackBoxTemplate = [Element] -- - Clash.Netlist.BlackBox.Types.usedVariables -- - Clash.Netlist.BlackBox.Types.verifyBlackBoxContext -- - Clash.Netlist.BlackBox.Types.walkElement -data Element +data Element arg = Text !Text -- ^ Dumps given text without processing in HDL - | Component !Decl + | Component !(Decl arg) -- ^ Component instantiation hole | Result -- ^ Output hole; - | Arg !Int + | Arg !arg -- ^ Input hole - | ArgGen !Int !Int + | ArgGen !Int !arg -- ^ Like Arg, but its first argument is the scoping level. For use in -- in generated code only. - | Const !Int + | Const !arg -- ^ Like Arg, but input hole must be a constant. - | Lit !Int + | Lit !arg -- ^ Like Arg, but input hole must be a literal - | Name !Int + | Name !arg -- ^ Name hole - | ToVar [Element] !Int + | ToVar [(Element arg)] !arg -- ^ Like Arg but only insert variable reference (creating an assignment -- elsewhere if necessary). | Sym !Text !Int -- ^ Symbol hole - | Typ !(Maybe Int) + | Typ !(Maybe arg) -- ^ Type declaration hole - | TypM !(Maybe Int) + | TypM !(Maybe arg) -- ^ Type root hole - | Err !(Maybe Int) + | Err !(Maybe arg) -- ^ Error value hole - | TypElem !Element + | TypElem !(Element arg) -- ^ Select element type from a vector-like type | CompName -- ^ Hole for the name of the component in which the blackbox is instantiated | IncludeName !Int - | IndexType !Element + | IndexType !(Element arg) -- ^ Index data type hole, the field is the (exclusive) maximum index - | Size !Element + | Size !(Element arg) -- ^ Size of a type hole - | Length !Element + | Length !(Element arg) -- ^ Length of a vector-like hole - | Depth !Element + | Depth !(Element arg) -- ^ Depth of a tree hole - | MaxIndex !Element + | MaxIndex !(Element arg) -- ^ Max index into a vector-like type - | FilePath !Element + | FilePath !(Element arg) -- ^ Hole containing a filepath for a data file - | Template [Element] [Element] + | Template [(Element arg)] [(Element arg)] -- ^ Create data file with contents | Gen !Bool -- ^ Hole marking beginning (True) or end (False) of a generative construct - | IF !Element [Element] [Element] - | And [Element] + | IF !(Element arg) [(Element arg)] [(Element arg)] + | And [(Element arg)] | IW64 -- ^ Hole indicating whether Int/Word/Integer are 64-Bit - | CmpLE !Element !Element + | CmpLE !(Element arg) !(Element arg) -- ^ Compare less-or-equal | HdlSyn HdlSyn -- ^ Hole indicating which synthesis tool we're generating HDL for - | BV !Bool [Element] !Element + | BV !Bool [(Element arg)] !(Element arg) -- ^ Convert to (True)/from(False) a bit-vector - | Sel !Element !Int + | Sel !(Element arg) !Int -- ^ Record selector of a type - | IsLit !Int - | IsVar !Int - | IsScalar !Int + | IsLit !arg + | IsVar !arg + | IsScalar !arg -- ^ Whether element is scalar - | IsActiveHigh !Int + | IsActiveHigh !arg -- ^ Whether a domain's reset lines are active high. Errors if not applied to -- a @KnownDomain@ or @KnownConfiguration@. - | Tag !Int + | Tag !arg -- ^ Tag of a domain. - | Period !Int + | Period !arg -- ^ Period of a domain. Errors if not applied to a @KnownDomain@ or -- @KnownConfiguration@. | LongestPeriod -- ^ Longest period of all known domains. The minimum duration returned is -- 100 ns, see https://github.com/clash-lang/clash-compiler/issues/2455. - | ActiveEdge !Signal.ActiveEdge !Int + | ActiveEdge !Signal.ActiveEdge !arg -- ^ Test active edge of memory elements in a certain domain. Errors if not -- applied to a @KnownDomain@ or @KnownConfiguration@. - | IsSync !Int + | IsSync !arg -- ^ Whether a domain's reset lines are synchronous. Errors if not applied to -- a @KnownDomain@ or @KnownConfiguration@. - | IsInitDefined !Int + | IsInitDefined !arg -- ^ Whether the initial (or "power up") value of memory elements in a domain -- are configurable to a specific value rather than unknown\/undefined. Errors -- if not applied to a @KnownDomain@ or @KnownConfiguration@. - | IsActiveEnable !Int + | IsActiveEnable !arg -- ^ Whether given enable line is active. More specifically, whether the -- enable line is NOT set to a constant 'True'. - | IsUndefined !Int + | IsUndefined !arg -- ^ Whether argument is undefined. E.g., an XException, error call, -- removed argument, or primitive that is undefined. This template tag will -- always return 0 (False) if `-fclash-aggressive-x-optimization-blackboxes` -- is NOT set. - | StrCmp [Element] !Int - | OutputUsage !Int - | Vars !Int - | GenSym [Element] !Int - | Repeat [Element] [Element] + | StrCmp [(Element arg)] !arg + | OutputUsage !arg + | Vars !arg + | GenSym [(Element arg)] !Int + | Repeat [(Element arg)] [(Element arg)] -- ^ Repeat n times - | DevNull [Element] + | DevNull [(Element arg)] -- ^ Evaluate but swallow output - | SigD [Element] !(Maybe Int) + | SigD [(Element arg)] !(Maybe arg) | CtxName -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the -- name of the closest binder @@ -220,9 +220,9 @@ data Element -- -- The LHS of the tuple is the name of the signal, while the RHS of the tuple -- is the type of the signal -data Decl +data Decl arg = Decl - !Int + !arg -- ^ Argument position of the function to instantiate !Int -- ^ Subposition of function: blackboxes can request multiple instances @@ -233,7 +233,7 @@ data Decl -- function until the very last moment. The blackbox language has no way -- to indicate the subposition, and every ~INST will default its subposition -- to zero. Haskell blackboxes can use this data type. - [(BlackBoxTemplate,BlackBoxTemplate)] + [([Element arg],[Element arg])] -- ^ (name of signal, type of signal) deriving (Show, Generic, NFData, Binary, Eq, Hashable) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index f0963f7fd2..a4d9f579af 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -73,7 +73,7 @@ import qualified Clash.Util.Interpolate as I import Clash.Annotations.Primitive (HDL(VHDL)) -inputHole :: Element -> Maybe Int +inputHole :: Element arg -> Maybe arg inputHole = \case Text _ -> Nothing Component _ -> Nothing @@ -212,11 +212,11 @@ setSym bbCtx l = do bbnm = Data.Text.unpack (bbName bbCtx) setSym' - :: Element + :: Element Int -> StateT ( IntMap.IntMap N.IdentifierText , IntMap.IntMap (N.IdentifierText, [N.Declaration])) m - Element + (Element Int) setSym' e = case e of ToVar nm i | i < length (bbInputs bbCtx) -> case bbInputs bbCtx !! i of (Identifier nm0 Nothing,_,_) -> @@ -262,7 +262,7 @@ setSym bbCtx l = do BV t e' m -> BV <$> pure t <*> mapM setSym' e' <*> pure m _ -> pure e - concatT :: [Element] -> Text + concatT :: [Element Int] -> Text concatT = Text.concat . map ( \case Text t -> t @@ -390,7 +390,7 @@ renderElem :: HasCallStack => Backend backend => BlackBoxContext - -> Element + -> Element Int -> State backend (Int -> Text) renderElem b (Component (Decl n subN (l:ls))) = do (o,oTy,_) <- idToExpr <$> bitraverse (lineToIdentifier b) (return . lineToType b) l @@ -496,7 +496,7 @@ renderElem b (IF c t f) = do let 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 :: Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element Int -> Int check xOpt iw hdl syn enums c' = case c' of (Size e) -> typeSize (lineToType b [e]) (Length e) -> case lineToType b [e] of @@ -682,7 +682,7 @@ lineToType _ _ = error $ $(curLoc) ++ "Unexpected type manipulation" -- context that matches the tag of the hole. renderTag :: Backend backend => BlackBoxContext - -> Element + -> Element Int -> State backend Text renderTag _ (Text t) = return t renderTag b (Result) = do @@ -883,7 +883,7 @@ renderTag _ e = do e' <- getAp (prettyElem e) -- on template level (constants). elementsToText :: BlackBoxContext - -> [Element] + -> [Element Int] -> Either String Text elementsToText bbCtx elements = foldl (\txt el -> case txt of @@ -894,11 +894,11 @@ elementsToText bbCtx elements = elementToText :: BlackBoxContext - -> Element + -> Element Int -> Either String Text elementToText bbCtx (Name n) = elementToText bbCtx (Lit n) elementToText _bbCtx (Text t) = return $ t -elementToText bbCtx (Lit n) = +elementToText bbCtx lit@(Lit n) = case bbInputs bbCtx ^? element n of Just (e,_,_) -> case exprToString e of @@ -907,9 +907,9 @@ elementToText bbCtx (Lit n) = Nothing -> Left $ $(curLoc) ++ unwords [ "Could not extract string from" , show e, "referred to by" - , show (Lit n) ] + , show lit ] Nothing -> - Left $ $(curLoc) ++ unwords [ "Invalid literal", show (Lit n) + Left $ $(curLoc) ++ unwords [ "Invalid literal", show lit , "used in blackbox with context:" , show bbCtx, "." ] @@ -931,14 +931,14 @@ exprToString (BlackBoxE "GHC.CString.unpackCString#" _ _ _ _ ctx _) = _ -> error "internal error: insufficient bbInputs" exprToString _ = Nothing -prettyBlackBox :: Monad m - => BlackBoxTemplate +prettyBlackBox :: (Monad m, PP.Pretty arg, Show arg) + => [Element arg] -> Ap m Text prettyBlackBox bbT = Text.concat <$> mapM prettyElem bbT prettyElem - :: (HasCallStack, Monad m) - => Element + :: (HasCallStack, Monad m, PP.Pretty arg, Show arg) + => Element arg -> Ap m Text prettyElem (Text t) = return t prettyElem (Component (Decl i 0 args)) = do @@ -946,7 +946,7 @@ prettyElem (Component (Decl i 0 args)) = do case args' of (arg:rest) -> renderOneLine <$> - (nest 2 (string "~INST" <+> int i <> line <> + (nest 2 (string "~INST" <+> argPpr i <> line <> string "~OUTPUT" <+> string "=>" <+> string (fst arg) <+> string (snd arg) <+> string "~" <> line <> vcat (mapM (\(a,b) -> string "~INPUT" <+> string "=>" <+> string a <+> string b <+> string "~") rest)) <> line <> string "~INST") @@ -954,20 +954,20 @@ prettyElem (Component (Decl i 0 args)) = do prettyElem (Component (Decl {})) = error $ $(curLoc) ++ "prettyElem can't (yet) render ~INST when subfuncion /= 0!" prettyElem Result = return "~RESULT" -prettyElem (Arg i) = renderOneLine <$> ("~ARG" <> brackets (int i)) -prettyElem (Lit i) = renderOneLine <$> (string "~LIT" <> brackets (int i)) -prettyElem (Const i) = renderOneLine <$> (string "~CONST" <> brackets (int i)) -prettyElem (Name i) = renderOneLine <$> (string "~NAME" <> brackets (int i)) +prettyElem (Arg i) = renderOneLine <$> ("~ARG" <> brackets (argPpr i)) +prettyElem (Lit i) = renderOneLine <$> (string "~LIT" <> brackets (argPpr i)) +prettyElem (Const i) = renderOneLine <$> (string "~CONST" <> brackets (argPpr i)) +prettyElem (Name i) = renderOneLine <$> (string "~NAME" <> brackets (argPpr i)) prettyElem (ToVar es i) = do es' <- prettySigD es - renderOneLine <$> (string "~VAR" <> brackets (string es') <> brackets (int i)) + renderOneLine <$> (string "~VAR" <> brackets (string es') <> brackets (argPpr i)) prettyElem (Sym _ i) = renderOneLine <$> (string "~SYM" <> brackets (int i)) prettyElem (Typ Nothing) = return "~TYPO" -prettyElem (Typ (Just i)) = renderOneLine <$> (string "~TYP" <> brackets (int i)) +prettyElem (Typ (Just i)) = renderOneLine <$> (string "~TYP" <> brackets (argPpr i)) prettyElem (TypM Nothing) = return "~TYPMO" -prettyElem (TypM (Just i)) = renderOneLine <$> (string "~TYPM" <> brackets (int i)) +prettyElem (TypM (Just i)) = renderOneLine <$> (string "~TYPM" <> brackets (argPpr i)) prettyElem (Err Nothing) = return "~ERRORO" -prettyElem (Err (Just i)) = renderOneLine <$> (string "~ERROR" <> brackets (int i)) +prettyElem (Err (Just i)) = renderOneLine <$> (string "~ERROR" <> brackets (argPpr i)) prettyElem (TypElem e) = do e' <- prettyElem e renderOneLine <$> (string "~TYPEL" <> brackets (string e')) @@ -1024,24 +1024,24 @@ prettyElem (BV b es e) = do prettyElem (Sel e i) = do e' <- prettyElem e renderOneLine <$> (string "~SEL" <> brackets (string e') <> brackets (int i)) -prettyElem (IsLit i) = renderOneLine <$> (string "~ISLIT" <> brackets (int i)) -prettyElem (IsVar i) = renderOneLine <$> (string "~ISVAR" <> brackets (int i)) -prettyElem (IsScalar i) = renderOneLine <$> (string "~ISSCALAR" <> brackets (int i)) -prettyElem (IsActiveHigh i) = renderOneLine <$> (string "~ISACTIVEHIGH" <> brackets (int i)) -prettyElem (IsActiveEnable i) = renderOneLine <$> (string "~ISACTIVEENABLE" <> brackets (int i)) -prettyElem (IsUndefined i) = renderOneLine <$> (string "~ISUNDEFINED" <> brackets (int i)) +prettyElem (IsLit i) = renderOneLine <$> (string "~ISLIT" <> brackets (argPpr i)) +prettyElem (IsVar i) = renderOneLine <$> (string "~ISVAR" <> brackets (argPpr i)) +prettyElem (IsScalar i) = renderOneLine <$> (string "~ISSCALAR" <> brackets (argPpr i)) +prettyElem (IsActiveHigh i) = renderOneLine <$> (string "~ISACTIVEHIGH" <> brackets (argPpr i)) +prettyElem (IsActiveEnable i) = renderOneLine <$> (string "~ISACTIVEENABLE" <> brackets (argPpr i)) +prettyElem (IsUndefined i) = renderOneLine <$> (string "~ISUNDEFINED" <> brackets (argPpr i)) -- Domain attributes: -prettyElem (Tag i) = renderOneLine <$> (string "~TAG" <> brackets (int i)) -prettyElem (Period i) = renderOneLine <$> (string "~PERIOD" <> brackets (int i)) +prettyElem (Tag i) = renderOneLine <$> (string "~TAG" <> brackets (argPpr i)) +prettyElem (Period i) = renderOneLine <$> (string "~PERIOD" <> brackets (argPpr i)) prettyElem LongestPeriod = return "~LONGESTPERIOD" -prettyElem (ActiveEdge e i) = renderOneLine <$> (string "~ACTIVEEDGE" <> brackets (string (Text.pack (show e))) <> brackets (int i)) -prettyElem (IsSync i) = renderOneLine <$> (string "~ISSYNC" <> brackets (int i)) -prettyElem (IsInitDefined i) = renderOneLine <$> (string "~ISINITDEFINED" <> brackets (int i)) +prettyElem (ActiveEdge e i) = renderOneLine <$> (string "~ACTIVEEDGE" <> brackets (string (Text.pack (show e))) <> brackets (argPpr i)) +prettyElem (IsSync i) = renderOneLine <$> (string "~ISSYNC" <> brackets (argPpr i)) +prettyElem (IsInitDefined i) = renderOneLine <$> (string "~ISINITDEFINED" <> brackets (argPpr i)) prettyElem (StrCmp es i) = do es' <- prettySigD es - renderOneLine <$> (string "~STRCMP" <> brackets (string es') <> brackets (int i)) + renderOneLine <$> (string "~STRCMP" <> brackets (string es') <> brackets (argPpr i)) prettyElem (GenSym es i) = do es' <- prettySigD es renderOneLine <$> (string "~GENSYM" <> brackets (string es') <> brackets (int i)) @@ -1066,12 +1066,12 @@ prettyElem (SigD es mI) = do es' <- prettySigD es renderOneLine <$> (maybe (string "~SIGDO" <> brackets (string es')) - (((string "~SIGD" <> brackets (string es')) <>) . brackets . int) + (((string "~SIGD" <> brackets (string es')) <>) . brackets . argPpr) mI) -prettyElem (Vars i) = renderOneLine <$> (string "~VARS" <> brackets (int i)) -prettyElem (OutputUsage n) = renderOneLine <$> (string "~OUTPUTUSAGE" <> brackets (int n)) +prettyElem (Vars i) = renderOneLine <$> (string "~VARS" <> brackets (argPpr i)) +prettyElem (OutputUsage n) = renderOneLine <$> (string "~OUTPUTUSAGE" <> brackets (argPpr n)) prettyElem (ArgGen n x) = - renderOneLine <$> (string "~ARGN" <> brackets (int n) <> brackets (int x)) + renderOneLine <$> (string "~ARGN" <> brackets (int n) <> brackets (argPpr x)) prettyElem (Template bbname source) = do bbname' <- prettySigD bbname source' <- prettySigD source @@ -1083,8 +1083,8 @@ prettyElem CtxName = return "~CTXNAME" -- This reverses what Clash.Netlist.Blackbox.Parser.pSigD does -- ie turn a "[" back into "[\" and "]" back into "\]" -prettySigD :: Monad m - => [Element] +prettySigD :: (Monad m, PP.Pretty arg, Show arg) + => [Element arg] -> Ap m Text prettySigD bbT = Text.concat <$> mapM prettySigDElem bbT where @@ -1097,8 +1097,8 @@ prettySigD bbT = Text.concat <$> mapM prettySigDElem bbT -- | Recursively walk @Element@, applying @f@ to each element in the tree. walkElement - :: (Element -> Maybe a) - -> Element + :: (Element arg -> Maybe a) + -> Element arg -> [a] walkElement f el = maybeToList (f el) ++ walked where diff --git a/clash-lib/src/Clash/Primitives/GHC/Literal.hs b/clash-lib/src/Clash/Primitives/GHC/Literal.hs index 82bcc1a948..16b1f52282 100644 --- a/clash-lib/src/Clash/Primitives/GHC/Literal.hs +++ b/clash-lib/src/Clash/Primitives/GHC/Literal.hs @@ -29,16 +29,16 @@ import Clash.Netlist.Types (BlackBox) import Clash.Netlist.BlackBox.Types (BlackBoxFunction, Element(Text), BlackBoxMeta) -unsigned :: Element -> [Element] +unsigned :: Element arg -> [Element arg] unsigned el = [Text "$unsigned(", el, Text ")"] -signed :: Element -> [Element] +signed :: Element arg -> [Element arg] signed el = [Text "$signed(", el, Text ")"] -assign :: Element -> [Element] -> [Element] +assign :: Element arg -> [Element arg] -> [Element arg] assign lhs rhs = Text "assign " : lhs : Text " = " : rhs ++ [Text ";"] -signedLiteral :: Int -> Integer -> Element +signedLiteral :: Int -> Integer -> Element arg signedLiteral wordSize wordVal = Text (LT.concat [ if wordVal < 0 then "-" else "" , showtl wordSize @@ -46,7 +46,7 @@ signedLiteral wordSize wordVal = , showtl (abs wordVal) ]) -unsignedLiteral :: Int -> Integer -> Element +unsignedLiteral :: Int -> Integer -> Element arg unsignedLiteral wordSize wordVal = Text (LT.concat [ if wordVal < 0 then "-" else "" , showtl wordSize diff --git a/clash-lib/src/Data/Text/Prettyprint/Doc/Extra.hs b/clash-lib/src/Data/Text/Prettyprint/Doc/Extra.hs index 40bb3ae551..9a9d24e010 100644 --- a/clash-lib/src/Data/Text/Prettyprint/Doc/Extra.hs +++ b/clash-lib/src/Data/Text/Prettyprint/Doc/Extra.hs @@ -56,6 +56,10 @@ renderOneLine -> LT.Text renderOneLine = renderLazy . layoutPretty defaultLayoutOptions + +argPpr :: (Applicative f, PP.Pretty a) => a -> f Doc +argPpr = pure . PP.pretty + int :: Applicative f => Int -> f Doc int = pure . PP.pretty From 25f21f2d529a883eac38de8bf06a6125fda073cc Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Thu, 7 Sep 2023 17:35:54 +0200 Subject: [PATCH 07/27] Add prim-yaml-to-inlineyaml tool Utility that can convert blackboxes from clash-lib .primitives.yaml files to InlineYamlPrimitive ANNotations. --- clash-lib/clash-lib.cabal | 27 ++ clash-lib/src/Clash/Netlist/BlackBox/Types.hs | 4 +- clash-lib/tools/prim-yaml-to-inlineyaml.hs | 306 ++++++++++++++++++ 3 files changed, 335 insertions(+), 2 deletions(-) create mode 100644 clash-lib/tools/prim-yaml-to-inlineyaml.hs diff --git a/clash-lib/clash-lib.cabal b/clash-lib/clash-lib.cabal index 4dd65dc521..7273fba162 100644 --- a/clash-lib/clash-lib.cabal +++ b/clash-lib/clash-lib.cabal @@ -364,6 +364,33 @@ executable static-files if impl(ghc >= 9.2.0) buildable: False +executable prim-yaml-to-inlineyaml + Main-Is: tools/prim-yaml-to-inlineyaml.hs + Build-Depends: + aeson, + base, + bytestring, + clash-lib, + clash-prelude, + containers, + directory, + extra, + filepath, + Glob, + lens, + lens-aeson, + prettyprinter, + stringsearch, + text, + trifecta, + vector, + yaml, + GHC-Options: -Wall -Wcompat + default-language: Haskell2010 + if impl(ghc < 9.0.0) -- some of the lens magic doesn't typecheck on ghc-8.* + buildable: False + + test-suite doctests type: exitcode-stdio-1.0 diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs index 3f88edc28a..025382baf3 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs @@ -211,7 +211,7 @@ data Element arg | CtxName -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the -- name of the closest binder - deriving (Show, Generic, NFData, Binary, Eq, Hashable) + deriving (Show, Generic, NFData, Binary, Eq, Hashable, Functor, Foldable, Traversable) -- | Component instantiation hole. First argument indicates which function argument -- to instantiate. Third argument corresponds to output and input assignments, @@ -235,7 +235,7 @@ data Decl arg -- to zero. Haskell blackboxes can use this data type. [([Element arg],[Element arg])] -- ^ (name of signal, type of signal) - deriving (Show, Generic, NFData, Binary, Eq, Hashable) + deriving (Show, Generic, NFData, Binary, Eq, Hashable, Functor, Foldable, Traversable) data HdlSyn = Vivado | Quartus | Other deriving (Eq, Show, Read, Generic, NFData, Binary, Hashable) diff --git a/clash-lib/tools/prim-yaml-to-inlineyaml.hs b/clash-lib/tools/prim-yaml-to-inlineyaml.hs new file mode 100644 index 0000000000..576d8f98e2 --- /dev/null +++ b/clash-lib/tools/prim-yaml-to-inlineyaml.hs @@ -0,0 +1,306 @@ +{-| + Utility that can convert blackboxes from clash-lib .primitives.yaml files + to InlineYamlPrimitive ANNotations. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Main(main) where + +import Control.Lens + (Getter, Traversal', (^.), foldMapOf, over, preview, set, to) +import Control.Monad (forM, when) + +import qualified Data.Aeson as Aeson +import Data.Aeson (Value(..)) +import Data.Aeson.Extra (decodeOrErrYaml) +import qualified Data.Aeson.Key as AesonKey +import Data.Aeson.Lens +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.Either (partitionEithers) +import Data.List (sortOn) +import Data.List.Extra (split) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Monoid (Ap(getAp)) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Data.Text.Encoding as Text +import Data.Text.Lazy (fromStrict,toStrict) +import qualified Data.Vector as Vector (fromList) +import qualified Data.Yaml as Yaml + +#if MIN_VERSION_prettyprinter(1,7,0 ) +import Prettyprinter +import Prettyprinter.Render.Text +#else +import Data.Text.Prettyprint.Doc +#endif + +import System.Directory (doesFileExist, removeFile) +import System.Environment (getArgs) +import System.FilePath ((), (<.>), splitPath, takeDirectory, takeFileName) +import System.FilePath.Glob (glob) + +import Clash.Annotations.Primitive (HDL(..)) +import Clash.Netlist.BlackBox.Util (parseFail, prettyBlackBox) +import Clash.Netlist.BlackBox.Types hiding (bbImports) + +#include "BlackBoxSorting.hs" + +help :: String +help = unlines + [ "Convert blackboxes from YAML files into InlineYamlPrimitive" + , "" + , "Usage:" + , " prim-yaml-to-inlineyaml [options]... ..." + , "" + , "Options:" + , " --dry-run | -n Do not write files." + , " --help | -h Show this screen." + , "" + , "Example:" + , " prim-yaml-to-inlineyaml --dry-run 'Clash.Signal.Internal.register#'" + ] + +type PrimName = Text +type PrimSet = Set PrimName +type Module = [String] + +main :: IO () +main = do + args0 <- Set.fromList . map Text.pack <$> getArgs + + let + doDryRun = Set.member "-n" args0 || Set.member "--dry-run" args0 + doWrite = not doDryRun + doHelp = Set.member "-h" args0 || Set.member "--help" args0 || Set.null args1 + args1 = foldr Set.delete args0 ["--dry-run", "-n", "--help", "-h"] + + if doHelp then + putStrLn help + else do + files <- glob "./clash-lib/prims/*/*.primitives.yaml" + + bbs <- foldr (Map.unionWith mappend) mempty <$> forM files (goFile doWrite args1) + let bbs' = fmap (map snd . sortOn fst) bbs + let go = if doWrite then writeResult else printResult + go bbs' + +writeResult :: Map Module [Text] -> IO () +writeResult = mapM_ go . Map.toList + where + go :: (Module,[Text]) -> IO () + go (modNm,xs) = do + let path = modPath modNm + exists <- doesFileExist path + if not exists then do + error $ path <> " doesn't exist" + else do + Text.appendFile path (Text.unlines (header : xs)) + +printResult :: Map Module [Text] -> IO () +printResult = mapM_ go . Map.toList + where + go :: (Module,[Text]) -> IO () + go (modNm,xs) = do + let path = modPath modNm + exists <- doesFileExist path + when (not exists) $ putStrLn $ "error: " <> path <> " doesn't exist" + putStrLn $ "Would append to " <> path <> ":" + Text.putStrLn $ Text.unlines (header : xs) + putStrLn "-------------" + +header :: Text +header = Text.unlines $ "" : map ("-- " <>) + [ "These generated InlineYamlPrimitive annotations need the following pragma and imports:" + , "" + , "{-# LANGUAGE QuasiQuotes #-}" + , "{-# LANGUAGE TemplateHaskellQuotes #-}" + , "" + , "import Clash.Annotations.Primitive(Primitive (InlineYamlPrimitive), HDL(..))" + , "import Data.List.Infinite (Infinite((:<)), (...))" + , "import Data.String.Interpolate (__i)" + ] + +modPath :: Module -> FilePath +modPath xs = "clash-prelude/src/" foldr1 () xs <.> "hs" + +escapeValueWith :: (Text -> Text) -> Aeson.Value -> Aeson.Value +escapeValueWith f v = case v of + Object o -> goObject o + Array xs -> goArray xs + String str -> goString str + Number {} -> v + Bool {} -> v + Null -> v + where + goObject = Object . Aeson.mapKeyVal goKey (escapeValueWith f) + goArray = Array . fmap (escapeValueWith f) + goString = String . f + goKey = AesonKey.fromText . f . AesonKey.toText + +escapeHash :: Aeson.Value -> Aeson.Value +escapeHash = escapeValueWith (Text.replace "#" "\\#") + +escapeBracketEscapes :: Aeson.Value -> Aeson.Value +escapeBracketEscapes = escapeValueWith (Text.replace "[\\" "[\\\\" . Text.replace "\\]" "\\\\]") + + +goFile :: Bool -> PrimSet -> FilePath -> IO (Map Module [(PrimName,Text)]) +goFile doRemove wantedPrims path = do + -- putStrLn $ "Processing " <> path + contents <- BL.readFile path + let prims = decodeOrErrYaml @[Value] path contents + let (rest,found) = partitionEithers $ map lookingFor prims + + if (null found) + then return mempty + else do + putStrLn $ "Found in " <> path + when doRemove $ do + if rest == [] + then + removeFile path + else + BS.writeFile path $ customYamlEncode $ mkArray rest + let convertedTemplates = map (\p -> let nm = getName p in (nm, genInlineYamlAnn nm (getHdls path) p)) found + return $ Map.singleton (getModule path) convertedTemplates + where + mkArray = Aeson.Array . Vector.fromList + lookingFor :: Value -> Either Value Value + lookingFor prim = case preview bbName prim of + Just nm | Set.member nm wantedPrims -> Right prim + _ -> Left prim + + getName :: Value -> PrimName + getName v = v ^. bbName + +getHdls :: FilePath -> [HDL] +getHdls path = case lastPart path of + "common" -> [SystemVerilog,Verilog,VHDL] + "commonverilog" -> [SystemVerilog,Verilog] + "systemverilog" -> [SystemVerilog] + "verilog" -> [Verilog] + "vhdl" -> [VHDL] + _ -> [SystemVerilog,Verilog,VHDL] + where + lastPart p = last $ splitPath $ takeDirectory p + +getModule :: FilePath -> Module +getModule p = case split (== '.') $ takeFileName p of + [modNm,"primitives","yaml"] -> split (== '_') modNm + _ -> error $ p <> " doesn't end in \".primitives.yaml\"" + +-- optics to fields in the yaml value that contain templates +bbTemplateFields :: [Traversal' Value Text] +bbTemplateFields = [bbTemplate,bbResultInit,bbResultName,bbImports,bbLibraries,bbIncludesTemplate] + where + bbTemplate,bbResultInit,bbResultName,bbImports,bbLibraries,bbIncludesTemplate + :: Traversal' Value Text + bbTemplate = bbObj . key "template" . _String + bbResultInit = bbObj . key "resultInit" . key "template" . _String + bbResultName = bbObj . key "resultName" . key "template" . _String + bbLibraries = bbObj . key "libraries" . values . _String + bbImports = bbObj . key "imports" . values . _String + bbIncludesTemplate = bbObj . key "includes" . values . key "template" . _String + +bbObj :: Traversal' Value Value +bbObj = key "BlackBox" + +bbName :: Traversal' Value Text +bbName = bbObj . key "name" . _String + + + +getUsedArgs :: Value -> Set Int +getUsedArgs val = Set.unions $ map go bbTemplateFields + where + go :: Traversal' Value Text -> Set Int + go l = foldMapOf (l . getParsedTemplate . traverse @[] . traverse @Element) Set.singleton val + + +updateArgs :: Value -> Value +updateArgs val0 = set bbName "#{bbName}" $ escapeBracketEscapes $ foldl go (escapeHash val0) bbTemplateFields + where + go :: Value -> Traversal' Value Text -> Value + go val t = over t convertToSplicedArgs val + convertToSplicedArgs :: Text -> Text + convertToSplicedArgs = unparse . map (fmap SplicedArgN) . parse + +getParsedTemplate :: Getter Text [Element Int] +getParsedTemplate = to parse + +newtype SplicedArgN a = SplicedArgN a deriving Show + +instance Pretty (SplicedArgN Int) where + pretty (SplicedArgN n) = string "#{arg" <> pretty n <> string "}" + +instance Pretty (SplicedArgN String) where + pretty (SplicedArgN str) = string "#{" <> string str <> string "}" + + +parse + :: Text + -> [Element Int] -- BlackBoxTemplate +parse = parseFail . fromStrict + +unparse + :: (Pretty arg, Show arg) + => [Element arg] + -> Text +unparse elems = case toStrict <$> getAp (prettyBlackBox elems) of + Just t -> t + Nothing -> error "unparse failed" + +genInlineYamlAnn :: PrimName -> [HDL] -> Value -> Text +genInlineYamlAnn fqNm hdls val = renderStrict $ layoutPretty (LayoutOptions Unbounded) go + where + lNm = last $ Text.splitOn "." fqNm + go = string "{-# ANN" <+> pretty lNm <+> parens (hardline <> indent 2 annValue) <+> string "#-}" + annValue = vsep [ string "let" + , indent 2 (vsep $ map pprBinder binders) + , string "in" + , indent 2 body] + body = vsep + [ string "InlineYamlPrimitive" <+> list (map viaShow hdls) <+> string "[__i|" + , indent 2 (vsep (map pretty (Text.lines blackbox))) + , string "|]" + ] + + val' = updateArgs val + blackbox = Text.decodeUtf8 $ customYamlEncode val' + usedArgs = getUsedArgs val + binders = + [ (string "bbName", string "show" <+> squote <> pretty lNm) + , (hcat $ punctuate (string " :< ") ((pprUsedArgs usedArgs ++ [string "_"])), parens (string "(0 :: Int)" <> string "...")) + ] + +pprBinder :: (Doc ann, Doc ann) -> Doc ann +pprBinder (pat,val) = pat <+> equals <+> val + +-- | Turns +-- > Set.fromList [1,3]) +-- into +-- > ["_arg0","arg1","_arg2","arg3"] +pprUsedArgs :: Set Int -> [Doc ann] +pprUsedArgs = snd . Set.foldl (flip go) (-1,[]) + where + go arg (lastUsed,out) + | arg > lastUsed = (arg, out ++ [pprUnused n | n <- [lastUsed+1..arg-1]] ++ [pprUsed arg]) + | otherwise = (lastUsed,out) + pprUsed n = string "arg" <> pretty n + pprUnused n = pretty '_' <> pprUsed n + + +-- | `pretty` specialised to 'String' +string :: String -> Doc ann +string = pretty From c6f7316b509d06b3d4bada896622391b348b9188 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 2 Oct 2023 15:07:39 +0200 Subject: [PATCH 08/27] Allow blackbox templates to get domain info from Clock,Reset,Enable,etc You can now use ~PERIOD, ~ISSYNC, ~ISINITDEFINED and ~ACTIVEEDGE on arguments of type Clock,Reset,Enable,ClockN and DiffClock. --- clash-lib/src/Clash/Netlist/BlackBox/Util.hs | 124 ++++++++++++------- clash-prelude/src/Clash/Tutorial.hs | 8 +- 2 files changed, 80 insertions(+), 52 deletions(-) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index a4d9f579af..62713c389b 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -57,7 +57,7 @@ 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 @@ -65,7 +65,7 @@ import Clash.Netlist.Types 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 @@ -493,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 -> Int + check :: Backend backend => Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element Int -> 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 @@ -534,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 @@ -557,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 _ -> @@ -585,52 +585,80 @@ 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 + :: (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 $ $(curLoc) ++ "Don't know how to get a Domain out of HWType: " <> show t + where + go dom = do + doms <- getDomainMap + case HashMap.lookup dom doms of + Nothing -> error $ "Can't find domain " <> show dom + Just conf -> pure conf + parseFail :: Text -> BlackBoxTemplate parseFail t = case runParse t of Failure errInfo -> diff --git a/clash-prelude/src/Clash/Tutorial.hs b/clash-prelude/src/Clash/Tutorial.hs index 54c67d388f..faff085bd0 100644 --- a/clash-prelude/src/Clash/Tutorial.hs +++ b/clash-prelude/src/Clash/Tutorial.hs @@ -1289,16 +1289,16 @@ a general listing of the available template holes: * @~TAG[N]@: Name of given domain. Errors when called on an argument which is not a 'KnownDomain', 'Reset', or 'Clock'. * @~PERIOD[N]@: Clock period of given domain. Errors when called on an argument - which is not a 'KnownDomain' or 'KnownConf'. + which is not a 'Clock', 'Reset', 'KnownDomain' or 'KnownConf'. * @~ISACTIVEENABLE[N]@: Is the @(N+1)@'th argument a an Enable line NOT set to a constant True. Can be used instead of deprecated (and removed) template tag * @~ISSYNC[N]@: Does synthesis domain at the @(N+1)@'th argument have synchronous resets. Errors - when called on an argument which is not a 'KnownDomain' or 'KnownConf'. + when called on an argument which is not a 'Reset', 'Clock', 'Enable', 'KnownDomain' or 'KnownConf'. * @~ISINITDEFINED[N]@: Does synthesis domain at the @(N+1)@'th argument have defined initial - values. Errors when called on an argument which is not a 'KnownDomain' or 'KnownConf'. + values. Errors when called on an argument which is not a 'Clock', 'Reset', 'Enable', 'KnownDomain' or 'KnownConf'. * @~ACTIVEEDGE[edge][N]@: Does synthesis domain at the @(N+1)@'th argument respond to /edge/. /edge/ must be one of 'Falling' or 'Rising'. Errors when called on an - argument which is not a 'KnownDomain' or 'KnownConf'. + argument which is not a 'Clock', 'Reset', 'Enable', 'KnownDomain' or 'KnownConf'. * @~AND[\,\,..]@: Logically /and/ the conditions in the @\@'s * @~VAR[\][N]@: Like @~ARG[N]@ but binds the argument to a variable named NAME. The @\@ can be left blank, then clash will come up with a (unique) name. From c08b6241597a6c3039fb0a06beb24e7f799e805f Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 2 Oct 2023 15:39:05 +0200 Subject: [PATCH 09/27] Put a KnownDomain constraint inside of Clock and Reset This allows the removal of the KnownDomain constraint on functions which take a Clock and/or a Reset/ Which is most of them. The only functions that still need a KnownDomain constraint should be the ones creating Clocks and/or Resets. --- .../Clash_Signal_Internal.primitives.yaml | 4 +-- .../Clash_Signal_Internal.primitives.yaml | 4 +-- clash-prelude/src/Clash/Signal/Internal.hs | 30 ++++++++++--------- 3 files changed, 20 insertions(+), 18 deletions(-) diff --git a/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml index e84cc2c0b7..2a2244544d 100644 --- a/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml @@ -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 diff --git a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml index afd0e89e36..6de077240e 100644 --- a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml @@ -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 diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 77f0ec1e35..0afd6443d0 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -920,7 +920,7 @@ enableGen :: Enable dom enableGen = toEnable (pure True) -- | A clock signal belonging to a domain named /dom/. -data Clock (dom :: Domain) = Clock +data Clock (dom :: Domain) = KnownDomain dom => Clock { -- | Domain associated with the clock clockTag :: SSymbol dom @@ -1160,7 +1160,8 @@ resetGenN n = -- | A reset signal belonging to a domain called /dom/. -- -- The underlying representation of resets is 'Bool'. -data Reset (dom :: Domain) = Reset (Signal dom Bool) +data Reset (dom :: Domain) where + Reset :: KnownDomain dom => Signal dom Bool -> Reset dom -- | Non-ambiguous version of 'Clash.Signal.Internal.Ambiguous.resetPolarity' resetPolarityProxy @@ -1184,13 +1185,14 @@ resetPolarityProxy _proxy = -- asynchronous resets. unsafeToActiveHigh :: forall dom - . KnownDomain dom - => Reset dom + . Reset dom -> Signal dom Bool -unsafeToActiveHigh (unsafeFromReset -> r) = +unsafeToActiveHigh r0@(Reset{}) = case resetPolarityProxy (Proxy @dom) of SActiveHigh -> r SActiveLow -> not <$> r + where + r = unsafeFromReset r0 {-# INLINE unsafeToActiveHigh #-} -- | Convert a reset to an active high reset. Has no effect if reset is already @@ -1204,8 +1206,7 @@ unsafeToActiveHigh (unsafeFromReset -> r) = -- asynchronous resets. unsafeToHighPolarity :: forall dom - . KnownDomain dom - => Reset dom + . Reset dom -> Signal dom Bool unsafeToHighPolarity = unsafeToActiveHigh {-# DEPRECATED unsafeToHighPolarity "Use 'unsafeToActiveHigh' instead. This function will be removed in Clash 1.12." #-} @@ -1222,13 +1223,14 @@ unsafeToHighPolarity = unsafeToActiveHigh -- asynchronous resets. unsafeToActiveLow :: forall dom - . KnownDomain dom - => Reset dom + . Reset dom -> Signal dom Bool -unsafeToActiveLow (unsafeFromReset -> r) = +unsafeToActiveLow r0@(Reset{}) = case resetPolarityProxy (Proxy @dom) of SActiveHigh -> not <$> r SActiveLow -> r + where + r = unsafeFromReset r0 {-# INLINE unsafeToActiveLow #-} -- | Convert a reset to an active low reset. Has no effect if reset is already @@ -1242,8 +1244,7 @@ unsafeToActiveLow (unsafeFromReset -> r) = -- asynchronous resets. unsafeToLowPolarity :: forall dom - . KnownDomain dom - => Reset dom + . Reset dom -> Signal dom Bool unsafeToLowPolarity = unsafeToActiveLow {-# DEPRECATED unsafeToLowPolarity "Use 'unsafeToActiveLow' instead. This function will be removed in Clash 1.12." #-} @@ -1276,7 +1277,8 @@ unsafeFromReset (Reset r) = r -- __NB__: You probably want to use 'unsafeFromActiveLow' or -- 'unsafeFromActiveHigh'. unsafeToReset - :: Signal dom Bool + :: KnownDomain dom + => Signal dom Bool -> Reset dom unsafeToReset r = Reset r -- See: https://github.com/clash-lang/clash-compiler/pull/2511 @@ -1357,7 +1359,7 @@ unsafeFromActiveLow r = -- | Invert reset signal invertReset :: Reset dom -> Reset dom -invertReset = unsafeToReset . fmap not . unsafeFromReset +invertReset r@(Reset{}) = unsafeToReset . fmap not . unsafeFromReset $ r infixr 2 .||. -- | The above type is a generalization for: From 55b117e83dfa490d26a58de8f93a807dda2626fc Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 11 Oct 2023 16:26:21 +0200 Subject: [PATCH 10/27] Add class HasKnownDomain --- clash-prelude/src/Clash/Explicit/Prelude.hs | 2 ++ clash-prelude/src/Clash/Signal/Internal.hs | 15 +++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs index 997918ecce..a99c13d644 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude.hs @@ -78,6 +78,7 @@ module Clash.Explicit.Prelude , isFalling , riseEvery , oscillate + , HasKnownDomain(..) -- * Testbench functions , assert , stimuliGenerator @@ -185,6 +186,7 @@ import Clash.Promoted.Nat import Clash.Promoted.Nat.TH import Clash.Promoted.Nat.Literals import Clash.Promoted.Symbol +import Clash.Signal.Internal (HasKnownDomain(..)) import Clash.Signal.Trace import Clash.Sized.BitVector import Clash.Sized.Fixed diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 0afd6443d0..435dbcfeb6 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -16,6 +16,7 @@ Maintainer : QBayLogic B.V. {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} @@ -84,6 +85,7 @@ module Clash.Signal.Internal , VDomainConfiguration(..) , vDomain , createDomain + , HasKnownDomain(..) -- * Clocks , Clock (..) , ClockN (..) @@ -1285,6 +1287,19 @@ unsafeToReset r = Reset r {-# CLASH_OPAQUE unsafeToReset #-} {-# ANN unsafeToReset hasBlackBox #-} +class HasKnownDomain a where + provideKnownDomainFrom :: a dom -> (KnownDomain dom => r) -> r + +instance HasKnownDomain Clock where + provideKnownDomainFrom (Clock{}) f = f + +instance HasKnownDomain DiffClock where + provideKnownDomainFrom (DiffClock clkP _) = provideKnownDomainFrom clkP + +instance HasKnownDomain Reset where + provideKnownDomainFrom (Reset{}) f = f + + -- | Interpret a signal of bools as an active high reset and convert it to -- a reset signal corresponding to the domain's setting. -- From d9b940effa77e5d7404104acdef0d30a61a597f2 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 2 Oct 2023 14:55:58 +0200 Subject: [PATCH 11/27] Add ZKnownDomain dummy contraint * ZKnownDomain is used only blackboxes, it used to replace the KnownDomain there, so we can postpone the renumbering of arguments --- clash-prelude/src/Clash/Explicit/Signal.hs | 1 + clash-prelude/src/Clash/Signal/Internal.hs | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index b4247e496f..92e4945978 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -155,6 +155,7 @@ module Clash.Explicit.Signal -- * Domain , Domain , KnownDomain(..) + , ZKnownDomain , KnownConfiguration , ActiveEdge(..) , SActiveEdge(..) diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 435dbcfeb6..7cf806b58b 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -43,6 +43,7 @@ module Clash.Signal.Internal , Domain , sameDomain , KnownDomain(..) + , ZKnownDomain , KnownConfiguration , knownDomainByName , ActiveEdge(..) @@ -172,6 +173,7 @@ module Clash.Signal.Internal where import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) +import Data.Kind (Constraint) import Type.Reflection (Typeable) import Control.Arrow.Transformer.Automaton #if !MIN_VERSION_base(4,18,0) @@ -463,6 +465,11 @@ deriving instance Show (SDomainConfiguration dom conf) type KnownConfiguration dom conf = (KnownDomain dom, KnownConf dom ~ conf) +-- temp constraint placeholder so we don't have to renumber the prim args just yet +{- # DEPRECATED ZKnownDomain ["ZKnownDomain is a transitional dummy constraint."] #-} +type ZKnownDomain (dom :: Domain) = () :: Constraint + + -- | 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 From bfe4968ca5108c06069c370404bb37f05f10bf1b Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Thu, 5 Oct 2023 17:11:58 +0200 Subject: [PATCH 12/27] Remove KnownDomain from clash-lib/prims For the more complex ones I've replaced KnownDomain with the a dummy ZKnownDomain constraint, so the argument numbers stay the same for now. --- .../Clash_Explicit_Signal.primitives.yaml | 10 ++- .../Clash_Explicit_Testbench.primitives.yaml | 10 ++- .../Clash_Explicit_Testbench.primitives.yaml | 3 +- .../Clash_Explicit_BlockRam.primitives.yaml | 18 ++--- ...ash_Explicit_BlockRam_Blob.primitives.yaml | 6 +- ...ash_Explicit_BlockRam_File.primitives.yaml | 6 +- .../Clash_Explicit_RAM.primitives.yaml | 6 +- .../Clash_Explicit_ROM.primitives.yaml | 6 +- .../Clash_Explicit_ROM_Blob.primitives.yaml | 6 +- .../Clash_Explicit_ROM_File.primitives.yaml | 6 +- .../Clash_Explicit_Testbench.primitives.yaml | 9 ++- .../Clash_Signal_Internal.primitives.yaml | 24 +++---- .../Clash_Explicit_BlockRam.primitives.yaml | 18 ++--- ...ash_Explicit_BlockRam_Blob.primitives.yaml | 6 +- ...ash_Explicit_BlockRam_File.primitives.yaml | 6 +- .../Clash_Explicit_RAM.primitives.yaml | 6 +- .../Clash_Explicit_ROM.primitives.yaml | 6 +- .../Clash_Explicit_ROM_Blob.primitives.yaml | 6 +- .../Clash_Explicit_ROM_File.primitives.yaml | 6 +- .../Clash_Explicit_Testbench.primitives.yaml | 8 +-- .../Clash_Signal_Internal.primitives.yaml | 24 +++---- .../Clash_Explicit_BlockRam.primitives.yaml | 18 ++--- ...ash_Explicit_BlockRam_Blob.primitives.yaml | 4 +- ...ash_Explicit_BlockRam_File.primitives.yaml | 10 +-- .../vhdl/Clash_Explicit_RAM.primitives.yaml | 6 +- .../vhdl/Clash_Explicit_ROM.primitives.yaml | 4 +- .../Clash_Explicit_ROM_Blob.primitives.yaml | 4 +- .../Clash_Explicit_ROM_File.primitives.yaml | 6 +- .../Clash_Explicit_Testbench.primitives.yaml | 11 ++-- .../Clash_Signal_Internal.primitives.yaml | 40 ++++++------ clash-prelude/src/Clash/Explicit/BlockRam.hs | 65 ++++++------------- .../src/Clash/Explicit/BlockRam/Blob.hs | 10 ++- .../src/Clash/Explicit/BlockRam/File.hs | 14 ++-- clash-prelude/src/Clash/Explicit/RAM.hs | 12 ++-- clash-prelude/src/Clash/Explicit/ROM.hs | 8 +-- clash-prelude/src/Clash/Explicit/ROM/Blob.hs | 10 ++- clash-prelude/src/Clash/Explicit/ROM/File.hs | 14 ++-- clash-prelude/src/Clash/Explicit/Signal.hs | 4 +- clash-prelude/src/Clash/Explicit/Testbench.hs | 32 +++------ clash-prelude/src/Clash/Signal/Internal.hs | 16 ++--- 40 files changed, 214 insertions(+), 270 deletions(-) diff --git a/clash-lib/prims/common/Clash_Explicit_Signal.primitives.yaml b/clash-lib/prims/common/Clash_Explicit_Signal.primitives.yaml index 362a356807..41967e1f09 100644 --- a/clash-lib/prims/common/Clash_Explicit_Signal.primitives.yaml +++ b/clash-lib/prims/common/Clash_Explicit_Signal.primitives.yaml @@ -14,11 +14,9 @@ kind: Expression type: |- unsafeSynchronizer - :: ( KnownDomain dom1 -- ARG[0] - , KnownDomain dom2 ) -- ARG[1] - => Clock dom1 -- ARG[2] - -> Clock dom2 -- ARG[3] - -> Signal dom1 a -- ARG[4] + :: Clock dom1 -- ARG[0] + -> Clock dom2 -- ARG[1] + -> Signal dom1 a -- ARG[2] -> Signal dom2 a - template: ~ARG[4] + template: ~ARG[2] workInfo: Never diff --git a/clash-lib/prims/common/Clash_Explicit_Testbench.primitives.yaml b/clash-lib/prims/common/Clash_Explicit_Testbench.primitives.yaml index 12b37629a3..f139b88e5b 100644 --- a/clash-lib/prims/common/Clash_Explicit_Testbench.primitives.yaml +++ b/clash-lib/prims/common/Clash_Explicit_Testbench.primitives.yaml @@ -4,12 +4,10 @@ type: |- unsafeSimSynchronizer :: forall dom1 dom2 a - . ( KnownDomain dom1 -- ARG[0] - , KnownDomain dom2 ) -- ARG[1] - => Clock dom1 -- ARG[2] - -> Clock dom2 -- ARG[3] - -> Signal dom1 a -- ARG[4] + . Clock dom1 -- ARG[0] + -> Clock dom2 -- ARG[1] + -> Signal dom1 a -- ARG[2] -> Signal dom2 a - template: ~ARG[4] + template: ~ARG[2] warning: Clash.Explicit.Testbench.unsafeSimSynchronizer is not safely synthesizable! workInfo: Never diff --git a/clash-lib/prims/commonverilog/Clash_Explicit_Testbench.primitives.yaml b/clash-lib/prims/commonverilog/Clash_Explicit_Testbench.primitives.yaml index b8810d53bf..956407236b 100644 --- a/clash-lib/prims/commonverilog/Clash_Explicit_Testbench.primitives.yaml +++ b/clash-lib/prims/commonverilog/Clash_Explicit_Testbench.primitives.yaml @@ -8,4 +8,5 @@ - BlackBox: name: Clash.Explicit.Testbench.seClockToDiffClock kind: Expression - template: '{~ARG[1], ~ ~ARG[1]}' + type: 'seClockToDiffClock :: Clock dom -> DiffClock dom' + template: '{~ARG[0], ~ ~ARG[0]}' diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml index 0e83169735..38b000f5b1 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- blockRam# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -21,7 +21,7 @@ initial begin ~SYM[1] = ~CONST[5]; end~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; @@ -35,7 +35,7 @@ ~SYM[2] <= ~SYM[1][~ARG[6]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; end @@ -48,7 +48,7 @@ kind: Declaration type: |- blockRamU# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -63,7 +63,7 @@ // blockRamU begin, ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LIT[5]-1]; logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; @@ -77,7 +77,7 @@ ~SYM[2] <= ~SYM[1][~ARG[6]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; end @@ -90,7 +90,7 @@ kind: Declaration type: |- blockRam1# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -109,7 +109,7 @@ initial begin ~SYM[1] = '{default: ~CONST[6]}; end~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; @@ -123,7 +123,7 @@ ~SYM[2] <= ~SYM[1][~ARG[7]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~TOBV[~ARG[10]][~TYP[10]]; end diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives.yaml index 353001dbaa..7c80a71cb2 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_Blob.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- blockRamBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -19,7 +19,7 @@ initial begin ~SYM[1] = ~CONST[3]; end~IF ~ISACTIVEENABLE[2] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN if (~ARG[2]) begin if (~ARG[5]) begin ~SYM[1][~ARG[6]] <= ~ARG[7]; @@ -33,7 +33,7 @@ ~SYM[2] <= ~SYM[1][~ARG[4]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] if (~ARG[5]) begin ~SYM[1][~ARG[6]] <= ~ARG[7]; end diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives.yaml index 9c0ec142c5..1497fd4254 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam_File.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- blockRamFile# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat m -- ARG[1] , HasCallStack ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -24,7 +24,7 @@ $readmemb(~FILE[~LIT[6]],~SYM[1]); end ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~ARG[10]; @@ -38,7 +38,7 @@ ~SYM[2] <= ~SYM[1][~ARG[7]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~ARG[10]; end diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_RAM.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_RAM.primitives.yaml index 14411d88b8..20bdfbf666 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_RAM.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_RAM.primitives.yaml @@ -4,8 +4,8 @@ type: |- asyncRam# :: ( HasCallStack -- ARG[0] - , KnownDomain wdom -- ARG[1] - , KnownDomain rdom -- ARG[2] + , ZKnownDomain wdom -- ARG[1] + , ZKnownDomain rdom -- ARG[2] , NFDataX a ) -- ARG[3] => Clock wdom -- ^ wclk, ARG[4] -> Clock rdom -- ^ rclk, ARG[5] @@ -19,7 +19,7 @@ template: |- // asyncRam begin logic [~SIZE[~TYP[11]]-1:0] ~GENSYM[RAM][0] [0:~LIT[7]-1]; - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[4]) begin : ~GENSYM[~COMPNAME_Ram][1] + always @(~IF~ACTIVEEDGE[Rising][4]~THENposedge~ELSEnegedge~FI ~ARG[4]) begin : ~GENSYM[~COMPNAME_Ram][1] if (~IF ~ISACTIVEENABLE[6] ~THEN ~ARG[6] & ~ELSE ~FI ~ARG[9]) begin ~SYM[0][~ARG[10]] <= ~TOBV[~ARG[11]][~TYP[11]]; end diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_ROM.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_ROM.primitives.yaml index 4e61a36a62..63dd68f483 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_ROM.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_ROM.primitives.yaml @@ -2,7 +2,7 @@ name: Clash.Explicit.ROM.rom# kind: Declaration type: |- - rom# :: ( KnownDomain dom ARG[0] + rom# :: ( ZKnownDomain dom ARG[0] , KnownNat n -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -16,12 +16,12 @@ assign ~SYM[1] = ~LIT[5]; logic [~SIZE[~TYPO]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][3] if (~ARG[4]) begin ~SYM[2] <= ~SYM[1][~ARG[6]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] ~SYM[2] <= ~SYM[1][~ARG[6]]; end~FI diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives.yaml index c03094eaa1..c203a588d5 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_Blob.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- romBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -15,12 +15,12 @@ assign ~SYM[1] = ~CONST[3]; logic [~SIZE[~TYPO]-1:0] ~GENSYM[~RESULT_q][2];~IF ~ISACTIVEENABLE[2] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][3] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][3] if (~ARG[2]) begin ~SYM[2] <= ~SYM[1][~ARG[4]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[3] ~SYM[2] <= ~SYM[1][~ARG[4]]; end~FI diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_ROM_File.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_File.primitives.yaml index bf7698ba02..a5ed252b28 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_ROM_File.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_ROM_File.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom ) -- ARG[1] + , ZKnownDomain dom ) -- ARG[1] => Clock dom -- clk, ARG[2] -> Enable dom -- en, ARG[3] -> SNat n -- sz, ARG[4] @@ -19,12 +19,12 @@ end ~SIGDO[~GENSYM[~RESULT_q][1]];~IF ~ISACTIVEENABLE[3] ~THEN - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] if (~ARG[3]) begin ~SYM[1] <= ~SYM[0][~ARG[6]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] ~SYM[1] <= ~SYM[0][~ARG[6]]; end~FI diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml index 94575a67bf..b05929baaa 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_Testbench.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) + :: (ZKnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) => Clock dom -- ARG[3] -> Reset dom -- ARG[4] -> String -- ARG[5] @@ -14,7 +14,7 @@ template: |- // assert begin // pragma translate_off - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin if (~ARG[6] !== ~ARG[7]) begin $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[5], ~TOBV[~ARG[7]][~TYP[7]], ~TOBV[~ARG[6]][~TYP[6]]); $stop; @@ -28,7 +28,7 @@ kind: Declaration type: |- assertBitVector - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat n ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -44,7 +44,7 @@ wire ~TYP[6] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; wire ~TYP[6] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin if (~SYM[1] !== ~SYM[2]) begin $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[4], ~TOBV[~ARG[6]][~TYP[6]], ~TOBV[~ARG[5]][~TYP[5]]); $stop; @@ -53,4 +53,3 @@ // pragma translate_on assign ~RESULT = ~ARG[7]; // assertBitVector end - diff --git a/clash-lib/prims/systemverilog/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Signal_Internal.primitives.yaml index ef07c52c2e..8d19adb3f8 100644 --- a/clash-lib/prims/systemverilog/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Signal_Internal.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- delay# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , Undefined a ) -- ARG[1] => Clock dom -- ARG[2] -> Enable dom -- ARG[3] @@ -12,17 +12,17 @@ -> Signal clk a -- ARG[5] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[4]~ELSE~FI resultName: template: ~CTXNAME template: |- // delay begin~IF ~ISACTIVEENABLE[3] ~THEN - always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] + always_ff @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] if (~ARG[3]) begin ~RESULT <= ~ARG[5]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] ~RESULT <= ~ARG[5]; end~FI // delay end @@ -32,7 +32,7 @@ outputUsage: NonBlocking type: |- asyncRegister# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , NFDataX a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -42,13 +42,13 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- // async register begin - always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + always_ff @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[3] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[3] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin ~RESULT <= ~CONST[6]; end else ~FI~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin ~RESULT <= ~ARG[7]; @@ -61,7 +61,7 @@ outputUsage: NonBlocking type: |- register# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , Undefined a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -71,13 +71,13 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- // register begin - always_ff @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + always_ff @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[3] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[3] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[3] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin ~RESULT <= ~CONST[6]; end else ~FI~IF ~ISACTIVEENABLE[4] ~THEN if (~ARG[4]) ~ELSE ~FI begin ~RESULT <= ~ARG[7]; diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml index 51a9b03069..97d695156f 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRam# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -28,7 +28,7 @@ end end ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~ARG[9]; @@ -42,7 +42,7 @@ ~RESULT <= ~SYM[1][~ARG[6]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] if (~ARG[7]) begin ~SYM[1][~ARG[8]] <= ~ARG[9]; end @@ -55,7 +55,7 @@ outputUsage: NonBlocking type: |- blockRamU# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -71,7 +71,7 @@ reg ~TYPO ~GENSYM[~RESULT_RAM][0] [0:~LIT[5]-1]; ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[7]) begin ~SYM[0][~ARG[8]] <= ~ARG[9]; @@ -85,7 +85,7 @@ ~RESULT <= ~SYM[0][~ARG[6]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] if (~ARG[7]) begin ~SYM[0][~ARG[8]] <= ~ARG[9]; end @@ -98,7 +98,7 @@ outputUsage: NonBlocking type: |- blockRam1# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -121,7 +121,7 @@ end ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[8]) begin ~SYM[0][~ARG[9]] <= ~ARG[10]; @@ -135,7 +135,7 @@ ~RESULT <= ~SYM[0][~ARG[7]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] if (~ARG[8]) begin ~SYM[0][~ARG[9]] <= ~ARG[10]; end diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives.yaml index 803c656368..d3860e199e 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_Blob.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRamBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -26,7 +26,7 @@ end end ~IF ~ISACTIVEENABLE[2] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN if (~ARG[2]) begin if (~ARG[5]) begin ~SYM[1][~ARG[6]] <= ~ARG[7]; @@ -40,7 +40,7 @@ ~RESULT <= ~SYM[1][~ARG[4]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] if (~ARG[5]) begin ~SYM[1][~ARG[6]] <= ~ARG[7]; end diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam_File.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_File.primitives.yaml index 378a2354d5..66f074df6c 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_BlockRam_File.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam_File.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRamFile# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat m -- ARG[1] , HasCallStack ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -24,7 +24,7 @@ $readmemb(~FILE[~LIT[6]],~SYM[1]); end ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRamFile][3]~IF ~VIVADO ~THEN if (~ARG[4]) begin if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~ARG[10]; @@ -38,7 +38,7 @@ ~RESULT <= ~SYM[1][~ARG[7]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] if (~ARG[8]) begin ~SYM[1][~ARG[9]] <= ~ARG[10]; end diff --git a/clash-lib/prims/verilog/Clash_Explicit_RAM.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_RAM.primitives.yaml index 7a2e3bac1d..b5b14f28b0 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_RAM.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_RAM.primitives.yaml @@ -4,8 +4,8 @@ type: |- asyncRam# :: ( HasCallStack -- ARG[0] - , KnownDomain wdom -- ARG[1] - , KnownDomain rdom -- ARG[2] + , ZKnownDomain wdom -- ARG[1] + , ZKnownDomain rdom -- ARG[2] , NFDataX a ) -- ARG[3] => Clock wdom -- ^ wclk, ARG[4] -> Clock rdom -- ^ rclk, ARG[5] @@ -19,7 +19,7 @@ template: |- // asyncRam begin reg ~TYPO ~GENSYM[RAM][0] [0:~LIT[7]-1]; - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[4]) begin : ~GENSYM[~COMPNAME_Ram][1] + always @(~IF~ACTIVEEDGE[Rising][4]~THENposedge~ELSEnegedge~FI ~ARG[4]) begin : ~GENSYM[~COMPNAME_Ram][1] if (~ARG[9] ~IF ~ISACTIVEENABLE[6] ~THEN & ~ARG[6] ~ELSE ~FI) begin ~SYM[0][~ARG[10]] <= ~ARG[11]; end diff --git a/clash-lib/prims/verilog/Clash_Explicit_ROM.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_ROM.primitives.yaml index 2f4bda73f9..7473d66a0c 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_ROM.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_ROM.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration outputUsage: NonBlocking type: |- - rom# :: ( KnownDomain dom ARG[0] + rom# :: ( ZKnownDomain dom ARG[0] , KnownNat n -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -24,12 +24,12 @@ end end ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][5] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_rom][5] if (~ARG[4]) begin ~RESULT <= ~SYM[1][~ARG[6]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] ~RESULT <= ~SYM[1][~ARG[6]]; end~FI // rom end diff --git a/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives.yaml index 2186c89ea2..3367762179 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_ROM_Blob.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- romBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -23,12 +23,12 @@ end end ~IF ~ISACTIVEENABLE[2] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][5] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~GENSYM[~COMPNAME_rom][5] if (~ARG[2]) begin ~RESULT <= ~SYM[1][~ARG[4]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] + always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[1]) begin : ~SYM[5] ~RESULT <= ~SYM[1][~ARG[4]]; end~FI // romBlob end diff --git a/clash-lib/prims/verilog/Clash_Explicit_ROM_File.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_ROM_File.primitives.yaml index 1776686d59..8240a0fbe2 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_ROM_File.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_ROM_File.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom ) -- ARG[1] + , ZKnownDomain dom ) -- ARG[1] => Clock dom -- clk, ARG[2] -> Enable dom -- en, ARG[3] -> SNat n -- sz, ARG[4] @@ -19,12 +19,12 @@ $readmemb(~FILE[~LIT[5]],~SYM[0]); end ~IF ~ISACTIVEENABLE[3] ~THEN - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_romFile][2] if (~ARG[3]) begin ~RESULT <= ~SYM[0][~ARG[6]]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][1]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[2] ~RESULT <= ~SYM[0][~ARG[6]]; end~FI // romFile end diff --git a/clash-lib/prims/verilog/Clash_Explicit_Testbench.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_Testbench.primitives.yaml index 2c74018c44..f9ec24d447 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_Testbench.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_Testbench.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration type: |- assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) + :: (ZKnownDomain dom, Eq a, ShowX a) -- (ARG[0], ARG[1], ARG[2]) => Clock dom -- ARG[3] -> Reset dom -- ARG[4] -> String -- ARG[5] @@ -14,7 +14,7 @@ template: |- // assert begin // pragma translate_off - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin if (~ARG[6] !== ~ARG[7]) begin $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[5], ~ARG[7], ~ARG[6]); $finish; @@ -28,7 +28,7 @@ kind: Declaration type: |- assertBitVector - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat n -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -44,7 +44,7 @@ wire ~TYP[5] ~GENSYM[checked][1] = ~ARG[5] ^ ~SYM[0]; wire ~TYP[5] ~GENSYM[expected][2] = ~ARG[6] ^ ~SYM[0]; - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin if (~SYM[1] !== ~SYM[2]) begin $display("@%0tns: %s, expected: %b, actual: %b", $time, ~LIT[4], ~ARG[6], ~ARG[5]); $finish; diff --git a/clash-lib/prims/verilog/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/verilog/Clash_Signal_Internal.primitives.yaml index b6ccd37d7a..b6b31426f4 100644 --- a/clash-lib/prims/verilog/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Signal_Internal.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- delay# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , Undefined a ) -- ARG[1] => Clock dom -- ARG[2] -> Enable dom -- ARG[3] @@ -12,17 +12,17 @@ -> Signal clk a -- ARG[5] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[4]~ELSE~FI resultName: template: ~CTXNAME template: |- // delay begin~IF ~ISACTIVEENABLE[3] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_delay][1] if (~ARG[3]) begin ~RESULT <= ~ARG[5]; end end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[1] ~RESULT <= ~ARG[5]; end~FI // delay end @@ -32,7 +32,7 @@ outputUsage: NonBlocking type: |- asyncRegister# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , NFDataX a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -42,13 +42,13 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- // async register begin - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[3] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[3] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin ~RESULT <= ~CONST[6]; end else ~FI~IF ~ISACTIVEENABLE[4] ~THENif (~ARG[4]) ~ELSE~FIbegin ~RESULT <= ~ARG[7]; @@ -61,7 +61,7 @@ outputUsage: NonBlocking type: |- register# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , Undefined a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -71,13 +71,13 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- // register begin - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[0] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[0] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]~IF ~ISSYNC[3] ~THEN ~ELSE~IF ~ISUNDEFINED[6] ~THEN ~ELSE or ~IF ~ISACTIVEHIGH[3] ~THEN posedge ~ELSE negedge ~FI ~VAR[rst][3]~FI~FI) begin : ~GENSYM[~RESULT_register][1] + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif (~IF ~ISACTIVEHIGH[3] ~THEN ~ELSE ! ~FI~VAR[rst][3]) begin ~RESULT <= ~CONST[6]; end else ~FI~IF ~ISACTIVEENABLE[4] ~THENif (~ARG[4]) ~ELSE~FIbegin ~RESULT <= ~ARG[7]; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml index 6dbb756b24..747d13ae1e 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRam# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -36,7 +36,7 @@ ~IF ~VIVADO ~THEN ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; end if; @@ -45,7 +45,7 @@ end process; ~ELSE ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~ARG[9]; end if; @@ -60,7 +60,7 @@ outputUsage: NonBlocking type: |- blockRamU# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -94,7 +94,7 @@ ~IF ~VIVADO ~THEN ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; end if; @@ -103,7 +103,7 @@ end process; ~ELSE ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~ARG[9]; end if; @@ -118,7 +118,7 @@ outputUsage: NonBlocking type: |- blockRam1# - :: ( KnownDomain dom ARG[0] + :: ( ZKnownDomain dom ARG[0] , HasCallStack -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -153,7 +153,7 @@ ~IF ~VIVADO ~THEN ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[10]][~TYP[10]]; end if; @@ -162,7 +162,7 @@ end process; ~ELSE ~SYM[6] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[8] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then ~SYM[2](~SYM[5]) <= ~ARG[10]; end if; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives.yaml index a4a4460d69..f6655309e4 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_Blob.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRamBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -33,7 +33,7 @@ ; ~SYM[6] : process(~ARG[1]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1]) then + if ~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1]) then if ~ARG[5]~IF~ISACTIVEENABLE[2]~THEN and ~ARG[2]~ELSE~FI then ~SYM[2](~SYM[5]) <= ~ARG[7]; end if; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_File.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_File.primitives.yaml index aaea9f15e9..279eeb1450 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_File.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam_File.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- blockRamFile# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat m -- ARG[1] , HasCallStack ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -51,7 +51,7 @@ ~IF ~VIVADO ~THEN ~IF ~ISACTIVEENABLE[4] ~THEN ~GENSYM[blockRamFile_sync][10] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[4] then if ~ARG[8] then ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); @@ -62,7 +62,7 @@ end process;~ELSE ~SYM[10] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[8] then ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); end if; @@ -71,7 +71,7 @@ end process;~FI ~ELSE ~IF ~ISACTIVEENABLE[4] ~THEN ~SYM[10] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[8] and ~ARG[4] then ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); end if; @@ -82,7 +82,7 @@ end process;~ELSE ~SYM[10] : process(~ARG[3]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then + if ~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then if ~ARG[8] then ~SYM[3](~SYM[6]) <= to_bitvector(~ARG[10]); end if; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_RAM.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_RAM.primitives.yaml index b85729480d..0797b28f52 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_RAM.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_RAM.primitives.yaml @@ -4,8 +4,8 @@ type: |- asyncRam# :: ( HasCallStack -- ARG[0] - , KnownDomain wdom -- ARG[1] - , KnownDomain rdom -- ARG[2] + , ZKnownDomain wdom -- ARG[1] + , ZKnownDomain rdom -- ARG[2] , NFDataX a ) -- ARG[3] => Clock wdom -- ^ wclk, ARG[4] -> Clock rdom -- ^ rclk, ARG[5] @@ -38,7 +38,7 @@ ; ~GENSYM[asyncRam_sync][7] : process(~ARG[4]) begin - if ~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then + if ~IF~ACTIVEEDGE[Rising][4]~THENrising_edge~ELSEfalling_edge~FI(~ARG[4]) then if (~ARG[9] ~IF ~ISACTIVEENABLE[6] ~THEN and ~ARG[6] ~ELSE ~FI) then~IF ~VIVADO ~THEN ~SYM[1](~SYM[3]) <= ~TOBV[~ARG[11]][~TYP[11]];~ELSE ~SYM[1](~SYM[3]) <= ~ARG[11];~FI diff --git a/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives.yaml index 0920c7070f..aa658ac3f7 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_ROM.primitives.yaml @@ -3,7 +3,7 @@ kind: Declaration outputUsage: NonBlocking type: |- - rom# :: ( KnownDomain dom ARG[0] + rom# :: ( ZKnownDomain dom ARG[0] , KnownNat n -- ARG[1] , Undefined a ) -- ARG[2] => Clock dom -- clk, ARG[3] @@ -26,7 +26,7 @@ ; ~GENSYM[romSync][6] : process (~ARG[3]) begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI) then~IF ~VIVADO ~THEN + if (~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI) then~IF ~VIVADO ~THEN ~RESULT <= ~FROMBV[~SYM[2](~SYM[3])][~TYPO];~ELSE ~RESULT <= ~SYM[2](~SYM[3]);~FI end if; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives.yaml index b87bbb5724..67822db004 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_ROM_Blob.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- romBlob# - :: KnownDomain dom -- ARG[0] + :: ZKnownDomain dom -- ARG[0] => Clock dom -- clk, ARG[1] -> Enable dom -- en, ARG[2] -> MemBlob n m -- init, ARG[3] @@ -25,7 +25,7 @@ ; ~GENSYM[romSync][6] : process (~ARG[1]) begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1])~IF~ISACTIVEENABLE[2]~THEN and ~ARG[2]~ELSE~FI) then + if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[1])~IF~ISACTIVEENABLE[2]~THEN and ~ARG[2]~ELSE~FI) then ~RESULT <= ~SYM[2](~SYM[3]); end if; end process; diff --git a/clash-lib/prims/vhdl/Clash_Explicit_ROM_File.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_ROM_File.primitives.yaml index 087715bb48..4eb82e9738 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_ROM_File.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_ROM_File.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- romFile# :: ( KnownNat m -- ARG[0] - , KnownDomain dom -- ARG[1] + , ZKnownDomain dom -- ARG[1] => Clock dom -- clk, ARG[2] -> Enable dom -- en, ARG[3] -> SNat n -- sz, ARG[4] @@ -39,7 +39,7 @@ ~IF ~ISACTIVEENABLE[3] ~THEN ~GENSYM[romFileSync][7] : process (~ARG[2]) begin - if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + if (~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then if ~ARG[3] then ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); end if; @@ -47,7 +47,7 @@ end process;~ELSE ~SYM[7] : process (~ARG[2]) begin - if (~IF~ACTIVEEDGE[Rising][1]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + if (~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then ~RESULT <= to_stdlogicvector(~SYM[2](~SYM[3])); end if; end process;~FI diff --git a/clash-lib/prims/vhdl/Clash_Explicit_Testbench.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_Testbench.primitives.yaml index 49b57e19fd..db0b23215d 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_Testbench.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_Testbench.primitives.yaml @@ -32,7 +32,7 @@ kind: Declaration type: |- assert - :: (KnownDomain dom, Eq a, ShowX a) -- (ARG[0],ARG[1],ARG[2]) + :: (ZKnownDomain dom, Eq a, ShowX a) -- (ARG[0],ARG[1],ARG[2]) => Clock dom -- ARG[3] -> Reset dom -- ARG[4] -> String -- ARG[5] @@ -53,7 +53,7 @@ ~SYM[3] <= ~ARG[7]; process(~ARG[3]) is begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])) then + if (~IF~ACTIVEEDGE[Rising][3]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3])) then assert (toSLV(~SYM[2]) = toSLV(~SYM[3])) report (~LIT[5] & ", expected: " & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & ", actual: " & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; end if; end process; @@ -118,7 +118,7 @@ kind: Declaration type: |- assertBitVector - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , KnownNat n ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -140,7 +140,7 @@ ~SYM[3] <= ~ARG[6]; process(~ARG[2]) is begin - if (~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then + if (~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2])) then assert (~INCLUDENAME[0].non_std_match(toSLV(~SYM[2]),toSLV(~SYM[3]))) report (~LIT[4] & ", expected: " & ~INCLUDENAME[0].slv2string(toSLV(~SYM[3])) & ", actual: " & ~INCLUDENAME[0].slv2string(toSLV(~SYM[2]))) severity error; end if; end process; @@ -158,4 +158,5 @@ - BlackBox: name: Clash.Explicit.Testbench.seClockToDiffClock kind: Expression - template: (~ARG[1], not ~ARG[1]) + type: 'seClockToDiffClock :: Clock dom -> DiffClock dom' + template: (~ARG[0], not ~ARG[0]) diff --git a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml index 6de077240e..5bee115b93 100644 --- a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml @@ -4,7 +4,7 @@ outputUsage: NonBlocking type: |- delay# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , Undefined a ) -- ARG[1] => Clock dom -- ARG[2] -> Enable dom -- ARG[3] @@ -12,14 +12,14 @@ -> Signal clk a -- ARG[5] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[4]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[4]~ELSE~FI resultName: template: ~CTXNAME template: |- -- delay begin~IF ~ISACTIVEENABLE[3] ~THEN ~GENSYM[~RESULT_delay][4] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then if ~ARG[3] then ~RESULT <= ~ARG[5]; end if; @@ -27,7 +27,7 @@ end process;~ELSE ~SYM[4] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then ~RESULT <= ~ARG[5]; end if; end process;~FI @@ -38,7 +38,7 @@ outputUsage: NonBlocking type: |- asyncRegister# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , NFDataX a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -48,16 +48,16 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- -- async register begin ~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) begin - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[3] ~THEN '1' ~ELSE '0' ~FI then ~RESULT <= ~CONST[6]; - els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + els~FIif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then ~IF ~ISACTIVEENABLE[4] ~THEN if ~ARG[4] then ~RESULT <= ~ARG[7]; @@ -74,7 +74,7 @@ outputUsage: NonBlocking type: |- register# - :: ( KnownDomain dom -- ARG[0] + :: ( ZKnownDomain dom -- ARG[0] , NFDataX a ) -- ARG[1] => Clock dom -- ARG[2] -> Reset dom -- ARG[3] @@ -84,15 +84,15 @@ -> Signal clk a -- ARG[7] -> Signal clk a resultInit: - template: ~IF~ISINITDEFINED[0]~THEN~CONST[5]~ELSE~FI + template: ~IF~ISINITDEFINED[2]~THEN~CONST[5]~ELSE~FI resultName: template: ~CTXNAME template: |- - -- register begin~IF ~ISACTIVEENABLE[4] ~THEN ~IF ~ISSYNC[0] ~THEN + -- register begin~IF ~ISACTIVEENABLE[4] ~THEN ~IF ~ISSYNC[3] ~THEN ~GENSYM[~RESULT_register][2] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[3] ~THEN '1' ~ELSE '0' ~FI then ~RESULT <= ~CONST[6]; els~FIif ~ARG[4] then ~RESULT <= ~ARG[7]; @@ -101,18 +101,18 @@ end process;~ELSE ~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) begin - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[3] ~THEN '1' ~ELSE '0' ~FI then ~RESULT <= ~CONST[6]; - els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + els~FIif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then if ~ARG[4] then ~RESULT <= ~ARG[7]; end if; end if; - end process;~FI~ELSE ~IF ~ISSYNC[0] ~THEN + end process;~FI~ELSE ~IF ~ISSYNC[3] ~THEN ~SYM[2] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[3] ~THEN '1' ~ELSE '0' ~FI then ~RESULT <= ~CONST[6]; else ~FI~RESULT <= ~ARG[7]; @@ -121,9 +121,9 @@ end process;~ELSE ~SYM[2] : process(~ARG[2]~IF ~ISUNDEFINED[6] ~THEN ~ELSE,~ARG[3]~FI) begin - ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[0] ~THEN '1' ~ELSE '0' ~FI then + ~IF ~ISUNDEFINED[6] ~THEN ~ELSEif ~ARG[3] = ~IF ~ISACTIVEHIGH[3] ~THEN '1' ~ELSE '0' ~FI then ~RESULT <= ~CONST[6]; - els~FIif ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + els~FIif ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then ~RESULT <= ~ARG[7]; end if; end process;~FI~FI diff --git a/clash-prelude/src/Clash/Explicit/BlockRam.hs b/clash-prelude/src/Clash/Explicit/BlockRam.hs index 17eb13a26b..919e800d4c 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam.hs @@ -130,8 +130,7 @@ We initially create a memory out of simple registers: @ dataMem - :: KnownDomain dom - => Clock dom + :: Clock dom -> Reset dom -> Enable dom -> Signal dom MemAddr @@ -156,8 +155,7 @@ And then connect everything: @ system - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -226,8 +224,7 @@ has the potential to be translated to a more efficient structure: @ system2 - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -318,8 +315,7 @@ We can now finally instantiate our system with a 'blockRam': @ system3 - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -447,7 +443,7 @@ import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), HDL(..), hasBlackBox) import Clash.Class.Num (SaturationMode(SatBound), satSucc) import Clash.Explicit.BlockRam.Model (TdpbramModelConfig(..), tdpbramModel) -import Clash.Explicit.Signal (KnownDomain, Enable, register, fromEnable) +import Clash.Explicit.Signal (ZKnownDomain, Enable, register, fromEnable) import Clash.Promoted.Nat (SNat(..)) import Clash.Signal.Bundle (unbundle) import Clash.Signal.Internal @@ -580,8 +576,7 @@ let cpu :: Vec 7 Value -- ^ Register bank >>> :{ let dataMem - :: KnownDomain dom - => Clock dom + :: Clock dom -> Reset dom -> Enable dom -> Signal dom MemAddr @@ -599,8 +594,7 @@ let dataMem >>> :{ let system - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -647,8 +641,7 @@ prog = -- 0 := 4 >>> :{ let system2 - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -698,8 +691,7 @@ let cpu2 :: (Vec 7 Value,Reg) -- ^ (Register bank, Load reg addr) >>> :{ let system3 - :: ( KnownDomain dom - , KnownNat n ) + :: ( KnownNat n ) => Vec n Instruction -> Clock dom -> Reset dom @@ -774,8 +766,7 @@ prog2 = -- 0 := 4 -- bram40 clk en = 'blockRam' clk en ('Clash.Sized.Vector.replicate' d40 1) -- @ blockRam - :: ( KnownDomain dom - , HasCallStack + :: ( HasCallStack , NFDataX a , Enum addr , NFDataX addr ) @@ -828,8 +819,7 @@ blockRam = \clk gen content rd wrM -> -- bram32 clk en = 'blockRamPow2' clk en ('Clash.Sized.Vector.replicate' d32 1) -- @ blockRamPow2 - :: ( KnownDomain dom - , HasCallStack + :: ( HasCallStack , NFDataX a , KnownNat n ) => Clock dom @@ -858,8 +848,7 @@ data ResetStrategy (r :: Bool) where -- an arbitrary state using a reset function. blockRamU :: forall n dom a r addr - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack , NFDataX a , Enum addr , NFDataX addr @@ -916,7 +905,7 @@ blockRamU clk rst0 en rstStrategy n@SNat initF rd0 mw0 = -- | blockRAMU primitive blockRamU# :: forall n dom a - . ( KnownDomain dom + . ( ZKnownDomain dom , HasCallStack , NFDataX a ) => Clock dom @@ -951,8 +940,7 @@ blockRamU# clk en SNat = -- memory positions blockRam1 :: forall n dom a r addr - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack , NFDataX a , Enum addr , NFDataX addr @@ -1009,7 +997,7 @@ blockRam1 clk rst0 en rstStrategy n@SNat a rd0 mw0 = -- | blockRAM1 primitive blockRam1# :: forall n dom a - . ( KnownDomain dom + . ( ZKnownDomain dom , HasCallStack , NFDataX a ) => Clock dom @@ -1040,7 +1028,7 @@ blockRam1# clk en n a = -- | blockRAM primitive blockRam# :: forall dom a n - . ( KnownDomain dom + . ( ZKnownDomain dom , HasCallStack , NFDataX a ) => Clock dom @@ -1136,8 +1124,7 @@ blockRam# _ _ _ = error "blockRam#: dynamic clocks not supported" -- | Create a read-after-write block RAM from a read-before-write one readNew - :: ( KnownDomain dom - , NFDataX a + :: ( NFDataX a , Eq addr ) => Clock dom -> Reset dom @@ -1196,8 +1183,6 @@ trueDualPortBlockRam :: forall nAddrs domA domB a . ( HasCallStack , KnownNat nAddrs - , KnownDomain domA - , KnownDomain domB , NFDataX a ) => Clock domA @@ -1244,8 +1229,6 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs - :< _knownDomainA - :< _knownDomainB :< _nfdataX :< clockA @@ -1315,8 +1298,6 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs - :< knownDomainA - :< knownDomainB :< _nfdataX :< clockA @@ -1349,7 +1330,7 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = ~SIGD[~GENSYM[b_dout][#{symDoutB}]][#{datB}]; // Port A - always @(~IF~ACTIVEEDGE[Rising][#{knownDomainA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin + always @(~IF~ACTIVEEDGE[Rising][#{clockA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin if(~ARG[#{enaA}]) begin ~SYM[#{symDoutA}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI]; if(~ARG[#{wenaA}]) begin @@ -1360,7 +1341,7 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = end // Port B - always @(~IF~ACTIVEEDGE[Rising][#{knownDomainB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin + always @(~IF~ACTIVEEDGE[Rising][#{clockB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin if(~ARG[#{enaB}]) begin ~SYM[#{symDoutB}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI]; if(~ARG[#{wenaB}]) begin @@ -1378,8 +1359,6 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = bbName = show 'trueDualPortBlockRam# _hasCallStack :< knownNatAddrs - :< knownDomainA - :< knownDomainB :< _nfdataX :< clockA @@ -1413,7 +1392,7 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = reg ~SIGD[~GENSYM[b_dout][#{symDoutB}]][#{datB}]; // Port A - always @(~IF~ACTIVEEDGE[Rising][#{knownDomainA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin + always @(~IF~ACTIVEEDGE[Rising][#{clockA}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockA}]) begin if(~ARG[#{enaA}]) begin ~SYM[#{symDoutA}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrA}]]~THEN~ARG[#{addrA}]~ELSE0~FI]; if(~ARG[#{wenaA}]) begin @@ -1424,7 +1403,7 @@ trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = end // Port B - always @(~IF~ACTIVEEDGE[Rising][#{knownDomainB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin + always @(~IF~ACTIVEEDGE[Rising][#{clockB}]~THENposedge~ELSEnegedge~FI ~ARG[#{clockB}]) begin if(~ARG[#{enaB}]) begin ~SYM[#{symDoutB}] <= ~SYM[#{symMem}][~IF~SIZE[~TYP[#{addrB}]]~THEN~ARG[#{addrB}]~ELSE0~FI]; if(~ARG[#{wenaB}]) begin @@ -1445,8 +1424,6 @@ trueDualPortBlockRam#, trueDualPortBlockRamWrapper :: forall nAddrs domA domB a . ( HasCallStack , KnownNat nAddrs - , KnownDomain domA - , KnownDomain domB , NFDataX a ) => diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs b/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs index 73b70f1271..c6a42ca496 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/Blob.hs @@ -56,7 +56,7 @@ import Clash.Annotations.Primitive (hasBlackBox) import Clash.Class.BitPack.Internal (BitPack, BitSize) import Clash.Explicit.BlockRam.Internal (MemBlob(..), packBVs, unpackMemBlob, unpackMemBlob0) -import Clash.Explicit.Signal (KnownDomain, Enable, fromEnable) +import Clash.Explicit.Signal (ZKnownDomain, Enable, fromEnable) import Clash.Promoted.Nat (natToInteger, natToNum) import Clash.Signal.Bundle (unbundle) import Clash.Signal.Internal (Clock, Signal(..), (.&&.)) @@ -88,8 +88,7 @@ import Clash.XException -- clk rst en ('blockRamBlob' clk en content) rd wrM@. blockRamBlob :: forall dom addr m n - . ( KnownDomain dom - , Enum addr + . ( Enum addr , NFDataX addr ) => Clock dom @@ -127,8 +126,7 @@ blockRamBlob = \clk gen content@MemBlob{} rd wrM -> -- clk rst en ('blockRamBlobPow2' clk en content) rd wrM@. blockRamBlobPow2 :: forall dom m n - . ( KnownDomain dom - , KnownNat n + . ( KnownNat n ) => Clock dom -- ^ 'Clock' to synchronize to @@ -150,7 +148,7 @@ blockRamBlobPow2 = blockRamBlob -- | blockRAMBlob primitive blockRamBlob# :: forall dom m n - . KnownDomain dom + . ZKnownDomain dom => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs index 385fd5eaab..90a44a3227 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs @@ -41,8 +41,7 @@ writeFile "memory.bin" (memFile Nothing [7 :: Unsigned 9 .. 13]) We can instantiate a block RAM using the contents of the file above like so: @ -f :: KnownDomain dom - => Clock dom +f :: Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) @@ -62,8 +61,7 @@ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ -g :: KnownDomain dom - => Clock dom +g :: Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) @@ -124,7 +122,7 @@ import Clash.Class.BitPack (BitPack, BitSize, pack) import Clash.Promoted.Nat (SNat (..), pow2SNat, natToNum, snatToNum) import Clash.Sized.Internal.BitVector (Bit(..), BitVector(..), undefined#) import Clash.Signal.Internal - (Clock(..), Signal (..), Enable, KnownDomain, fromEnable, (.&&.)) + (Clock(..), Signal (..), Enable, ZKnownDomain, fromEnable, (.&&.)) import Clash.Signal.Bundle (unbundle) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (maybeIsX, seqX, fromJustX, NFDataX(..), XException (..)) @@ -172,7 +170,7 @@ import Clash.XException (maybeIsX, seqX, fromJustX, NFDataX(..), XException -- create your own data files. blockRamFilePow2 :: forall dom n m - . (KnownDomain dom, KnownNat m, KnownNat n, HasCallStack) + . (KnownNat m, KnownNat n, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -219,7 +217,7 @@ blockRamFilePow2 = \clk en file rd wrM -> withFrozenCallStack -- * See "Clash.Sized.Fixed#creatingdatafiles" for more ideas on how to create -- your own data files. blockRamFile - :: (KnownDomain dom, KnownNat m, Enum addr, NFDataX addr, HasCallStack) + :: (KnownNat m, Enum addr, NFDataX addr, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -318,7 +316,7 @@ memFile care = foldr (\e -> showsBV $ pack e) "" -- | blockRamFile primitive blockRamFile# :: forall m dom n - . (KnownDomain dom, KnownNat m, HasCallStack) + . (ZKnownDomain dom, KnownNat m, HasCallStack) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom diff --git a/clash-prelude/src/Clash/Explicit/RAM.hs b/clash-prelude/src/Clash/Explicit/RAM.hs index b616ccd6eb..6d12d532f5 100644 --- a/clash-prelude/src/Clash/Explicit/RAM.hs +++ b/clash-prelude/src/Clash/Explicit/RAM.hs @@ -36,7 +36,7 @@ import GHC.TypeLits (KnownNat) import qualified Data.Sequence as Seq import Clash.Annotations.Primitive (hasBlackBox) -import Clash.Explicit.Signal (unbundle, KnownDomain, andEnable) +import Clash.Explicit.Signal (unbundle, ZKnownDomain, andEnable) import Clash.Promoted.Nat (SNat (..), snatToNum, pow2SNat) import Clash.Signal.Internal (Clock (..), ClockAB (..), Signal (..), Enable, fromEnable, clockTicks) @@ -58,8 +58,6 @@ asyncRamPow2 :: forall wdom rdom n a . ( KnownNat n , HasCallStack - , KnownDomain wdom - , KnownDomain rdom , NFDataX a ) => Clock wdom @@ -92,8 +90,6 @@ asyncRam :: ( Enum addr , NFDataX addr , HasCallStack - , KnownDomain wdom - , KnownDomain rdom , NFDataX a ) => Clock wdom @@ -121,8 +117,8 @@ asyncRam = \wclk rclk gen sz rd wrM -> asyncRam# :: forall wdom rdom n a . ( HasCallStack - , KnownDomain wdom - , KnownDomain rdom + , ZKnownDomain wdom + , ZKnownDomain rdom , NFDataX a ) => Clock wdom @@ -143,7 +139,7 @@ asyncRam# -- ^ Value to write (at address @w@) -> Signal rdom a -- ^ Value of the RAM at address @r@ -asyncRam# wClk rClk en sz rd we wr din = dout +asyncRam# wClk@(Clock{}) rClk@(Clock{}) en sz rd we wr din = dout where ramI = Seq.replicate szI diff --git a/clash-prelude/src/Clash/Explicit/ROM.hs b/clash-prelude/src/Clash/Explicit/ROM.hs index ec841290df..51074b8ee4 100644 --- a/clash-prelude/src/Clash/Explicit/ROM.hs +++ b/clash-prelude/src/Clash/Explicit/ROM.hs @@ -36,7 +36,7 @@ import Prelude hiding (length) import Clash.Annotations.Primitive (hasBlackBox) import Clash.Signal.Internal - (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) + (Clock (..), ZKnownDomain, Signal (..), Enable, fromEnable) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Vector (Vec, length, toList) import Clash.XException (deepErrorX, seqX, NFDataX) @@ -56,7 +56,7 @@ import Clash.XException (deepErrorX, seqX, NFDataX) -- 'Clash.Explicit.ROM.Blob.romBlobPow2' for different approaches that scale -- well. romPow2 - :: (KnownDomain dom, KnownNat n, NFDataX a) + :: (KnownNat n, NFDataX a) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -86,7 +86,7 @@ romPow2 = rom -- is constructed. See 'Clash.Explicit.ROM.File.romFile' and -- 'Clash.Explicit.ROM.Blob.romBlob' for different approaches that scale well. rom - :: (KnownDomain dom, KnownNat n, NFDataX a, Enum addr) + :: (KnownNat n, NFDataX a, Enum addr) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -105,7 +105,7 @@ rom = \clk en content rd -> rom# clk en content (fromEnum <$> rd) -- | ROM primitive rom# :: forall dom n a - . (KnownDomain dom, KnownNat n, NFDataX a) + . (ZKnownDomain dom, KnownNat n, NFDataX a) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom diff --git a/clash-prelude/src/Clash/Explicit/ROM/Blob.hs b/clash-prelude/src/Clash/Explicit/ROM/Blob.hs index 63181f8309..29e597be8d 100644 --- a/clash-prelude/src/Clash/Explicit/ROM/Blob.hs +++ b/clash-prelude/src/Clash/Explicit/ROM/Blob.hs @@ -47,7 +47,7 @@ import Clash.Explicit.BlockRam.Blob (createMemBlob, memBlobTH) import Clash.Explicit.BlockRam.Internal (MemBlob(..), unpackMemBlob) import Clash.Promoted.Nat (natToNum) import Clash.Signal.Internal - (Clock (..), KnownDomain, Signal (..), Enable, fromEnable) + (Clock (..), ZKnownDomain, Signal (..), Enable, fromEnable) import Clash.Sized.Internal.BitVector (BitVector) import Clash.Sized.Internal.Unsigned (Unsigned) import Clash.XException (deepErrorX, seqX) @@ -64,8 +64,7 @@ import Clash.XException (deepErrorX, seqX) -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlob :: forall dom addr m n - . ( KnownDomain dom - , Enum addr + . ( Enum addr ) => Clock dom -- ^ 'Clock' to synchronize to @@ -94,8 +93,7 @@ romBlob = \clk en content rd -> romBlob# clk en content (fromEnum <$> rd) -- "Clash.Explicit.BlockRam#usingrams" for ideas on how to use ROMs and RAMs. romBlobPow2 :: forall dom m n - . ( KnownDomain dom - , KnownNat n + . ( KnownNat n ) => Clock dom -- ^ 'Clock' to synchronize to @@ -115,7 +113,7 @@ romBlobPow2 = romBlob -- | ROM primitive romBlob# :: forall dom m n - . KnownDomain dom + . ZKnownDomain dom => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom diff --git a/clash-prelude/src/Clash/Explicit/ROM/File.hs b/clash-prelude/src/Clash/Explicit/ROM/File.hs index 9432e579b8..61c5442a9e 100644 --- a/clash-prelude/src/Clash/Explicit/ROM/File.hs +++ b/clash-prelude/src/Clash/Explicit/ROM/File.hs @@ -41,8 +41,7 @@ We can instantiate a synchronous ROM using the contents of the file above like so: @ -f :: KnownDomain dom - => Clock dom +f :: Clock dom -> Enable dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 9) @@ -61,8 +60,7 @@ However, we can also interpret the same data as a tuple of a 6-bit unsigned number, and a 3-bit signed number: @ -g :: KnownDomain dom - => Clock dom +g :: Clock dom -> Signal dom (Unsigned 3) -> Signal dom (Unsigned 6,Signed 3) g clk en rd = 'Clash.Class.BitPack.unpack' '<$>' 'romFile' clk en d7 \"memory.bin\" rd @@ -104,7 +102,7 @@ import Clash.Annotations.Primitive (hasBlackBox) import Clash.Explicit.BlockRam.File (initMem, memFile) import Clash.Promoted.Nat (SNat (..), pow2SNat, snatToNum) import Clash.Sized.BitVector (BitVector) -import Clash.Explicit.Signal (Clock, Enable, Signal, KnownDomain, delay) +import Clash.Explicit.Signal (Clock, Enable, Signal, ZKnownDomain, delay) import Clash.Sized.Unsigned (Unsigned) import Clash.XException (NFDataX(deepErrorX)) @@ -137,7 +135,7 @@ import Clash.XException (NFDataX(deepErrorX)) -- your own data files. romFilePow2 :: forall dom n m - . (KnownNat m, KnownNat n, KnownDomain dom) + . (KnownNat m, KnownNat n) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -178,7 +176,7 @@ romFilePow2 = \clk en -> romFile clk en (pow2SNat (SNat @n)) -- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your -- own data files. romFile - :: (KnownNat m, Enum addr, KnownDomain dom) + :: (KnownNat m, Enum addr) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom @@ -197,7 +195,7 @@ romFile = \clk en sz file rd -> romFile# clk en sz file (fromEnum <$> rd) -- | romFile primitive romFile# :: forall m dom n - . (KnownNat m, KnownDomain dom) + . (KnownNat m, ZKnownDomain dom) => Clock dom -- ^ 'Clock' to synchronize to -> Enable dom diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index 92e4945978..bbd66437f7 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -486,9 +486,7 @@ systemResetGen = resetGen -- [0,0,1,2,3,4,5,6,7,8,9,10] unsafeSynchronizer :: forall dom1 dom2 a - . ( KnownDomain dom1 - , KnownDomain dom2 ) - => Clock dom1 + . Clock dom1 -- ^ 'Clock' of the incoming signal -> Clock dom2 -- ^ 'Clock' of the outgoing signal diff --git a/clash-prelude/src/Clash/Explicit/Testbench.hs b/clash-prelude/src/Clash/Explicit/Testbench.hs index 8aedf2a589..4142a2301c 100644 --- a/clash-prelude/src/Clash/Explicit/Testbench.hs +++ b/clash-prelude/src/Clash/Explicit/Testbench.hs @@ -50,11 +50,12 @@ import Clash.Class.Num (satSucc, SaturationMode(SatBound)) import Clash.Promoted.Nat (SNat(..)) import Clash.Promoted.Symbol (SSymbol(..)) import Clash.Explicit.Signal - (Clock, Reset, System, Signal, toEnable, fromList, register, + (System, Signal, toEnable, fromList, register, unbundle, unsafeSynchronizer) import Clash.Signal.Internal - (ClockN (..), DiffClock (..), Reset (..), tbClockGen) + (Clock (..), ClockN (..), DiffClock (..), Reset (..), tbClockGen) import Clash.Signal (mux, KnownDomain, Enable) +import Clash.Signal.Internal (ZKnownDomain) import Clash.Sized.Index (Index) import Clash.Sized.Internal.BitVector (BitVector, isLike#) @@ -86,7 +87,7 @@ import Clash.XException (ShowX (..), XException) -- -- __NB__: This function /can/ be used in synthesizable designs. assert - :: (KnownDomain dom, Eq a, ShowX a) + :: (ZKnownDomain dom, Eq a, ShowX a) => Clock dom -> Reset dom -> String @@ -121,7 +122,7 @@ assert clk (Reset _) msg checked expected returned = -- | The same as 'assert', but can handle don't care bits in its expected value. assertBitVector - :: (KnownDomain dom, KnownNat n) + :: (ZKnownDomain dom, KnownNat n) => Clock dom -> Reset dom -> String @@ -162,8 +163,7 @@ assertBitVector clk (Reset _) msg checked expected returned = -- -- @ -- testInput --- :: KnownDomain dom --- => Clock dom +-- :: Clock dom -- -> Reset dom -- -> 'Signal' dom Int -- testInput clk rst = 'stimuliGenerator' clk rst $('Clash.Sized.Vector.listToVecTH' [(1::Int),3..21]) @@ -174,7 +174,7 @@ assertBitVector clk (Reset _) msg checked expected returned = stimuliGenerator :: forall l dom a . ( KnownNat l - , KnownDomain dom ) + ) => Clock dom -- ^ Clock to which to synchronize the output signal -> Reset dom @@ -201,7 +201,6 @@ stimuliGenerator clk rst samples = outputVerifier' :: forall l a dom . ( KnownNat l - , KnownDomain dom , Eq a , ShowX a , 1 <= l @@ -269,8 +268,6 @@ outputVerifier' clk = outputVerifier :: forall l a testDom circuitDom . ( KnownNat l - , KnownDomain testDom - , KnownDomain circuitDom , Eq a , ShowX a , 1 <= l @@ -298,7 +295,6 @@ outputVerifierBitVector' :: forall l n dom . ( KnownNat l , KnownNat n - , KnownDomain dom , 1 <= l ) => Clock dom @@ -320,8 +316,6 @@ outputVerifierBitVector :: forall l n testDom circuitDom . ( KnownNat l , KnownNat n - , KnownDomain testDom - , KnownDomain circuitDom , 1 <= l ) => Clock testDom @@ -345,8 +339,6 @@ outputVerifierBitVector = outputVerifierWith :: forall l a testDom circuitDom . ( KnownNat l - , KnownDomain testDom - , KnownDomain circuitDom , Eq a , ShowX a , 1 <= l @@ -391,8 +383,7 @@ outputVerifierWith assertF clkTest clkCircuit rst samples i0 = -- | Ignore signal for a number of cycles, while outputting a static value. ignoreFor :: forall dom n a - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Enable dom -> SNat n @@ -473,12 +464,11 @@ tbSystemClockGen = tbClockGen -- clk = seClockToDiffClock $ tbClockGen (not \<\$\> done) -- @ seClockToDiffClock :: - KnownDomain dom => -- | Single-ended input Clock dom -> -- | Differential output DiffClock dom -seClockToDiffClock clk = DiffClock clk (ClockN SSymbol) +seClockToDiffClock clk@(Clock{}) = DiffClock clk (ClockN SSymbol) -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE seClockToDiffClock #-} {-# ANN seClockToDiffClock hasBlackBox #-} @@ -492,9 +482,7 @@ seClockToDiffClock clk = DiffClock clk (ClockN SSymbol) -- for simulating the generated HDL. unsafeSimSynchronizer :: forall dom1 dom2 a - . ( KnownDomain dom1 - , KnownDomain dom2 ) - => Clock dom1 + . Clock dom1 -- ^ 'Clock' of the incoming signal -> Clock dom2 -- ^ 'Clock' of the outgoing signal diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 7cf806b58b..88312fcb2a 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -1425,7 +1425,7 @@ infixr 3 .&&. delay# :: forall dom a - . ( KnownDomain dom + . ( ZKnownDomain dom , NFDataX a ) => Clock dom -> Enable dom @@ -1464,7 +1464,7 @@ delay# (Clock dom _) (fromEnable -> en) powerUpVal0 = -- 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 + . ( ZKnownDomain dom , NFDataX a ) => Clock dom -> Reset dom @@ -1489,8 +1489,7 @@ register# clk@(Clock dom _) rst ena powerUpVal resetVal = -- value constructed with 'deepErrorX' otherwise. registerPowerup# :: forall dom a - . ( KnownDomain dom - , NFDataX a + . ( NFDataX a , HasCallStack ) => Clock dom -> a @@ -1505,7 +1504,7 @@ registerPowerup# (Clock dom _) a = -- domain. Is synthesizable. asyncRegister# :: forall dom a - . ( KnownDomain dom + . ( ZKnownDomain dom , NFDataX a ) => Clock dom -- ^ Clock signal @@ -1519,7 +1518,7 @@ asyncRegister# -- ^ Reset value -> Signal dom a -> Signal dom a -asyncRegister# clk (unsafeToActiveHigh -> rst) (fromEnable -> ena) initVal resetVal = +asyncRegister# clk@(Clock{}) (unsafeToActiveHigh -> rst) (fromEnable -> ena) initVal resetVal = go (registerPowerup# clk initVal) rst ena where go o (r :- rs) enas@(~(e :- es)) as@(~(x :- xs)) = @@ -1535,8 +1534,7 @@ asyncRegister# clk (unsafeToActiveHigh -> rst) (fromEnable -> ena) initVal reset -- domain. Not synthesizable. syncRegister# :: forall dom a - . ( KnownDomain dom - , NFDataX a ) + . ( NFDataX a ) => Clock dom -- ^ Clock signal -> Reset dom @@ -1922,7 +1920,6 @@ data ClockAB -- 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] @@ -1930,7 +1927,6 @@ clockTicks clkA clkB = clockTicksEither (toEither clkA) (toEither clkB) where toEither :: forall dom. - KnownDomain dom => Clock dom -> Either Int64 (Signal dom Int64) toEither (Clock _ maybePeriods) From d52aef3cdf4ab7b77003300e04ba53f162c123b9 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 9 Oct 2023 14:36:38 +0200 Subject: [PATCH 13/27] Clash.*.ClockGen PLLs --- .../Clash_Xilinx_ClockGen.primitives.yaml | 15 +++--- .../Clash_Xilinx_ClockGen.primitives.yaml | 13 +++-- .../src/Clash/Primitives/Intel/ClockGen.hs | 51 ++++++++++--------- .../src/Clash/Primitives/Xilinx/ClockGen.hs | 36 +++++++------ clash-prelude/src/Clash/Clocks.hs | 4 +- clash-prelude/src/Clash/Intel/ClockGen.hs | 7 +-- clash-prelude/src/Clash/Xilinx/ClockGen.hs | 6 +-- 7 files changed, 65 insertions(+), 67 deletions(-) diff --git a/clash-lib/prims/commonverilog/Clash_Xilinx_ClockGen.primitives.yaml b/clash-lib/prims/commonverilog/Clash_Xilinx_ClockGen.primitives.yaml index c7c1d78cd5..2f4c715d4a 100644 --- a/clash-lib/prims/commonverilog/Clash_Xilinx_ClockGen.primitives.yaml +++ b/clash-lib/prims/commonverilog/Clash_Xilinx_ClockGen.primitives.yaml @@ -3,17 +3,16 @@ kind: Declaration type: |- clockWizard - :: ( KnownDomain domIn -- ARG[0] - , KnownDomain domOut ) -- ARG[1] - => SSymbol name -- ARG[2] - -> Clock domIn -- ARG[3] - -> Reset domIn -- ARG[4] + :: KnownDomain domOut -- ARG[0] + => SSymbol name -- ARG[1] + -> Clock domIn -- ARG[2] + -> Reset domIn -- ARG[3] -> (Clock domOut, Signal domOut Bool) template: |- // clockWizard begin - ~NAME[2] ~GENSYM[clockWizard_inst][2] - (.clk_in1 (~ARG[3]) - ,.reset (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[4]) + ~NAME[1] ~GENSYM[clockWizard_inst][2] + (.clk_in1 (~ARG[2]) + ,.reset (~IF ~ISACTIVEHIGH[3] ~THEN ~ELSE ! ~FI ~ARG[3]) ,.clk_out1 (~RESULT[1]) ,.locked (~RESULT[0])); // clockWizard end diff --git a/clash-lib/prims/vhdl/Clash_Xilinx_ClockGen.primitives.yaml b/clash-lib/prims/vhdl/Clash_Xilinx_ClockGen.primitives.yaml index 75afe78889..fe3ac9809a 100644 --- a/clash-lib/prims/vhdl/Clash_Xilinx_ClockGen.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Xilinx_ClockGen.primitives.yaml @@ -3,11 +3,10 @@ kind: Declaration type: |- clockWizard - :: ( KnownDomain domIn -- ARG[0] - , KnownDomain domOut ) -- ARG[1] - => SSymbol name -- ARG[2] - -> Clock domIn -- ARG[3] - -> Reset domIn -- ARG[4] + :: KnownDomain domOut -- ARG[0] + => SSymbol name -- ARG[1] + -> Clock domIn -- ARG[2] + -> Reset domIn -- ARG[3] -> (Clock domIn, Signal domOut Bool) template: |- -- clockWizard begin @@ -16,14 +15,14 @@ signal ~GENSYM[locked][2] : std_logic; signal ~GENSYM[pllLock][3] : boolean; - component ~NAME[2] + component ~NAME[1] port (clk_in1 : in std_logic; reset : in std_logic; clk_out1 : out std_logic; locked : out std_logic); end component; begin - ~GENSYM[clockWizard_inst][4] : component ~NAME[2] port map (~ARG[3],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[4] ~ELSE NOT(~ARG[4]) ~FI,~SYM[1],~SYM[2]); + ~GENSYM[clockWizard_inst][4] : component ~NAME[1] port map (~ARG[2],~IF ~ISACTIVEHIGH[3] ~THEN ~ARG[3] ~ELSE NOT(~ARG[3]) ~FI,~SYM[1],~SYM[2]); ~SYM[3] <= true when ~SYM[2] = '1' else false; ~RESULT <= (~SYM[1],~SYM[3]); end block; diff --git a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs index 3184775f63..6d2c17343e 100644 --- a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs @@ -19,7 +19,7 @@ import Clash.Netlist.BlackBox.Util import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types import Clash.Netlist.Util -import Clash.Signal (periodToHz) +import Clash.Signal (periodToHz, vPeriod) import Control.Monad.State import Data.List.Infinite (Infinite(..), (...)) @@ -30,12 +30,12 @@ import qualified Prettyprinter.Interpolate as I import qualified Data.Text as TextS import Data.Text.Extra (showt) +import Numeric.Natural altpllTF :: TemplateFunction altpllTF = TemplateFunction used valid altpllTemplate where - _knownDomIn - :< _knownDomOut + _knownDomOut :< nm :< clk :< rst @@ -51,20 +51,18 @@ altpllTF = TemplateFunction used valid altpllTemplate altpllQsysTF :: TemplateFunction altpllQsysTF = TemplateFunction used valid altpllQsysTemplate where - knownDomIn - :< knownDomOut + knownDomOut :< _name - :< _clk + :< clk :< _rst :< _ = (0...) - used = [ knownDomIn, knownDomOut ] + used = [ knownDomOut, clk ] valid = const True alteraPllTF :: TemplateFunction alteraPllTF = TemplateFunction used valid alteraPllTemplate where _clocksClass - :< _knownDomIn :< _clocksCxt :< nm :< clk @@ -81,13 +79,12 @@ alteraPllQsysTF :: TemplateFunction alteraPllQsysTF = TemplateFunction used valid alteraPllQsysTemplate where _clocksClass - :< knownDomIn :< clocksCxt :< _name - :< _clk + :< clk :< _rst :< _ = (0...) - used = [ knownDomIn, clocksCxt ] + used = [ clocksCxt, clk ] valid = const True alteraPllTemplate @@ -98,7 +95,6 @@ alteraPllTemplate alteraPllTemplate bbCtx | [(Identifier result Nothing,resTy@(Product _ _ (init -> tys)))] <- bbResults bbCtx , [ _clocksClass - , _knownDomIn , _clocksCxt , (nm,_,_) , (clk,clkTy,_) @@ -147,8 +143,7 @@ altpllTemplate => BlackBoxContext -> State s Doc altpllTemplate bbCtx - | [ _knownDomIn - , _knownDomOut + | [ _knownDomOut , (nm,_,_) , (clk,clkTy,_) , (rst,rstTy,_)] <- bbInputs bbCtx @@ -194,12 +189,15 @@ altpllQsysTemplate => BlackBoxContext -> State s Doc altpllQsysTemplate bbCtx - | (_,stripVoid -> kdIn,_) - : (_,stripVoid -> kdOut,_) + | (_,stripVoid -> kdOut,_) + : _ssymbolName + : _clkIn@(_,clkInTy,_) + : _rstIn : _ <- bbInputs bbCtx - , KnownDomain _ clkInPeriod _ _ _ _ <- kdIn - , KnownDomain _ clkOutPeriod _ _ _ _ <- kdOut - = let + , KnownDomain _ (fromInteger @Natural -> clkOutPeriod) _ _ _ _ <- kdOut + = do + clkInPeriod <- vPeriod <$> getDomainConf clkInTy + let clkOutFreq :: Double clkOutFreq = periodToHz (fromIntegral clkOutPeriod) / 1e6 clklcm = lcm clkInPeriod clkOutPeriod @@ -296,10 +294,16 @@ alteraPllQsysTemplate -> State s Doc alteraPllQsysTemplate bbCtx | _clocksClass - : (_,stripVoid -> kdIn,_) : (_,stripVoid -> Product _ _ (init -> kdOuts),_) + : _ssymbolName + : (_,clkInTy,_) + : _rstIn : _ <- bbInputs bbCtx - = let + = do + clkInPeriod <- vPeriod <$> getDomainConf clkInTy + let + clkInFreq = periodToHz (fromIntegral clkInPeriod) / 1e6 :: Double + cklFreq (KnownDomain _ p _ _ _ _) = periodToHz (fromIntegral p) / 1e6 :: Double cklFreq _ = error "internal error: not a KnownDomain" @@ -323,12 +327,11 @@ alteraPllQsysTemplate bbCtx #{clkOuts} - + |] - in - pure bbText + pure bbText | otherwise = error ("alteraPllQsysTemplate: bad bbContext: " <> show bbCtx) diff --git a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs index af300057d4..0e67749b31 100644 --- a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs @@ -18,10 +18,10 @@ import qualified Data.Text as T import Prettyprinter.Interpolate (__di) import Text.Show.Pretty (ppShow) -import Clash.Signal (periodToHz) +import Clash.Signal (periodToHz, vPeriod) import Clash.Backend (Backend) -import Clash.Netlist.BlackBox.Util (exprToString) +import Clash.Netlist.BlackBox.Util (exprToString, getDomainConf) import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types import Clash.Netlist.Util (stripVoid) @@ -33,13 +33,12 @@ clockWizardDifferentialTF :: TemplateFunction clockWizardDifferentialTF = TemplateFunction used valid clockWizardDifferentialTemplate where - knownDomIn - :< knownDomOut + knownDomOut :< name :< clk :< rst :< _ = (0...) - used = [knownDomIn, knownDomOut, name, clk, rst] + used = [knownDomOut, name, clk, rst] valid = const True @@ -48,8 +47,7 @@ clockWizardDifferentialTemplate => BlackBoxContext -> State s Doc clockWizardDifferentialTemplate bbCtx - | knownDomIn - : _knownDomOut + | _knownDomOut : name0 : clk : rst @@ -100,27 +98,25 @@ clockWizardTclTF :: TemplateFunction clockWizardTclTF = TemplateFunction used valid (clockWizardTclTemplate False) where - knownDomIn - :< knownDomOut + knownDomOut :< name - :< _clk + :< clk :< _rst :< _ = (0...) - used = [knownDomIn, knownDomOut, name] + used = [knownDomOut, name, clk] valid = const True clockWizardDifferentialTclTF :: TemplateFunction clockWizardDifferentialTclTF = TemplateFunction used valid (clockWizardTclTemplate True) where - knownDomIn - :< knownDomOut + knownDomOut :< name - :< _clkN + :< clkN :< _clkP :< _rst :< _ = (0...) - used = [knownDomIn, knownDomOut, name] + used = [knownDomOut, name, clkN] valid = const True @@ -130,16 +126,18 @@ clockWizardTclTemplate -> BlackBoxContext -> State s Doc clockWizardTclTemplate isDifferential bbCtx - | (_,stripVoid -> (KnownDomain _ clkInPeriod _ _ _ _),_) - : (_,stripVoid -> (KnownDomain _ clkOutPeriod _ _ _ _),_) + | (_,stripVoid -> (KnownDomain _ clkOutPeriod _ _ _ _),_) : (nm,_,_) + : (_,clkInTy,_) : _ <- bbInputs bbCtx , [(Identifier _ Nothing,Product {})] <- bbResults bbCtx , Just compName <- exprToString nm - = + = do + clkInPeriod <- vPeriod <$> getDomainConf clkInTy + let clkInFreq :: Double - clkInFreq = periodToHz (fromInteger clkInPeriod) / 1e6 + clkInFreq = periodToHz (fromIntegral clkInPeriod) / 1e6 clkOutFreq :: Double clkOutFreq = periodToHz (fromInteger clkOutPeriod) / 1e6 diff --git a/clash-prelude/src/Clash/Clocks.hs b/clash-prelude/src/Clash/Clocks.hs index e3102cd910..efdcdb1a61 100644 --- a/clash-prelude/src/Clash/Clocks.hs +++ b/clash-prelude/src/Clash/Clocks.hs @@ -17,14 +17,14 @@ module Clash.Clocks (Clocks(..)) where import Data.Kind (Constraint) -import Clash.Signal.Internal +import Clash.Signal (Clock, Reset) import Clash.Clocks.Deriving (deriveClocksInstances) class Clocks t where type ClocksCxt t :: Constraint clocks - :: (KnownDomain domIn, ClocksCxt t) + :: ClocksCxt t => Clock domIn -> Reset domIn -> t diff --git a/clash-prelude/src/Clash/Intel/ClockGen.hs b/clash-prelude/src/Clash/Intel/ClockGen.hs index 08f6d7d63a..ab416c46b7 100644 --- a/clash-prelude/src/Clash/Intel/ClockGen.hs +++ b/clash-prelude/src/Clash/Intel/ClockGen.hs @@ -102,7 +102,7 @@ import Clash.Signal.Internal -- @ altpll :: forall domOut domIn name - . (KnownDomain domIn, KnownDomain domOut) + . KnownDomain domOut => SSymbol name -- ^ Name of the component instance -- @@ -113,7 +113,7 @@ altpll -- ^ Reset for the PLL -> (Clock domOut, Signal domOut Bool) -- ^ (Stable PLL clock, PLL lock) -altpll !_ = knownDomain @domIn `seq` knownDomain @domOut `seq` clocks +altpll !_ = clocks -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE altpll #-} {-# ANN altpll hasBlackBox #-} @@ -191,7 +191,8 @@ altpll !_ = knownDomain @domIn `seq` knownDomain @domOut `seq` clocks -- (modulo local resets, which will be based on @rst@ or never asserted at all -- if the component doesn't need a reset). alteraPll - :: (Clocks t, KnownDomain domIn, ClocksCxt t) + :: forall t domIn name + . (Clocks t, ClocksCxt t) => SSymbol name -- ^ Name of the component instance -- diff --git a/clash-prelude/src/Clash/Xilinx/ClockGen.hs b/clash-prelude/src/Clash/Xilinx/ClockGen.hs index 1c3f788c7c..4d6d95c193 100644 --- a/clash-prelude/src/Clash/Xilinx/ClockGen.hs +++ b/clash-prelude/src/Clash/Xilinx/ClockGen.hs @@ -34,8 +34,7 @@ import Clash.Signal.Internal -- See also the [Clocking Wizard LogiCORE IP Product Guide](https://docs.xilinx.com/r/en-US/pg065-clk-wiz) clockWizard :: forall domIn domOut name - . ( KnownDomain domIn - , KnownDomain domOut ) + . KnownDomain domOut => SSymbol name -- ^ Name of the component instance -- @@ -67,8 +66,7 @@ clockWizard !_ = clocks -- See also the [Clocking Wizard LogiCORE IP Product Guide](https://docs.xilinx.com/r/en-US/pg065-clk-wiz) clockWizardDifferential :: forall domIn domOut name - . ( KnownDomain domIn - , KnownDomain domOut ) + . KnownDomain domOut => SSymbol name -- ^ Name of the component instance -- From b585e185eca807af9d660e8967560e6f9a520c8f Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 9 Oct 2023 16:10:56 +0200 Subject: [PATCH 14/27] Remove KnownDomain from Clash.(Explicit.)Verification --- .../src/Clash/Primitives/Verification.hs | 20 ++++++++----------- .../src/Clash/Explicit/Verification.hs | 8 +++----- clash-prelude/src/Clash/Verification.hs | 8 +++----- 3 files changed, 14 insertions(+), 22 deletions(-) diff --git a/clash-lib/src/Clash/Primitives/Verification.hs b/clash-lib/src/Clash/Primitives/Verification.hs index 9bfce226af..c529b924d6 100644 --- a/clash-lib/src/Clash/Primitives/Verification.hs +++ b/clash-lib/src/Clash/Primitives/Verification.hs @@ -8,7 +8,6 @@ import Data.Either import qualified Control.Lens as Lens import Control.Monad.State (State) import Data.List.Infinite (Infinite(..), (...)) -import Data.Maybe (listToMaybe) import Data.Monoid (Ap(getAp)) import Data.Text.Prettyprint.Doc.Extra (Doc) import qualified Data.Text as Text @@ -22,17 +21,18 @@ import Clash.Core.Term (Term(Var), varToId) import Clash.Core.TermLiteral (termToDataError) import Clash.Util (indexNote) import Clash.Netlist (mkExpr) -import Clash.Netlist.Util (stripVoid) import qualified Clash.Netlist.Id as Id import Clash.Netlist.Types (BlackBox(BBFunction), TemplateFunction(..), BlackBoxContext, Identifier, NetlistMonad, Declaration(Assignment, NetDecl), Usage(Cont), - HWType(Bool, KnownDomain), NetlistId(..), + HWType(Bool), NetlistId(..), DeclarationType(Concurrent), tcCache, bbInputs, Expr(Identifier)) import Clash.Netlist.BlackBox.Types (BlackBoxFunction, BlackBoxMeta(..), TemplateKind(TDecl), RenderVoid(..), emptyBlackBoxMeta) +import Clash.Netlist.BlackBox.Util (getDomainConf) +import Clash.Signal (vActiveEdge) import Clash.Verification.Internal import Clash.Verification.Pretty @@ -48,8 +48,7 @@ checkBBF _isD _primName args _ty = where -- TODO: Improve error handling; currently errors don't indicate what -- TODO: blackbox generated them. - _knownDomainArg - :< clkArg + clkArg :< _rstArg :< propNameArg :< renderAsArg @@ -112,18 +111,15 @@ checkTF' -> BlackBoxContext -> State s Doc checkTF' decls (clk, clkId) propName renderAs prop bbCtx = do + let (_,clkTy,_) = head $ bbInputs bbCtx + edge <- vActiveEdge <$> getDomainConf clkTy blockName <- Id.makeBasic (propName <> "_block") - getAp (blockDecl blockName (renderedPslProperty : decls)) + getAp (blockDecl blockName (renderedPslProperty edge : decls)) where hdl = hdlKind (undefined :: s) - edge = - case bbInputs bbCtx of - (_, stripVoid -> KnownDomain _nm _period e _rst _init _polarity, _):_ -> e - _ -> error $ "Unexpected first argument: " ++ show (listToMaybe (bbInputs bbCtx)) - - renderedPslProperty = case renderAs of + renderedPslProperty edge = case renderAs of PSL -> psl SVA -> sva AutoRenderAs -> case hdl of diff --git a/clash-prelude/src/Clash/Explicit/Verification.hs b/clash-prelude/src/Clash/Explicit/Verification.hs index 10e1c0e0c4..deb450a69e 100644 --- a/clash-prelude/src/Clash/Explicit/Verification.hs +++ b/clash-prelude/src/Clash/Explicit/Verification.hs @@ -64,7 +64,7 @@ import Data.String.Interpolate (__i) import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), HDL(..)) -import Clash.Signal.Internal (KnownDomain, Signal, Clock, Reset) +import Clash.Signal.Internal (Signal, Clock, Reset) import Clash.XException (errorX, hwSeqX) import Clash.Verification.Internal @@ -247,8 +247,7 @@ assume = Property . CvAssume . assertion . toAssertionValue -- | Print property as PSL/SVA in HDL. Clash simulation support not yet -- implemented. check - :: KnownDomain dom - => Clock dom + :: Clock dom -> Reset dom -> Text -- ^ Property name (used in reports and error messages) @@ -271,8 +270,7 @@ check !_clk !_rst !_propName !_renderAs !_prop = -- | Same as 'check', but doesn't require a design to explicitly carried to -- top-level. checkI - :: KnownDomain dom - => Clock dom + :: Clock dom -> Reset dom -> Text -- ^ Property name (used in reports and error messages) diff --git a/clash-prelude/src/Clash/Verification.hs b/clash-prelude/src/Clash/Verification.hs index 7a89335f7d..d06c8aa8ba 100644 --- a/clash-prelude/src/Clash/Verification.hs +++ b/clash-prelude/src/Clash/Verification.hs @@ -48,13 +48,12 @@ module Clash.Verification import qualified Clash.Explicit.Verification as EV import Clash.Signal - (KnownDomain, HiddenClock, HiddenReset, Signal, hasClock, hasReset) + (HiddenClock, HiddenReset, Signal, hasClock, hasReset) import Clash.Verification.Internal import Data.Text (Text) check - :: ( KnownDomain dom - , HiddenClock dom + :: ( HiddenClock dom , HiddenReset dom ) => Text @@ -66,8 +65,7 @@ check check = EV.check hasClock hasReset checkI - :: ( KnownDomain dom - , HiddenClock dom + :: ( HiddenClock dom , HiddenReset dom ) => Text From 0df8aa567e8a02a0a70a1290102b44024dc7918c Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 11 Oct 2023 14:47:31 +0200 Subject: [PATCH 15/27] Remove KnownDomain from Clash.Explicit.SimIO --- clash-lib/src/Clash/Netlist/BlackBox.hs | 18 +++++++++++------- clash-lib/src/Clash/Netlist/Types.hs | 6 +++++- clash-lib/src/Clash/Normalize/Util.hs | 2 +- clash-prelude/src/Clash/Explicit/SimIO.hs | 3 +-- 4 files changed, 18 insertions(+), 11 deletions(-) diff --git a/clash-lib/src/Clash/Netlist/BlackBox.hs b/clash-lib/src/Clash/Netlist/BlackBox.hs index 077f8071e1..3588b48425 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox.hs @@ -102,7 +102,7 @@ import Clash.Netlist.Util as N import Clash.Normalize.Primitives (removedArg) import Clash.Primitives.Types as P import qualified Clash.Primitives.Util as P -import Clash.Signal.Internal (ActiveEdge (..)) +import Clash.Signal.Internal (ActiveEdge (..), VDomainConfiguration(..)) import Clash.Util import qualified Clash.Util.Interpolate as I @@ -804,7 +804,7 @@ collectMealy -> [Term] -- ^ The arguments to 'mealyIO' -> NetlistMonad [Declaration] -collectMealy dstNm dst tcm (kd:clk:mealyFun:mealyInit:mealyIn:_) = do +collectMealy dstNm dst tcm (clk:mealyFun:mealyInit:mealyIn:_) = do let (lefts -> args0,res0) = collectBndrs mealyFun is0 = mkInScopeSet (Lens.foldMapOf freeIds unitVarSet res0 <> Lens.foldMapOf freeIds unitVarSet mealyInit <> @@ -929,15 +929,14 @@ collectMealy dstNm dst tcm (kd:clk:mealyFun:mealyInit:mealyIn:_) = do -- be of type 'reg' in Verilog nomenclature let netDeclsSeq1 = netDeclsSeq ++ netDeclsSeqMisc ++ netDeclsInit + + clkTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (inferCoreTypeOf tcm clk) + domConf <- getDomainConfNetlistM clkTy -- We run mealy block in the opposite clock edge of the the ambient system -- because we're basically clocked logic; so we need to have our outputs -- ready before the ambient system starts sampling them. The clockGen code -- ensures that the "opposite" edge always comes first. - kdTy <- unsafeCoreTypeToHWTypeM $(curLoc) (inferCoreTypeOf tcm kd) - let edge = case stripVoid (stripFiltered kdTy) of - KnownDomain _ _ Rising _ _ _ -> Falling - KnownDomain _ _ Falling _ _ _ -> Rising - _ -> error "internal error" + let edge = invertEdge $ vActiveEdge domConf (clkExpr,clkDecls) <- mkExpr False Concurrent (NetlistId (Id.unsafeMake "__MEALY_CLK__") (inferCoreTypeOf tcm clk)) clk @@ -953,9 +952,14 @@ collectMealy dstNm dst tcm (kd:clk:mealyFun:mealyInit:mealyIn:_) = do where isNet NetDecl' {} = True isNet _ = False + invertEdge Rising = Falling + invertEdge Falling = Rising collectMealy _ _ _ _ = error "internal error" +getDomainConfNetlistM :: HasCallStack => HWType -> NetlistMonad VDomainConfiguration +getDomainConfNetlistM = generalGetDomainConf (Lens.view domainMap) + -- | Collect the sequential declarations for 'bindIO' collectBindIO :: NetlistId -> [Term] -> NetlistMonad (Expr,[Declaration]) #if __GLASGOW_HASKELL__ >= 900 diff --git a/clash-lib/src/Clash/Netlist/Types.hs b/clash-lib/src/Clash/Netlist/Types.hs index b2cd248fcf..0befc5ab96 100644 --- a/clash-lib/src/Clash/Netlist/Types.hs +++ b/clash-lib/src/Clash/Netlist/Types.hs @@ -73,7 +73,7 @@ import Clash.Annotations.SynthesisAttributes(Attr) import Clash.Annotations.BitRepresentation (FieldAnn) import Clash.Annotations.Primitive (HDL(..)) import Clash.Annotations.TopEntity (TopEntity) -import Clash.Backend (Backend, HasUsageMap (..)) +import Clash.Backend (Backend, DomainMap, HasUsageMap (..)) import Clash.Core.HasType import Clash.Core.Type (Type) import Clash.Core.Var (Id) @@ -987,6 +987,10 @@ primitives = clashEnv . Lens.to envPrimitives clashOpts :: Lens.Getter NetlistEnv ClashOpts clashOpts = clashEnv . Lens.to envOpts +domainMap :: Lens.Getter NetlistEnv DomainMap +domainMap = clashEnv . Lens.to envDomains + + -- | Structures that hold an 'IdentifierSet' class HasIdentifierSet s where identifierSet :: Lens' s IdentifierSet diff --git a/clash-lib/src/Clash/Normalize/Util.hs b/clash-lib/src/Clash/Normalize/Util.hs index 910f07b2cf..7626ff0536 100644 --- a/clash-lib/src/Clash/Normalize/Util.hs +++ b/clash-lib/src/Clash/Normalize/Util.hs @@ -101,7 +101,7 @@ isConstantArg -- ^ Yields @DontCare@ for if given primitive name is not found, if the -- argument does not exist, or if the argument was not mentioned by the -- blackbox. -isConstantArg "Clash.Explicit.SimIO.mealyIO" i = pure (i == 2 || i == 3) +isConstantArg "Clash.Explicit.SimIO.mealyIO" i = pure (i == 1 || i == 2) isConstantArg nm i = do argMap <- Lens.use (extra.primitiveArgs) case Map.lookup nm argMap of diff --git a/clash-prelude/src/Clash/Explicit/SimIO.hs b/clash-prelude/src/Clash/Explicit/SimIO.hs index d37df14a53..4d94d0deb0 100644 --- a/clash-prelude/src/Clash/Explicit/SimIO.hs +++ b/clash-prelude/src/Clash/Explicit/SimIO.hs @@ -384,8 +384,7 @@ flush (File fp) = SimIO (IO.hFlush fp) -- regIn = 'mealyIO' clk tbMachine tbInit regOut -- @ mealyIO - :: KnownDomain dom - => Clock dom + :: Clock dom -- ^ Clock at which rate the I\/O environment progresses -> (s -> i -> SimIO o) -- ^ Transition function inside an I\/O environment From 1d3e7f798f40c41ea36042358968e0f89ad35dae Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Fri, 6 Oct 2023 17:12:53 +0200 Subject: [PATCH 16/27] Remove now unused KnownDomain constraints For some functions we add explicit foralls, so the order of the type arguments stays the same. --- .../src/Clash/Class/AutoReg/Internal.hs | 4 +- .../src/Clash/Explicit/BlockRam/Model.hs | 4 +- clash-prelude/src/Clash/Explicit/Mealy.hs | 28 +++++++------- clash-prelude/src/Clash/Explicit/Moore.hs | 24 ++++++------ clash-prelude/src/Clash/Explicit/Prelude.hs | 9 ++--- .../src/Clash/Explicit/Prelude/Safe.hs | 18 ++++----- clash-prelude/src/Clash/Explicit/Reset.hs | 38 +++++++++---------- clash-prelude/src/Clash/Explicit/Signal.hs | 38 +++++++------------ .../src/Clash/Explicit/Signal/Delayed.hs | 25 ++++-------- .../src/Clash/Explicit/Synchronizer.hs | 15 +++----- clash-prelude/src/Clash/Prelude/DataFlow.hs | 17 ++++----- .../src/Clash/Signal/Delayed/Internal.hs | 15 +++----- 12 files changed, 96 insertions(+), 139 deletions(-) diff --git a/clash-prelude/src/Clash/Class/AutoReg/Internal.hs b/clash-prelude/src/Clash/Class/AutoReg/Internal.hs index d147740c9e..462a8d1bf0 100644 --- a/clash-prelude/src/Clash/Class/AutoReg/Internal.hs +++ b/clash-prelude/src/Clash/Class/AutoReg/Internal.hs @@ -107,7 +107,7 @@ class NFDataX a => AutoReg a where -- This is the version with explicit clock\/reset\/enable inputs, -- "Clash.Prelude" exports an implicit version of this: 'Clash.Prelude.autoReg' autoReg - :: (HasCallStack, KnownDomain dom) + :: HasCallStack => Clock dom -> Reset dom -> Enable dom -> a -- ^ Reset value -> Signal dom a @@ -164,7 +164,7 @@ instance AutoReg a => AutoReg (Maybe a) where instance (KnownNat n, AutoReg a) => AutoReg (Vec n a) where autoReg - :: forall dom. (HasCallStack, KnownDomain dom) + :: forall dom. HasCallStack => Clock dom -> Reset dom -> Enable dom -> Vec n a -- ^ Reset value -> Signal dom (Vec n a) diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/Model.hs b/clash-prelude/src/Clash/Explicit/BlockRam/Model.hs index 240e0e6864..dca410d6c9 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/Model.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/Model.hs @@ -25,7 +25,7 @@ import GHC.TypeNats (KnownNat) import Clash.Promoted.Nat (SNat(..), natToNum) import Clash.Signal.Bundle (Bundle(bundle)) import Clash.Signal.Internal - (KnownDomain(..), Clock (..), Signal (..), ClockAB (..), clockTicks) + (Clock (..), Signal (..), ClockAB (..), clockTicks) import Clash.Sized.Index (Index) import Clash.XException (XException(..), NFDataX(..), seqX) import Clash.XException.MaybeX (MaybeX(..), toMaybeX, andX) @@ -218,8 +218,6 @@ tdpbramModel :: forall nAddrs domA domB a writeEnable . ( HasCallStack , KnownNat nAddrs - , KnownDomain domA - , KnownDomain domB , NFDataX a ) => TdpbramModelConfig writeEnable a -> diff --git a/clash-prelude/src/Clash/Explicit/Mealy.hs b/clash-prelude/src/Clash/Explicit/Mealy.hs index d70e75e810..02c7cda14f 100644 --- a/clash-prelude/src/Clash/Explicit/Mealy.hs +++ b/clash-prelude/src/Clash/Explicit/Mealy.hs @@ -27,7 +27,7 @@ module Clash.Explicit.Mealy where import Clash.Explicit.Signal - (KnownDomain, Bundle (..), Clock, Reset, Signal, Enable, register) + (Bundle (..), Clock, Reset, Signal, Enable, register) import Clash.XException (NFDataX) import Control.Monad.State.Strict @@ -100,8 +100,7 @@ delayTop clk rst en = mealyS clk rst en delayS initialDelayState -- s' = x * y + s -- -- mac --- :: 'KnownDomain' dom --- => 'Clock' dom +-- :: 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> 'Signal' dom (Int, Int) @@ -118,8 +117,7 @@ delayTop clk rst en = mealyS clk rst en delayS initialDelayState -- -- @ -- dualMac --- :: 'KnownDomain' dom --- => 'Clock' dom +-- :: 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int, 'Signal' dom Int) @@ -131,8 +129,8 @@ delayTop clk rst en = mealyS clk rst en delayS initialDelayState -- s2 = 'mealy' clk rst en macT 0 ('bundle' (b,y)) -- @ mealy - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i o + . NFDataX s => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom @@ -177,8 +175,8 @@ mealy clk rst en f iS = -- out <- uses history last -- return (Just out) -- --- delayTop ::'KnownDomain' dom --- => 'Clock' dom +-- delayTop :: +-- 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int -> 'Signal' dom (Maybe Int)) @@ -189,8 +187,8 @@ mealy clk rst en f iS = -- [Nothing,Nothing,Nothing,Nothing,Just 1,Just 2,Just 3] -- mealyS - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i o + . NFDataX s => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom @@ -236,8 +234,8 @@ mealyS clk rst en f iS = -- (i2,b2) = 'mealyB' clk rst en f 3 (c,i1) -- @ mealyB - :: ( KnownDomain dom - , NFDataX s + :: forall dom s i o + . ( NFDataX s , Bundle i , Bundle o ) => Clock dom @@ -256,8 +254,8 @@ mealyB clk rst en f iS i = unbundle (mealy clk rst en f iS (bundle i)) -- | A version of 'mealyS' that does automatic 'Bundle'ing, see 'mealyB' for details. mealySB - :: ( KnownDomain dom - , NFDataX s + :: forall dom s i o + . ( NFDataX s , Bundle i , Bundle o ) => Clock dom diff --git a/clash-prelude/src/Clash/Explicit/Moore.hs b/clash-prelude/src/Clash/Explicit/Moore.hs index e5a209dd79..e1c25861f8 100644 --- a/clash-prelude/src/Clash/Explicit/Moore.hs +++ b/clash-prelude/src/Clash/Explicit/Moore.hs @@ -26,7 +26,7 @@ module Clash.Explicit.Moore where import Clash.Explicit.Signal - (KnownDomain, Bundle (..), Clock, Reset, Signal, Enable, register) + (Bundle (..), Clock, Reset, Signal, Enable, register) import Clash.XException (NFDataX) {- $setup @@ -47,8 +47,7 @@ import Clash.XException (NFDataX) -- macT s (x,y) = x * y + s -- -- mac --- :: 'KnownDomain' dom --- => 'Clock' dom +-- :: 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> 'Signal' dom (Int, Int) @@ -65,8 +64,7 @@ import Clash.XException (NFDataX) -- -- @ -- dualMac --- :: 'KnownDomain' dom --- => 'Clock' dom +-- :: 'Clock' dom -- -> 'Reset' dom -- -> 'Enable' dom -- -> ('Signal' dom Int, 'Signal' dom Int) @@ -78,8 +76,8 @@ import Clash.XException (NFDataX) -- s2 = 'moore' clk rst en macT id 0 ('bundle' (b,y)) -- @ moore - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i o + . NFDataX s => Clock dom -- ^ 'Clock' to synchronize to -> Reset dom @@ -102,8 +100,8 @@ moore clk rst en ft fo iS = -- | Create a synchronous function from a combinational function describing -- a moore machine without any output logic medvedev - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i + . NFDataX s => Clock dom -> Reset dom -> Enable dom @@ -141,8 +139,8 @@ medvedev clk rst en tr st = moore clk rst en tr id st -- (i2,b2) = 'mooreB' clk rst en t o 3 (c,i1) -- @ mooreB - :: ( KnownDomain dom - , NFDataX s + :: forall dom s i o + . ( NFDataX s , Bundle i , Bundle o ) => Clock dom @@ -164,8 +162,8 @@ mooreB clk rst en ft fo iS i = unbundle (moore clk rst en ft fo iS (bundle i)) -- | A version of 'medvedev' that does automatic 'Bundle'ing medvedevB - :: ( KnownDomain dom - , NFDataX s + :: forall dom s i + . ( NFDataX s , Bundle i , Bundle s ) => Clock dom diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs index a99c13d644..49bf7f0da5 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude.hs @@ -229,8 +229,8 @@ functions a type class called 'Clash.Class.Parity.Parity' is available at -- [1 :> 0 :> 0 :> 0 :> Nil,2 :> 1 :> 0 :> 0 :> Nil,3 :> 2 :> 1 :> 0 :> Nil,4 :> 3 :> 2 :> 1 :> Nil,5 :> 4 :> 3 :> 2 :> Nil,... -- ... window - :: ( KnownNat n - , KnownDomain dom + :: forall n dom a + . ( KnownNat n , NFDataX a , Default a ) @@ -255,8 +255,7 @@ window clk rst en x = res -- -- @ -- windowD3 --- :: KnownDomain dom --- -> Clock dom +-- :: Clock dom -- -> Enable dom -- -> Reset dom -- -> 'Signal' dom Int @@ -271,7 +270,7 @@ windowD :: ( KnownNat n , NFDataX a , Default a - , KnownDomain dom ) + ) => Clock dom -- ^ Clock to which the incoming signal is synchronized -> Reset dom diff --git a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs index e39d98d37d..6cb38335d5 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs @@ -186,8 +186,8 @@ functions a type class called 'Clash.Class.Parity.Parity' is available at -- [(8,8),(8,8),(1,1),(2,2),(3,3)... -- ... registerB - :: ( KnownDomain dom - , NFDataX a + :: forall dom a + . ( NFDataX a , Bundle a ) => Clock dom -> Reset dom @@ -201,8 +201,8 @@ registerB clk rst en i = -- | Give a pulse when the 'Signal' goes from 'minBound' to 'maxBound' isRising - :: ( KnownDomain dom - , NFDataX a + :: forall dom a + . ( NFDataX a , Bounded a , Eq a ) => Clock dom @@ -219,8 +219,8 @@ isRising clk rst en is s = liftA2 edgeDetect prev s -- | Give a pulse when the 'Signal' goes from 'maxBound' to 'minBound' isFalling - :: ( KnownDomain dom - , NFDataX a + :: forall dom a + . ( NFDataX a , Bounded a , Eq a ) => Clock dom @@ -240,8 +240,7 @@ isFalling clk rst en is s = liftA2 edgeDetect prev s -- @'Clash.Explicit.Signal.mux'@, in order to delay a register by a known amount. riseEvery :: forall dom n - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Enable dom -> SNat n @@ -258,8 +257,7 @@ riseEvery clk rst en SNat = moore clk rst en transfer output 0 (pure ()) -- | Oscillate a @'Bool'@ for a given number of cycles, given the starting state. oscillate :: forall dom n - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Enable dom -> Bool diff --git a/clash-prelude/src/Clash/Explicit/Reset.hs b/clash-prelude/src/Clash/Explicit/Reset.hs index 15c6a878a9..930ee6d334 100644 --- a/clash-prelude/src/Clash/Explicit/Reset.hs +++ b/clash-prelude/src/Clash/Explicit/Reset.hs @@ -83,12 +83,15 @@ orReset = unsafeOrReset -- asserted. This function is considered unsafe because it can be used on -- domains with components with asynchronous resets, where use of this function -- can introduce glitches triggering a reset. -unsafeOrReset :: forall dom. KnownDomain dom => Reset dom -> Reset dom -> Reset dom -unsafeOrReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = +unsafeOrReset :: forall dom. Reset dom -> Reset dom -> Reset dom +unsafeOrReset r0@(Reset{}) r1 = unsafeToReset $ case resetPolarity @dom of SActiveHigh -> rst0 .||. rst1 SActiveLow -> rst0 .&&. rst1 + where + rst0 = unsafeFromReset r0 + rst1 = unsafeFromReset r1 -- | Output reset will be asserted when both input resets are asserted andReset :: @@ -103,12 +106,15 @@ andReset = unsafeAndReset -- function is considered unsafe because it can be used on domains with -- components with asynchronous resets, where use of this function can introduce -- glitches triggering a reset. -unsafeAndReset :: forall dom. KnownDomain dom => Reset dom -> Reset dom -> Reset dom -unsafeAndReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = +unsafeAndReset :: forall dom. Reset dom -> Reset dom -> Reset dom +unsafeAndReset r0@(Reset{}) r1 = unsafeToReset $ case resetPolarity @dom of SActiveHigh -> rst0 .&&. rst1 SActiveLow -> rst0 .||. rst1 + where + rst0 = unsafeFromReset r0 + rst1 = unsafeFromReset r1 -- | The resetSynchronizer will synchronize an incoming reset according to -- whether the domain is synchronous or asynchronous. @@ -212,11 +218,10 @@ unsafeAndReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = -- resetSynchronizer :: forall dom - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Reset dom -resetSynchronizer clk rst = rstOut +resetSynchronizer clk@(Clock{}) rst = rstOut where isActiveHigh = case resetPolarity @dom of { SActiveHigh -> True; _ -> False } rstOut = @@ -303,7 +308,6 @@ resetGlitchFilter = unsafeResetGlitchFilter unsafeResetGlitchFilter :: forall dom glitchlessPeriod . ( HasCallStack - , KnownDomain dom , 1 <= glitchlessPeriod ) => SNat glitchlessPeriod @@ -312,7 +316,7 @@ unsafeResetGlitchFilter -> Clock dom -> Reset dom -> Reset dom -unsafeResetGlitchFilter glitchlessPeriod clk = +unsafeResetGlitchFilter glitchlessPeriod clk@(Clock{}) = resetGlitchFilter# glitchlessPeriod reg dffSync where reg = delay clk enableGen @@ -338,7 +342,6 @@ unsafeResetGlitchFilter glitchlessPeriod clk = resetGlitchFilterWithReset :: forall dom glitchlessPeriod . ( HasCallStack - , KnownDomain dom , 1 <= glitchlessPeriod ) => SNat glitchlessPeriod @@ -360,7 +363,6 @@ resetGlitchFilterWithReset glitchlessPeriod clk ownRst = resetGlitchFilter# :: forall dom glitchlessPeriod state . ( HasCallStack - , KnownDomain dom , 1 <= glitchlessPeriod , state ~ (Bool, Index glitchlessPeriod) ) @@ -375,7 +377,7 @@ resetGlitchFilter# ) -> Reset dom -> Reset dom -resetGlitchFilter# SNat reg dffSync rstIn0 = +resetGlitchFilter# SNat reg dffSync rstIn0@(Reset{}) = let s' = go <$> s <*> rstIn2 s = reg (asserted, 0) s' in unsafeToReset $ fst <$> s @@ -416,8 +418,7 @@ resetGlitchFilter# SNat reg dffSync rstIn0 = -- holdReset :: forall dom n - . KnownDomain dom - => Clock dom + . Clock dom -> Enable dom -- ^ Global enable -> SNat n @@ -426,7 +427,7 @@ holdReset -> Reset dom -- ^ Reset to extend -> Reset dom -holdReset clk en SNat rst = +holdReset clk en SNat rst@(Reset{}) = unsafeFromActiveHigh ((/=maxBound) <$> counter) where counter :: Signal dom (Index (n+1)) @@ -440,14 +441,11 @@ holdReset clk en SNat rst = -- filter glitches. This adds one @domA@ clock cycle delay. convertReset :: forall domA domB - . ( KnownDomain domA - , KnownDomain domB - ) - => Clock domA + . Clock domA -> Clock domB -> Reset domA -> Reset domB -convertReset clkA clkB rstA0 = rstB1 +convertReset clkA@(Clock{}) clkB@(Clock{}) rstA0 = rstB1 where rstA1 = unsafeFromReset rstA0 rstA2 = diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index bbd66437f7..68ddbe973c 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -572,8 +572,7 @@ andEnable e0 e1 = -- | Special version of 'delay' that doesn't take enable signals of any kind. -- Initial value will be undefined. dflipflop - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -> Signal dom a -> Signal dom a @@ -591,8 +590,7 @@ dflipflop = \clk i -> -- >>> sampleN 3 (delay systemClockGen enableGen 0 (fromList [1,2,3,4])) -- [0,1,2] delay - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -- ^ Clock -> Enable dom @@ -611,8 +609,7 @@ delay = delay# -- >>> sampleN 7 (delayMaybe systemClockGen enableGen 0 input) -- [0,1,2,2,2,5,6] delayMaybe - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -- ^ Clock -> Enable dom @@ -632,8 +629,7 @@ delayMaybe = \clk gen dflt i -> -- >>> sampleN 7 (delayEn systemClockGen enableGen 0 enable input) -- [0,1,2,2,2,5,6] delayEn - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -- ^ Clock -> Enable dom @@ -654,8 +650,7 @@ delayEn = \clk gen dflt en i -> -- >>> sampleN 5 (register systemClockGen resetGen enableGen 8 (fromList [1,1,2,3,4])) -- [8,8,1,2,3] register - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -- ^ clock -> Reset dom @@ -693,8 +688,7 @@ register = \clk rst gen initial i -> -- >>> sampleN 9 (count systemClockGen resetGen enableGen) -- [0,0,0,1,1,2,2,3,3] regMaybe - :: ( KnownDomain dom - , NFDataX a ) + :: NFDataX a => Clock dom -- ^ Clock -> Reset dom @@ -725,9 +719,7 @@ regMaybe = \clk rst en initial iM -> -- >>> sampleN 9 (count systemClockGen resetGen enableGen) -- [0,0,0,1,1,2,2,3,3] regEn - :: ( KnownDomain dom - , NFDataX a - ) + :: NFDataX a => Clock dom -- ^ Clock -> Reset dom @@ -761,8 +753,7 @@ simulateWithReset -- ^ Number of cycles to assert the reset -> a -- ^ Reset value - -> ( KnownDomain dom - => Clock dom + -> ( Clock dom -> Reset dom -> Enable dom -> Signal dom a @@ -793,8 +784,7 @@ simulateWithResetN -- ^ Reset value -> Int -- ^ Number of cycles to simulate (excluding cycle spent in reset) - -> ( KnownDomain dom - => Clock dom + -> ( Clock dom -> Reset dom -> Enable dom -> Signal dom a @@ -851,7 +841,7 @@ simulateB_lazy f = simulate_lazy (bundle . f . unbundle) -- __NB__: This function is not synthesizable fromListWithReset :: forall dom a - . (KnownDomain dom, NFDataX a) + . NFDataX a => Reset dom -> a -> [a] @@ -875,8 +865,7 @@ sampleWithReset , 1 <= m ) => SNat m -- ^ Number of cycles to assert the reset - -> (KnownDomain dom - => Clock dom + -> ( Clock dom -> Reset dom -> Enable dom -> Signal dom a) @@ -902,8 +891,7 @@ sampleWithResetN -- ^ Number of cycles to assert the reset -> Int -- ^ Number of samples to produce - -> (KnownDomain dom - => Clock dom + -> ( Clock dom -> Reset dom -> Enable dom -> Signal dom a) @@ -979,7 +967,7 @@ sampleWithResetN nReset nSamples f = -- @ runUntil :: forall dom a - . (KnownDomain dom, NFDataX a, ShowX a) + . (NFDataX a, ShowX a) => (a -> Bool) -- ^ Condition checking function, should return @True@ to finish run -> Signal dom a diff --git a/clash-prelude/src/Clash/Explicit/Signal/Delayed.hs b/clash-prelude/src/Clash/Explicit/Signal/Delayed.hs index acb70b473e..093e136193 100644 --- a/clash-prelude/src/Clash/Explicit/Signal/Delayed.hs +++ b/clash-prelude/src/Clash/Explicit/Signal/Delayed.hs @@ -56,7 +56,7 @@ import Clash.Signal.Delayed.Internal unsafeFromSignal, antiDelay, feedback, forward) import Clash.Explicit.Signal - (KnownDomain, Clock, Domain, Reset, Signal, Enable, register, delay, bundle, unbundle) + (Clock, Domain, Reset, Signal, Enable, register, delay, bundle, unbundle) import Clash.Promoted.Nat (SNat (..), snatToInteger) import Clash.XException (NFDataX) @@ -67,7 +67,7 @@ import Clash.XException (NFDataX) >>> let delay3 clk rst en = delayed clk rst en (-1 :> -1 :> -1 :> Nil) >>> let delay2 clk rst en = (delayedI clk rst en :: Int -> DSignal System n Int -> DSignal System (n + 2) Int) >>> let delayN2 = delayN d2 ->>> let delayI2 = delayI :: KnownDomain dom => Int -> Enable dom -> Clock dom -> DSignal dom n Int -> DSignal dom (n + 2) Int +>>> let delayI2 = delayI :: Int -> Enable dom -> Clock dom -> DSignal dom n Int -> DSignal dom (n + 2) Int >>> let countingSignals = Clash.Prelude.repeat (dfromList [0..]) :: Vec 4 (DSignal dom 0 Int) >>> :{ let mac :: Clock System @@ -91,8 +91,7 @@ let mac :: Clock System -- -- @ -- delay3 --- :: KnownDomain dom --- => Clock dom +-- :: Clock dom -- -> Reset dom -- -> Enable dom -- -> 'DSignal' dom n Int @@ -104,8 +103,7 @@ let mac :: Clock System -- [-1,-1,-1,-1,1,2,3] delayed :: forall dom a n d - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , NFDataX a ) => Clock dom -> Reset dom @@ -128,8 +126,7 @@ delayed clk rst en m ds = coerce (delaySignal (coerce ds)) -- -- @ -- delay2 --- :: KnownDomain dom --- => Clock dom +-- :: Clock dom -- -> Reset dom -- -> Enable dom -- -> Int @@ -154,7 +151,6 @@ delayed clk rst en m ds = coerce (delaySignal (coerce ds)) -- -> DSignal dom (n + 3) a delayedI :: ( KnownNat d - , KnownDomain dom , NFDataX a ) => Clock dom -> Reset dom @@ -169,8 +165,7 @@ delayedI clk rst en dflt = delayed clk rst en (repeat dflt) -- -- @ -- delayN2 --- :: 'KnownDomain' dom --- => Int +-- :: Int -- -> 'Enable' dom -- -> 'Clock' dom -- -> 'DSignal' dom n Int @@ -182,8 +177,7 @@ delayedI clk rst en dflt = delayed clk rst en (repeat dflt) -- [-1,-1,1,2,3,4] delayN :: forall dom a d n - . ( KnownDomain dom - , NFDataX a ) + . ( NFDataX a ) => SNat d -> a -- ^ Initial value @@ -201,8 +195,7 @@ delayN d dflt ena clk = coerce . go (snatToInteger d) . coerce @_ @(Signal dom a -- -- @ -- delayI2 --- :: 'KnownDomain' dom --- => Int +-- :: Int -- -> 'Enable' dom -- -> 'Clock' dom -- -> 'DSignal' dom n Int @@ -220,7 +213,6 @@ delayN d dflt ena clk = coerce . go (snatToInteger d) . coerce @_ @(Signal dom a delayI :: forall d n a dom . ( NFDataX a - , KnownDomain dom , KnownNat d ) => a -- ^ Initial value @@ -250,7 +242,6 @@ type instance Apply (DelayedFold dom n delay a) k = DSignal dom (n + (delay*k)) delayedFold :: forall dom n delay k a . ( NFDataX a - , KnownDomain dom , KnownNat delay , KnownNat k ) => SNat delay diff --git a/clash-prelude/src/Clash/Explicit/Synchronizer.hs b/clash-prelude/src/Clash/Explicit/Synchronizer.hs index f5987ed1a3..2d93409a8d 100644 --- a/clash-prelude/src/Clash/Explicit/Synchronizer.hs +++ b/clash-prelude/src/Clash/Explicit/Synchronizer.hs @@ -42,7 +42,7 @@ import Clash.Explicit.Mealy (mealyB) import Clash.Explicit.BlockRam (RamOp (..), trueDualPortBlockRam) import Clash.Explicit.Signal (Clock, Reset, Signal, Enable, register, unsafeSynchronizer, fromEnable, - (.&&.), mux, KnownDomain) + (.&&.), mux) import Clash.Promoted.Nat (SNat (..)) import Clash.Promoted.Nat.Literals (d0) import Clash.Sized.BitVector (BitVector, (++#)) @@ -73,9 +73,7 @@ import Clash.XException (NFDataX, fromJustX) -- If you want to have /safe/ __word__-synchronization use -- 'asyncFIFOSynchronizer'. dualFlipFlopSynchronizer - :: ( NFDataX a - , KnownDomain dom1 - , KnownDomain dom2 ) + :: NFDataX a => Clock dom1 -- ^ 'Clock' to which the incoming data is synchronized -> Clock dom2 @@ -99,9 +97,7 @@ dualFlipFlopSynchronizer clk1 clk2 rst en i = fifoMem :: forall wdom rdom a addrSize - . ( KnownDomain wdom - , KnownDomain rdom - , NFDataX a + . ( NFDataX a , KnownNat addrSize , 1 <= addrSize ) => Clock wdom @@ -204,9 +200,8 @@ isFull addrSize@SNat ptr s_ptr = -- bus skew and maximum delay constraints inside your synthesis tool for the -- clock domain crossings of the gray pointers. asyncFIFOSynchronizer - :: ( KnownDomain wdom - , KnownDomain rdom - , 2 <= addrSize + :: forall wdom rdom addrSize a + . ( 2 <= addrSize , NFDataX a ) => SNat addrSize -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ diff --git a/clash-prelude/src/Clash/Prelude/DataFlow.hs b/clash-prelude/src/Clash/Prelude/DataFlow.hs index 3041d36aaa..4a05c1788e 100644 --- a/clash-prelude/src/Clash/Prelude/DataFlow.hs +++ b/clash-prelude/src/Clash/Prelude/DataFlow.hs @@ -53,7 +53,7 @@ import Clash.Class.Resize (truncateB) import Clash.Class.BitPack.BitIndex (msb) import Clash.Explicit.Mealy (mealyB) import Clash.Promoted.Nat (SNat) -import Clash.Signal (KnownDomain, (.&&.)) +import Clash.Signal ((.&&.)) import Clash.Signal.Bundle (Bundle (..)) import Clash.Explicit.Signal (Clock, Reset, Signal, Enable, andEnable, register) import Clash.Sized.BitVector (BitVector) @@ -152,8 +152,8 @@ pureDF f = DF (\i iV oR -> (fmap f i,iV,oR)) -- | Create a 'DataFlow' circuit from a Mealy machine description as those of -- "Clash.Prelude.Mealy" mealyDF - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i o + . NFDataX s => Clock dom -> Reset dom -> Enable dom @@ -169,8 +169,8 @@ mealyDF clk rst gen f iS = -- | Create a 'DataFlow' circuit from a Moore machine description as those of -- "Clash.Prelude.Moore" mooreDF - :: ( KnownDomain dom - , NFDataX s ) + :: forall dom s i o + . NFDataX s => Clock dom -> Reset dom -> Enable dom @@ -217,8 +217,7 @@ fifoDF_mealy (mem,rptr,wptr) (wdata,winc,rinc) = -- @ fifoDF :: forall addrSize m n a dom - . ( KnownDomain dom - , NFDataX a + . ( NFDataX a , KnownNat addrSize , KnownNat n , KnownNat m @@ -356,8 +355,8 @@ parNDF fs = -- -- <> loopDF - :: ( KnownDomain dom - , NFDataX d + :: forall dom d m n addrSize a b + . ( NFDataX d , KnownNat m , KnownNat n , KnownNat addrSize diff --git a/clash-prelude/src/Clash/Signal/Delayed/Internal.hs b/clash-prelude/src/Clash/Signal/Delayed/Internal.hs index b7bb1b0b7f..4da1691229 100644 --- a/clash-prelude/src/Clash/Signal/Delayed/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Delayed/Internal.hs @@ -52,8 +52,7 @@ import Clash.XException (NFDataX) >>> :{ let mac :: forall dom - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Enable dom -> DSignal dom 0 Int @@ -73,8 +72,7 @@ let mac >>> :{ let numbers :: forall dom - . KnownDomain dom - => Clock dom + . Clock dom -> Reset dom -> Enable dom -> DSignal dom 5 (Int, Int) @@ -136,8 +134,7 @@ dfromList_lazy = coerce . fromList_lazy -- @ -- mac -- :: forall dom --- . KnownDomain dom --- => Clock dom +-- . Clock dom -- -> Reset dom -- -> Enable dom -- -> 'DSignal' dom 0 Int @@ -181,8 +178,7 @@ unsafeFromSignal = DSignal -- -- @ -- mac --- :: KnownDomain dom --- => Clock dom +-- :: Clock dom -- -> Reset dom -- -> Enable dom -- -> 'DSignal' dom 0 Int @@ -212,8 +208,7 @@ antiDelay _ = coerce -- @ -- numbers -- :: forall dom --- . KnownDomain dom --- => Clock dom +-- . Clock dom -- -> Reset dom -- -> Enable dom -- -> 'DSignal' dom 5 (Int, Int) From 8d6c6485e161dc9e197abbc246d12e4fce72628e Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 11 Oct 2023 16:42:24 +0200 Subject: [PATCH 17/27] Remove KnownDomain from Tutorial --- clash-prelude/src/Clash/Tutorial.hs | 174 +++++++++++++--------------- 1 file changed, 82 insertions(+), 92 deletions(-) diff --git a/clash-prelude/src/Clash/Tutorial.hs b/clash-prelude/src/Clash/Tutorial.hs index faff085bd0..f103ca166c 100644 --- a/clash-prelude/src/Clash/Tutorial.hs +++ b/clash-prelude/src/Clash/Tutorial.hs @@ -1106,8 +1106,7 @@ import qualified Data.Vector as V import GHC.Stack (HasCallStack, withFrozenCallStack) blockRam# - :: ( KnownDomain dom - , HasCallStack + :: ( HasCallStack , NFDataX a ) => 'Clock' dom -- ^ 'Clock' to synchronize to -> 'Enable' dom -- ^ Global enable @@ -1154,40 +1153,39 @@ BlackBox: kind: Declaration type: |- blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] + :: ( HasCallStack -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- clk, ARG[2] + -> Enable dom -- en, ARG[3] + -> Vec n a -- init, ARG[4] + -> Signal dom Int -- rd, ARG[5] + -> Signal dom Bool -- wren, ARG[6] + -> Signal dom Int -- wr, ARG[7] + -> Signal dom a -- din, ARG[8] -> Signal dom a template: |- -- blockRam begin ~GENSYM[~RESULT_blockRam][1] : block - signal ~GENSYM[~RESULT_RAM][2] : ~TYP[5] := ~CONST[5]; - signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[5]] - 1; - signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[5]] - 1; + signal ~GENSYM[~RESULT_RAM][2] : ~TYP[4] := ~CONST[4]; + signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[4]] - 1; + signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[4]] - 1; begin - ~SYM[4] <= to_integer(~ARG[6]) + ~SYM[4] <= to_integer(~ARG[5]) -- pragma translate_off - mod ~LENGTH[~TYP[5]] + mod ~LENGTH[~TYP[4]] -- pragma translate_on ; - ~SYM[5] <= to_integer(~ARG[8]) + ~SYM[5] <= to_integer(~ARG[7]) -- pragma translate_off - mod ~LENGTH[~TYP[5]] + mod ~LENGTH[~TYP[4]] -- pragma translate_on ; ~IF ~VIVADO ~THEN - ~SYM[6] : process(~ARG[3]) + ~SYM[6] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~ARG[6] ~IF ~ISACTIVEENABLE[3] ~THEN and ~ARG[3] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[8]][~TYP[8]]; end if; ~RESULT <= fromSLV(~SYM[2](~SYM[4])) -- pragma translate_off @@ -1196,11 +1194,11 @@ BlackBox: ; end if; end process; ~ELSE - ~SYM[6] : process(~ARG[3]) + ~SYM[6] : process(~ARG[2]) begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~ARG[9]; + if ~IF~ACTIVEEDGE[Rising][2]~THENrising_edge~ELSEfalling_edge~FI(~ARG[2]) then + if ~ARG[6] ~IF ~ISACTIVEENABLE[3] ~THEN and ~ARG[3] ~ELSE ~FI then + ~SYM[2](~SYM[5]) <= ~ARG[8]; end if; ~RESULT <= ~SYM[2](~SYM[4]) -- pragma translate_off @@ -1345,49 +1343,48 @@ BlackBox: outputReg: true type: |- blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] + :: ( HasCallStack -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- clk, ARG[2] + => Enable dom -- en, ARG[3] + -> Vec n a -- init, ARG[4] + -> Signal dom Int -- rd, ARG[5] + -> Signal dom Bool -- wren, ARG[6] + -> Signal dom Int -- wr, ARG[7] + -> Signal dom a -- din, ARG[8] -> Signal dom a template: |- // blockRam begin - reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[5]]-1]; + reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[4]]-1]; - reg ~TYP[5] ~GENSYM[ram_init][3]; + reg ~TYP[4] ~GENSYM[ram_init][3]; integer ~GENSYM[i][4]; initial begin - ~SYM[3] = ~CONST[5]; - for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin - ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; + ~SYM[3] = ~CONST[4]; + for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[4]]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LENGTH[~TYP[4]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; end end - ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; + ~IF ~ISACTIVEENABLE[3] ~THEN + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN + if (~ARG[3]) begin + if (~ARG[6]) begin + ~SYM[1][~ARG[7]] <= ~ARG[8]; end - ~RESULT <= ~SYM[1][~ARG[6]]; + ~RESULT <= ~SYM[1][~ARG[5]]; end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; + if (~ARG[6] & ~ARG[3]) begin + ~SYM[1][~ARG[7]] <= ~ARG[8]; end - if (~ARG[4]) begin - ~RESULT <= ~SYM[1][~ARG[6]]; + if (~ARG[3]) begin + ~RESULT <= ~SYM[1][~ARG[5]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[5] + if (~ARG[6]) begin + ~SYM[1][~ARG[7]] <= ~ARG[8]; end - ~RESULT <= ~SYM[1][~ARG[6]]; + ~RESULT <= ~SYM[1][~ARG[5]]; end~FI // blockRam end @ @@ -1413,45 +1410,44 @@ BlackBox: kind: Declaration type: |- blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] + :: ( HasCallStack -- ARG[0] + , NFDataX a ) -- ARG[1] + => Clock dom -- clk, ARG[2] + -> Enable dom -- en, ARG[3] + -> Vec n a -- init, ARG[4] + -> Signal dom Int -- rd, ARG[5] + -> Signal dom Bool -- wren, ARG[6] + -> Signal dom Int -- wr, ARG[7] + -> Signal dom a -- din, ARG[8] -> Signal dom a template: |- // blockRam begin - ~SIGD[~GENSYM[RAM][1]][5]; - logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2]; + ~SIGD[~GENSYM[RAM][1]][4]; + logic [~SIZE[~TYP[8]]-1:0] ~GENSYM[~RESULT_q][2]; initial begin - ~SYM[1] = ~CONST[5]; - end~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + ~SYM[1] = ~CONST[4]; + end~IF ~ISACTIVEENABLE[3] ~THEN + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN + if (~ARG[3]) begin + if (~ARG[6]) begin + ~SYM[1][~ARG[7]] <= ~TOBV[~ARG[8]][~TYP[8]]; end - ~SYM[2] <= ~SYM[1][~ARG[6]]; + ~SYM[2] <= ~SYM[1][~ARG[5]]; end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + if (~ARG[6] & ~ARG[3]) begin + ~SYM[1][~ARG[7]] <= ~TOBV[~ARG[8]][~TYP[8]]; end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[6]]; + if (~ARG[3]) begin + ~SYM[2] <= ~SYM[1][~ARG[5]]; end~FI end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[2]) begin : ~SYM[3] + if (~ARG[6]) begin + ~SYM[1][~ARG[7]] <= ~TOBV[~ARG[8]][~TYP[8]]; end - ~SYM[2] <= ~SYM[1][~ARG[6]]; + ~SYM[2] <= ~SYM[1][~ARG[5]]; end~FI - assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; + assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[8]]; // blockRam end @ @@ -1561,8 +1557,6 @@ synchronous logic. As a consequence, we see in the type signature of __asyncRam__ :: ( 'Enum' addr , 'HasCallStack' - , 'KnownDomain' wdom - , 'KnownDomain' rdom ) => 'Clock' wdom -- ^ 'Clock' to which to synchronize the write port of the RAM -> 'Clock' rdom -- ^ 'Clock' to which the read address signal, @r@, is synchronized to @@ -1675,9 +1669,7 @@ Finally we combine all the components in: @ asyncFIFOSynchronizer - :: ( 'KnownDomain' wdom - , 'KnownDomain' rdom - , 2 <= addrSize ) + :: ( 2 <= addrSize ) => SNat addrSize -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ -- elements. @@ -1796,9 +1788,7 @@ ptrSync clk1 clk2 rst2 en2 = -- Async FIFO synchronizer asyncFIFOSynchronizer - :: ( 'KnownDomain' wdom - , 'KnownDomain' rdom - , 2 <= addrSize ) + :: ( 2 <= addrSize ) => SNat addrSize -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ -- elements. From 1902d62430b66a7a960a5c56856d98420e1fcb8b Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 9 Oct 2023 17:41:58 +0200 Subject: [PATCH 18/27] Simplify Clash.Primitives.DSL.unsafeToActive[High,Low] You don't need to provide a KnownDomain anymore --- .../Xilinx/DcFifo/Internal/BlackBoxes.hs | 4 +-- clash-lib/src/Clash/Primitives/DSL.hs | 33 +++++++++++-------- .../src/Clash/Primitives/Xilinx/ClockGen.hs | 2 +- 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs index ce55a2ee51..3dc55cceb1 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs @@ -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" @@ -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" diff --git a/clash-lib/src/Clash/Primitives/DSL.hs b/clash-lib/src/Clash/Primitives/DSL.hs index 2d814a351c..582e0e3885 100644 --- a/clash-lib/src/Clash/Primitives/DSL.hs +++ b/clash-lib/src/Clash/Primitives/DSL.hs @@ -117,8 +117,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 @@ -203,6 +203,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 @@ -992,32 +1003,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 diff --git a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs index 0e67749b31..2c3058b76e 100644 --- a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs @@ -62,7 +62,7 @@ clockWizardDifferentialTemplate bbCtx clkWizInstName <- Id.makeBasic "clockWizardDifferential_inst" DSL.declarationReturn bbCtx "clockWizardDifferential" $ do - rstHigh <- DSL.unsafeToActiveHigh "reset" (DSL.ety knownDomIn) rst + rstHigh <- DSL.unsafeToActiveHigh "reset" rst pllOut <- DSL.declare "pllOut" Bit locked <- DSL.declare "locked" Bit pllLock <- DSL.boolFromBit "pllLock" locked From e98bbe97455f89e9bd9bf45082b799bf10848deb Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Tue, 10 Oct 2023 15:35:42 +0200 Subject: [PATCH 19/27] clash-cores --- .../Cores/LatticeSemi/ECP5/Blackboxes/IO.hs | 3 +- .../src/Clash/Cores/LatticeSemi/ECP5/IO.hs | 2 - .../src/Clash/Cores/Xilinx/BlockRam.hs | 5 +- .../Clash/Cores/Xilinx/BlockRam/BlackBoxes.hs | 6 -- .../Clash/Cores/Xilinx/BlockRam/Internal.hs | 2 - clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs | 9 +- .../Xilinx/DcFifo/Internal/BlackBoxes.hs | 91 ++++++++----------- .../Cores/Xilinx/Floating/Annotations.hs | 28 ++---- .../Clash/Cores/Xilinx/Floating/BlackBoxes.hs | 30 +++--- .../Clash/Cores/Xilinx/Floating/Explicit.hs | 42 +++------ clash-cores/src/Clash/Cores/Xilinx/Ila.hs | 4 +- .../src/Clash/Cores/Xilinx/Ila/Internal.hs | 11 +-- clash-cores/src/Clash/Cores/Xilinx/VIO.hs | 8 +- .../Cores/Xilinx/VIO/Internal/BlackBoxes.hs | 12 +-- .../Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs | 7 +- .../Xilinx/Xpm/Cdc/ArraySingle/Internal.hs | 8 +- .../src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs | 7 +- .../Cores/Xilinx/Xpm/Cdc/Gray/Internal.hs | 8 +- .../Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs | 7 +- .../Xilinx/Xpm/Cdc/Handshake/Internal.hs | 8 +- .../src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs | 9 +- .../Cores/Xilinx/Xpm/Cdc/Single/Internal.hs | 8 +- .../test/Test/Cores/Internal/Signals.hs | 6 +- clash-cores/test/Test/Cores/SPI/MultiSlave.hs | 3 +- clash-lib/src/Clash/Primitives/DSL.hs | 1 + 25 files changed, 116 insertions(+), 209 deletions(-) diff --git a/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/Blackboxes/IO.hs b/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/Blackboxes/IO.hs index 9e3442439a..adf8511baa 100644 --- a/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/Blackboxes/IO.hs +++ b/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/Blackboxes/IO.hs @@ -29,7 +29,7 @@ import Prelude bbTF :: TemplateFunction bbTF = TemplateFunction used valid bbTemplate where - used = [3..6] + used = [2..5] valid = const True bbTemplate @@ -39,7 +39,6 @@ bbTemplate bbTemplate bbCtx | [ _HasCallStack , _HasBiSignalDefault - , _KnownDomain , (intrinsicName, String, _) , (packagePin, packagePinTy, _) , (dOut, Bit, _) diff --git a/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/IO.hs b/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/IO.hs index 473198bee3..bf3b64b115 100644 --- a/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/IO.hs +++ b/clash-cores/src/Clash/Cores/LatticeSemi/ECP5/IO.hs @@ -30,7 +30,6 @@ bidirectionalBuffer :: forall ds dom . ( HasCallStack , HasBiSignalDefault ds - , KnownDomain dom ) => Enable dom -- ^ output enable @@ -56,7 +55,6 @@ bbECP5 :: forall ds dom . ( HasCallStack , HasBiSignalDefault ds - , KnownDomain dom ) => String -> BiSignalIn ds dom 1 diff --git a/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs b/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs index 0fb1d2df22..7e8a219951 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/BlockRam.hs @@ -14,6 +14,7 @@ module Clash.Cores.Xilinx.BlockRam (tdpbram) where import Clash.Explicit.Prelude +import Clash.Signal.Internal (Clock(Clock)) import GHC.Stack (HasCallStack) @@ -30,8 +31,6 @@ tdpbram :: forall nAddrs domA domB nBytes a . ( HasCallStack , KnownNat nAddrs - , KnownDomain domA - , KnownDomain domB , KnownNat nBytes , BitSize a ~ (8 * nBytes) , NFDataX a @@ -61,7 +60,7 @@ tdpbram :: ( Signal domA a , Signal domB a ) -tdpbram clkA enA addrA byteEnaA datA clkB enB addrB byteEnaB datB = +tdpbram clkA@(Clock{}) enA addrA byteEnaA datA clkB@(Clock{}) enB addrB byteEnaB datB = -- [Note: eta port names for tdpbram] -- -- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC diff --git a/clash-cores/src/Clash/Cores/Xilinx/BlockRam/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/BlockRam/BlackBoxes.hs index fa5c36a288..c7ddbdfced 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/BlockRam/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/BlockRam/BlackBoxes.hs @@ -44,8 +44,6 @@ used = :< _risingEdgeConstraintA :< _risingEdgeConstraintB :< knownNatNAddrs - :< _knownDomainA - :< _knownDomainB :< _nfDataX :< _bitpack :< nBytes @@ -64,8 +62,6 @@ tdpbramBBTF bbCtx , _risingEdgeConstraintA , _risingEdgeConstraintB , _knownNatNAddrs - , _knownDomainA - , _knownDomainB , _nfDataX , _bitpack , (fmap fromIntegral . DSL.tExprToInteger -> Just nBytes) @@ -155,8 +151,6 @@ tdpbramTclBBTF bbCtx , _risingEdgeConstraintA , _risingEdgeConstraintB , DSL.tExprToInteger -> Just depth - , _knownDomainA - , _knownDomainB , _nfDataX , _bitpack , DSL.tExprToInteger -> Just width diff --git a/clash-cores/src/Clash/Cores/Xilinx/BlockRam/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/BlockRam/Internal.hs index c9d36c9ac2..cb265bae83 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/BlockRam/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/BlockRam/Internal.hs @@ -186,8 +186,6 @@ tdpbram# :: , DomainActiveEdge domA ~ 'Rising , DomainActiveEdge domB ~ 'Rising , KnownNat nAddrs - , KnownDomain domA - , KnownDomain domB , NFDataX a , BitPack a , KnownNat nBytes diff --git a/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs b/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs index 81f96977b7..efe1b6266d 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/DcFifo.hs @@ -71,7 +71,7 @@ module Clash.Cores.Xilinx.DcFifo ) where import Clash.Explicit.Prelude -import Clash.Signal.Internal (Signal (..), ClockAB (..), clockTicks) +import Clash.Signal.Internal (Clock(..), Signal (..), ClockAB (..), clockTicks) import Data.Maybe (isJust) import qualified Data.Sequence as Seq import Data.Sequence (Seq) @@ -129,10 +129,7 @@ defConfig = DcConfig -- disabled, the relevant signals will return 'XException'. dcFifo :: forall depth a write read . - ( KnownDomain write - , KnownDomain read - - , NFDataX a + ( NFDataX a , KnownNat depth -- Number of elements should be between [2**4, 2**17] ~ [16, 131072]. @@ -156,7 +153,7 @@ dcFifo :: -- | Read enable @rd_en@ Signal read Bool -> FifoOut read write depth a -dcFifo DcConfig{..} wClk wRst rClk rRst writeData rEnable = +dcFifo DcConfig{..} wClk@(Clock{}) wRst rClk@(Clock{}) rRst writeData rEnable = case (resetKind @write, resetKind @read) of (SSynchronous, SSynchronous) -> let diff --git a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs index 3dc55cceb1..1963b7b798 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs @@ -27,9 +27,10 @@ import GHC.Stack (HasCallStack) import Clash.Backend (Backend) import Clash.Core.TermLiteral (termToDataError) import Clash.Netlist.BlackBox.Types (BlackBoxFunction, emptyBlackBoxMeta) +import Clash.Netlist.BlackBox.Util (getDomainConf) import Clash.Netlist.Types (TemplateFunction(..), BlackBox(BBFunction), BlackBoxContext) -import Clash.Netlist.Util (orNothing, stripVoid) -import Clash.Signal.Internal (ResetKind(..)) +import Clash.Netlist.Util (orNothing) +import Clash.Signal.Internal (ResetKind(..),vResetKind) import Clash.Promoted.Nat (snatToNum) import qualified Clash.Primitives.DSL as DSL @@ -51,8 +52,7 @@ import Clash.Cores.Xilinx.Internal -- * 'dcFifoTF': instantiates IP generated in @dcFifoTclTF@ dcFifoBBF :: HasCallStack => BlackBoxFunction dcFifoBBF _isD _primName args _resTys - | [ _knownDomainWrite, _knownDomainRead - , _nfDataX, _knownNatDepth + | [ _nfDataX, _knownNatDepth , _constraint1, _constraint2, _hasCallStack , either error id . termToDataError -> dcConfig , _wClk, _wRst, _rClk, _rRst, _wData @@ -93,22 +93,20 @@ dcFifoBBF _ _ args _ = error ("dcFifoBBF, bad args: " <> show args) dcFifoTF :: HasCallStack => DcConfig n -> TemplateFunction dcFifoTF config = TemplateFunction - -- ( KnownDomain write -- 0 - -- , KnownDomain read -- 1 - -- , NFDataX a -- 2 - -- , KnownNat depth -- 3 - -- , 4 <= depth -- 4 - -- , depth <= 17 -- 5 - -- , HasCallStack -- 6 + -- ( NFDataX a -- 0 + -- , KnownNat depth -- 1 + -- , 4 <= depth -- 2 + -- , depth <= 17 -- 3 + -- , HasCallStack -- 4 -- ) => - -- DcConfig (SNat depth) -> -- 7 Note: argument passed to this function - -- Clock write -> -- 8 - -- Reset write -> -- 9 - -- Clock read -> -- 10 - -- Reset read -> -- 11 - -- Signal write (Maybe a) -> -- 12 - -- Signal read Bool -> -- 13 - [0, 1, 7, 8, 9, 10, 11, 12, 13] + -- DcConfig (SNat depth) -> -- 5 Note: argument passed to this function + -- Clock write -> -- 6 + -- Reset write -> -- 7 + -- Clock read -> -- 8 + -- Reset read -> -- 9 + -- Signal write (Maybe a) -> -- 10 + -- Signal read Bool -> -- 11 + [5, 6, 7, 8, 9, 10, 11] (const True) (dcFifoBBTF config) where @@ -119,8 +117,7 @@ dcFifoBBTF :: BlackBoxContext -> State s Doc dcFifoBBTF DcConfig{..} bbCtx - | [ knownDomainWrite, knownDomainRead - , _nfDataX, _knownNatDepth + | [ _nfDataX, _knownNatDepth , _constraint1, _constraint2, _hasCallStack , _dcConfig , wClk, wRst, rClk, rRst, wDataM @@ -174,29 +171,23 @@ dcFifoBBTF DcConfig{..} bbCtx rdEmptyBool <- DSL.boolFromBit "rd_empty_bool" rdEmpty rEnableBit <- DSL.boolToBit "rd_enable" rEnable + wDomConf <- DSL.liftToBlockState $ getDomainConf (DSL.ety wClk) wRstHigh <- - let domty = DSL.ety knownDomainWrite - in case stripVoid domty of - N.KnownDomain _ _ _ Synchronous _ _ -> + case vResetKind wDomConf of + Synchronous -> DSL.unsafeToActiveHigh "wr_rst_high" wRst - N.KnownDomain _ _ _ Asynchronous _ _ -> + Asynchronous -> error $ show 'dcFifoTF <> ": dcFifo only supports synchronous resets" - _ -> - error $ show 'dcFifoTF <> ": Bug: Not a KnownDomain " <> - "constraint, mismatch between function and its blackbox" + rDomConf <- DSL.liftToBlockState $ getDomainConf (DSL.ety rClk) rRstHigh <- - let domty = DSL.ety knownDomainRead - in case stripVoid domty of - N.KnownDomain _ _ _ Synchronous _ _ -> + case vResetKind rDomConf of + Synchronous -> DSL.unsafeToActiveHigh "rd_rst_high" rRst - N.KnownDomain _ _ _ Asynchronous _ _ -> + Asynchronous -> error $ show 'dcFifoTF <> ": dcFifo only supports synchronous resets" - _ -> - error $ show 'dcFifoTF <> ": Bug: Not a KnownDomain " <> - "constraint, mismatch between function and its blackbox" (rdDataCountUnsigned, rdDataCountPort) <- if dcReadDataCount then do @@ -274,22 +265,20 @@ dcFifoBBTF _ bbCtx = error ("dcFifoBBTF, bad bbCtx: " <> show bbCtx) dcFifoTclTF :: HasCallStack => DcConfig n -> TemplateFunction dcFifoTclTF conf = TemplateFunction - -- ( KnownDomain write -- 0 - -- , KnownDomain read -- 1 - -- , NFDataX a -- 2 - -- , KnownNat depth -- 3 - -- , 4 <= depth -- 4 - -- , depth <= 17 -- 5 - -- , HasCallStack -- 6 + -- ( NFDataX a -- 0 + -- , KnownNat depth -- 1 + -- , 4 <= depth -- 2 + -- , depth <= 17 -- 3 + -- , HasCallStack -- 4 -- ) => - -- DcConfig (SNat depth) -> -- 7 Note: argument passed to this function - -- Clock write -> -- 8 - -- Reset write -> -- 9 - -- Clock read -> -- 10 - -- Reset read -> -- 11 - -- Signal write (Maybe a) -> -- 12 - -- Signal read Bool -> -- 13 - [7, 12] + -- DcConfig (SNat depth) -> -- 5 Note: argument passed to this function + -- Clock write -> -- 6 + -- Reset write -> -- 7 + -- Clock read -> -- 8 + -- Reset read -> -- 9 + -- Signal write (Maybe a) -> -- 10 + -- Signal read Bool -> -- 11 + [5, 10] (const True) (dcFifoTclBBTF conf) @@ -300,7 +289,7 @@ dcFifoTclBBTF :: State s Doc dcFifoTclBBTF DcConfig{..} bbCtx | [dcFifoName] <- N.bbQsysIncName bbCtx - , [ _knownDomainWrite, _knownDomainRead, _nfDataX + , [ _nfDataX , _knownNatDepth, _constraint1, _constraint2, _hasCallStack , _dcConfig, _wClk, _wRst, _rClk, _rRst, wDataM, _rEnable ] <- map fst (DSL.tInputs bbCtx) diff --git a/clash-cores/src/Clash/Cores/Xilinx/Floating/Annotations.hs b/clash-cores/src/Clash/Cores/Xilinx/Floating/Annotations.hs index 09230230a1..40295357fe 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Floating/Annotations.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Floating/Annotations.hs @@ -43,8 +43,7 @@ vhdlBinaryPrim -> Primitive vhdlBinaryPrim primName tclTFName funcName = let - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< config :< clk @@ -110,8 +109,7 @@ veriBinaryPrim -> Primitive veriBinaryPrim primName tclTFName funcName = let - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< config :< clk @@ -148,8 +146,7 @@ vhdlFromUPrim -> Primitive vhdlFromUPrim primName funcName = let tfName = 'fromUTclTF - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clk :< en @@ -186,7 +183,7 @@ vhdlFromUPrim primName funcName = ~GENSYM[#{funcName}][#{compSym}] : ~INCLUDENAME[0] port map ( aclk => ~ARG[#{clk}], - ~IF~ISACTIVEENABLE[#{en}]~THEN aclken => ~SYM[#{clk}], + ~IF~ISACTIVEENABLE[#{en}]~THEN aclken => ~SYM[#{clkEnStdSym}], ~ELSE~FI s_axis_a_tvalid => '1', s_axis_a_tdata => ~SYM[#{inpSlvSym}], m_axis_result_tvalid => open, @@ -208,8 +205,7 @@ veriFromUPrim veriFromUPrim primName funcName = let tfName = 'fromUTclTF - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clk :< en @@ -245,8 +241,7 @@ vhdlFromSPrim vhdlFromSPrim primName funcName = let tfName = 'fromSTclTF - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clk :< en @@ -283,7 +278,7 @@ vhdlFromSPrim primName funcName = ~GENSYM[#{funcName}][#{compSym}] : ~INCLUDENAME[0] port map ( aclk => ~ARG[#{clk}], - ~IF~ISACTIVEENABLE[#{en}]~THEN aclken => ~SYM[#{clk}], + ~IF~ISACTIVEENABLE[#{en}]~THEN aclken => ~SYM[#{clkEnStdSym}], ~ELSE~FI s_axis_a_tvalid => '1', s_axis_a_tdata => ~SYM[#{inpSlvSym}], m_axis_result_tvalid => open, @@ -305,8 +300,7 @@ veriFromSPrim veriFromSPrim primName funcName = let tfName = 'fromSTclTF - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clk :< en @@ -344,8 +338,7 @@ vhdlComparePrim -> Primitive vhdlComparePrim primName tclTFName funcName = let - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clock :< enable @@ -410,8 +403,7 @@ veriComparePrim -> Primitive veriComparePrim primName tclTFName funcName = let - _knownDomain - :< _knownNat + _knownNat :< _hasCallStack :< clock :< enable diff --git a/clash-cores/src/Clash/Cores/Xilinx/Floating/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/Floating/BlackBoxes.hs index ecda182824..fc7302afce 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Floating/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Floating/BlackBoxes.hs @@ -86,7 +86,7 @@ binaryTclTF binaryTclTF hasCustom operType = TemplateFunction used valid (tclTemplate hasCustom operType) where - used = [0..4] + used = [0,2,4] valid = const True tclTemplate @@ -96,8 +96,8 @@ tclTemplate -> BlackBoxContext -> State s Doc tclTemplate (HasCustom {..}) operType bbCtx - | (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 1 - , (DataCon _ _ cfgExprs, _, _) <- bbInputs bbCtx !! 3 + | (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 0 + , (DataCon _ _ cfgExprs, _, _) <- bbInputs bbCtx !! 2 , let cfgArchOptExpr = cfgExprs !! 0 , DataCon _ (DC (Sum _ cfgArchOptConstrs, cfgArchOptTag)) _ <- cfgArchOptExpr , let cfgDspUsageExpr = cfgExprs !! 1 @@ -133,7 +133,7 @@ tclTemplate (HasCustom {..}) operType bbCtx tclClkEn :: String tclClkEn = - case bbInputs bbCtx !! 5 of + case bbInputs bbCtx !! 4 of (DataCon _ _ [Literal Nothing (BoolLit True)], _, _) -> "false" _ -> "true" @@ -176,7 +176,7 @@ tclTemplate _ _ bbCtx = error ("Xilinx.Floating.tclTemplate, bad bbCtx: " <> sho fromUTclTF :: TemplateFunction fromUTclTF = TemplateFunction used valid fromUTclTemplate where - used = [1,4,5] + used = [0,3,4] valid = const True fromUTclTemplate @@ -185,13 +185,13 @@ fromUTclTemplate -> State s Doc fromUTclTemplate bbCtx | [compName] <- bbQsysIncName bbCtx - , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 1 - , (_, Unsigned inpLen, _) <- bbInputs bbCtx !! 5 + , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 0 + , (_, Unsigned inpLen, _) <- bbInputs bbCtx !! 4 = let tclClkEn :: String tclClkEn = - case bbInputs bbCtx !! 4 of + case bbInputs bbCtx !! 3 of (DataCon _ _ [Literal Nothing (BoolLit True)], _, _) -> "false" _ -> "true" @@ -228,7 +228,7 @@ fromUTclTemplate bbCtx = error ("Xilinx.Floating.fromUTclTemplate, bad bbCtx: " fromSTclTF :: TemplateFunction fromSTclTF = TemplateFunction used valid fromSTclTemplate where - used = [1,4,5] + used = [0,3,4] valid = const True fromSTclTemplate @@ -237,13 +237,13 @@ fromSTclTemplate -> State s Doc fromSTclTemplate bbCtx | [compName] <- bbQsysIncName bbCtx - , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 1 - , (_, Signed inpLen, _) <- bbInputs bbCtx !! 5 + , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 0 + , (_, Signed inpLen, _) <- bbInputs bbCtx !! 4 = let tclClkEn :: String tclClkEn = - case bbInputs bbCtx !! 4 of + case bbInputs bbCtx !! 3 of (DataCon _ _ [Literal Nothing (BoolLit True)], _, _) -> "false" _ -> "true" @@ -280,7 +280,7 @@ fromSTclTemplate bbCtx = error ("Xilinx.Floating.fromSTclTemplate, bad bbCtx: " compareTclTF :: TemplateFunction compareTclTF = TemplateFunction used valid compareTclTemplate where - used = [1,3,4,5,6] + used = [0,2,3,4,5] valid = const True compareTclTemplate @@ -289,12 +289,12 @@ compareTclTemplate -> State s Doc compareTclTemplate bbCtx | [compName] <- bbQsysIncName bbCtx - , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 1 + , (Literal _ (NumLit latency), _, _) <- bbInputs bbCtx !! 0 = let tclClkEn :: String tclClkEn = - case bbInputs bbCtx !! 4 of + case bbInputs bbCtx !! 3 of (DataCon _ _ [Literal Nothing (BoolLit True)], _, _) -> "false" _ -> "true" diff --git a/clash-cores/src/Clash/Cores/Xilinx/Floating/Explicit.hs b/clash-cores/src/Clash/Cores/Xilinx/Floating/Explicit.hs index 2dc0ff0dc5..19f72fe4d8 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Floating/Explicit.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Floating/Explicit.hs @@ -94,8 +94,7 @@ import Clash.Cores.Xilinx.Floating.Internal -- | Customizable floating point addition. addWith :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Config @@ -116,8 +115,7 @@ addWith !_ clk en (conditionFloatF -> x) (conditionFloatF -> y) = -- | Floating point addition with default settings. add :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -133,8 +131,7 @@ type AddDefDelay = 11 -- | Customizable floating point subtraction. subWith :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Config @@ -155,8 +152,7 @@ subWith !_ clk en (conditionFloatF -> x) (conditionFloatF -> y) = -- | Floating point subtraction with default settings. sub :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -173,8 +169,7 @@ type SubDefDelay = 11 -- | Customizable floating point multiplication. mulWith :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Config @@ -195,8 +190,7 @@ mulWith !_ clk en (conditionFloatF -> x) (conditionFloatF -> y) = -- | Floating point multiplication with default settings. mul :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -213,8 +207,7 @@ type MulDefDelay = 8 -- | Customizable floating point division. divWith :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Config @@ -235,8 +228,7 @@ divWith !_ clk en (conditionFloatF -> x) (conditionFloatF -> y) = -- | Floating point division with default settings. div :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -255,8 +247,7 @@ type DivDefDelay = 28 -- argument. fromU32With :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Clock dom @@ -274,8 +265,7 @@ fromU32With clk en = delayI und en clk . fmap fromIntegral -- | Conversion of @Unsigned 32@ to @Float@, with default delay fromU32 :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -293,8 +283,7 @@ type FromU32DefDelay = 5 -- argument. fromS32With :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Clock dom @@ -312,8 +301,7 @@ fromS32With clk en = delayI und en clk . fmap fromIntegral -- | Conversion of @Signed 32@ to @Float@, with default delay fromS32 :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom @@ -334,8 +322,7 @@ type FromS32DefDelay = 6 -- argument. compareWith :: forall d dom n - . ( KnownDomain dom - , KnownNat d + . ( KnownNat d , HasCallStack ) => Clock dom @@ -357,8 +344,7 @@ compareWith clk ena a b = delayI und ena clk (xilinxCompare <$> a <*> b) -- NaN. Otherwise, it behaves like Haskell's 'P.compare'. compare :: forall dom n - . ( KnownDomain dom - , HasCallStack + . ( HasCallStack ) => Clock dom -> Enable dom diff --git a/clash-cores/src/Clash/Cores/Xilinx/Ila.hs b/clash-cores/src/Clash/Cores/Xilinx/Ila.hs index 85e8544858..044d83faa8 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Ila.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Ila.hs @@ -106,7 +106,7 @@ instance Ila dom a => Ila dom (Signal dom i -> a) where -- optimized away by GHC. ila :: forall dom a n . - (KnownDomain dom, Ila dom a, 1 <= n) => + (Ila dom a, 1 <= n) => IlaConfig n -> -- | Clock to sample inputs on. Note that this is not necessarily the clock -- Xilinx's debug hub will run at, if multiple ILAs are instantiated. @@ -124,7 +124,7 @@ ila conf clk = -- probabilities. ila# :: forall dom a n . - (KnownDomain dom, Ila dom a, 1 <= n) => + (Ila dom a, 1 <= n) => IlaConfig n -> Clock dom -> a diff --git a/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs index f87eb2ac31..e3587fc14b 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs @@ -151,7 +151,7 @@ ilaBBF :: HasCallStack => BlackBoxFunction ilaBBF _isD _primName args _resTys = Lens.view tcCache >>= go where go tcm - | _:_:_:config:_ <- lefts args + | _:_:config:_ <- lefts args , _:_:(coreView tcm -> LitTy (NumTy n)):_ <- rights args , Just (SomeNat (Proxy :: Proxy n)) <- someNatVal n = case termToDataError @(IlaConfig n) config of @@ -176,8 +176,7 @@ ilaBBF _isD _primName args _resTys = Lens.view tcCache >>= go usedArguments :: [Int] usedArguments = ilaConfig : clock : inputProbes where - ( _knownDomain - :< _ilaConstraint + ( _ilaConstraint :< _1nConstraint :< ilaConfig :< clock @@ -215,8 +214,7 @@ ilaBBTF :: BlackBoxContext -> State s Doc ilaBBTF config bbCtx - | ( _knownDomainDom - : _ilaConstraint + | ( _ilaConstraint : _1nConstraint : _ilaConfig : clk @@ -289,8 +287,7 @@ ilaTclBBTF :: State s Doc ilaTclBBTF config@IlaConfig{..} bbCtx | [ilaName] <- bbQsysIncName bbCtx - , ( _knownDomainDom - : _IlaConstraint + , ( _IlaConstraint : _1nConstraint : _ilaConfig : _clk diff --git a/clash-cores/src/Clash/Cores/Xilinx/VIO.hs b/clash-cores/src/Clash/Cores/Xilinx/VIO.hs index 51c4fa1093..5935049772 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/VIO.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/VIO.hs @@ -80,7 +80,7 @@ instance VIO dom a o => VIO dom (Signal dom i -> a) o where -- Example incarnations are: -- -- @ --- someProbe :: 'KnownDomain' dom => 'Clock' dom -> 'Signal' dom 'Bit' -> 'Signal' dom ('Unsigned' 8) -> 'Signal' dom ('Bool', 'Maybe' ('Signed' 8)) +-- someProbe :: 'Clock' dom -> 'Signal' dom 'Bit' -> 'Signal' dom ('Unsigned' 8) -> 'Signal' dom ('Bool', 'Maybe' ('Signed' 8)) -- someProbe = 'vioProbe' ("in_b" :> "in_u8" :> Nil) ("out_b" :> "out_mu8" :> Nil) ('False', 'Nothing') -- @ -- @@ -89,7 +89,7 @@ instance VIO dom a o => VIO dom (Signal dom i -> a) o where -- output probes are both initialized to 0. -- -- @ --- otherProbe :: 'KnownDomain' dom => 'Clock' dom -> 'Signal' dom ('Unsigned' 4, 'Unsigned' 2, 'Bit') -> 'Signal' dom ('Vec' 3 'Bit') +-- otherProbe :: 'Clock' dom -> 'Signal' dom ('Unsigned' 4, 'Unsigned' 2, 'Bit') -> 'Signal' dom ('Vec' 3 'Bit') -- otherProbe = 'vioProbe' ("in_u4" :> "in_u2" :> "in_b" :> Nil) ("out_b1" :> "out_b2" :> "out_b3" :> Nil) ('repeat' 'high') -- @ -- @@ -103,7 +103,7 @@ instance VIO dom a o => VIO dom (Signal dom i -> a) o where -- in this case to enforce the VIO to be rendered in HDL. vioProbe :: forall dom a o n m. - (KnownDomain dom, VIO dom a o) => + VIO dom a o => Vec n String -> Vec m String -> o -> @@ -118,7 +118,7 @@ vioProbe inputNames outputNames initialOutputProbeValues clk = -- probabilities. vioProbe# :: forall dom a o n m. - (KnownDomain dom, VIO dom a o) => + VIO dom a o => Vec n String -> Vec m String -> o -> diff --git a/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs index 9d8f7b4ddf..06bfa6715f 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs @@ -87,8 +87,7 @@ vioProbeBBF _isD _primName _args _resTys = pure $ Right (bbMeta, bb) usedArguments :: [Int] usedArguments = (inputNames : outputNames : initOutValues : clock : inputProbes) where - ( _knownDomain - :< _vioConstraint + ( _vioConstraint :< inputNames :< outputNames :< initOutValues @@ -129,8 +128,7 @@ checkNameCollision _ tExpr = error [__i| vioProbeBBTF :: (Backend s, HasCallStack) => BlackBoxContext -> State s Doc vioProbeBBTF bbCtx - | ( _knownDomainDom - : _vioConstraint + | ( _vioConstraint : (DSL.getVec -> Just userInputNameExprs) : (DSL.getVec -> Just userOutputNameExprs) : _initialOutputProbeValues @@ -244,8 +242,7 @@ vioProbeTclBBTF :: BlackBoxContext -> State s Doc vioProbeTclBBTF bbCtx - | ( _knownDomainDom - : _vioConstraint + | ( _vioConstraint : _inputNames : _outputNames : initialOutputProbeValues @@ -340,8 +337,7 @@ validateVioProbeBBC bbCtx = case probesFromTypes bbCtx of probesFromTypes :: BlackBoxContext -> Either String ([HWType], [HWType]) probesFromTypes Context{..} = do is <- case map (\(_,x,_) -> x) bbInputs of - ( _knownDomainDom - : _VIOConstraint + ( _VIOConstraint : _inputNames : _outputNames : _clk diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs index 8e8dbf20b3..357b87d409 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle.hs @@ -12,6 +12,7 @@ module Clash.Cores.Xilinx.Xpm.Cdc.ArraySingle ) where import Clash.Explicit.Prelude +import Clash.Signal.Internal (Clock(Clock)) import GHC.Stack (HasCallStack) @@ -32,8 +33,6 @@ import Clash.Cores.Xilinx.Xpm.Cdc.ArraySingle.Internal (xpmCdcArraySingle#) xpmCdcArraySingle :: forall a src dst. ( 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , HasCallStack , NFDataX a , BitPack a @@ -42,7 +41,7 @@ xpmCdcArraySingle :: Clock dst -> Signal src a -> Signal dst a -xpmCdcArraySingle = xpmCdcArraySingleWith XpmCdcArraySingleConfig{..} +xpmCdcArraySingle clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcArraySingleWith XpmCdcArraySingleConfig{..} clkSrc clkDst where registerInput = True stages = d4 @@ -78,8 +77,6 @@ xpmCdcArraySingleWith :: forall stages a src dst. ( 2 <= stages, stages <= 10 , 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , HasCallStack , NFDataX a , BitPack a diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle/Internal.hs index 726b3beb55..b053d885f5 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/ArraySingle/Internal.hs @@ -24,7 +24,7 @@ import GHC.Stack (HasCallStack) import Text.Show.Pretty (ppShow) import Clash.Explicit.Prelude - ( type (<=), SNat, Clock, KnownDomain, BitPack(BitSize), NFDataX, deepErrorX + ( type (<=), SNat, Clock, BitPack(BitSize), NFDataX, deepErrorX , unsafeSynchronizer, unpack ) import Clash.Annotations.Primitive (Primitive(..), HDL(..), hasBlackBox) import Clash.Backend (Backend) @@ -47,8 +47,6 @@ xpmCdcArraySingleTF = :< _stagesLte10 :< _1LteBitsize :< _bitsizeLte1024 - :< _knownDomainSrc - :< _knownDomainDst :< _hasCallStack :< _nfdatax :< _bitpack @@ -66,8 +64,6 @@ xpmCdcArraySingleTF# bbCtx , _stagesLte10 , _1LteBitSize , _bitsizeLte1024 - , _knownDomainSrc - , _knownDomainDst , _hasCallStack , _nfdatax , _bitpack @@ -160,8 +156,6 @@ xpmCdcArraySingle# :: forall stages a src dst. ( 2 <= stages, stages <= 10 , 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , HasCallStack , NFDataX a , BitPack a diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs index 91976e43e2..73a55dc976 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray.hs @@ -15,6 +15,7 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Gray import GHC.Stack (HasCallStack) import Clash.Explicit.Prelude +import Clash.Signal.Internal (Clock(Clock)) import Clash.Cores.Xilinx.Xpm.Cdc.Gray.Internal (xpmCdcGray#) @@ -46,15 +47,13 @@ xpmCdcGray :: forall n src dst. ( 2 <= n, n <= 32 , KnownNat n - , KnownDomain src - , KnownDomain dst , HasCallStack ) => Clock src -> Clock dst -> Signal src (Unsigned n) -> Signal dst (Unsigned n) -xpmCdcGray = xpmCdcGrayWith XpmCdcGrayConfig{..} +xpmCdcGray clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcGrayWith XpmCdcGrayConfig{..} clkSrc clkDst where stages = d4 initialValues = @@ -87,8 +86,6 @@ xpmCdcGrayWith :: ( 2 <= n, n <= 32 , 2 <= stages, stages <= 10 , KnownNat n - , KnownDomain src - , KnownDomain dst , HasCallStack ) => XpmCdcGrayConfig stages -> diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray/Internal.hs index 040755d72b..617b098e92 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Gray/Internal.hs @@ -16,7 +16,7 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Gray.Internal where import Prelude import Clash.Explicit.Prelude - ( type (<=), KnownNat, SNat, Unsigned, Clock, KnownDomain, errorX + ( type (<=), KnownNat, SNat, Unsigned, Clock, errorX , unsafeSynchronizer ) import Clash.Annotations.Primitive (Primitive(..), HDL(..), hasBlackBox) @@ -50,8 +50,6 @@ xpmCdcGrayTF = :< _2LteStages :< _stagesLte10 :< _knownNatN - :< _knownDomainSrc - :< _knownDomainDst :< _hasCallStack :< initBehavior :< stages @@ -67,8 +65,6 @@ xpmCdcGrayTF# bbCtx , _2LteStages , _stagesLte10 , _knownNatN - , _knownDomainSrc - , _knownDomainDst , _hasCallStack , DSL.getBool -> Just initValues , DSL.tExprToInteger -> Just stages @@ -160,8 +156,6 @@ xpmCdcGray# :: ( 2 <= n, n <= 32 , 2 <= stages, stages <= 10 , KnownNat n - , KnownDomain src - , KnownDomain dst , HasCallStack ) => -- | Initial value usage diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs index e47deb2a83..9c5e8c57d2 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake.hs @@ -12,6 +12,7 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Handshake ) where import Clash.Explicit.Prelude +import Clash.Signal.Internal (Clock(Clock)) import GHC.Stack (HasCallStack) @@ -35,8 +36,6 @@ import Clash.Cores.Xilinx.Xpm.Cdc.Handshake.Internal (xpmCdcHandshake#) xpmCdcHandshake :: forall a src dst. ( 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , BitPack a , NFDataX a , HasCallStack @@ -67,7 +66,7 @@ xpmCdcHandshake :: , "dest_req" ::: Signal dst Bool , "src_rcv" ::: Signal src Bool ) -xpmCdcHandshake = xpmCdcHandshakeWith XpmCdcHandshakeConfig{..} +xpmCdcHandshake clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcHandshakeWith XpmCdcHandshakeConfig{..} clkSrc clkDst where srcStages = d4 dstStages = d4 @@ -105,8 +104,6 @@ xpmCdcHandshakeWith :: ( 2 <= srcStages, srcStages <= 10 , 2 <= dstStages, dstStages <= 10 , 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , BitPack a , NFDataX a , HasCallStack diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake/Internal.hs index 3f22f2dabc..99e05f8b55 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Handshake/Internal.hs @@ -25,7 +25,7 @@ import Text.Show.Pretty (ppShow) import Clash.Annotations.Primitive (Primitive(..), HDL(..), hasBlackBox) import Clash.Backend (Backend) import Clash.Explicit.Prelude - ( type (<=), type (:::), SNat, Clock, KnownDomain, Signal, BitPack(BitSize) + ( type (<=), type (:::), SNat, Clock, Signal, BitPack(BitSize) , NFDataX, deepErrorX, unsafeSynchronizer, enableGen, delay, toEnable, (.&&.), unpack ) import Clash.Netlist.Types (TemplateFunction(..), BlackBoxContext) @@ -49,8 +49,6 @@ xpmCdcHandshakeTF = :< _dstStagesLte10 :< _1LteBitsize :< _bitsizeLte1024 - :< _knownDomainSrc - :< _knownDomainDst :< _bitpackA :< _nfdataxA :< _hasCallStack @@ -69,8 +67,6 @@ xpmCdcHandshakeTF# bbCtx | [ _2LteSrcStages, _srcStagesLte10 , _2LteDstStages, _dstStagesLte10 , _1LteBitsize, _bitsizeLte1024 - , _knownDomainSrc - , _knownDomainDst , _bitpackA , _nfdataxA , _hasCallStack @@ -179,8 +175,6 @@ xpmCdcHandshake# :: ( 2 <= srcStages, srcStages <= 10 , 2 <= dstStages, dstStages <= 10 , 1 <= BitSize a, BitSize a <= 1024 - , KnownDomain src - , KnownDomain dst , BitPack a , NFDataX a , HasCallStack diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs index f1eff0012f..6c0bb6ff1b 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single.hs @@ -12,6 +12,7 @@ module Clash.Cores.Xilinx.Xpm.Cdc.Single ) where import Clash.Explicit.Prelude +import Clash.Signal.Internal (Clock(Clock)) import GHC.Stack (HasCallStack) @@ -30,9 +31,7 @@ import Clash.Cores.Xilinx.Xpm.Cdc.Single.Internal (xpmCdcSingle#) -- 'xpmCdcSingleWith'. xpmCdcSingle :: forall a src dst. - ( KnownDomain src - , KnownDomain dst - , HasCallStack + ( HasCallStack , NFDataX a , BitPack a , BitSize a ~ 1 @@ -41,7 +40,7 @@ xpmCdcSingle :: Clock dst -> Signal src a -> Signal dst a -xpmCdcSingle = xpmCdcSingleWith XpmCdcSingleConfig{..} +xpmCdcSingle clkSrc@(Clock{}) clkDst@(Clock{}) = xpmCdcSingleWith XpmCdcSingleConfig{..} clkSrc clkDst where registerInput = True stages = d4 @@ -76,8 +75,6 @@ data XpmCdcSingleConfig stages = XpmCdcSingleConfig xpmCdcSingleWith :: forall stages a src dst. ( 2 <= stages, stages <= 10 - , KnownDomain src - , KnownDomain dst , NFDataX a , BitPack a , BitSize a ~ 1 diff --git a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single/Internal.hs index 24a7794013..46a5ff1fc2 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Xpm/Cdc/Single/Internal.hs @@ -26,7 +26,7 @@ import Text.Show.Pretty (ppShow) import Clash.Annotations.Primitive (Primitive(..), HDL(..), hasBlackBox) import Clash.Backend (Backend) import Clash.Explicit.Prelude - ( type (<=), SNat, Clock, KnownDomain, BitPack(BitSize), NFDataX, deepErrorX + ( type (<=), SNat, Clock, BitPack(BitSize), NFDataX, deepErrorX , unsafeSynchronizer, unpack ) import Clash.Netlist.Types (TemplateFunction(..), BlackBoxContext) import Clash.Promoted.Nat (snatToNum) @@ -45,8 +45,6 @@ xpmCdcSingleTF = where _2LteN :< _stagesLte10 - :< _knownDomainSrc - :< _knownDomainDst :< _hasCallStack :< _nfdatax :< _bitpack @@ -63,8 +61,6 @@ xpmCdcSingleTF# :: Backend backend => BlackBoxContext -> State backend Doc xpmCdcSingleTF# bbCtx | [ _2LteStages , _stagesLte10 - , _knownDomainSrc - , _knownDomainDst , _hasCallStack , _nfdatax , _bitpack @@ -152,8 +148,6 @@ xpmCdcSingleTF# bbCtx = error (ppShow bbCtx) xpmCdcSingle# :: forall stages a src dst. ( 2 <= stages, stages <= 10 - , KnownDomain src - , KnownDomain dst , HasCallStack , NFDataX a , BitPack a diff --git a/clash-cores/test/Test/Cores/Internal/Signals.hs b/clash-cores/test/Test/Cores/Internal/Signals.hs index 2d18afc069..564622a491 100644 --- a/clash-cores/test/Test/Cores/Internal/Signals.hs +++ b/clash-cores/test/Test/Cores/Internal/Signals.hs @@ -24,8 +24,7 @@ import Clash.Prelude type GenMaster n = forall dom - . ( KnownDomain dom - , KnownNat n ) + . KnownNat n => Clock dom -> Reset dom -> NonEmpty (BitVector n) @@ -35,8 +34,7 @@ type GenMaster n = type GenSlave n = forall dom - . ( KnownDomain dom - , KnownNat n ) + . KnownNat n => Clock dom -> Reset dom -> NonEmpty (BitVector n) diff --git a/clash-cores/test/Test/Cores/SPI/MultiSlave.hs b/clash-cores/test/Test/Cores/SPI/MultiSlave.hs index 08e05f4ba5..1807915730 100644 --- a/clash-cores/test/Test/Cores/SPI/MultiSlave.hs +++ b/clash-cores/test/Test/Cores/SPI/MultiSlave.hs @@ -20,7 +20,7 @@ import Test.Cores.Internal.Signals -- slaveAddressRotate :: forall n dom - . (KnownDomain dom, KnownNat n, 1 <= n) + . (KnownNat n, 1 <= n) => Clock dom -> Reset dom -> (Signal dom Bool, Signal dom Bool) @@ -114,4 +114,3 @@ tests = testCase (show spi <> ", Divider 2, No Slave Latch") $ testMasterMultiSlave d1 d3 0b0110011101 0b0110010101 spi False (3 * 27) @?= (([0b0110011101],1),([0b0110011101],1),([0b0110011101],1),([0b0110010101],3)) - diff --git a/clash-lib/src/Clash/Primitives/DSL.hs b/clash-lib/src/Clash/Primitives/DSL.hs index 582e0e3885..9aaf7150e0 100644 --- a/clash-lib/src/Clash/Primitives/DSL.hs +++ b/clash-lib/src/Clash/Primitives/DSL.hs @@ -91,6 +91,7 @@ module Clash.Primitives.DSL , litTExpr , toIdentifier , tySize + , liftToBlockState ) where import Control.Lens hiding (Indexed, assign) From 133d6bbabffa4f2dc8276d889b48ebe8bfd28d15 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 11 Oct 2023 15:18:35 +0200 Subject: [PATCH 20/27] Remove various other KnownDomains --- clash-prelude/src/Clash/Signal.hs | 62 +++++++++++----------- clash-prelude/src/Clash/Signal/Internal.hs | 22 +++----- clash-prelude/tests/Clash/Tests/Reset.hs | 2 +- 3 files changed, 39 insertions(+), 47 deletions(-) diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs index 961141e772..170db52cee 100644 --- a/clash-prelude/src/Clash/Signal.hs +++ b/clash-prelude/src/Clash/Signal.hs @@ -617,7 +617,7 @@ type HiddenReset dom = --