From 17fee3a39803a57fb71c9326bce8fdcce4f844bc Mon Sep 17 00:00:00 2001
From: Leon Schoorl <leon@qbaylogic.com>
Date: Wed, 23 Oct 2019 16:36:22 +0200
Subject: [PATCH] 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  | 11 ++++++-----
 clash-prelude/src/Clash/Sized/Vector.hs |  4 ++--
 clash-prelude/src/Clash/XException.hs   |  4 ++++
 3 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/clash-prelude/src/Clash/Sized/RTree.hs b/clash-prelude/src/Clash/Sized/RTree.hs
index ee2aca19f6..99b4d810ce 100644
--- a/clash-prelude/src/Clash/Sized/RTree.hs
+++ b/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 ())
diff --git a/clash-prelude/src/Clash/Sized/Vector.hs b/clash-prelude/src/Clash/Sized/Vector.hs
index 01e7a4f0e6..4ee9bbc7cf 100644
--- a/clash-prelude/src/Clash/Sized/Vector.hs
+++ b/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 #-}
diff --git a/clash-prelude/src/Clash/XException.hs b/clash-prelude/src/Clash/XException.hs
index 811f067a21..734d21fe13 100644
--- a/clash-prelude/src/Clash/XException.hs
+++ b/clash-prelude/src/Clash/XException.hs
@@ -648,6 +648,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.