> OTOH, if we were to redefine all the xxxBy functions that involve
> comparison, I'd vote for ((<=) :: a->a->Bool) over (compare ::
> a->a->Ordering) as the comparison function since (<=) is often easier to
> create a quick definition for.  I wouldn't consider such a change until
> Haskell 2, though.

I disagree... I don't think we should be making `quick-and-dirty' 
definitions easy, I think we should be doing it the Right Way.  It 
takes two `<=' comparisons to get the information obtainable from one 
`compare', but one `compare' is also enough to give a result for `<='.  
It usually requires no more computation to give the more specific 
result.

If you really want quick-and-dirty, you could add:

le2ord :: (a -> a -> Bool) -> (a -> a -> Ordering)
le2ord le a b = case (a `le` b, b `le` a) of
                  (True, False) -> LT
                  (True, True ) -> EQ
                  (False,True ) -> GT

to the prelude (or to an Ordering library).  While you're constructing 
an Ordering library, you could add to it:

isLE :: Ordering -> Bool
isLE LT = True
isLE EQ = True
isLE GT = False

thenCmp :: Ordering -> Ordering -> Ordering
EQ `thenCmp` o2 = o2
o1 `thenCmp` _  = o1

and a partial ordering class

type POrdering = Maybe Ordering

class POrd a where
  pcompare :: a -> a -> POrdering

instance Ord a => POrd a where
  pcompare a b = Just (compare a b)

Just my £0.02 (about US$0.04 I believe).

--KW 8-)
-- 
: Keith Wansbrough, MSc, BSc(Hons) (Auckland) -------------------:
: PhD Student, Computer Laboratory, University of Cambridge, UK. :
: Native of Antipodean Auckland, New Zealand: 174d47'E, 36d55'S. :
: http://www.cl.cam.ac.uk/users/kw217/ mailto:[EMAIL PROTECTED] :
:----------------------------------------------------------------:



Reply via email to