Skip to content

Commit

Permalink
Make 'tzipWith' lazy in its second RTree. Fix #871
Browse files Browse the repository at this point in the history
This fixes various strictness problems with 'lazyT', 'ensureSpine',
'bundle', ...
  • Loading branch information
leonschoorl authored and martijnbastiaan committed Oct 29, 2019
1 parent eba9095 commit 17fee3a
Show file tree
Hide file tree
Showing 3 changed files with 12 additions and 7 deletions.
11 changes: 6 additions & 5 deletions clash-prelude/src/Clash/Sized/RTree.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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 ())
4 changes: 2 additions & 2 deletions clash-prelude/src/Clash/Sized/Vector.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}
Expand Down
4 changes: 4 additions & 0 deletions clash-prelude/src/Clash/XException.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down

0 comments on commit 17fee3a

Please sign in to comment.