Infer size of BitVector from string in bLit

changelog/2021-04-21T13_09_07+02_00_infer_length_in_bLit

@@ -0,0 +1 @@
+CHANGED: `bLit` now infers the size of the generated BitVector from the string given to it. This means you don't have to give it an explicit type signature anymore. This does slightly modify the syntax needed to invoke `bLit`. E.g., `$$(bLit "00..1") :: BitVector 5` should be rewritten as `$(bLit "00..1")`. If you relied on the size inference, wrap the new invocation in `resize`. For example: `resize $(bLit "00..1")`.

clash-prelude/src/Clash/Class/BitPack.hs

@@ -151,9 +151,9 @@ packXWith f x =
 -- However, it is still trivially reflexive and transitive:
 --
 -- >>> :set -XTemplateHaskell
--- >>> let x1 = $$(bLit "0010") :: BitVector 4
--- >>> let x2 = $$(bLit "0.10") :: BitVector 4
--- >>> let x3 = $$(bLit "0.1.") :: BitVector 4
+-- >>> let x1 = $(bLit "0010")
+-- >>> let x2 = $(bLit "0.10")
+-- >>> let x3 = $(bLit "0.1.")
 -- >>> isLike x1 x1
 -- True
 -- >>> isLike x1 x2

clash-prelude/src/Clash/Sized/Internal/BitVector.hs

@@ -159,15 +159,18 @@ import GHC.TypeNats               (natVal)
 import GHC.TypeLits               (natVal)
 #endif
 import GHC.TypeLits.Extra         (Max)
-import Language.Haskell.TH        (Lit (..), Pat, Q, appT, conT, litE, litP, litT, mkName, numTyLit, sigE, tupE, tupP, varP)
+import Language.Haskell.TH
+  (Lit (..), ExpQ, Type(ConT, AppT, LitT), Exp(VarE, AppE, SigE, LitE),
+   TyLit(NumTyLit), Pat, Q, appT, conT, litE, litP, litT, mkName, numTyLit,
+   sigE, tupE, tupP, varP)
 import Language.Haskell.TH.Syntax (Lift(..))
 #if MIN_VERSION_template_haskell(2,16,0)
 import Language.Haskell.TH.Compat
 #endif
 #if MIN_VERSION_template_haskell(2,17,0)
-import Language.Haskell.TH        (Code, Quote, Type)
+import Language.Haskell.TH        (Quote)
 #else
-import Language.Haskell.TH        (TExp, TypeQ)
+import Language.Haskell.TH        (TypeQ)
 #endif
 import Test.QuickCheck.Arbitrary  (Arbitrary (..), CoArbitrary (..),
                                    arbitraryBoundedIntegral,
@@ -442,10 +445,8 @@ instance KnownNat n => NFDataX (BitVector n) where
 
 -- | Create a binary literal
 --
--- >>> $$(bLit "1001") :: BitVector 4
+-- >>> $(bLit "1001")
 -- 0b1001
--- >>> $$(bLit "1001") :: BitVector 3
--- 0b001
 --
 -- __NB__: You can also just write:
 --
@@ -456,41 +457,41 @@ instance KnownNat n => NFDataX (BitVector n) where
 -- string literal:
 --
 -- >>> import qualified Data.List as List
--- >>> $$(bLit (List.replicate 4 '1')) :: BitVector 4
+-- >>> $(bLit (List.replicate 4 '1'))
 -- 0b1111
 --
 -- Also 'bLit' can handle don't care bits:
 --
--- >>> $$(bLit "1.0.") :: BitVector 4
+-- >>> $(bLit "1.0.")
 -- 0b1.0.
-#if MIN_VERSION_template_haskell(2,17,0)
-bLit :: forall n. KnownNat n => String -> Code Q (BitVector n)
-#else
-bLit :: forall n. KnownNat n => String -> Q (TExp (BitVector n))
-#endif
-bLit s = [|| fromInteger# m i1 ||]
-  where
-    bv :: BitVector n
-    bv = read# s
-
-    m,i :: Natural
-    BV m i = bv
+--
+-- __N.B.__: From Clash 1.6 an onwards 'bLit' will deduce the size of the
+--           BitVector from the given string and annotate the splice it
+--           produces accordingly.
+bLit :: String -> ExpQ
+bLit s = pure (SigE body typ)
+ where
+  typ = ConT ''BitVector `AppT` LitT (NumTyLit (toInteger n))
+  body = VarE 'fromInteger# `AppE` iLit mask `AppE` iLit value
 
-    i1 :: Integer
-    i1 = toInteger i
+  iLit = LitE . IntegerL . toInteger
+  (n, BV mask value) = read# s :: (Natural, BitVector n)
 
-read# :: KnownNat n => String -> BitVector n
-read# cs = BV m v
+read# :: String -> (Natural, BitVector n)
+read# cs0 = (fromIntegral (length cs1), BV m v)
   where
-    (vs,ms) = unzip . map readBit . filter (/= '_') $ cs
+    cs1 = filter (/= '_') cs0
+    (vs, ms) = unzip (map readBit cs1)
     combineBits = foldl (\b a -> b*2+a) 0
     v = combineBits vs
     m = combineBits ms
     readBit c = case c of
       '0' -> (0,0)
       '1' -> (1,0)
       '.' -> (0,1)
-      _   -> error $ "Clash.Sized.Internal.bLit: unknown character: " ++ show c ++ " in input: " ++ cs
+      _   -> error $
+           "Clash.Sized.Internal.bLit: unknown character: "
+        ++ show c ++ " in input: " ++ cs0
 
 
 instance KnownNat n => Eq (BitVector n) where
@@ -1219,7 +1220,7 @@ undefError op bvs = withFrozenCallStack $
   ++ unwords (L.map show bvs)
 
 
--- | Implement BitVector undefinedness checking for unpack funtions
+-- | Implement BitVector undefinedness checking for unpack functions
 checkUnpackUndef :: (KnownNat n, Typeable a)
                  => (BitVector n -> a) -- ^ unpack function
                  -> BitVector n -> a
@@ -1245,8 +1246,8 @@ undefined# =
 -- in the second argument as being "don't care" bits. This is a more lenient
 -- version of '(==)', similar to @std_match@ in VHDL or @casez@ in Verilog.
 --
--- >>> let expected = $$(bLit "1.") :: BitVector 2
--- >>> let checked  = $$(bLit "11") :: BitVector 2
+-- >>> let expected = $(bLit "1.")
+-- >>> let checked  = $(bLit "11")
 --
 -- >>> checked  `isLike#` expected
 -- True

tests/shouldwork/BitVector/GenericBitPack.hs

@@ -80,17 +80,17 @@ testBench = done
                 , $(lift (pack jT))
                 , $(lift (pack kT))
                 )
-              , ( $$(bLit "00100010")  :: BitVector 8
-                , $$(bLit "000")       :: BitVector 3
-                , $$(bLit "001")       :: BitVector 3
-                , $$(bLit "010")       :: BitVector 3
-                , $$(bLit "110")       :: BitVector 3
-                , $$(bLit "000100010") :: BitVector 9
-                , $$(bLit "100001010") :: BitVector 9
-                , $$(bLit "0001000001") :: BitVector 10
-                , $$(bLit "01010.....") :: BitVector 10
-                , $$(bLit "1000001...") :: BitVector 10
-                , $$(bLit "00100010")  :: BitVector 8
+              , ( $(bLit "00100010")
+                , $(bLit "000")
+                , $(bLit "001")
+                , $(bLit "010")
+                , $(bLit "110")
+                , $(bLit "000100010")
+                , $(bLit "100001010")
+                , $(bLit "0001000001")
+                , $(bLit "01010.....")
+                , $(bLit "1000001...")
+                , $(bLit "00100010")
                 )
               ) :> Nil)
 

tests/shouldwork/CustomReprs/Deriving/BitPackDerivation.hs

@@ -43,11 +43,11 @@ testBench = done'
 
     expectedOutput :: SystemClockResetEnable
                    => Signal System (BitVector 8) -> Signal System Bool
-    expectedOutput = outputVerifierBitVector' $ ($$(bLit "1000....") :: BitVector 8)
-                                            :> ($$(bLit "0100....") :: BitVector 8)
-                                            :> ($$(bLit "00101011") :: BitVector 8)
-                                            :> ($$(bLit "000101..") :: BitVector 8)
-                                            :> Nil
+    expectedOutput = outputVerifierBitVector' $ $(bLit "1000....")
+                                             :> $(bLit "0100....")
+                                             :> $(bLit "00101011")
+                                             :> $(bLit "000101..")
+                                             :> Nil
     done :: _ => _
     done  = expectedOutput (topEntity testInput)
     done' =