3 (*based on kitlifeopt
.sml
, but
with copying
4 to avoid many generations
in the same region
*)
9 structure Main
: BMARK
=
14 | map
f (a
::x
) = f a
:: map f x
16 fun map_rec(f
, []) = []
17 |
map_rec(f
, x
::xs
) = f x
:: map_rec(f
, xs
)
19 exception ex_undefined
of string
20 fun error str
= raise ex_undefined str
22 fun accumulate f a
[] = a (* this now has no escaping regions
, although still an escaping arrow effect
*)
23 | accumulate f
a (b
::x
) = accumulate
f (f a b
) x
26 rev (accumulate (fn x
=> fn a
=> if p a
then a
::x
else x
) [] l
)
27 (*builds an intermediate list
; the regions
of this list
28 are now made
local (unlike
in escape
.sml
) *)
30 fun member x
[] = false
31 | member
x (y
::ys
) = x
=y
orelse member x ys
37 fun revonto x y
= accumulate (C cons
) x
y (* eta expanded
*)
39 fun length x
= (let fun count n a
= n
+1 in accumulate count
0 end) x
42 fun repeat f
= let (* rptf moved into inner
let *)
43 fun check n
= if n
<0 then error
"repeat<0" else n
44 in fn x
=> fn y
=> let fun rptf n x
= if n
=0 then x
else rptf(n
-1)(f x
)
49 fun copy n x
= repeat (cons x
) n
[]
51 fun spaces n
= implode (copy n #
" ")
56 |
copy_list((x
,y
)::rest
) = (x
,y
):: copy_list rest
59 |
lexordset (a
::x
) = lexordset (filter (lexless a
) x
) @
[a
] @
60 lexordset (filter (lexgreater a
) x
)
61 and lexless(a1
:int,b1
:int)(a2
,b2
) =
62 if a2
<a1
then true else if a2
=a1
then b2
<b1
else false
63 and lexgreater pr1 pr2
= lexless pr2 pr1
66 let fun accumf sofar
[] = sofar
67 | accumf
sofar (a
::x
) = accumf (revonto
sofar (f a
)) x
68 in accumf
[] list (* note
: this worked without changes
!*)
72 (* finds coords which occur exactly
3 times
in coordlist x
*)
74 fun diff x y
= filter (fn x
=> not(member x y
)) x (* unfolded
o *)
75 fun f xover x3 x2 x1
[] = diff x3 xover
76 | f xover x3 x2
x1 (a
::x
) =
77 if member a xover
then f xover x3 x2 x1 x
else
78 if member a x3
then f (a
::xover
) x3 x2 x1 x
else
79 if member a x2
then f
xover (a
::x3
) x2 x1 x
else
80 if member a x1
then f xover
x3 (a
::x2
) x1 x
else
81 f xover x3
x2 (a
::x1
) x
82 in f
[] [] [] [] x
end
87 fun copy_string s
= implode(explode s
)
88 fun copy_bool
true = true
89 | copy_bool
false = false
92 abstype generation
= GEN
of (int*int) list
94 fun copy (GEN l
) = GEN( copy_list l
)
95 fun alive (GEN livecoords
) = livecoords
96 and mkgen coordlist
= GEN (lexordset coordlist
)
97 and mk_nextgen_fn neighbours gen
=
99 let val living
= alive gen
100 fun isalive x
= copy_bool(member x living
) (* eta
*)
101 fun liveneighbours x
= length( filter
isalive ( neighbours x
)) (*eta
*)
102 fun twoorthree n
= n
= 2 orelse n
= 3
103 val survivors
= copy_list(filter (twoorthree
o liveneighbours
) living
)
104 val newnbrlist
= copy_list(collect (fn z
=> filter (fn x
=> not( isalive x
)) ( neighbours z
)) living
) (* unfolded
o twice
*)
105 val newborn
= copy_list(occurs3 newnbrlist
)
106 in mkgen (survivors @ newborn
) end
111 fun neighbours (i
,j
) = [(i
-1,j
-1),(i
-1,j
),(i
-1,j
+1),
113 (i
+1,j
-1),(i
+1,j
),(i
+1,j
+1)]
115 local val xstart
= 0 and ystart
= 0
116 fun markafter n
string = string ^ spaces n ^
"0"
117 fun plotfrom (x
,y
) (* current position
*)
118 str (* current line being prepared
-- a
string *)
119 ((x1
,y1
)::more
) (* coordinates to be plotted
*)
121 then (* same line so extend str
and continue from y1
+1 *)
122 plotfrom(x
,y1
+1)(markafter(y1
-y
)str
)more
123 else (* flush current line
and start a new line
*)
124 str
:: plotfrom(x
+1,ystart
)""((x1
,y1
)::more
)
125 |
plotfrom (x
,y
) str
[] = [str
]
126 fun good (x
,y
) = x
>=xstart
andalso y
>=ystart
127 in fun plot coordlist
= map_rec(copy_string
,(plotfrom(xstart
,ystart
) ""
128 (copy_list(filter good coordlist
))))
133 fun coordlist
at (x
:int,y
:int) = let fun move(a
,b
) = (a
+x
,b
+y
)
134 in map move coordlist
end
135 fun rotate x
= map (fn (x
:int,y
:int) => (y
,~x
)) x (* eta converted
*)
137 val glider
= [(0,0),(0,2),(1,1),(1,2),(2,1)]
138 val bail
= [(0,0),(0,1),(1,0),(1,1)]
140 let fun f i
= if i
= n
then (n
+n
-1,n
+n
)::(n
+n
,n
+n
)::nil
141 else (i
+i
,i
+i
+1)::(i
+i
+2,i
+i
+1)::f(i
+1)
142 in (0,0)::(1,0):: f
0
145 val genB
= mkgen(glider
at (2,2) @ bail
at (2,12)
146 @
rotate (barberpole
4) at (5,20))
148 fun copy_whole_arg (p
, g
) = (p
, copy g
)
150 fun nthgen
'(p
as(0,g
)) = p
151 | nthgen
'(p
as(i
,g
)) = (print
".\n";
152 nthgen
' (copy_whole_arg(copy_whole_arg(i
-1,mk_nextgen_fn neighbours g
))))
154 fun gun() = mkgen (* turned into function
*)
155 [(2,20),(3,19),(3,21),(4,18),(4,22),(4,23),(4,32),(5,7),(5,8),(5,18),
156 (5,22),(5,23),(5,29),(5,30),(5,31),(5,32),(5,36),(6,7),(6,8),(6,18),
157 (6,22),(6,23),(6,28),(6,29),(6,30),(6,31),(6,36),(7,19),(7,21),(7,28),
158 (7,31),(7,40),(7,41),(8,20),(8,28),(8,29),(8,30),(8,31),(8,40),(8,41),
159 (9,29),(9,30),(9,31),(9,32)]
162 fun iter n
= #
2(nthgen
'(n
,gun()))
166 fun show(x
) = (pr
"starting printing\n";
167 app (fn s
=> (pr s
; pr
"\n"))(plot(alive x
));
169 ) (* had to uncurry show
, as iter
50 gave attop
170 also made it return a different unit
*)
172 (* fun doit () = show((fn _
=> ()), (iter
50)) (* inserted call
of iter
*)*)
175 fun testit _
= show(iter
50) (* inserted call
of iter
*)
182 (* val _
= (doit (); doit(); doit()); *)
185 testit (); testit (); testit ()