Fix literal rendering of Index values (copy #2816)

changelog/2024-10-01T14_41_36+02_00_fix_index_literal_rendering

@@ -0,0 +1,2 @@
+FIXED: Clash hanging when rendering `Index n` literals, for large values of `n` [#2813](https://github.com/clash-lang/clash-compiler/issues/2813)
+FIXED: Render overflowed Index literals as don't-cares in HDL

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

@@ -1,7 +1,7 @@
 {-|
   Copyright   :  (C) 2015-2016, University of Twente,
                      2017-2018, Google Inc.,
-                     2021-2023, QBayLogic B.V.,
+                     2021-2024, QBayLogic B.V.,
                      2022     , Google Inc.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -65,7 +65,7 @@ import           Clash.Netlist.Types                  hiding (intWidth, usages,
 import           Clash.Netlist.Util
 import           Clash.Signal.Internal                (ActiveEdge (..))
 import           Clash.Util
-  (SrcSpan, noSrcSpan, curLoc, makeCached, indexNote)
+  (SrcSpan, clogBase, noSrcSpan, curLoc, makeCached, indexNote)
 import           Clash.Util.Graph                     (reverseTopSort)
 
 -- | State for the 'Clash.Backend.SystemVerilog.SystemVerilogM' monad:
@@ -1228,7 +1228,9 @@ expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
 expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
   | pNm == "Clash.Sized.Internal.Index.fromInteger#"
   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx
-  = exprLitSV (Just (Index (fromInteger n),fromInteger n)) i
+  , Just k <- clogBase 2 n
+  , let k' = max 1 k
+  = exprLitSV (Just (Index (fromInteger n),k')) i
 
 expr_ b (BlackBoxE _ libs imps inc bs bbCtx b') =
   parenIf (b || b') (Ap (renderBlackBox libs imps inc bs bbCtx <*> pure 0))

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

@@ -1762,7 +1762,7 @@ expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx
   , Just k <- clogBase 2 n
   , let k' = max 1 k
-  = exprLit (Just (Unsigned k',k')) i
+  = exprLit (Just (Index n,k')) i
 
 expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
   | pNm == "Clash.Sized.Internal.Index.maxBound#"
@@ -1860,6 +1860,9 @@ exprLit (Just (hty,sz)) (NumLit i) = case hty of
     | i < 0                    -> "unsigned" <> parens ("std_logic_vector" <> parens ("to_signed" <> parens(integer i <> "," <> int n)))
     | i < 2^(31 :: Integer) -> "to_unsigned" <> parens (integer i <> "," <> int n)
     | otherwise -> "unsigned'" <> parens lit
+  Index n
+   | 0 <= i && i < n -> exprLit (Just (Unsigned sz, sz)) (NumLit i)  -- reuse Unsigned implementation above
+   | otherwise       -> hdlTypeErrValue hty
   Signed n
     | i < 2^(31 :: Integer) && i > (-2^(31 :: Integer)) -> "to_signed" <> parens (integer i <> "," <> int n)
     | otherwise -> "signed'" <> parens lit

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

@@ -82,7 +82,7 @@ import           Clash.Netlist.Types as N             hiding (intWidth, usages,
 import           Clash.Netlist.Util
 import           Clash.Signal.Internal                (ActiveEdge (..))
 import           Clash.Util
-  (SrcSpan, noSrcSpan, curLoc, indexNote, makeCached)
+  (SrcSpan, clogBase, noSrcSpan, curLoc, indexNote, makeCached)
 
 -- | State for the 'Clash.Backend.Verilog.VerilogM' monad:
 data VerilogState =
@@ -1151,7 +1151,9 @@ expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
 expr_ _ (BlackBoxE pNm _ _ _ _ bbCtx _)
   | pNm == "Clash.Sized.Internal.Index.fromInteger#"
   , [Literal _ (NumLit n), Literal _ i] <- extractLiterals bbCtx
-  = exprLit undefValue (Just (Index (fromInteger n),fromInteger n)) i
+  , Just k <- clogBase 2 n
+  , let k' = max 1 k
+  = exprLitV (Just (Index (fromInteger n),k')) i
 
 expr_ b (BlackBoxE _ libs imps inc bs bbCtx b') = do
   parenIf (b || b') (Ap (renderBlackBox libs imps inc bs bbCtx <*> pure 0))
@@ -1216,14 +1218,16 @@ rtreeChain _                               = Nothing
 exprLitV :: Maybe (HWType,Size) -> Literal -> VerilogM Doc
 exprLitV = exprLit undefValue
 
-exprLit :: Lens' s (Maybe (Maybe Int)) -> Maybe (HWType,Size) -> Literal -> Ap (State s) Doc
+exprLit :: Backend s => Lens' s (Maybe (Maybe Int)) -> Maybe (HWType,Size) -> Literal -> Ap (State s) Doc
 exprLit _ Nothing (NumLit i) = integer i
 
 exprLit k (Just (hty,sz)) (NumLit i0) = case hty of
   Unsigned _
    | i < 0     -> string "-" <> int sz <> string "'d" <> integer (abs i)
    | otherwise -> int sz <> string "'d" <> integer i
-  Index _ -> int (typeSize hty) <> string "'d" <> integer i
+  Index n
+   | 0 <= i0 && i0 < n -> int (typeSize hty) <> string "'d" <> integer i0
+   | otherwise         -> hdlTypeErrValue hty
   Signed _
    | i < 0     -> string "-" <> int sz <> string "'sd" <> integer (abs i)
    | otherwise -> int sz <> string "'sd" <> integer i

tests/shouldfail/Verification/SymbiYosys.hs

@@ -13,10 +13,13 @@ import           Clash.Verification  (RenderAs (YosysFormal), assert, checkI,
 topEntity :: Clock System -> Reset System -> Enable System -> Signal System (Bool, Bool, Bool)
 topEntity = exposeClockResetEnable go
 
-go :: HiddenClockResetEnable dom => Signal dom (Bool, Bool, Bool)
+go :: forall dom. HiddenClockResetEnable dom => Signal dom (Bool, Bool, Bool)
 go =
   let -- oops, 'b' is never lit
-      c   = register (0 :: Index 15) (countSucc <$> c)
+      cI :: Signal dom (Index 15)
+      cI  = register (0 :: Index 15) (countSucc <$> cI)
+      c :: Signal dom (Unsigned 4)
+      c   = fmap bitCoerce cI
       r   = (< 10) <$> c
       g   = ((>= 10) .&&. (< 15)) <$> c
       b   = (>= 15) <$> c