Merge pull request #2689 from clash-lang/fix-numeric-prims

Fixes various issues with black boxes and evaluator rules for number-related primitives
clash-lang · Mar 7, 2024 · aff963f · aff963f
2 parents b921212 + d4c5588
commit aff963f
Show file tree

Hide file tree

Showing 23 changed files with 335 additions and 165 deletions.
diff --git a/.ci/docker/Dockerfile b/.ci/docker/Dockerfile
@@ -21,6 +21,7 @@ FROM builder AS build-ghdl
 ARG DEPS_GHDL="gnat-10 llvm-13-dev"
 RUN apt-get install -y --no-install-recommends $DEPS_GHDL
 
+# TODO when updating this see if you can enable the Int32 part of tests/shouldwork/Numbers/Bits.hs
 ARG ghdl_version="2.0.0"
 RUN curl -L "https://github.com/ghdl/ghdl/archive/v$ghdl_version.tar.gz" \
         | tar -xz \

diff --git a/changelog/2024-03-04T17_11_12+01_00_fix_numeric_issues b/changelog/2024-03-04T17_11_12+01_00_fix_numeric_issues
@@ -0,0 +1 @@
+FIXED: various issues with black boxes and evaluator rules for number-related primitives
diff --git a/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs b/clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2013-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017-2022, Google Inc.,
-                     2017-2023, QBayLogic B.V.
+                     2017-2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -486,7 +486,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word16) $ i
   "GHC.Prim.popCnt32#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.popCnt64#" | [i] <- wordLiterals' args
+  "GHC.Prim.popCnt64#" | [i] <- word64Literals' args
     -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word64) $ i
   "GHC.Prim.popCnt#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . popCount . (fromInteger :: Integer -> Word) $ i
@@ -497,7 +497,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word16) $ i
   "GHC.Prim.clz32#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.clz64#" | [i] <- wordLiterals' args
+  "GHC.Prim.clz64#" | [i] <- word64Literals' args
     -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word64) $ i
   "GHC.Prim.clz#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . countLeadingZeros . (fromInteger :: Integer -> Word) $ i
@@ -508,7 +508,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 16 - 1)
   "GHC.Prim.ctz32#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i .&. (bit 32 - 1)
-  "GHC.Prim.ctz64#" | [i] <- wordLiterals' args
+  "GHC.Prim.ctz64#" | [i] <- word64Literals' args
     -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word64) $ i .&. (bit 64 - 1)
   "GHC.Prim.ctz#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . countTrailingZeros . (fromInteger :: Integer -> Word) $ i
@@ -517,7 +517,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     -> reduce . integerToWordLiteral . toInteger . byteSwap16 . (fromInteger :: Integer -> Word16) $ i
   "GHC.Prim.byteSwap32#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . byteSwap32 . (fromInteger :: Integer -> Word32) $ i
-  "GHC.Prim.byteSwap64#" | [i] <- wordLiterals' args
+  "GHC.Prim.byteSwap64#" | [i] <- word64Literals' args
     -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
   "GHC.Prim.byteSwap#" | [i] <- wordLiterals' args -- assume 64bits
     -> reduce . integerToWordLiteral . toInteger . byteSwap64 . (fromInteger :: Integer -> Word64) $ i
@@ -531,7 +531,7 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     -> reduce . integerToWordLiteral . toInteger . bitReverse16 . fromInteger $ i
   "GHC.Prim.bitReverse32#" | [i] <- wordLiterals' args
     -> reduce . integerToWordLiteral . toInteger . bitReverse32 . fromInteger $ i
-  "GHC.Prim.bitReverse64#" | [i] <- wordLiterals' args
+  "GHC.Prim.bitReverse64#" | [i] <- word64Literals' args
     -> reduce . integerToWordLiteral . toInteger . bitReverse64 . fromInteger $ i
 #endif
 ------------
@@ -1861,6 +1861,8 @@ ghcPrimStep tcm isSubj pInfo tys args mach = case primName pInfo of
     | [Lit l] <- args
     -> error ("IP: " <> show l)
   "GHC.Num.Integer.IN"
+    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
+    -> reduce (Literal (IntegerLiteral (IN ba)))
     | [Lit l] <- args
     -> error ("IN: " <> show l)
 #else
@@ -4864,16 +4866,20 @@ word32Literal :: Value -> Maybe Integer
 word32Literal x = case x of
   Lit (Word32Literal i) -> Just i
   _ -> Nothing
+#endif
 
-#if MIN_VERSION_base(4,17,0)
 word64Literals' :: [Value] -> [Integer]
 word64Literals' = listOf word64Literal
 
+#if MIN_VERSION_base(4,17,0)
 word64Literal :: Value -> Maybe Integer
 word64Literal x = case x of
   Lit (Word64Literal i) -> Just i
   _ -> Nothing
-#endif
+#else
+-- Prior to GHC 9.4 Word64# didn't exist, 64 bit primitives took Word# instead
+word64Literal :: Value -> Maybe Integer
+word64Literal= wordLiteral
 #endif
 
 charLiterals :: [Value] -> Maybe (Char,Char)

diff --git a/clash-ghc/src-ghc/Clash/GHC/GHC2Core.hs b/clash-ghc/src-ghc/Clash/GHC/GHC2Core.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2013-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017-2022, Google Inc.
-                     2021,      QBayLogic B.V.,
+                     2021,2023  QBayLogic B.V.,
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -676,9 +676,9 @@ coreToTerm primMap unlocs = term
         LitNumNatural -> C.NaturalLiteral i
 #endif
         LitNumInt     -> C.IntLiteral i
-        LitNumInt64   -> C.IntLiteral i
+        LitNumInt64   -> C.Int64Literal i
         LitNumWord    -> C.WordLiteral i
-        LitNumWord64  -> C.WordLiteral i
+        LitNumWord64  -> C.Word64Literal i
 #if MIN_VERSION_ghc(9,2,0)
         LitNumInt8    -> C.Int8Literal i
         LitNumInt16   -> C.Int16Literal i

diff --git a/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml b/clash-lib/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml
@@ -106,8 +106,11 @@
     kind: Expression
     type: 'fromInteger# ::
       KnownNat n => Integer -> Signed (n :: Nat)'
-    template: ~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]])
-      {1'b0}},~VAR[i][1]})~FI
+    template: >-
+      ~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]
+      ~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])
+      ~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]){~VAR[i][1][~SIZE[~TYP[1]]-1]}},~VAR[i][1]})
+      ~FI
     workInfo: Never
 - BlackBox:
     name: Clash.Sized.Internal.Signed.toEnum#

diff --git a/clash-lib/prims/commonverilog/GHC_Num_Integer.primitives.yaml b/clash-lib/prims/commonverilog/GHC_Num_Integer.primitives.yaml
@@ -150,8 +150,8 @@
     name: GHC.Num.Integer.integerTestBit#
     kind: Expression
     type: 'integerTestBit
-      :: Integer -> Word# -> Bool'
-    template: ~VAR[input][0][~ARG[1]] == 1'b1
+      :: Integer -> Word# -> Int#'
+    template: "((~VAR[input][0][~ARG[1]] == 1'b1) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0)"
     warning: 'GHC.Num.Integer.integerTestBit#: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:

diff --git a/clash-lib/prims/systemverilog/GHC_Prim.primitives.yaml b/clash-lib/prims/systemverilog/GHC_Prim.primitives.yaml
@@ -871,7 +871,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -942,7 +942,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1029,7 +1029,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1132,7 +1132,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1144,7 +1144,7 @@
       end
       ~ENDGENERATE
 
-      logic [0:47] a;
+      logic [0:47] ~GENSYM[a][4];
       genvar ~GENSYM[i1][5];
       ~GENERATE
       for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6]
@@ -1252,7 +1252,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1347,7 +1347,7 @@
       genvar ~SYM[18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 

diff --git a/clash-lib/prims/verilog/GHC_Prim.primitives.yaml b/clash-lib/prims/verilog/GHC_Prim.primitives.yaml
@@ -920,7 +920,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -991,7 +991,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1078,7 +1078,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1181,7 +1181,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1193,7 +1193,7 @@
       end
       ~ENDGENERATE
 
-      reg [0:47] a;
+      reg [0:47] ~GENSYM[a][4];
       genvar ~GENSYM[i1][5];
       ~GENERATE
       for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6]
@@ -1300,7 +1300,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1395,7 +1395,7 @@
       genvar ~SYM[18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 

diff --git a/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml b/clash-lib/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml
@@ -75,10 +75,16 @@
     workInfo: Constant
 - BlackBox:
     name: Clash.Sized.Internal.Signed.*#
-    kind: Expression
+    kind: Declaration
     type: '(*#) :: KnownNat
       n => Signed n -> Signed n -> Signed n'
-    template: resize(~ARG[1] * ~ARG[2], ~LIT[0])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[1] * ~ARG[2];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: Clash.Sized.Internal.Signed.negate#
     kind: Expression

diff --git a/clash-lib/prims/vhdl/GHC_Int.primitives.yaml b/clash-lib/prims/vhdl/GHC_Int.primitives.yaml
@@ -4,6 +4,7 @@
     type: 'I8# :: Int# ->
       Int8'
     template: resize(~ARG[0],8)
+    # TODO Starting with ghc-9.0/base-4.16 this takes an I8# that is already properly sized and don't have to do this resize anymore. Same applies to the rest of this file.
     workInfo: Never
 - BlackBox:
     name: GHC.Int.I16#

diff --git a/clash-lib/prims/vhdl/GHC_Integer_Type.primitives.yaml b/clash-lib/prims/vhdl/GHC_Integer_Type.primitives.yaml
@@ -18,10 +18,16 @@
     workInfo: Never
 - BlackBox:
     name: GHC.Integer.Type.timesInteger
-    kind: Expression
+    kind: Declaration
     type: 'timesInteger ::
       Integer -> Integer -> Integer'
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
     warning: 'GHC.Integer.Type.timesInteger: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:

diff --git a/clash-lib/prims/vhdl/GHC_Num_Integer.primitives.yaml b/clash-lib/prims/vhdl/GHC_Num_Integer.primitives.yaml
@@ -44,10 +44,16 @@
     workInfo: Never
 - BlackBox:
     name: GHC.Num.Integer.integerMul
-    kind: Expression
+    kind: Declaration
     type: 'integerMul :: Integer
       -> Integer -> Integer'
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
     warning: 'GHC.Num.Integer.integerMul: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
@@ -266,10 +272,10 @@
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
     name: GHC.Num.Integer.integerTestBit#
-    kind: Expression
+    kind: Declaration
     type: 'integerTestBit
-      :: Integer -> Word# -> Bool'
-    template: ~VAR[input][0](to_integer(~ARG[1])) = '1'
+      :: Integer -> Word# -> Int#'
+    template: ~RESULT <= (0 => ~VAR[input][0](to_integer(~ARG[1])), others => '0');
     warning: 'GHC.Num.Integer.integerTestBit#: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		FIXED: various issues with black boxes and evaluator rules for number-related primitives