-- 2008.10.12: GHC 6.10 breaks -fno-warn-orphans so that it no -- longer suppresses the warnings for orphaned RULES. Hence -Werror -- will make things crash on those systems, and even if that's -- removed then -Wall will send up too many false positives which -- may disconcert users. {-# OPTIONS_GHC -Wall -fwarn-tabs #-} -- Unfortunately GHC < 6.10 needs -fglasgow-exts in order to actually -- parse RULES (see -ddump-rules); the -frewrite-rules flag only -- enables the application of rules, instead of doing what we want. -- Apparently this is fixed in 6.10. -- -- http://hackage.haskell.org/trac/ghc/ticket/2213 -- http://www.mail-archive.com/glasgow-haskell-users@haskell.org/msg14313.html -- OPTIONS_GHC -O2 -fglasgow-exts -frewrite-rules ---------------------------------------------------------------- -- ~ 2021.10.17 -- | -- Module : Data.List.Extras.LazyLength -- Copyright : Copyright (c) 2007--2021 wren gayle romano -- License : BSD3 -- Maintainer : wren@cpan.org -- Stability : stable -- Portability : Haskell98 -- -- This module provides least-strict functions for getting a list's -- length and doing natural things with it. -- -- The regular version of @length@ will traverse the entire spine -- of the list in order to return an answer. For comparing the -- length against some bound, that is by far too strict. Being too -- strict can cause a space leak by expanding a lazy list before -- necessary (or more than is ever necessary). And it can lead to -- unnecessarily non-terminating programs when trying to determine -- if an infinite list is longer or shorter than some finite bound. -- -- A nicer version of @length@ would return some lazy approximation -- of an answer which retains the proper semantics. An option for -- doing this is to return Peano integers which can be decremented -- as much as necessary and no further (i.e. at most one more than -- the bound). Of course, Peano integers are woefully inefficient. -- This module provides functions with the same lazy effect but -- does so efficiently instead. -- -- As of version 0.3.0 the GHC rules to automatically rewrite -- certain calls to 'length' into our least-strict versions have -- been /removed/ for more consistent and predictable semantics. -- All clients should explicitly call these least-strict functions -- if they want the least-strict behavior. ---------------------------------------------------------------- module Data.List.Extras.LazyLength ( lengthBound, lengthCompare ) where ---------------------------------------------------------------- ---------------------------------------------------------------- -- | A variant of 'length' which is least-strict for comparing -- against a boundary length. -- -- @lengthBound@ is polymorphic in the return of the helper -- function so we can use 'compare' as well as '>', '>=', '==', -- '/=', '<=', '<'. If you want to use any other functions, know -- that we only preserve the ordering of the list's length vs the -- boundary length and so the function should not rely on the true -- values of either of the numbers being compared. lengthBound :: Int -> (Int -> Int -> a) -> [b] -> a lengthBound :: Int -> (Int -> Int -> a) -> [b] -> a lengthBound Int n Int -> Int -> a cmp [b] xs | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = case [b] xs of [] -> Int -> Int -> a cmp Int n Int 0 (b _:[b] _) -> Int -> Int -> a cmp Int n Int 1 | Bool otherwise = Int -> [b] -> a forall a. Int -> [a] -> a go Int n [b] xs where go :: Int -> [a] -> a go Int n' [] = Int -> Int -> a cmp Int n' Int 0 go Int 0 (a _:[a] _) = Int -> Int -> a cmp Int 0 Int 1 go Int n' (a _:[a] xs') = (Int -> [a] -> a go (Int -> [a] -> a) -> Int -> [a] -> a forall a b. (a -> b) -> a -> b $! Int n'Int -> Int -> Int forall a. Num a => a -> a -> a -Int 1) [a] xs' {- bad RULES -- The rules themselves are correct but they alter program semantics -- regarding bottoms, depending on whether they fire or not. "lengthBound/(>)" forall n xs. n > length xs = lengthBound n (>) xs "lengthBound/(>=)" forall n xs. n >= length xs = lengthBound n (>=) xs "lengthBound/(==)" forall n xs. n == length xs = lengthBound n (==) xs "lengthBound/(/=)" forall n xs. n /= length xs = lengthBound n (/=) xs "lengthBound/(<=)" forall n xs. n <= length xs = lengthBound n (<=) xs "lengthBound/(<)" forall n xs. n < length xs = lengthBound n (<) xs "lengthBound/compare" forall n xs. compare n (length xs) = lengthBound n compare xs "lengthBound\\(>)" forall n xs. length xs > n = lengthBound n (<) xs "lengthBound\\(>=)" forall n xs. length xs >= n = lengthBound n (<=) xs "lengthBound\\(==)" forall n xs. length xs == n = lengthBound n (==) xs "lengthBound\\(/=)" forall n xs. length xs /= n = lengthBound n (/=) xs "lengthBound\\(<=)" forall n xs. length xs <= n = lengthBound n (>=) xs "lengthBound\\(<)" forall n xs. length xs < n = lengthBound n (>) xs "lengthBound\\compare" forall n xs. compare (length xs) n = lengthBound n (flip compare) xs -} ---------------------------------------------------------------- ---------------------------------------------------------------- -- | A variant of 'length' which is least-strict for comparing -- the lengths of two lists. This is as strict as the length of the -- shorter list (which allows comparing an infinite list against a -- finite list). -- -- If you're going to immediately follow this with a 'zip' function -- then see "Data.List.Extras.Pair" instead. lengthCompare :: [a] -> [b] -> Ordering lengthCompare :: [a] -> [b] -> Ordering lengthCompare [] [] = Ordering EQ lengthCompare (a _:[a] _) [] = Ordering GT lengthCompare [] (b _:[b] _) = Ordering LT lengthCompare (a _:[a] xs) (b _:[b] ys) = [a] -> [b] -> Ordering forall a b. [a] -> [b] -> Ordering lengthCompare [a] xs [b] ys {- bad RULES -- The rules themselves are correct but they alter program semantics -- regarding bottoms, depending on whether they fire or not. "lengthCompare/(>)" forall xs ys. length xs > length ys = lengthCompare xs ys == GT "lengthCompare/(>=)" forall xs ys. length xs >= length ys = lengthCompare xs ys /= LT "lengthCompare/(==)" forall xs ys. length xs == length ys = lengthCompare xs ys == EQ "lengthCompare/(/=)" forall xs ys. length xs /= length ys = lengthCompare xs ys /= EQ "lengthCompare/(<=)" forall xs ys. length xs <= length ys = lengthCompare xs ys /= GT "lengthCompare/(<)" forall xs ys. length xs < length ys = lengthCompare xs ys == LT "lengthCompare/compare" forall xs ys. compare (length xs) (length ys) = lengthCompare xs ys -} ---------------------------------------------------------------- ----------------------------------------------------------- fin.