ghc/lib/prelude/ITup5.hs

   1 module PreludeBuiltin where
   2
   3 --- 5-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
  15 instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a,b,c,d,e) where
  16     (a1,a2,a3,a4,a5) == (b1,b2,b3,b4,b5) = a1 == b1 && a2 == b2 && a3 == b3 && a4 == b4 && a5 == b5
  17     aaaaa            /= bbbbb            = if (aaaaa == bbbbb) then False else True
  18
  19 instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a,b,c,d,e) where
  20     a <  b  = case _tagCmp a b of { _LT -> True;  _EQ -> False; _GT -> False }
  21     a <= b  = case _tagCmp a b of { _LT -> True;  _EQ -> True;  _GT -> False }
  22     a >= b  = case _tagCmp a b of { _LT -> False; _EQ -> True;  _GT -> True  }
  23     a >  b  = case _tagCmp a b of { _LT -> False; _EQ -> False; _GT -> True  }
  24
  25     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
  26     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
  27
  28     _tagCmp (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2)
  29       = case (_tagCmp a1 a2) of {
  30           _LT -> _LT;
  31           _GT -> _GT;
  32           _EQ -> case _tagCmp b1 b2 of {
  33                       _LT -> _LT;
  34                       _GT -> _GT;
  35                       _EQ -> case _tagCmp c1 c2 of {
  36                                   _LT -> _LT;
  37                                   _GT -> _GT;
  38                                   _EQ -> case _tagCmp d1 d2 of {
  39                                               _LT -> _LT;
  40                                               _GT -> _GT;
  41                                               _EQ -> _tagCmp e1 e2
  42                                             }
  43                                 }
  44                     }
  45         }
  46
  47 instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where
  48     range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
  49         [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
  50                             i2 <- range (l2,u2),
  51                             i3 <- range (l3,u3),
  52                             i4 <- range (l4,u4),
  53                             i5 <- range (l5,u5)]
  54
  55     index ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
  56       index (l5,u5) i5 + rangeSize (l5,u5) * (
  57         index (l4,u4) i4 + rangeSize (l4,u4) * (
  58          index (l3,u3) i3 + rangeSize (l3,u3) * (
  59            index (l2,u2) i2 + rangeSize (l2,u2) * (
  60              index (l1,u1) i1))))
  61       where
  62         rangeSize (l,u) = index (l,u) u + (1 :: Int)
  63
  64     inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
  65         inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
  66             inRange (l3,u3) i3 && inRange (l4,u4) i4 && inRange (l5,u5) i5
  67
  68 -- ToDo: something for Binary
  69
  70 instance (Text a, Text b, Text c, Text d, Text e) => Text (a, b, c, d, e) where
  71     readsPrec p = readParen False
  72                     (\a -> [((w,x,y,z,v), l) | ("(",b) <- lex a,
  73                                                (w,c)   <- reads b,
  74                                                (",",d) <- lex c,
  75                                                (x,e)   <- reads d,
  76                                                (",",f) <- lex e,
  77                                                (y,g)   <- reads f,
  78                                                (",",h) <- lex g,
  79                                                (z,i)   <- reads h,
  80                                                (",",j) <- lex i,
  81                                                (v,k)   <- reads j,
  82                                                (")",l) <- lex k ] )
  83
  84     showsPrec p (v,w,x,y,z) = showChar '(' . shows v . showString ", " .
  85                                              shows w . showString ", " .
  86                                              shows x . showString ", " .
  87                                              shows y . showString ", " .
  88                                              shows z . showChar ')'
  89
  90 #if defined(__UNBOXED_INSTANCES__)
  91
  92 -- We only create SPECIALIZED instances unboxed tuples
  93 -- which have all the same unboxed component
  94
  95 -- {-# SPECIALIZE instance Eq   (Char#,Char#,Char#,Char#,Char#) #-}
  96 -- {-# SPECIALIZE instance Ord  (Char#,Char#,Char#,Char#,Char#) #-}
  97 -- {-# SPECIALIZE instance Ix   (Char#,Char#,Char#,Char#,Char#) #-}
  98 -- {-# SPECIALIZE instance Text (Char#,Char#,Char#,Char#,Char#) #-}
  99
 100 -- {-# SPECIALIZE instance Eq   (Int#,Int#,Int#,Int#,Int#) #-}
 101 -- {-# SPECIALIZE instance Ord  (Int#,Int#,Int#,Int#,Int#) #-}
 102 -- {-# SPECIALIZE instance Ix   (Int#,Int#,Int#,Int#,Int#) #-}
 103 -- {-# SPECIALIZE instance Text (Int#,Int#,Int#,Int#,Int#) #-}
 104
 105 -- {-# SPECIALIZE instance Eq   (Double#,Double#,Double#,Double#,Double#) #-}
 106 -- {-# SPECIALIZE instance Ord  (Double#,Double#,Double#,Double#,Double#) #-}
 107 -- {-# SPECIALIZE instance Text (Double#,Double#,Double#,Double#,Double#) #-}
 108
 109 #endif