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 new file mode 100644 index 0000000000..10a685089d --- /dev/null +++ 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 index 05e8adf080..801072a72b 100644 --- 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 index 4c31d2da3a..bcd844572f 100644 --- 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. -} @@ -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 index b6cb9b80bd..8be4200d54 100644 --- 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" ] ]