Make sure the VHDL BB for Signed.fromInteger can handle any Netlist Expr (#2157)

Previously it could only handle Identifier.
(And Literal, which is handled seperately in Clash.Backend.VHDL.expr_)

I've also renamed it to make it clear this blackbox is VHDL only.

Fixes #2149

Author: leonschoorl

changelog/2022-04-01T16_38_37+02_00_fix_Signed.fromInteger_VHDL_BB

@@ -0,0 +1 @@
+FIXED: The VHDL BB for Signed.fromInteger can now handle any Netlist Expr as input [#2149](https://github.com/clash-lang/clash-compiler/issues/2149)

clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml

@@ -97,7 +97,7 @@
     kind: Expression
     type: 'fromInteger# ::
       KnownNat n => Integer -> Signed (n :: Nat)'
-    templateFunction: Clash.Primitives.Sized.Signed.fromIntegerTF
+    templateFunction: Clash.Primitives.Sized.Signed.fromIntegerTFvhdl
     workInfo: Never
 - BlackBox:
     name: Clash.Sized.Internal.Signed.toEnum#

clash-lib/src/Clash/Driver.hs

@@ -596,7 +596,7 @@ knownTemplateFunctions =
     , ('P.alteraPllQsysTF, P.alteraPllQsysTF)
     , ('P.alteraPllTF, P.alteraPllTF)
     , ('P.altpllTF, P.altpllTF)
-    , ('P.fromIntegerTF, P.fromIntegerTF)
+    , ('P.fromIntegerTFvhdl, P.fromIntegerTFvhdl)
     ]
 
 -- | Compiles blackbox functions and parses blackbox templates.

clash-lib/src/Clash/Primitives/Sized/Signed.hs

@@ -1,13 +1,13 @@
 {-|
-  Copyright   :  (C) 2021 QBayLogic
+  Copyright   :  (C) 2021-2022, QBayLogic
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <[email protected]>
 
   VHDL Blackbox implementations for "Clash.Sized.Internal.Signed.toInteger#".
 -}
 
 {-# LANGUAGE OverloadedStrings #-}
-module Clash.Primitives.Sized.Signed (fromIntegerTF) where
+module Clash.Primitives.Sized.Signed (fromIntegerTFvhdl) where
 
 import Control.Monad.State (State)
 import Data.Monoid (Ap(getAp))
@@ -18,8 +18,8 @@ import Clash.Netlist.Types
   (BlackBoxContext (..), Expr (..), HWType (..), Literal (..), Modifier (..),
    TemplateFunction (..))
 
-fromIntegerTF :: TemplateFunction
-fromIntegerTF = TemplateFunction used valid fromIntegerTFTemplate
+fromIntegerTFvhdl :: TemplateFunction
+fromIntegerTFvhdl = TemplateFunction used valid fromIntegerTFTemplateVhdl
  where
   used = [0,1]
   valid bbCtx = case bbInputs bbCtx of
@@ -28,16 +28,19 @@ fromIntegerTF = TemplateFunction used valid fromIntegerTFTemplate
       _ -> False
     _ -> False
 
-fromIntegerTFTemplate
+fromIntegerTFTemplateVhdl
   :: Backend s
   => BlackBoxContext
   -> State s Doc
-fromIntegerTFTemplate bbCtx = getAp $ do
-  let [(Literal _ (NumLit sz),_,_), (i@(Identifier iV m), Signed szI, _)] = bbInputs bbCtx
+fromIntegerTFTemplateVhdl bbCtx = getAp $ do
+  let [(Literal _ (NumLit sz),_,_), (i, Signed szI, _)] = bbInputs bbCtx
   case compare sz (toInteger szI) of
-    LT -> let sl = Sliced (Signed szI,fromInteger sz-1,0)
-              m1 = Just (maybe sl (`Nested` sl) m)
-           in expr False (Identifier iV m1)
+    LT -> case i of
+           Identifier iV m ->
+            let sl = Sliced (Signed szI,fromInteger sz-1,0)
+                m1 = Just (maybe sl (`Nested` sl) m)
+            in expr False (Identifier iV m1)
+           _ -> "signed(std_logic_vector(resize(unsigned(std_logic_vector(" <> expr False i <> "))," <> expr False (Literal Nothing (NumLit sz)) <> ")))"
     EQ -> expr False i
     GT -> "resize" <> tupled (sequenceA [expr False i
                                         ,expr False (Literal Nothing (NumLit sz))])

tests/Main.hs

@@ -637,6 +637,7 @@ runClashTest = defaultMain $ clashTestRoot
         , runTest "Strict" def
         , runTest "T1019" def{hdlSim=False}
         , runTest "T1351" def
+        , runTest "T2149" def
         , outputTest "UndefinedConstantFolding" def{ghcFlags=["-itests/shouldwork/Numbers"]}
         , runTest "UnsignedZero" def
         ]

tests/shouldwork/Numbers/T2149.hs

@@ -0,0 +1,29 @@
+module T2149 where
+
+import Clash.Prelude
+import Clash.Explicit.Testbench
+
+topEntity :: Word -> Signed 8
+topEntity = fromIntegral
+{-# NOINLINE topEntity #-}
+
+testBench :: Signal System Bool
+testBench = done
+  where
+    testInput      = stimuliGenerator clk rst (negNr 42 :> posNr 41 :> negNr (-40) :> posNr (-39) :> Nil)
+    expectedOutput = outputVerifier' clk rst (42 :> 41 :> (-40) :> (-39) :> Nil)
+    done           = expectedOutput (topEntity <$> testInput)
+    clk            = tbSystemClockGen (not <$> done)
+    rst            = systemResetGen
+
+
+-- | Use input as the lower byte of the output, and set its bits 31 and 63
+--
+-- By setting both bit 31 and 63, the sign-bit of the intermediate Integer is always set,
+-- no matter if we're representing it as a signed 64 or 32 bit number.
+negNr :: Signed 8 -> Word
+negNr x = unpack (resize (pack x)) .|. bit 31 .|. bit 63
+
+
+posNr :: Signed 8 -> Word
+posNr x = unpack (resize (pack x)) .|. bit 30