diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-07 20:01:47 +0000 |
---|---|---|
committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-07 20:37:58 +0000 |
commit | 6e280c2c5b2903ae38f4da15a41ea94793907407 (patch) | |
tree | a81a3bfe2b059936becd7cf878757415fd80a983 /compiler | |
parent | 64bce8c31450d846cf1a1ca4ff31ec6c724f2e46 (diff) | |
download | haskell-6e280c2c5b2903ae38f4da15a41ea94793907407.tar.gz |
Utils: Fix `lengthIs` and `lengthExceeds` for negative args
Credits goes to SPJ for finding this.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/utils/Util.hs | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index ff0f45f725..d20a604519 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -443,9 +443,9 @@ atLength :: ([a] -> b) -- Called when length ls >= n, passed (drop n ls) -> [a] -> Int -> b -atLength atLenPred atEnd ls n - | n < 0 = atLenPred ls - | otherwise = go n ls +atLength atLenPred atEnd ls0 n0 + | n0 < 0 = atLenPred ls0 + | otherwise = go n0 ls0 where -- go's first arg n >= 0 go 0 ls = atLenPred ls @@ -454,15 +454,24 @@ atLength atLenPred atEnd ls n -- Some special cases of atLength: +-- | @(lengthExceeds xs n) = (length xs > n)@ lengthExceeds :: [a] -> Int -> Bool --- ^ > (lengthExceeds xs n) = (length xs > n) -lengthExceeds = atLength notNull False +lengthExceeds lst n + | n < 0 + = True + | otherwise + = atLength notNull False lst n lengthAtLeast :: [a] -> Int -> Bool lengthAtLeast = atLength (const True) False +-- | @(lengthIs xs n) = (length xs == n)@ lengthIs :: [a] -> Int -> Bool -lengthIs = atLength null False +lengthIs lst n + | n < 0 + = False + | otherwise + = atLength null False lst n listLengthCmp :: [a] -> Int -> Ordering listLengthCmp = atLength atLen atEnd |