1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
module PreludeTuple where
{-#Prelude#-} -- Indicates definitions of compiler prelude symbols
import PreludeTuplePrims
-- This module contains support routines which handle tuple instances.
-- These are based on a implementation level data type which represents
-- general tuples and a data type to hold the set of dictionaries which
-- are associated with the tuple.
-- Each of these functions takes the tupledicts as the first argument.
-- Force all of these functions to take strict arguments because they'll
-- never be called with 0-length tuples anyway.
-- The following primitives operate on tuples.
-- tupleSize :: TupleDicts -> Int
-- tupleSel :: Tuple -> Int -> Int -> a
-- dictSel :: TupleDicts -> method -> Int -> a
-- listToTuple :: [a] -> Tuple
-- Eq functions
tupleEq :: TupleDicts -> Tuple -> Tuple -> Bool
{-# tupleEq :: Strictness("S,S,S") #-}
tupleEq dicts x y = tupleEq1 0 where
tupleEq1 i | i == size = True
| otherwise =
((dictSel (cmpEq dicts i)) x' y') && tupleEq1 (i+1)
where
x' = tupleSel x i size
y' = tupleSel y i size
size = tupleSize dicts
cmpEq x y = x == y
tupleNeq dicts x y = not (tupleEq dicts x y)
-- Ord functions
tupleLe :: TupleDicts -> Tuple -> Tuple -> Bool
{-# tupleLe :: Strictness("S,S,S") #-}
tupleLe dicts x y = tupleLe1 0 where
tupleLe1 i | i == size = False
| (dictSel (cmpLs dicts i)) x' y' = True
| (dictSel (ordEq dicts i)) x' y' = tupleLe1 (i+1)
| otherwise = False
where
x' = tupleSel x i size
y' = tupleSel y i size
size = tupleSize dicts
cmpLs x y = x < y
ordEq :: Ord a => a -> a -> Bool
ordEq x y = x == y
tupleLeq :: TupleDicts -> Tuple -> Tuple -> Bool
{-# tupleLeq :: Strictness("S,S,S") #-}
tupleLeq dicts x y = tupleLeq1 0 where
tupleLeq1 i | i == size = True
| (dictSel (cmpLs dicts i)) x' y' = True
| (dictSel (ordEq dicts i)) x' y' = tupleLeq1 (i+1)
| otherwise = False
where
x' = tupleSel x i size
y' = tupleSel y i size
size = tupleSize dicts
tupleGe :: TupleDicts -> Tuple -> Tuple -> Bool
tupleGe d x y = tupleLe d y x
tupleGeq :: TupleDicts -> Tuple -> Tuple -> Bool
tupleGeq d x y = tupleLeq d y x
tupleMax,tupleMin :: TupleDicts -> Tuple -> Tuple -> Tuple
tupleMax d x y = if tupleGe d x y then x else y
tupleMin d x y = if tupleLe d x y then x else y
-- Ix functions
tupleRange :: TupleDicts -> (Tuple,Tuple) -> [Tuple]
{-# tupleRange :: Strictness("S,S") #-}
tupleRange dicts (x,y) = map listToTuple (tupleRange' 0) where
tupleRange' i | i == size = [[]]
| otherwise =
[(i1 : i2) | i1 <- r, i2 <- tupleRange' (i+1)]
where
x' = tupleSel x i size
y' = tupleSel y i size
r = (dictSel (range' dicts i)) (x',y')
size = tupleSize dicts
range' x = range x
tupleIndex :: TupleDicts -> (Tuple,Tuple) -> Tuple -> Int
{-# tupleIndex :: Strictness("S,S,S") #-}
tupleIndex dicts (low,high) n = tupleIndex' (size-1) where
size = tupleSize dicts
tupleIndex' i | i == 0 = i'
| otherwise = i' + r' * (tupleIndex' (i-1))
where
low' = tupleSel low i size
high' = tupleSel high i size
n' = tupleSel n i size
i' = (dictSel (index' dicts i)) (low',high') n'
r' = (dictSel (rangeSize dicts i)) (low',high')
index' x = index x
rangeSize :: (Ix a) => (a,a) -> Int
rangeSize (l,u) = index (l,u) u + 1
tupleInRange :: TupleDicts -> (Tuple,Tuple) -> Tuple -> Bool
{-# tupleInRange :: Strictness("S,S,S") #-}
tupleInRange dicts (low,high) n = tupleInRange' 0 where
size = tupleSize dicts
tupleInRange' i | i == size = True
| otherwise = (dictSel (inRange' dicts i)) (low',high') n'
&& tupleInRange' (i+1)
where
low' = tupleSel low i size
high' = tupleSel high i size
n' = tupleSel n i size
inRange' x = inRange x
-- Text functions
tupleReadsPrec :: TupleDicts -> Int -> ReadS Tuple
tupleReadsPrec dicts p = readParen False
(\s -> map ( \ (t,w) -> (listToTuple t,w))
(tRP' s 0))
where
size = tupleSize dicts
tRP' s i | i == 0 = [(t':t,w) |
("(",s1) <- lex s,
(t',s2) <- nextItem s1,
(t,w) <- tRP' s2 (i+1)]
| i == size = [([],w) | (")",w) <- lex s]
| otherwise =
[(t':t,w) |
(",",s1) <- lex s,
(t',s2) <- nextItem s1,
(t,w) <- tRP' s2 (i+1)]
where
nextItem s = (dictSel (reads dicts i)) s
tupleShowsPrec :: TupleDicts -> Int -> Tuple -> ShowS
tupleShowsPrec dicts p tuple =
showChar '(' . tSP' 0
where
size = tupleSize dicts
tSP' i | i == (size-1) =
showTup . showChar ')'
| otherwise =
showTup . showChar ',' . tSP' (i+1)
where
showTup = (dictSel (shows dicts i)) (tupleSel tuple i size)
tupleReadList :: TupleDicts -> ReadS [Tuple]
tupleReadList dicts =
readParen False (\r -> [pr | ("[",s) <- lex r,
pr <- readl s])
where readl s = [([],t) | ("]",t) <- lex s] ++
[(x:xs,u) | (x,t) <- tupleReads s,
(xs,u) <- readl' t]
readl' s = [([],t) | ("]",t) <- lex s] ++
[(x:xs,v) | (",",t) <- lex s,
(x,u) <- tupleReads t,
(xs,v) <- readl' u]
tupleReads s = tupleReadsPrec dicts 0 s
tupleShowList :: TupleDicts -> [Tuple] -> ShowS
tupleShowList dicts [] = showString "[]"
tupleShowList dicts (x:xs)
= showChar '[' . showsTuple x . showl xs
where showl [] = showChar ']'
showl (x:xs) = showString ", " . showsTuple x
. showl xs
showsTuple x = tupleShowsPrec dicts 0 x
-- Binary functions
tupleShowBin :: TupleDicts -> Tuple -> Bin -> Bin
tupleShowBin dicts t bin = tSB' 0
where
size = tupleSize dicts
tSB' i | i == size = bin
tSB' i | otherwise =
(dictSel (showBin' dicts i)) (tupleSel t i size) (tSB' (i+1))
showBin' x = showBin x
tupleReadBin :: TupleDicts -> Bin -> (Tuple,Bin)
tupleReadBin dicts bin = (listToTuple t,b) where
size = tupleSize dicts
(t,b) = tRB' bin 0
tRB' b i | i == size = ([],b)
| otherwise = (t':ts,b') where
(t',b'') = (dictSel (readBin' dicts i)) b
(ts,b') = tRB' b'' (i+1)
readBin' x = readBin x
|
