3 (*based on kitlifeopt
.sml
, but
with copying
4 to avoid many generations
in the same region
*)
9 |
loop (x
::xs
) = f x
:: loop xs
14 let fun rev_rec(p
as ([], acc
)) = p
15 |
rev_rec(x
::xs
, acc
) = rev_rec(xs
, x
::acc
)
16 in #
2 (rev_rec(l
,nil
))
19 |
length (x
::xs
) = 1 + length xs
22 | app
f (x
::xs
) = (f x
; app f xs
)
25 fun eq_integer_curry(x
)(y
:int) = x
= y
26 fun eq_int_pair_curry (x
:int,x
':int)(y
,y
'): bool =
29 exception ex_undefined
of string
30 fun error str
= raise ex_undefined str
32 fun accumulate f a
[] = a (* this now has no escaping regions
, although still an escaping arrow effect
*)
33 | accumulate f
a (b
::x
) = accumulate
f (f a b
) x
35 fun accumulate
' (f
, a
, []) = a
36 | accumulate
' (f
, a
, b
::x
) = accumulate
'(f
, f(a
,b
), x
)
41 if pred(x
) then x
:: loop xs
else loop xs
48 let fun loop
[] = false
50 pred(x
) orelse loop xs
55 fun member eq x a
= exists (eq a
) x
59 fun revonto x y
= accumulate
' ((fn (x
,y
) => y
::x
), x
, y
)
62 fun check n
= if n
<0 then error
"repeat<0" else n
65 let fun loop(p
as (0,x
)) = p
66 |
loop(n
,x
) = loop(n
-1, f x
)
72 fun copy n x
= repeat (cons x
) n
[]
74 fun spaces n
= implode (copy n #
" ")
78 |
cp_list((x
,y
)::rest
) =
79 let val l
= cp_list rest
83 fun lexless(a2
,b2
)(a1
:int,b1
:int) =
84 if a2
<a1
then true else if a2
=a1
then b2
<b1
else false
89 |
copy (x
::xs
) = x
:: copy xs
92 | x
::xs
=> if i
>0 then x
::take(i
-1,xs
) else nil
93 fun drop(i
,l
) = case l
of [] => []
94 | x
::xs
=> if i
>0 then drop(i
-1,xs
) else l
95 fun merge(lp
as (left
, right
)) =
96 case left
of [] => right
97 | x
::xs
=> (case right
of
99 | y
::ys
=> if lexless x y
then x
::merge(xs
, right
)
100 else if lexless y x
then y
:: merge(left
,ys
)
101 else (*x
=y
*) merge(xs
, right
)
106 | x
::xs
=> (case xs
of []=> l
107 | _
=> let val k
= length l
div 2
108 in merge(copy (tmergesort(take(k
,l
))),
109 copy (tmergesort(drop(k
,l
))))
112 fun lexordset x
= tmergesort x
117 let fun accumf sofar
[] = sofar
118 | accumf
sofar (a
::x
) = accumf (revonto
sofar (f a
)) x
119 in accumf
[] list (* note
: this worked without changes
!*)
123 (* finds coords which occur exactly
3 times
in coordlist x
*)
125 case q
of (_
,_
,_
,_
,[]) => q
126 |
( xover
, x3
, x2
, x1
, (a
::x
)) =>
127 if member eq_int_pair_curry xover a
then f( xover
, x3
, x2
, x1
, x
) else
128 if member eq_int_pair_curry x3 a
then f ((a
::xover
), x3
, x2
, x1
, x
) else
129 if member eq_int_pair_curry x2 a
then f (xover
, (a
::x3
), x2
, x1
, x
) else
130 if member eq_int_pair_curry x1 a
then f (xover
, x3
, (a
::x2
), x1
, x
) else
131 f (xover
, x3
, x2
, (a
::x1
), x
)
132 fun diff x y
= filter (fn x
=> not(member eq_int_pair_curry y x
)) x (* unfolded
o *)
133 val (xover
, x3
, _
, _
, _
) = f ([],[],[],[],x
)
137 fun neighbours (i
,j
) = [(i
-1,j
-1),(i
-1,j
),(i
-1,j
+1),
139 (i
+1,j
-1),(i
+1,j
),(i
+1,j
+1)]
144 abstype generation
= GEN
of (int*int) list
146 fun copy (GEN l
) = GEN(cp_list l
)
147 fun alive (GEN livecoords
) = livecoords
148 and mkgen coordlist
= GEN (lexordset coordlist
)
151 val living
= alive gen
152 fun isalive x
= member eq_int_pair_curry living x
153 fun liveneighbours x
= length( filter
isalive ( neighbours x
))
154 fun twoorthree n
= n
=2 orelse n
=3
155 val survivors
= filter (twoorthree
o liveneighbours
) living
156 val newnbrlist
= collect (fn z
=> filter (fn x
=> not(isalive x
))
159 val newborn
= occurs3 newnbrlist
160 in mkgen (cp_list(survivors @ newborn
))
165 val xstart
= 0 and ystart
= 0
166 fun markafter n
string = string ^ spaces n ^
"0"
167 fun plotfrom (x
,y
) (* current position
*)
168 str (* current line being prepared
-- a
string *)
169 ((x1
:int,y1
)::more
) (* coordinates to be plotted
*)
171 then (* same line so extend str
and continue from y1
+1 *)
172 plotfrom(x
,y1
+1)(markafter(y1
-y
)str
)more
173 else (* flush current line
and start a new line
*)
174 str
:: plotfrom(x
+1,ystart
)""((x1
,y1
)::more
)
175 |
plotfrom (x
,y
) str
[] = [str
]
176 fun good (x
,y
) = x
>=xstart
andalso y
>=ystart
178 fun plot coordlist
= plotfrom(xstart
,ystart
) ""
179 (filter good coordlist
)
182 (* the initial generation
*)
185 [(2,20),(3,19),(3,21),(4,18),(4,22),(4,23),(4,32),(5,7),(5,8),(5,18),
186 (5,22),(5,23),(5,29),(5,30),(5,31),(5,32),(5,36),(6,7),(6,8),(6,18),
187 (6,22),(6,23),(6,28),(6,29),(6,30),(6,31),(6,36),(7,19),(7,21),(7,28),
188 (7,31),(7,40),(7,41),(8,20),(8,28),(8,29),(8,30),(8,31),(8,40),(8,41),
189 (9,29),(9,30),(9,31),(9,32)]
193 fun show(x
) = app (fn s
=> (print s
; print
"\n"))(plot(alive x
));
196 fun nthgen
'(p
as(0,g
)) = p
197 | nthgen
'(p
as(i
,g
)) =
198 nthgen
' (i
-1, let val g
' = nextgen g
200 (*resetRegions g
;*) (* resetRegions g can actually be omitted here
, since
*)
201 copy g
' (* copy will reset the regions
of g
! *)
205 fun iter n
= #
2(nthgen
'(n
,gun()))
208 fun testit _
= show(iter
200)