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.

NOTE: To avoid backporting the changes for compatibility with
prettyprinter-1.7.1, a more restrictive bound is set in this branch.

(cherry picked from commit 5c6bf8b)

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).

clash-lib/clash-lib.cabal

@@ -164,7 +164,7 @@ Library
                       mtl                     >= 2.1.2    && < 2.3,
                       ordered-containers      >= 0.2      && < 0.3,
                       parsers                 >= 0.12.8   && < 1.0,
-                      prettyprinter           >= 1.2.0.1  && < 2.0,
+                      prettyprinter           >= 1.2.0.1  && < 1.7.1,
                       primitive               >= 0.5.0.1  && < 1.0,
                       process                 >= 1.1.0.2  && < 1.7,
                       reducers                >= 3.12.2   && < 4.0,

clash-lib/src/Clash/Backend/VHDL.hs

@@ -88,7 +88,13 @@ data VHDLState =
   , _memoryDataFiles:: [(String,String)]
   -- ^ Files to be stored: (filename, contents). These files are generated
   -- during the execution of 'genNetlist'.
+<<<<<<< HEAD
   , _idSeen    :: HashMapS.HashMap Identifier Word
+=======
+  , _idSeen    :: IdentifierSet
+  , _tyPkgCtx :: Bool
+  -- ^ Are we in the context of generating the @_types@ package?
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
   , _intWidth  :: Int
   -- ^ Int/Word/Integer bit-width
   , _hdlsyn    :: HdlSyn
@@ -100,8 +106,31 @@ data VHDLState =
 makeLenses ''VHDLState
 
 instance Backend VHDLState where
+<<<<<<< HEAD
   initBackend     = VHDLState HashSet.empty HashMap.empty HashMap.empty ""
                               noSrcSpan [] [] [] [] [] HashMapS.empty
+=======
+  initBackend w hdlsyn_ esc lw undefVal xOpt enums = VHDLState
+    { _tyCache=mempty
+    , _nameCache=mempty
+    , _modNm=""
+    , _srcSpan=noSrcSpan
+    , _libraries=[]
+    , _packages=[]
+    , _includes=[]
+    , _dataFiles=[]
+    , _memoryDataFiles=[]
+    , _idSeen=Id.emptyIdentifierSet esc lw VHDL
+    , _tyPkgCtx=False
+    , _intWidth=w
+    , _hdlsyn=hdlsyn_
+    , _undefValue=undefVal
+    , _productFieldNameCache=mempty
+    , _enumNameCache=mempty
+    , _aggressiveXOptBB_=xOpt
+    , _renderEnums_=enums
+    }
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
   hdlKind         = const VHDL
   primDirs        = const $ do root <- primsRoot
                                return [ root System.FilePath.</> "common"
@@ -399,15 +428,25 @@ mkTyPackage_ :: Identifier
              -> [HWType]
              -> VHDLM [(String,Doc)]
 mkTyPackage_ modName (map filterTransparent -> hwtys) = do
+<<<<<<< HEAD
     { syn <- Mon hdlSyn
     ; mkId <- Mon (mkIdentifier <*> pure Basic)
+=======
+    { Ap (tyPkgCtx .= True)
+    ; syn <- Ap hdlSyn
+    ; enums <- Ap renderEnums
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
     ; let usedTys     = concatMap mkUsedTys hwtys
     ; let normTys0    = nub (map mkVecZ (hwtys ++ usedTys))
     ; let sortedTys0  = topSortHWTys normTys0
           packageDec  = vcat $ mapM tyDec (nubBy eqTypM sortedTys0)
           (funDecs,funBodies) = unzip . mapMaybe (funDec syn) $ nubBy eqTypM (map normaliseType sortedTys0)
 
+<<<<<<< HEAD
     ; (:[]) <$> (TextS.unpack $ mkId (modName `TextS.append` "_types"),) <$>
+=======
+    ; pkg <- (:[]) <$> (TextS.unpack (modName `TextS.append` "_types"),) <$>
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
       "library IEEE;" <> line <>
       "use IEEE.STD_LOGIC_1164.ALL;" <> line <>
       "use IEEE.NUMERIC_STD.ALL;" <> line <> line <>
@@ -416,6 +455,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
@@ -676,14 +717,21 @@ funDec _ (Unsigned _) = Just
 
   )
 
+<<<<<<< HEAD
 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 <>
+=======
+funDec _ _ t@(Product _ labels elTys) = Just
+  ( "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 <>
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
     "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 <>
@@ -1042,8 +1090,17 @@ qualTyName (filterTransparent -> hwty) = case hwty of
 
   -- Custom types:
   _ -> do
+<<<<<<< HEAD
     modName <- Mon (use modNm)
     pretty (TextS.toLower modName) <> "_types." <> tyName hwty
+=======
+    pkgCtx <- Ap (use tyPkgCtx)
+    modName <- Ap (use modNm)
+
+    if pkgCtx
+      then tyName hwty
+      else pretty modName <> "_types." <> tyName hwty
+>>>>>>> 5c6bf8b0b (Don't prefix package name in `_types` package in VHDL)
 
 -- | Generates a unique name for a given type. This action will cache its
 -- results, thus returning the same answer for the same @HWType@ argument.

clash-term/clash-term.cabal

@@ -27,7 +27,7 @@ executable clash-term
   Build-Depends:      base              >= 4.3.1.0  && < 5,
                       clash-lib,
                       binary            >= 0.8.5    && < 0.11,
-                      prettyprinter     >= 1.2.0.1  && < 2.0,
+                      prettyprinter     >= 1.2.0.1  && < 1.7.1,
                       bytestring        >= 0.10.0.2 && < 0.11,
                       rewrite-inspector == 0.1.0.11