[project @ 1996-01-08 20:28:12 by partain]
[ghc-hetmet.git] / 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
15 instance (Eq a, Eq b, Eq c) => Eq (a, b, c) where
16     (a1,a2,a3) == (b1,b2,b3) = a1 == b1 && a2 == b2 && a3 == b3
17     aaa        /= bbb        = if (aaa == bbb) then False else True
18
19 instance (Ord a, Ord b, Ord c) => Ord (a, b, c) 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) (a2, b2, c2)
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 -> _tagCmp c1 c2
36                     }
37         }
38
39 instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where
40     range ((l1,l2,l3),(u1,u2,u3)) =
41         [(i1,i2,i3) | i1 <- range (l1,u1),
42                       i2 <- range (l2,u2),
43                       i3 <- range (l3,u3)]
44
45     index ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
46       index (l3,u3) i3 + rangeSize (l3,u3) * (
47        index (l2,u2) i2 + rangeSize (l2,u2) * (
48          index (l1,u1) i1))
49       where
50         rangeSize (l,u) = index (l,u) u + (1 :: Int)
51
52     inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
53         inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
54             inRange (l3,u3) i3
55
56 -- ToDo: something for Binary
57
58 instance (Text a, Text b, Text c) => Text (a, b, c) where
59     readsPrec p = readParen False
60                         (\a -> [((x,y,z), h) | ("(",b) <- lex a,
61                                                (x,c)   <- reads b,
62                                                (",",d) <- lex c,
63                                                (y,e)   <- reads d,
64                                                (",",f) <- lex e,
65                                                (z,g)   <- reads f,
66                                                (")",h) <- lex g ] )
67
68     showsPrec p (x,y,z) = showChar '(' . shows x . showString ", " .
69                                          shows y . showString ", " .
70                                          shows z . showChar ')'
71
72 #if defined(__UNBOXED_INSTANCES__)
73
74 -- We only create SPECIALIZED instances unboxed tuples
75 -- which have all the same unboxed component
76
77 -- {-# SPECIALIZE instance Eq   (Char#,Char#,Char#) #-}
78 -- {-# SPECIALIZE instance Ord  (Char#,Char#,Char#) #-}
79 -- {-# SPECIALIZE instance Ix   (Char#,Char#,Char#) #-}
80 -- {-# SPECIALIZE instance Text (Char#,Char#,Char#) #-}
81
82 -- {-# SPECIALIZE instance Eq   (Int#,Int#,Int#) #-}
83 -- {-# SPECIALIZE instance Ord  (Int#,Int#,Int#) #-}
84 -- {-# SPECIALIZE instance Ix   (Int#,Int#,Int#) #-}
85 -- {-# SPECIALIZE instance Text (Int#,Int#,Int#) #-}
86
87 -- {-# SPECIALIZE instance Eq   (Double#,Double#,Double#) #-}
88 -- {-# SPECIALIZE instance Ord  (Double#,Double#,Double#) #-}
89 -- {-# SPECIALIZE instance Text (Double#,Double#,Double#) #-}
90
91 #endif