ghc/lib/prelude/ITup3.hs

   1 module PreludeBuiltin where
   2
   3 --- 3-tuples ------------------------------------------
   4
   5 import Cls
   6 import Core
   7 import IChar
   8 import IInt
   9 import IList
  10 import List             ( (++), foldr )
  11 import Prel             ( (&&), (.) )
  12 import PS               ( _PackedString, _unpackPS )
  13 import Text
  14 import TyArray
  15 import TyComplex
  16
  17 instance (Eq a, Eq b, Eq c) => Eq (a, b, c) where
  18     (a1,a2,a3) == (b1,b2,b3) = a1 == b1 && a2 == b2 && a3 == b3
  19     aaa        /= bbb        = if (aaa == bbb) then False else True
  20
  21 instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where
  22     a <  b  = case _tagCmp a b of { _LT -> True;  _EQ -> False; _GT -> False }
  23     a <= b  = case _tagCmp a b of { _LT -> True;  _EQ -> True;  _GT -> False }
  24     a >= b  = case _tagCmp a b of { _LT -> False; _EQ -> True;  _GT -> True  }
  25     a >  b  = case _tagCmp a b of { _LT -> False; _EQ -> False; _GT -> True  }
  26
  27     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
  28     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
  29
  30     _tagCmp (a1, b1, c1) (a2, b2, c2)
  31       = case (_tagCmp a1 a2) of {
  32           _LT -> _LT;
  33           _GT -> _GT;
  34           _EQ -> case _tagCmp b1 b2 of {
  35                       _LT -> _LT;
  36                       _GT -> _GT;
  37                       _EQ -> _tagCmp c1 c2
  38                     }
  39         }
  40
  41 instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where
  42     range ((l1,l2,l3),(u1,u2,u3)) =
  43         [(i1,i2,i3) | i1 <- range (l1,u1),
  44                       i2 <- range (l2,u2),
  45                       i3 <- range (l3,u3)]
  46
  47     index ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
  48       index (l3,u3) i3 + rangeSize (l3,u3) * (
  49        index (l2,u2) i2 + rangeSize (l2,u2) * (
  50          index (l1,u1) i1))
  51       where
  52         rangeSize (l,u) = index (l,u) u + (1 :: Int)
  53
  54     inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
  55         inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
  56             inRange (l3,u3) i3
  57
  58 -- ToDo: something for Binary
  59
  60 instance (Text a, Text b, Text c) => Text (a, b, c) where
  61     readsPrec p = readParen False
  62                         (\a -> [((x,y,z), h) | ("(",b) <- lex a,
  63                                                (x,c)   <- readsPrec 0 b,
  64                                                (",",d) <- lex c,
  65                                                (y,e)   <- readsPrec 0 d,
  66                                                (",",f) <- lex e,
  67                                                (z,g)   <- readsPrec 0 f,
  68                                                (")",h) <- lex g ] )
  69
  70     showsPrec p (x,y,z) = showChar '(' . showsPrec 0 x . showString ", " .
  71                                          showsPrec 0 y . showString ", " .
  72                                          showsPrec 0 z . showChar ')'
  73
  74     readList    = _readList (readsPrec 0)
  75     showList    = _showList (showsPrec 0)
  76
  77 {-# SPECIALIZE instance Eq   (Int,Int,Int) #-}
  78 {-# SPECIALIZE instance Ord  (Int,Int,Int) #-}
  79 {-# SPECIALIZE instance Text (Int,Int,Int) #-}
  80
  81 #if defined(__UNBOXED_INSTANCES__)
  82
  83 -- We only create SPECIALIZED instances unboxed tuples
  84 -- which have all the same unboxed component
  85
  86 -- {-# SPECIALIZE instance Eq   (Char#,Char#,Char#) #-}
  87 -- {-# SPECIALIZE instance Ord  (Char#,Char#,Char#) #-}
  88 -- {-# SPECIALIZE instance Ix   (Char#,Char#,Char#) #-}
  89 -- {-# SPECIALIZE instance Text (Char#,Char#,Char#) #-}
  90
  91 -- {-# SPECIALIZE instance Eq   (Int#,Int#,Int#) #-}
  92 -- {-# SPECIALIZE instance Ord  (Int#,Int#,Int#) #-}
  93 -- {-# SPECIALIZE instance Ix   (Int#,Int#,Int#) #-}
  94 -- {-# SPECIALIZE instance Text (Int#,Int#,Int#) #-}
  95
  96 -- {-# SPECIALIZE instance Eq   (Double#,Double#,Double#) #-}
  97 -- {-# SPECIALIZE instance Ord  (Double#,Double#,Double#) #-}
  98 -- {-# SPECIALIZE instance Text (Double#,Double#,Double#) #-}
  99
 100 #endif