[commit: ghc] master: Define Util.leLength :: [a] -> [b] -> Bool (28059ba)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/28059ba7c490c035f125ec5ef26026467b5171ac/ghc

>---------------------------------------------------------------

commit 28059ba7c490c035f125ec5ef26026467b5171ac
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Sep 18 16:04:41 2014 +0100

    Define Util.leLength :: [a] -> [b] -> Bool


>---------------------------------------------------------------

28059ba7c490c035f125ec5ef26026467b5171ac
 compiler/utils/Util.lhs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index dfac0ae..97bafe6 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -26,7 +26,8 @@ module Util (
         foldl1', foldl2, count, all2,
 
         lengthExceeds, lengthIs, lengthAtLeast,
-        listLengthCmp, atLength, equalLength, compareLength,
+        listLengthCmp, atLength,
+        equalLength, compareLength, leLength,
 
         isSingleton, only, singleton,
         notNull, snocView,
@@ -423,6 +424,13 @@ compareLength (_:xs) (_:ys) = compareLength xs ys
 compareLength []     _      = LT
 compareLength _      []     = GT
 
+leLength :: [a] -> [b] -> Bool
+-- ^ True if length xs <= length ys
+leLength xs ys = case compareLength xs ys of
+                   LT -> True
+                   EQ -> True
+                   GT -> False
+
 ----------------------------
 singleton :: a -> [a]
 singleton x = [x]