Add hex and octal BitVector parsing (#2505)

Fixes #1772
clash-lang · Aug 12, 2023 · 43145e7 · 43145e7
1 parent 682ec44
commit 43145e7
Show file tree

Hide file tree

Showing 4 changed files with 85 additions and 1 deletion.
diff --git a/changelog/2023-07-29T21_30_46-04_00_Add_hex_and_octal_BitVector_parsing b/changelog/2023-07-29T21_30_46-04_00_Add_hex_and_octal_BitVector_parsing
@@ -0,0 +1 @@
+ * Add hex and octal BitVector parsing. [#1772](https://github.com/clash-lang/clash-compiler/pull/2505)
diff --git a/clash-prelude/src/Clash/Sized/BitVector.hs b/clash-prelude/src/Clash/Sized/BitVector.hs
@@ -24,6 +24,8 @@ module Clash.Sized.BitVector
   , maxIndex#
     -- ** Construction
   , bLit
+  , hLit
+  , oLit
     -- ** Concatenation
   , (++#)
     -- * Modification

diff --git a/clash-prelude/src/Clash/Sized/Internal/BitVector.hs b/clash-prelude/src/Clash/Sized/Internal/BitVector.hs
@@ -3,6 +3,7 @@ Copyright  :  (C) 2013-2016, University of Twente,
                   2019     , Gergő Érdi
                   2016-2019, Myrtle Software Ltd,
                   2021-2022, QBayLogic B.V.
+                  2023     , Nadia Chambers
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -57,6 +58,8 @@ module Clash.Sized.Internal.BitVector
   , maxIndex#
     -- ** Construction
   , bLit
+  , hLit
+  , oLit
   , undefined#
     -- ** Concatenation
   , (++#)
@@ -141,6 +144,7 @@ import Data.Proxy                 (Proxy (..))
 import Data.Typeable              (Typeable, typeOf)
 import GHC.Generics               (Generic)
 import Data.Maybe                 (fromMaybe)
+import Numeric                    (readOct, readHex)
 import GHC.Exts
   (Word#, Word (W#), eqWord#, int2Word#, isTrue#, uncheckedShiftRL#)
 #if MIN_VERSION_base(4,15,0)
@@ -553,6 +557,74 @@ read# cs0 = (fromIntegral (length cs1), BV m v)
            "Clash.Sized.Internal.bLit: unknown character: "
         ++ show c ++ " in input: " ++ cs0
 
+-- | Create a hexadecimal literal
+--
+-- >>> $(hLit "dead")
+-- 0b1101_1110_1010_1101
+--
+-- Don't care digits set 4 bits:
+--
+-- >>> $(hLit "de..")
+-- 0b1101_1110_...._....
+hLit :: String -> ExpQ
+hLit s = pure (SigE body typ)
+  where
+    typ = ConT ''BitVector `AppT` LitT (NumTyLit (toInteger n))
+    body = VarE 'fromInteger# `AppE` iLit mask `AppE` iLit value
+
+    iLit = LitE . IntegerL . toInteger
+    (n, BV mask value) = read16# s :: (Natural, BitVector n)
+
+read16# :: String -> (Natural, BitVector n)
+read16# cs0 = (fromIntegral $ 4 * length cs1, BV m v)
+  where
+    cs1 = filter (/= '_') cs0
+    (vs, ms) = unzip $ map readHexDigit cs1
+    combineHexDigits = foldl (\b a -> 16*b+a) 0
+    v = combineHexDigits vs
+    m = combineHexDigits ms
+    -- The dot is a don't care, which applies to a whole digit.
+    readHexDigit '.' = (0, 0xf)
+    readHexDigit c = case readHex [c] of
+      [(n,  "")] -> (n, 0)
+      _ -> error $
+             "Clash.Sized.Internal.hLit: unknown character: "
+             ++ show c ++ " in input: " ++ cs0
+
+-- | Create an octal literal
+--
+-- >>> $(oLit "5234")
+-- 0b1010_1001_1100
+--
+-- Don't care digits set 3 bits:
+--
+-- >>> $(oLit "52..")
+-- 0b1010_10.._....
+oLit :: String -> ExpQ
+oLit s = pure (SigE body typ)
+  where
+    typ = ConT ''BitVector `AppT` LitT (NumTyLit (toInteger n))
+    body = VarE 'fromInteger# `AppE` iLit mask `AppE` iLit value
+
+    iLit = LitE . IntegerL . toInteger
+    (n, BV mask value) = read8# s :: (Natural, BitVector n)
+
+read8# :: String -> (Natural, BitVector n)
+read8# cs0 = (fromIntegral $ 3 * length cs1, BV m v)
+  where
+    cs1 = filter (/= '_') cs0
+    (vs, ms) = unzip $ map readOctDigit cs1
+    combineOctDigits = foldl (\b a -> 8*b+a) 0
+    v = combineOctDigits vs
+    m = combineOctDigits ms
+    -- The dot is a don't care, which applies to a whole digit.
+    readOctDigit '.' = (0, 0o7)
+    readOctDigit c = case readOct [c] of
+      [(n,  "")] -> (n, 0)
+      _ -> error $
+             "Clash.Sized.Internal.oLit: unknown character: "
+             ++ show c ++ " in input: " ++ cs0
+
 
 instance KnownNat n => Eq (BitVector n) where
   (==) = eq#

diff --git a/clash-prelude/tests/Clash/Tests/BitVector.hs b/clash-prelude/tests/Clash/Tests/BitVector.hs
@@ -27,7 +27,7 @@ import qualified Test.Tasty.QuickCheck as Q
 import Control.Applicative (liftA2)
 #endif
 import Clash.Prelude
-  (Bit, high, low, bitPattern, type (<=), type (-), natToInteger, msb, bLit)
+  (Bit, high, low, bitPattern, type (<=), type (-), natToInteger, msb, bLit, hLit, oLit)
 import Clash.Sized.Internal.BitVector (BitVector (..))
 
 import Clash.Tests.SizedNum
@@ -124,6 +124,15 @@ tests = localOption (Q.QuickCheckMaxRatio 2) $ testGroup "All"
     , testCase "show11" $ show @(BitVector 5) $(bLit "1010.") @?= "0b1_010."
     , testCase "show12" $ show @(BitVector 8) $(bLit "0001010.") @?= "0b0001_010."
     , testCase "show13" $ show @(BitVector 9) $(bLit "10001010.") @?= "0b1_0001_010."
+
+    , testCase "show14" $ show @(BitVector 16) $(hLit "dead") @?= "0b1101_1110_1010_1101"
+    , testCase "show14" $ show @(BitVector 16) $(hLit "de.d") @?= "0b1101_1110_...._1101"
+    , testCase "show15" $ show @(BitVector 16) $(hLit "beef") @?= "0b1011_1110_1110_1111"
+    , testCase "show15" $ show @(BitVector 16) $(hLit ".eef") @?= "0b...._1110_1110_1111"
+    , testCase "show16" $ show @(BitVector 12) $(oLit "7734") @?= "0b1111_1101_1100"
+    , testCase "show16" $ show @(BitVector 12) $(oLit "77.4") @?= "0b1111_11.._.100"
+    , testCase "show17" $ show @(BitVector 12) $(oLit "5324") @?= "0b1010_1101_0100"
+    , testCase "show17" $ show @(BitVector 12) $(oLit ".324") @?= "0b...0_1101_0100"
     ]
   ]