1 --------------------------------
3 --------------------------------
7 data L a = N | C1 a (L a)
9 data Tuple2 a b = T2 a b
11 data Tuple3 a b c = T3 a b c
14 main = putStr (listChar_string
16 (life1 (generations ()) (start ()))))
18 listChar_string :: L Char -> String
19 listChar_string N = []
20 listChar_string (C1 x xs) = x : listChar_string xs
22 start :: a -> L (L Int)
64 (C1 0 N))))))))))))))))))))))))))) N)))))))))))))))
66 -- Calculating the next generation
68 gen1 :: Int -> L (L Int) -> L (L Int)
69 gen1 n board = map1 row1 (shift1 (copy1 n 0) board)
71 row1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int
72 row1 (T3 last this next)
73 = zipWith31 elt1 (shift2 0 last)
78 elt1 :: Tuple3 Int Int Int
79 -> (Tuple3 Int Int Int)
80 -> (Tuple3 Int Int Int) -> Int
81 elt1 (T3 a b c) (T3 d e f) (T3 g h i)
85 else if (eq tot 3) then 1 else e
86 where tot = a `plus` b `plus` c `plus` d
87 `plus` f `plus` g `plus` h `plus` i
89 eq :: Int -> Int -> Bool
92 plus :: Int -> Int -> Int
95 shiftr1 :: L Int -> L (L Int) -> L (L Int)
96 shiftr1 x xs = append2 (C1 x N) (init1 xs)
98 shiftl1 :: L Int -> L (L Int) -> L (L Int)
99 shiftl1 x xs = append2 (tail1 xs) (C1 x N)
101 shift1 :: L Int -> L (L Int)
102 -> L (Tuple3 (L Int) (L Int) (L Int))
103 shift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)
105 shiftr2 :: Int -> L Int -> L Int
106 shiftr2 x xs = append3 (C1 x N) (init2 xs)
108 shiftl2 :: Int -> L Int -> L Int
109 shiftl2 x xs = append3 (tail2 xs) (C1 x N)
111 shift2 :: Int -> L Int -> L (Tuple3 Int Int Int)
112 shift2 x xs = zip32 (shiftr2 x xs) xs (shiftl2 x xs)
116 copy1 :: Int -> Int -> L Int
118 copy1 n x = C1 x (copy1 (n-1) x)
120 copy2 :: Int -> L Int -> L (L Int)
122 copy2 n x = C1 x (copy2 (n-1) x)
124 copy3 :: Int -> Char -> L Char
126 copy3 n x = C1 x (copy3 (n-1) x)
128 -- Displaying one generation
130 disp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char
133 (append1 (C1 '\n' (C1 '\n' N))
134 (foldr_1 (glue1 (C1 '\n' N)) N
135 (map4 (compose2 concat1 (map2 star1)) xss)))
137 star1 :: Int -> L Char
139 0 -> C1 ' ' (C1 ' ' N)
140 1 -> C1 ' ' (C1 'o' N)
142 glue1 :: L Char -> L Char -> L Char -> L Char
143 glue1 s xs ys = append1 xs (append1 s ys)
145 -- Generating and displaying a sequence of generations
147 life1 :: Int -> L (L Int) -> L Char
149 = foldr_1 (glue1 (copy3 (n+2) '\VT')) N
151 (zip1_ (map6 (string_ListChar.show) (ints 0))
154 gens = take3 (740::Int) (iterate1 (gen1 n) (initial1 n xss))
157 ints x = C1 x (ints (x+1))
159 string_ListChar :: String -> L Char
160 string_ListChar [] = N
161 string_ListChar (x:xs) = C1 x (string_ListChar xs)
163 initial1 :: Int -> L (L Int) -> L (L Int)
164 initial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)
165 (`append3` (copy1 n 0))) xss)
166 (copy2 n (copy1 n 0)))
168 iterate1 :: (L (L Int) -> L (L Int))
169 -> L (L Int) -> L (L (L Int))
170 iterate1 f x = C1 x (iterate1 f (f x))
172 -- versions of built in functions
175 take1 :: Int -> L (L Int) -> L (L Int)
178 --should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)
179 take1 n (C1 x xs) | n < 0 = error "Main.take1"
180 | otherwise = C1 x (take1 (n-1) xs)
182 take2 :: Int -> L Int -> L Int
185 --should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)
186 take2 n (C1 x xs) | n < 0 = error "Main.take2"
187 | otherwise = C1 x (take2 (n-1) xs)
189 take3 :: Int -> L (L (L Int))
193 take3 n (C1 x xs) = C1 x (take3 (n-1) xs)
197 init1 :: L (L Int) -> L (L Int)
199 init1 (C1 x xs) = C1 x (init1 xs)
200 init1 N = error "init1 got a bad list"
202 init2 :: L Int -> L Int
204 init2 (C1 x xs) = C1 x (init2 xs)
205 init2 N = error "init1 got a bad list"
209 tail1 :: L (L Int) -> L (L Int)
211 tail1 N = error "tail1 got a bad list"
213 tail2 :: L Int -> L Int
215 tail2 N = error "tail2 got a bad list"
219 map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) ->
220 L (Tuple3 (L Int) (L Int) (L Int))
223 map1 f (C1 x xs) = C1 (f x) (map1 f xs)
225 map2 :: (Int -> L Char) -> L Int -> L (L Char)
227 map2 f (C1 x xs) = C1 (f x) (map2 f xs)
229 map3 :: (L Int -> L Int) -> L (L Int) -> L (L Int)
231 map3 f (C1 x xs) = C1 (f x) (map3 f xs)
233 map4 :: (L Int -> L Char)
234 -> L (L Int) -> L (L Char)
236 map4 f (C1 x xs) = C1 (f x) (map4 f xs)
238 map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char)
239 -> L (Tuple2 (L Char) (L (L Int)))
242 map5 f (C1 x xs) = C1 (f x) (map5 f xs)
244 map6 :: (Int -> L Char) -> L Int -> L (L Char)
246 map6 f (C1 x xs) = C1 (f x) (map6 f xs)
250 compose2 :: (L (L Char) -> L Char)
251 -> (L Int -> L (L Char))
253 compose2 f g xs = f (g xs)
255 compose1 :: (L Int -> L Int)
256 -> (L Int -> L Int) -> L Int -> L Int
257 compose1 f g xs = f (g xs)
261 concat1 :: L (L Char) -> L Char
262 concat1 = foldr_1 append1 N
266 foldr_1 :: (L Char -> L Char -> L Char)
267 -> L Char -> L (L Char) -> L Char
269 foldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)
273 append1 :: L Char -> L Char -> L Char
275 append1 (C1 x xs) ys = C1 x (append1 xs ys)
277 append2 :: L (L Int) -> L (L Int) -> L (L Int)
279 append2 (C1 x xs) ys = C1 x (append2 xs ys)
281 append3 :: L Int -> L Int -> L Int
283 append3 (C1 x xs) ys = C1 x (append3 xs ys)
287 pzip f (C1 x1 xs) (C1 y1 ys)
288 = C1 (f x1 y1) (pzip f xs ys)
294 -> L (Tuple2 (L Char) (L (L Int)))
299 -> L (Tuple2 (L Int) (L Int))
302 zip3d :: L Int -> (Tuple2 (L Int) (L Int))
303 -> (Tuple3 (L Int) (L Int) (L Int))
304 zip3d x (T2 y z) = T3 x y z
307 -> L (Tuple2 (L Int) (L Int))
308 -> L (Tuple3 (L Int) (L Int) (L Int))
313 -> L (Tuple2 Int Int)
316 zip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)
317 zip5d x (T2 y z) = T3 x y z
320 -> L (Tuple2 Int Int)
321 -> L (Tuple3 Int Int Int)
324 zip6_ :: L (Tuple3 Int Int Int)
325 -> L (Tuple3 Int Int Int)
326 -> L (Tuple2 (Tuple3 Int Int Int)
327 (Tuple3 Int Int Int))
330 zip31 :: L (L Int) -> L (L Int)
332 -> L (Tuple3 (L Int) (L Int) (L Int))
334 = zip3_ as (zip2_ bs cs)
336 zip32 :: L Int -> L Int -> L Int
337 -> L (Tuple3 Int Int Int)
339 = zip5_ as (zip4_ bs cs)
343 zipWith21 :: ((Tuple3 Int Int Int)
344 -> (Tuple2 (Tuple3 Int Int Int)
345 (Tuple3 Int Int Int)) -> Int)
346 -> L (Tuple3 Int Int Int)
347 -> L (Tuple2 (Tuple3 Int Int Int)
348 (Tuple3 Int Int Int))
352 zipWith31 :: ((Tuple3 Int Int Int)
353 -> (Tuple3 Int Int Int)
354 -> (Tuple3 Int Int Int) -> Int)
355 -> L (Tuple3 Int Int Int)
356 -> L (Tuple3 Int Int Int)
357 -> L (Tuple3 Int Int Int) -> L Int
359 = zipWith21 z' as (zip6_ bs cs)
360 where z' a (T2 b c) = z a b c