diff --git a/changelog/2025-08-18T20_57_06+02_00_fix_2988_2809 b/changelog/2025-08-18T20_57_06+02_00_fix_2988_2809 new file mode 100644 index 0000000000..301661968a --- /dev/null +++ b/changelog/2025-08-18T20_57_06+02_00_fix_2988_2809 @@ -0,0 +1,2 @@ +FIXED: Verilog and System Verilog code gen bug for `map head` [#2809](https://github.com/clash-lang/clash-compiler/issues/2809) +FIXED: Error parsing blackbox: `Clash.Sized.Vector.head` [#2988](https://github.com/clash-lang/clash-compiler/issues/2988) diff --git a/clash-lib/src/Clash/Netlist/BlackBox.hs b/clash-lib/src/Clash/Netlist/BlackBox.hs index 8228b607e5..f85c0307b7 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox.hs @@ -20,7 +20,13 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -module Clash.Netlist.BlackBox where +module Clash.Netlist.BlackBox + ( mkBlackBoxContext + , extractPrimWarnOrFail + , mkPrimitive + , prepareBlackBox + , isLiteral + ) where import Control.Exception (throw) import Control.Lens ((%=)) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs b/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs index 77fbad019a..4a2f79d5d8 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Parser.hs @@ -150,8 +150,8 @@ pElemE = pTagE -- | Parse SigD pSigD :: Parser [Element] -pSigD = some (pTagE <|> (Text (pack "[") <$ (pack <$> string "[\\")) - <|> (Text (pack "]") <$ (pack <$> string "\\]")) +pSigD = some (pTagE <|> (EscapedSymbol SquareBracketOpen <$ string "[\\") + <|> (EscapedSymbol SquareBracketClose <$ string "\\]") <|> (Text <$> (pack <$> some (satisfyRange '\000' '\90'))) <|> (Text <$> (pack <$> some (satisfyRange '\94' '\125')))) diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs index d09c52f727..cdfd7ed2e8 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Types.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Types.hs @@ -19,6 +19,7 @@ module Clash.Netlist.BlackBox.Types , BlackBoxTemplate , TemplateKind (..) , Element(..) + , EscapedSymbol(..) , Decl(..) , HdlSyn(..) , RenderVoid(..) @@ -211,6 +212,12 @@ data Element | CtxName -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the -- name of the closest binder + | EscapedSymbol EscapedSymbol + -- ^ Used for "[\" and "\]", they'll be rendered as "[" and "]", + -- but pretty printed as "[\" and "\]". + deriving (Show, Generic, NFData, Binary, Eq, Hashable) + +data EscapedSymbol = SquareBracketOpen | SquareBracketClose deriving (Show, Generic, NFData, Binary, Eq, Hashable) -- | Component instantiation hole. First argument indicates which function argument diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index 79c546edfa..2051e69151 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -20,7 +20,21 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Clash.Netlist.BlackBox.Util where +module Clash.Netlist.BlackBox.Util + ( renderTemplate + , walkElement + , verifyBlackBoxContext + , onBlackBox + , setSym + , extractLiterals + , renderBlackBox + , getUsedArguments + , renderFilePath + , exprToString + , renderElem + , getDomainConf + , prettyBlackBox + ) where import Control.Exception (throw) import Control.Lens @@ -126,6 +140,7 @@ inputHole = \case DevNull _ -> Nothing SigD _ nM -> nM CtxName -> Nothing + EscapedSymbol _ -> Nothing -- | Determine if the number of normal\/literal\/function inputs of a blackbox -- context at least matches the number of argument that is expected by the @@ -403,7 +418,7 @@ renderElem b (Component (Decl n subN (l:ls))) = do Just (templ0,_,libs,imps,inc,pCtx) -> do let b' = pCtx { bbResults = [(o,oTy)], bbInputs = bbInputs pCtx ++ is } layoutOptions = LayoutOptions (AvailablePerLine 120 0.4) - render = N.BBTemplate . parseFail . renderLazy . layoutPretty layoutOptions + render = N.BBTemplate . parseFail b' . renderLazy . layoutPretty layoutOptions templ1 <- case templ0 of @@ -660,10 +675,15 @@ generalGetDomainConf getDomainMap ty = case (snd . stripAttributes . stripVoid) Nothing -> error $ "Can't find domain " <> show dom <> ". Please report an issue at https://github.com/clash-lang/clash-compiler/issues." Just conf -> pure conf -parseFail :: Text -> BlackBoxTemplate -parseFail t = case runParse t of +parseFail :: BlackBoxContext -> Text -> BlackBoxTemplate +parseFail b t = case runParse t of Failure errInfo -> - error (show (_errDoc errInfo)) + error $ unlines + [ "error while parsing blackbox: " <> Data.Text.unpack (bbName b) + , "in component " <> Data.Text.unpack (Id.toText $ bbCompName b) + , "error:" + , show (_errDoc errInfo) + ] Success templ -> templ idToExpr @@ -904,6 +924,9 @@ renderTag b CtxName = case bbCtxName b of -> return (Id.toLazyText t) _ -> error "internal error" +renderTag _ (EscapedSymbol sym) = case sym of + SquareBracketOpen -> return "[" + SquareBracketClose -> return "]" renderTag _ e = do e' <- getAp (prettyElem e) error $ $(curLoc) ++ "Unable to evaluate: " ++ show e' @@ -1108,6 +1131,9 @@ prettyElem (Template bbname source) = do <> brackets (string $ Text.concat bbname') <> brackets (string $ Text.concat source')) prettyElem CtxName = return "~CTXNAME" +prettyElem (EscapedSymbol sym) = case sym of + SquareBracketOpen -> return "[\\" + SquareBracketClose -> return "\\]" -- | Recursively walk @Element@, applying @f@ to each element in the tree. walkElement @@ -1178,6 +1204,7 @@ walkElement f el = maybeToList (f el) ++ walked Repeat es1 es2 -> concatMap go es1 ++ concatMap go es2 CtxName -> [] + EscapedSymbol _ -> [] -- | Determine variables used in an expression. Used for VHDL sensitivity list. -- Also see: https://github.com/clash-lang/clash-compiler/issues/365 @@ -1266,6 +1293,7 @@ getUsedArguments (N.BBTemplate t) = nub (concatMap (walkElement matchArg) t) TypM _ -> Nothing Vars _ -> Nothing CtxName -> Nothing + EscapedSymbol _ -> Nothing onBlackBox :: (BlackBoxTemplate -> r) diff --git a/tests/Main.hs b/tests/Main.hs index 393d7aec49..528bd3d353 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -668,6 +668,7 @@ runClashTest = defaultMain , runTest "T2845" def{hdlSim=[],hdlTargets=[Verilog]} , runTest "T2904" def , runTest "T2966" def{hdlSim=[],hdlTargets=[Verilog]} + , runTest "T2988" def{hdlSim=[]} ] <> if compiledWith == Cabal then -- This tests fails without environment files present, which are only diff --git a/tests/shouldwork/Issues/T2988.hs b/tests/shouldwork/Issues/T2988.hs new file mode 100644 index 0000000000..797b2bada1 --- /dev/null +++ b/tests/shouldwork/Issues/T2988.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} + +module T2988 where + +import Clash.Prelude +import Prelude () + +topEntity :: Signal System (Vec 4 (Vec 4 (Unsigned 32))) -> Signal System (Vec 4 (Unsigned 32)) +topEntity = f +{-# CLASH_OPAQUE topEntity #-} + +f :: Signal System (Vec n (Vec 4 (Unsigned 32))) -> Signal System (Vec n (Unsigned 32)) +f x = fmap (fmap head) x +{-# CLASH_OPAQUE f #-}