Test fixes

Author: kleinreact

clash-prelude/src/Clash/Sized/Vector.hs

@@ -259,24 +259,35 @@ instance NFData a => NFData (Vec n a) where
 --
 -- Can be used as a pattern:
 --
--- >>> let f (x :> y :> _) = x + y
--- >>> :t f
--- f :: Num a => Vec ((n + 1) + 1) a -> a
+-- >>> :{
+-- f :: Num a => Vec (n + 2) a -> a
+-- f (x :> y :> _) = x + y
+-- :}
+--
 -- >>> f (3:>4:>5:>6:>7:>Nil)
 -- 7
 --
 -- Also in conjunctions with (':<'):
 --
--- >>> let g (a :> b :> (_ :< y :< x)) = a + b +  x + y
--- >>> :t g
--- g :: Num a => Vec ((((n + 1) + 1) + 1) + 1) a -> a
+-- >>> :{
+-- g :: Num a => Vec (n + 4) a -> a
+-- g (a :> b :> (_ :< y :< x)) = a + b + x + y
+-- :}
+--
 -- >>> g (1:>2:>3:>4:>5:>Nil)
 -- 12
+#if MIN_VERSION_base(4,15,0)
 pattern (:>) ::
   forall {n} a. () =>
   forall m. n ~ m + 1 =>
   a -> Vec m a -> Vec n a
 pattern (:>) x xs = Cons x xs
+#else
+pattern (:>) :: a -> Vec n a -> Vec (n + 1) a
+pattern (:>) x xs <- ((\ys -> (head ys,tail ys)) -> (x,xs))
+  where
+    (:>) x xs = Cons x xs
+#endif
 
 infixr CONS_PREC :>
 
@@ -676,9 +687,11 @@ infixl 5 :<
 --
 -- Also in conjunctions with (':>'):
 --
--- >>> let g (a :> b :> (_ :< y :< x)) = a + b +  x + y
--- >>> :t g
--- g :: Num a => Vec ((((n + 1) + 1) + 1) + 1) a -> a
+-- >>> :{
+-- g :: Num a => Vec (n + 4) a -> a
+-- g (a :> b :> (_ :< y :< x)) = a + b + x + y
+-- :}
+--
 -- >>> g (1:>2:>3:>4:>5:>Nil)
 -- 12
 pattern (:<) :: Vec n a -> a -> Vec (n+1) a
@@ -2385,7 +2398,7 @@ lazyV = lazyV' (repeat ())
 -- While the type of (':>') is:
 --
 -- >>> :t (:>)
--- (:>) :: a -> Vec n a -> Vec (n + 1) a
+-- (:>) :: (n ~ (m + 1)) => a -> Vec m a -> Vec n a
 --
 -- We thus need a @fold@ function that can handle the growing vector type:
 -- 'dfold'. Compared to 'foldr', 'dfold' takes an extra parameter, called the

clash-prelude/src/Clash/Sized/Vector/ToTuple.hs

@@ -51,7 +51,10 @@ class VecToTuple a where
   -- The following would produce a warning even though we can be sure
   -- no other pattern can ever apply:
   --
-  -- >>> (a :> b :> c :> Nil) = myVec
+  -- >>> :{
+  -- a, b, c :: Int
+  -- (a :> b :> c :> Nil) = myVec
+  -- :}
   --
   -- 'vecToTuple' can be used to work around the warning:
   --

tests/shouldwork/Basic/T1340.hs

@@ -72,18 +72,14 @@ catLayout (BitLayout aBitCount aInFn aOutFn) (BitLayout bBitCount bInFn bOutFn)
   in BitLayout SNat inFn outFn
 
 vecLayout
-  :: forall n n' t
-  .  ( n' ~ (n - 1)
-     , 1 <= n
-     , KnownNat n
-     , KnownNat n' )
+  :: (1 <= n, KnownNat n)
   => Vec n (BitLayout t)
   -> BitLayout (Vec n t)
 vecLayout (BitLayout{..} :> others) = let
   headLayout = BitLayout SNat (headSigFn >>> inFn) (outFn >>> singletonSigFn)
   in case others of
-       Nil -> headLayout
-       _ -> headLayout `catLayout` vecLayout @n' others
+       Nil      -> headLayout
+       Cons _ _ -> headLayout `catLayout` vecLayout others
 
 layout :: BitLayout (Vec Lanes Bit)
 layout = mkPos (0 :: Index (Lanes + 1))

tests/shouldwork/Basic/T1354B.hs

@@ -76,18 +76,14 @@ catLayout (BitLayout aBitCount aInFn aOutFn) (BitLayout bBitCount bInFn bOutFn)
   in BitLayout SNat inFn outFn
 
 vecLayout
-  :: forall n n' t
-  .  ( n' ~ (n - 1)
-     , 1 <= n
-     , KnownNat n
-     , KnownNat n' )
+  :: (1 <= n, KnownNat n)
   => Vec n (BitLayout t)
   -> BitLayout (Vec n t)
 vecLayout (BitLayout{..} :> others) = let
   headLayout = BitLayout SNat (headSigFn >>> inFn) (outFn >>> singletonSigFn)
   in case others of
-       Nil -> headLayout
-       _ -> headLayout `catLayout` vecLayout @n' others
+       Nil      -> headLayout
+       Cons _ _ -> headLayout `catLayout` vecLayout others
 
 layout :: BitLayout (Vec Lanes Bit)
 layout = mkPos (0 :: Index (Lanes + 1))