From d5a8864ebdbf13517574aa360b0f2c396a973a52 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Thu, 8 Feb 2024 09:45:10 +0100 Subject: [PATCH] VIO and ILA: explicitly check setName If `Clash.Magic.setName` was used, use that name for the instance. Otherwise, use a fixed default name. Fixes #2654 --- .../src/Clash/Cores/Xilinx/Ila/Internal.hs | 36 +++++++--------- .../Cores/Xilinx/VIO/Internal/BlackBoxes.hs | 42 +++++++++---------- 2 files changed, 36 insertions(+), 42 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs index f87eb2ac31..cbcb99f91d 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs @@ -29,7 +29,7 @@ import Data.List (zip4, group) import Data.List.Infinite((...), Infinite((:<))) import Data.Proxy (Proxy(..)) import Data.String.Interpolate (__i) -import Data.Maybe (isJust) +import Data.Maybe (isJust, fromMaybe) import Data.Text.Prettyprint.Doc.Extra (Doc) import GHC.Stack (HasCallStack) import GHC.TypeLits (KnownNat, SomeNat(..), someNatVal) @@ -148,15 +148,18 @@ areEqual :: Eq a => [a] -> Maybe a areEqual = \case { [x:_] -> Just x; _ -> Nothing } . group ilaBBF :: HasCallStack => BlackBoxFunction -ilaBBF _isD _primName args _resTys = Lens.view tcCache >>= go +ilaBBF _isD _primName args _resTys = do + instName <- fromMaybe "ila_inst" <$> Lens.view setName + tcm <- Lens.view tcCache + go instName tcm where - go tcm + go instName tcm | _:_:_:config:_ <- lefts args , _:_:(coreView tcm -> LitTy (NumTy n)):_ <- rights args , Just (SomeNat (Proxy :: Proxy n)) <- someNatVal n = case termToDataError @(IlaConfig n) config of Left s -> error ("ilaBBF, bad config:\n" <> s) - Right c -> pure $ Right (bbMeta c, bb c) + Right c -> pure $ Right (bbMeta c, bb instName c) | otherwise = error $ "ilaBBF, bad args:\n" <> ppShow args bbMeta :: KnownNat n => IlaConfig n -> BlackBoxMeta @@ -170,8 +173,8 @@ ilaBBF _isD _primName args _resTys = Lens.view tcCache >>= go ] } - bb :: KnownNat n => IlaConfig n -> BlackBox - bb config = BBFunction (show 'ilaTF) 0 (ilaTF config) + bb :: KnownNat n => T.Text -> IlaConfig n -> BlackBox + bb instName config = BBFunction (show 'ilaTF) 0 (ilaTF instName config) usedArguments :: [Int] usedArguments = ilaConfig : clock : inputProbes @@ -187,8 +190,9 @@ usedArguments = ilaConfig : clock : inputProbes -- when forcing this argument to NF we limit it to a modest -- 8096 input ports. -ilaTF :: (HasCallStack, KnownNat n) => IlaConfig n -> TemplateFunction -ilaTF config = TemplateFunction usedArguments (const True) (ilaBBTF config) +ilaTF :: (HasCallStack, KnownNat n) => T.Text -> IlaConfig n -> TemplateFunction +ilaTF instName config = + TemplateFunction usedArguments (const True) (ilaBBTF instName config) checkNameCollision :: HasCallStack => T.Text -> DSL.TExpr -> DSL.TExpr checkNameCollision userName tExpr@(DSL.TExpr _ (Identifier (Id.toText -> name) Nothing)) @@ -211,10 +215,11 @@ checkNameCollision _ tExpr = error [I.i| ilaBBTF :: forall s n . (Backend s, KnownNat n, HasCallStack) => + T.Text -> IlaConfig n -> BlackBoxContext -> State s Doc -ilaBBTF config bbCtx +ilaBBTF instName1 config bbCtx | ( _knownDomainDom : _ilaConstraint : _1nConstraint @@ -236,7 +241,7 @@ ilaBBTF config bbCtx #{ppShow userInputNames} |] - ilaInstName <- Id.makeBasic (getIlaName (bbCtxName bbCtx)) + instName2 <- Id.makeBasic instName1 let inPs = filter ((> (0 :: Int)) . DSL.tySize . DSL.ety) inputs @@ -252,7 +257,7 @@ ilaBBTF config bbCtx DSL.instDecl Empty (Id.unsafeMake ilaName) - ilaInstName + instName2 [] -- Generics / parameters (("clk", clk) : zip inNames inProbesBV) [] -- outputs @@ -269,15 +274,6 @@ ilaBBTF config bbCtx checkNameCollision nameHint <$> DSL.toBvWithAttrs keepAttrs nameHint inProbe - -- Return user-friendly name given a context name hint. Note that we ignore - -- @__VOID_TDECL_NOOP__@. It is created by 'mkPrimitive' whenever a user hint - -- is _not_ given and the primitive returns a zero-width type. - getIlaName :: Maybe T.Text -> T.Text - getIlaName Nothing = "ila_inst" - getIlaName (Just "result") = getIlaName Nothing - getIlaName (Just "__VOID_TDECL_NOOP__") = getIlaName Nothing - getIlaName (Just s) = s - ilaTclTF :: (HasCallStack, KnownNat n) => IlaConfig n -> TemplateFunction ilaTclTF config = TemplateFunction usedArguments (const True) (ilaTclBBTF config) 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..664c2e5cf2 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/VIO/Internal/BlackBoxes.hs @@ -25,10 +25,12 @@ import GHC.Stack (HasCallStack) import Data.Foldable (fold) import Data.List.Infinite((...), Infinite((:<))) import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromMaybe) import Data.String.Interpolate (__i) import Data.Text.Prettyprint.Doc.Extra (Doc) import Text.Show.Pretty (ppShow) +import qualified Control.Lens as Lens import qualified Data.List.Infinite as Infinite import qualified Data.Text as T (Text, pack, concat) @@ -50,6 +52,7 @@ import Clash.Netlist.Types , TemplateFunction(..) , BlackBoxContext(..) , BlackBox(BBFunction) + , setName ) import Clash.Netlist.BlackBox.Types ( TemplateKind(..) @@ -68,7 +71,9 @@ import Clash.Cores.Xilinx.Internal ) vioProbeBBF :: HasCallStack => BlackBoxFunction -vioProbeBBF _isD _primName _args _resTys = pure $ Right (bbMeta, bb) +vioProbeBBF _isD _primName _args _resTys = do + instName <- fromMaybe "vio_inst" <$> Lens.view setName + pure $ Right (bbMeta, bb instName) where bbMeta :: BlackBoxMeta bbMeta = emptyBlackBoxMeta @@ -81,8 +86,9 @@ vioProbeBBF _isD _primName _args _resTys = pure $ Right (bbMeta, bb) ] } - bb :: BlackBox - bb = BBFunction (show 'vioProbeTF) 0 vioProbeTF + bb :: T.Text -> BlackBox + bb instName = + BBFunction (show 'vioProbeTF) 0 (vioProbeTF instName) usedArguments :: [Int] usedArguments = (inputNames : outputNames : initOutValues : clock : inputProbes) @@ -99,8 +105,8 @@ usedArguments = (inputNames : outputNames : initOutValues : clock : inputProbes) -- when forcing this argument to NF we limit it to a modest -- 8096 input ports. -vioProbeTF :: HasCallStack => TemplateFunction -vioProbeTF = +vioProbeTF :: HasCallStack => T.Text -> TemplateFunction +vioProbeTF instName = TemplateFunction usedArguments -- 'validateVioProbeBCC' already produces string describing @@ -108,7 +114,7 @@ vioProbeTF = -- yet. This is prepared to get updated easily as soon as the -- feature gets implemented in clash-lib. (maybe True error . validateVioProbeBBC) - vioProbeBBTF + (vioProbeBBTF instName) checkNameCollision :: HasCallStack => T.Text -> DSL.TExpr -> DSL.TExpr checkNameCollision userName tExpr@(DSL.TExpr _ (Identifier (Id.toText -> name) Nothing)) @@ -127,8 +133,12 @@ checkNameCollision _ tExpr = error [__i| #{ppShow tExpr} |] -vioProbeBBTF :: (Backend s, HasCallStack) => BlackBoxContext -> State s Doc -vioProbeBBTF bbCtx +vioProbeBBTF :: + (Backend s, HasCallStack) => + T.Text -> + BlackBoxContext -> + State s Doc +vioProbeBBTF instName1 bbCtx | ( _knownDomainDom : _vioConstraint : (DSL.getVec -> Just userInputNameExprs) @@ -161,7 +171,7 @@ vioProbeBBTF bbCtx #{ppShow userOutputNames} |] - vioProbeInstName <- Id.makeBasic (vioName (bbCtxName bbCtx)) + instName2 <- Id.makeBasic instName1 let inPs = filter ((> (0 :: Int)) . DSL.tySize . DSL.ety) inputProbes @@ -190,7 +200,7 @@ vioProbeBBTF bbCtx inProbesBV <- zipWithM toNameCheckedBv userInputNames inProbes - DSL.instDecl Empty (Id.unsafeMake vioProbeName) vioProbeInstName [] + DSL.instDecl Empty (Id.unsafeMake vioProbeName) instName2 [] (("clk", clk) : zip (NE.toList inNames) inProbesBV) (zip outNames outProbesBV) @@ -215,18 +225,6 @@ vioProbeBBTF bbCtx outProbe <- DSL.fromBV nameHintOut outTy outProbeBv pure (outProbe, outProbeBv) - -- Return user-friendly name given a context name hint. Note that we ignore - -- @__VOID_TDECL_NOOP__@. It is created by 'mkPrimitive' whenever a user hint - -- is _not_ given and the primitive returns a zero-width type. - -- - -- XXX: Is the input every 'Nothing' for non-recursive calls? It looks like - -- Clash always picks a context hint. - vioName :: Maybe T.Text -> T.Text - vioName Nothing = "vio_inst" - vioName (Just "result") = vioName Nothing - vioName (Just "__VOID_TDECL_NOOP__") = vioName Nothing - vioName (Just s) = s - vioProbeTclTF :: HasCallStack => TemplateFunction vioProbeTclTF = TemplateFunction