Make 'tzipWith' lazy in its second RTree. Fix #871

This fixes various strictness problems with 'lazyT', 'ensureSpine',
'bundle', ...

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

@@ -472,16 +472,17 @@ tzipWith :: forall a b c d . KnownNat d => (a -> b -> c) -> RTree d a -> RTree d
 tzipWith f = tdfold (Proxy @(ZipWithTree b c)) lr br
   where
     lr :: a -> RTree 0 b -> RTree 0 c
-    lr a (LR b) = LR (f a b)
-    lr _ _      = error "impossible"
+    lr a t = LR (f a (textract t))
 
     br :: SNat l
        -> (RTree l b -> RTree l c)
        -> (RTree l b -> RTree l c)
        -> RTree (l+1) b
        -> RTree (l+1) c
-    br _ fl fr (BR l r) = BR (fl l) (fr r)
-    br _ _  _  _        = error "impossible"
+    br _ fl fr t = BR (fl l) (fr r)
+      where
+        (l,r) = tsplit t
+
 
 -- | 'tzip' takes two trees and returns a tree of corresponding pairs.
 tzip :: KnownNat d => RTree d a -> RTree d b -> RTree d (a,b)
@@ -506,4 +507,4 @@ tunzip = tdfold (Proxy @(UnzipTree a b)) lr br
 lazyT :: KnownNat d
       => RTree d a
       -> RTree d a
-lazyT = tzipWith (flip const) (trepeat undefined)
+lazyT = tzipWith (flip const) (trepeat ())

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

@@ -1870,9 +1870,9 @@ lengthS _ = SNat
 lazyV :: KnownNat n
       => Vec n a
       -> Vec n a
-lazyV = lazyV' (repeat undefined)
+lazyV = lazyV' (repeat ())
   where
-    lazyV' :: Vec n a -> Vec n a -> Vec n a
+    lazyV' :: Vec n () -> Vec n a -> Vec n a
     lazyV' Nil           _  = Nil
     lazyV' (_ `Cons` xs) ys = head ys `Cons` lazyV' xs (tail ys)
 {-# NOINLINE lazyV #-}

clash-prelude/src/Clash/XException.hs

@@ -66,6 +66,8 @@ import System.IO.Unsafe  (unsafeDupablePerformIO)
 
 -- $setup
 -- >>> import Clash.Class.BitPack (pack)
+-- >>> import Clash.Sized.Vector (Vec)
+-- >>> import Clash.Sized.RTree (RTree)
 -- >>> :set -fplugin GHC.TypeLits.Normalise
 -- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver
 
@@ -649,6 +651,10 @@ class NFDataX a where
   -- >>> spined = ensureSpine (errorX "?" :: (Int, Int))
   -- >>> case spined of (_, _) -> 'a'
   -- 'a'
+  -- >>> fmap (const 'b') (ensureSpine undefined :: Vec 3 Int)
+  -- <'b','b','b'>
+  -- >>> fmap (const 'c') (ensureSpine undefined :: RTree 2 Int)
+  -- <<'c','c'>,<'c','c'>>
   --
   -- For users familiar with 'Clash.Sized.Vector.lazyV': this is the generalized
   -- version of it.