Simplify (un)concatBitVector# implementations

clash-lang · Sep 15, 2017 · 4fb8f78 · 4fb8f78
1 parent 1a23fe5
commit 4fb8f78
Showing 1 changed file with 17 additions and 21 deletions.
diff --git a/src/CLaSH/Sized/Vector.hs b/src/CLaSH/Sized/Vector.hs
@@ -1932,31 +1932,27 @@ instance (KnownNat n, KnownNat (BitSize a), BitPack a) => BitPack (Vec n a) wher
   pack   = concatBitVector# . map pack
   unpack = map unpack . unconcatBitVector#
 
-concatBitVector# :: KnownNat m
-                 => Vec n (BitVector m)
-                 -> BitVector (n * m)
-concatBitVector# = concatBitVector' . reverse
-  where
-    concatBitVector' :: KnownNat m
-                     => Vec n (BitVector m)
-                     -> BitVector (n * m)
-    concatBitVector' Nil           = 0
-    concatBitVector' (x `Cons` xs) = concatBitVector' xs ++# x
+concatBitVector#
+  :: (KnownNat n, KnownNat m)
+  => Vec n (BitVector m)
+  -> BitVector (n * m)
+concatBitVector# Nil           = 0
+concatBitVector# (x `Cons` xs) = x ++# concatBitVector# xs
 {-# NOINLINE concatBitVector# #-}
 
-unconcatBitVector# :: (KnownNat n, KnownNat m)
-                   => BitVector (n * m)
-                   -> Vec n (BitVector m)
-unconcatBitVector# bv = withSNat (\s -> ucBV (toUNat s) bv)
+unconcatBitVector#
+  :: forall n m
+   . (KnownNat n, KnownNat m)
+  => BitVector (n * m)
+  -> Vec n (BitVector m)
+unconcatBitVector# = go (toUNat (SNat @ n))
+  where
+    go :: KnownNat x => UNat x -> BitVector (x * m) -> Vec x (BitVector m)
+    go UZero     _  = Nil
+    go (USucc n) bv = let (x :: BitVector m,bv') = split# bv
+                      in  x :> go n bv'
 {-# NOINLINE unconcatBitVector# #-}
 
-ucBV :: forall n m . KnownNat m
-     => UNat n -> BitVector (n * m) -> Vec n (BitVector m)
-ucBV UZero     _  = Nil
-ucBV (USucc n) bv = let (bv',x :: BitVector m) = split# bv
-                    in  ucBV n bv' :< x
-{-# INLINE ucBV #-}
-
 -- | Convert a 'BitVector' to a 'Vec' of 'Bit's.
 --
 -- >>> let x = 6 :: BitVector 8