From 5c6bf8b0b2a5b3361a08554c10fd71a8dd7eda85 Mon Sep 17 00:00:00 2001 From: Alex McKenna Date: Thu, 11 Nov 2021 11:26:18 +0100 Subject: [PATCH] Don't prefix package name in `_types` package in VHDL Similar to ece7f26 for SystemVerilog, types should not appear qualified in the package body for the types package in VHDL. Fixes #1996. --- ...29_26+01_00_unqualify_package_body_vhdl.md | 1 + clash-lib/src/Clash/Backend/VHDL.hs | 24 ++++++++++++------ tests/Main.hs | 1 + tests/shouldwork/Issues/T1996.hs | 25 +++++++++++++++++++ 4 files changed, 44 insertions(+), 7 deletions(-) create mode 100644 changelog/2021-11-11T11_29_26+01_00_unqualify_package_body_vhdl.md create mode 100644 tests/shouldwork/Issues/T1996.hs diff --git a/changelog/2021-11-11T11_29_26+01_00_unqualify_package_body_vhdl.md b/changelog/2021-11-11T11_29_26+01_00_unqualify_package_body_vhdl.md new file mode 100644 index 0000000000..5438d43361 --- /dev/null +++ b/changelog/2021-11-11T11_29_26+01_00_unqualify_package_body_vhdl.md @@ -0,0 +1 @@ +CHANGED: Types defined in the package head are no longer qualified in the package body when rendering VHDL [#1996](https://github.com/clash-lang/clash-compiler/issues/1996). diff --git a/clash-lib/src/Clash/Backend/VHDL.hs b/clash-lib/src/Clash/Backend/VHDL.hs index b879930b52..5f7ae43617 100644 --- a/clash-lib/src/Clash/Backend/VHDL.hs +++ b/clash-lib/src/Clash/Backend/VHDL.hs @@ -96,6 +96,8 @@ data VHDLState = -- ^ Files to be stored: (filename, contents). These files are generated -- during the execution of 'genNetlist'. , _idSeen :: IdentifierSet + , _tyPkgCtx :: Bool + -- ^ Are we in the context of generating the @_types@ package? , _intWidth :: Int -- ^ Int/Word/Integer bit-width , _hdlsyn :: HdlSyn @@ -126,6 +128,7 @@ instance Backend VHDLState where , _dataFiles=[] , _memoryDataFiles=[] , _idSeen=Id.emptyIdentifierSet esc lw VHDL + , _tyPkgCtx=False , _intWidth=w , _hdlsyn=hdlsyn_ , _undefValue=undefVal @@ -390,7 +393,8 @@ genVHDL nm sp seen c = do -- | Generate a VHDL package containing type definitions for the given HWTypes mkTyPackage_ :: ModName -> [HWType] -> VHDLM [(String,Doc)] mkTyPackage_ modName (map filterTransparent -> hwtys) = do - { syn <- Ap hdlSyn + { Ap (tyPkgCtx .= True) + ; syn <- Ap hdlSyn ; enums <- Ap renderEnums ; let usedTys = concatMap mkUsedTys hwtys ; let normTys0 = nub (map mkVecZ (hwtys ++ usedTys)) @@ -398,7 +402,7 @@ mkTyPackage_ modName (map filterTransparent -> hwtys) = do packageDec = vcat $ mapM tyDec (nubBy eqTypM sortedTys0) (funDecs,funBodies) = unzip . mapMaybe (funDec enums syn) $ nubBy eqTypM (normaliseType enums <$> sortedTys0) - ; (:[]) <$> (TextS.unpack (modName `TextS.append` "_types"),) <$> + ; pkg <- (:[]) <$> (TextS.unpack (modName `TextS.append` "_types"),) <$> "library IEEE;" <> line <> "use IEEE.STD_LOGIC_1164.ALL;" <> line <> "use IEEE.NUMERIC_STD.ALL;" <> line <> line <> @@ -407,6 +411,8 @@ mkTyPackage_ modName (map filterTransparent -> hwtys) = do vcat (sequence funDecs) ) <> line <> "end" <> semi <> packageBodyDec funBodies + ; Ap (tyPkgCtx .= False) + ; return pkg } where packageBodyDec :: [VHDLM Doc] -> VHDLM Doc @@ -682,13 +688,13 @@ funDec _ _ (Unsigned _) = Just ) funDec _ _ t@(Product _ labels elTys) = Just - ( "function" <+> "toSLV" <+> parens ("p :" <+> sizedQualTyName t) <+> "return std_logic_vector" <> semi <> line <> - "function" <+> "fromSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> sizedQualTyName t <> semi - , "function" <+> "toSLV" <+> parens ("p :" <+> sizedQualTyName t) <+> "return std_logic_vector" <+> "is" <> line <> + ( "function" <+> "toSLV" <+> parens ("p :" <+> sizedTyName t) <+> "return std_logic_vector" <> semi <> line <> + "function" <+> "fromSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> sizedTyName t <> semi + , "function" <+> "toSLV" <+> parens ("p :" <+> sizedTyName t) <+> "return std_logic_vector" <+> "is" <> line <> "begin" <> line <> indent 2 ("return" <+> parens (hcat (punctuate " & " elTyToSLV)) <> semi) <> line <> "end" <> semi <> line <> - "function" <+> "fromSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> sizedQualTyName t <+> "is" <> line <> + "function" <+> "fromSLV" <+> parens ("slv" <+> colon <+> "in" <+> "std_logic_vector") <+> "return" <+> sizedTyName t <+> "is" <> line <> "alias islv : std_logic_vector(0 to slv'length - 1) is slv;" <> line <> "begin" <> line <> indent 2 ("return" <+> parens (hcat (punctuate "," elTyFromSLV)) <> semi) <> line <> @@ -1063,8 +1069,12 @@ qualTyName (filterTransparent -> hwty) = case hwty of -- Custom types: _ -> do + pkgCtx <- Ap (use tyPkgCtx) modName <- Ap (use modNm) - pretty modName <> "_types." <> tyName hwty + + if pkgCtx + then tyName hwty + else pretty modName <> "_types." <> tyName hwty -- | Generates a unique name for a given type. This action will cache its -- results, thus returning the same answer for the same @HWType@ argument. diff --git a/tests/Main.hs b/tests/Main.hs index 240b7c9c28..52b56c7635 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -548,6 +548,7 @@ runClashTest = defaultMain $ clashTestRoot hdlTargets=[VHDL] , expectClashFail=Just (NoTestExitCode, "NOT:WARNING") } + , outputTest "T1996" def{hdlTargets=[VHDL]} ] <> if compiledWith == Cabal then -- This tests fails without environment files present, which are only diff --git a/tests/shouldwork/Issues/T1996.hs b/tests/shouldwork/Issues/T1996.hs new file mode 100644 index 0000000000..0a33f47578 --- /dev/null +++ b/tests/shouldwork/Issues/T1996.hs @@ -0,0 +1,25 @@ +module T1996 where + +import qualified Prelude as P +import Data.List (isInfixOf) +import System.Environment (getArgs) +import System.FilePath ((), takeDirectory) + +import Clash.Prelude + +topEntity :: (Int, Int) -> (Int, Int) +topEntity = id + +assertNotIn :: String -> String -> IO () +assertNotIn needle haystack + | needle `isInfixOf` haystack = + P.error $ P.concat [ "Did not expect:\n\n ", needle + , "\n\nIn:\n\n", haystack ] + | otherwise = return () + +mainVHDL :: IO () +mainVHDL = do + [topDir] <- getArgs + content <- readFile (topDir show 'topEntity "T1996_topEntity_types.vhdl") + + assertNotIn "T1996_topEntity_types." content