ghc/lib/prelude/ITup2.hs

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