[project @ 1999-12-08 10:10:59 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelBase.lhs

diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs
index e3d4d6f..89b0694 100644 (file)
--- a/ghc/lib/std/PrelBase.lhs
+++ b/ghc/lib/std/PrelBase.lhs
@@ -55,10 +55,10 @@ class  (Eq a) => Ord a  where
                                -- be defined for an instance of Ord
            | otherwise = GT
 
-    x <= y  = case compare x y of { GT -> False; other -> True }
-    x <         y  = case compare x y of { LT -> True;  other -> False }
-    x >= y  = case compare x y of { LT -> False; other -> True }
-    x >         y  = case compare x y of { GT -> True;  other -> False }
+    x <= y  = case compare x y of { GT -> False; _other -> True }
+    x <         y  = case compare x y of { LT -> True;  _other -> False }
+    x >= y  = case compare x y of { LT -> False; _other -> True }
+    x >         y  = case compare x y of { GT -> True;  _other -> False }
 
        -- These two default methods use '>' rather than compare
        -- because the latter is often more expensive
@@ -99,6 +99,7 @@ data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
                          -- to avoid weird names like con2tag_[]#
 
 instance (Eq a) => Eq [a]  where
+    {-# SPECIALISE instance Eq [Char] #-}
     []     == []     = True    
     (x:xs) == (y:ys) = x == y && xs == ys
     _xs    == _ys    = False                   
@@ -106,6 +107,7 @@ instance (Eq a) => Eq [a]  where
     xs     /= ys     = if (xs == ys) then False else True
 
 instance (Ord a) => Ord [a] where
+    {-# SPECIALISE instance Ord [Char] #-}
     a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
     a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
     a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
@@ -147,29 +149,32 @@ foldr k z xs = go xs
               go (x:xs) = x `k` go xs
 
 build  :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE build #-}
+{-# INLINE 2 build #-}
        -- The INLINE is important, even though build is tiny,
        -- because it prevents [] getting inlined in the version that
        -- appears in the interface file.  If [] *is* inlined, it
        -- won't match with [] appearing in rules in an importing module.
+       --
+       -- The "2" says to inline in phase 2
+
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE augment #-}
+{-# INLINE 2 augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
-"fold/build"   forall k,z,g::forall b. (a->b->b) -> b -> b . 
+"fold/build"   forall k z (g::forall b. (a->b->b) -> b -> b) . 
                foldr k z (build g) = g k z
 
-"foldr/augment" forall k,z,xs,g::forall b. (a->b->b) -> b -> b . 
+"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . 
                foldr k z (augment g xs) = g k (foldr k z xs)
 
 "foldr/id"     foldr (:) [] = \x->x
-"foldr/app"            forall xs, ys. foldr (:) ys xs = append xs ys
+"foldr/app"            forall xs ys. foldr (:) ys xs = append xs ys
 
-"foldr/cons"   forall k,z,x,xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/nil"    forall k,z.      foldr k z []     = z 
+"foldr/cons"   forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+"foldr/nil"    forall k z.      foldr k z []     = z 
  #-}
 \end{code}
 
@@ -191,7 +196,7 @@ mapList _ []     = []
 mapList f (x:xs) = f x : mapList f xs
 
 {-# RULES
-"mapFB"            forall c,f,g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
+"mapFB"            forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
 "mapList"   forall f.          foldr (mapFB (:) f) []  = mapList f
  #-}
 \end{code}
@@ -377,6 +382,47 @@ instance  Eq Integer  where
     (S# i)     /=  (J# s d)   = cmpIntegerInt# s d i /=# 0#
     (J# s d)   /=  (S# i)     = cmpIntegerInt# s d i /=# 0#
     (J# s1 d1) /=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+
+instance  Ord Integer  where
+    (S# i)     <=  (S# j)     = i <=# j
+    (J# s d)   <=  (S# i)     = cmpIntegerInt# s d i <=# 0#
+    (S# i)     <=  (J# s d)   = cmpIntegerInt# s d i >=# 0#
+    (J# s1 d1) <=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
+
+    (S# i)     >   (S# j)     = i ># j
+    (J# s d)   >   (S# i)     = cmpIntegerInt# s d i ># 0#
+    (S# i)     >   (J# s d)   = cmpIntegerInt# s d i <# 0#
+    (J# s1 d1) >   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
+
+    (S# i)     <   (S# j)     = i <# j
+    (J# s d)   <   (S# i)     = cmpIntegerInt# s d i <# 0#
+    (S# i)     <   (J# s d)   = cmpIntegerInt# s d i ># 0#
+    (J# s1 d1) <   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
+
+    (S# i)     >=  (S# j)     = i >=# j
+    (J# s d)   >=  (S# i)     = cmpIntegerInt# s d i >=# 0#
+    (S# i)     >=  (J# s d)   = cmpIntegerInt# s d i <=# 0#
+    (J# s1 d1) >=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
+
+    compare (S# i)  (S# j)
+       | i ==# j = EQ
+       | i <=# j = LT
+       | otherwise = GT
+    compare (J# s d) (S# i)
+       = case cmpIntegerInt# s d i of { res# ->
+        if res# <# 0# then LT else 
+        if res# ># 0# then GT else EQ
+        }
+    compare (S# i) (J# s d)
+       = case cmpIntegerInt# s d i of { res# ->
+        if res# ># 0# then LT else 
+        if res# <# 0# then GT else EQ
+        }
+    compare (J# s1 d1) (J# s2 d2)
+       = case cmpInteger# s1 d1 s2 d2 of { res# ->
+        if res# <# 0# then LT else 
+        if res# ># 0# then GT else EQ
+        }
 \end{code}