ghc/lib/prelude/ITup2.hs

   1 module PreludeBuiltin where
   2
   3 --- 2-tuples ------------------------------------------
   4
   5 import Cls
   6 import Core
   7 import IInt
   8 import IInteger
   9 import IList
  10 import List     ( (++), foldr )
  11 import Prel     ( (&&), (.) )
  12 import PS       ( _PackedString, _unpackPS )
  13 import Text
  14
  15 instance (Eq a, Eq b) => Eq (a, b) where
  16     (a,b) == (c,d) = a == c && b == d
  17
  18 instance (Ord a, Ord b) => Ord (a, b) where
  19     a <  b  = case _tagCmp a b of { _LT -> True;  _EQ -> False; _GT -> False }
  20     a <= b  = case _tagCmp a b of { _LT -> True;  _EQ -> True;  _GT -> False }
  21     a >= b  = case _tagCmp a b of { _LT -> False; _EQ -> True;  _GT -> True  }
  22     a >  b  = case _tagCmp a b of { _LT -> False; _EQ -> False; _GT -> True  }
  23     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
  24     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
  25     _tagCmp (a1, b1) (a2, b2) = case (_tagCmp a1 a2) of
  26                                     _LT -> _LT
  27                                     _GT -> _GT
  28                                     _EQ -> _tagCmp b1 b2
  29
  30 instance (Ix a, Ix b) => Ix (a, b) where
  31     range ((l1,l2),(u1,u2))
  32       = [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
  33
  34     index ((l1,l2),(u1,u2)) (i1,i2)
  35       = index (l1,u1) i1 * (index (l2,u2) u2 + 1){-rangeSize (l2,u2)-} + index (l2,u2) i2
  36
  37     inRange ((l1,l2),(u1,u2)) (i1,i2)
  38       = inRange (l1,u1) i1 && inRange (l2,u2) i2
  39
  40 instance (Text a, Text b) => Text (a, b) where
  41     readsPrec p = readParen False
  42                             (\r -> [((x,y), w) | ("(",s) <- lex r,
  43                                                  (x,t)   <- reads s,
  44                                                  (",",u) <- lex t,
  45                                                  (y,v)   <- reads u,
  46                                                  (")",w) <- lex v ] )
  47
  48     showsPrec p (x,y) = showChar '(' . shows x . showString ", " .
  49                                        shows y . showChar ')'
  50
  51 {-# SPECIALIZE instance Eq      (Int, Int) #-}
  52 {-# SPECIALIZE instance Ord     (Int, Int) #-}
  53 {-# SPECIALIZE instance Ix      (Int, Int) #-}
  54 {-# SPECIALIZE instance Text    (Int, Int) #-}
  55
  56 {-# SPECIALIZE instance Text    (Integer, Integer) #-}
  57
  58 {-# SPECIALIZE instance Eq      (_PackedString, _PackedString) #-}
  59 {-# SPECIALIZE instance Ord     (_PackedString, _PackedString) #-}
  60
  61 #if defined(__UNBOXED_INSTANCES__)
  62 -- We generate SPECIALIZED instances for all combinations of unboxed pairs
  63
  64 {-# GENERATE_SPECS instance a b :: Eq (a,b) #-}
  65 {-# GENERATE_SPECS instance a b :: Ord (a,b) #-}
  66 {-# GENERATE_SPECS instance a{Char#,Int#} b{Char#,Int#} :: Ix (a,b) #-}
  67 {-# GENERATE_SPECS instance a b :: Text (a,b) #-}
  68
  69 #endif {-UNBOXED INSTANCES-}