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
|
exception Unreachable and Unimplemented
fun $ (x, y) = x y
infixr 0 $
fun assert truth = if not truth then raise Unreachable else ()
local
val lastIsNL = ref true
fun endsWith s =
String.sub (s, String.size s - 1) = #"\n" handle
Subscript => raise Unreachable
val print' = print
in
fun print s = (
lastIsNL := endsWith s;
print' s
)
fun printLn s = (
lastIsNL := true;
print' s; print "\n"
)
fun printOnNL s = (
if not $ !lastIsNL then print' "\n" else ();
print' s;
lastIsNL := endsWith s
)
end
(* All global values which computations may raise an exception must be
* wrapped in lazy, so that no exception is thrown before custom
* top-level handler is set.
*)
fun lazy thunk =
let
datatype 'a value =
Unevaluated of unit -> 'a |
Evaluated of 'a |
Exn of exn
val value = ref $ Unevaluated thunk
in
fn () =>
case !value of
Unevaluated th =>
let
val x = th () handle e => (value := Exn e; raise e)
in
value := Evaluated x;
x
end
| Evaluated v => v
| Exn e => raise e
end
structure FRU = struct
fun fold (a, f) g = g (a, f)
fun step0 h (a, f) = fold (h a, f)
fun step2 h (a, f) b c = fold (h (b, c, a), f)
fun next g (f, z) x = g (f x, z)
fun f1 (f, z) x = f (z x)
fun f2 z = next f1 z
fun f3 z = next f2 z
fun f4 z = next f3 z
fun f5 z = next f4 z
fun f6 z = next f5 z
fun f7 z = next f6 z
fun f8 z = next f7 z
fun f9 z = next f8 z
fun c0 from = from
fun c1 from = c0 from f1
fun c2 from = c1 from f2
fun c3 from = c2 from f3
fun c4 from = c3 from f4
fun c5 from = c4 from f5
fun c6 from = c5 from f6
fun c7 from = c6 from f7
fun c8 from = c7 from f8
fun c9 from = c8 from f9
fun makeUpdate cX (from, from', to) record =
let
fun ops () = cX from'
fun vars f = to f record
in
fold ((vars, ops), fn (vars, _) => vars from)
end
fun makeUpdate0 z = makeUpdate c0 z
fun makeUpdate1 z = makeUpdate c1 z
fun makeUpdate2 z = makeUpdate c2 z
fun makeUpdate3 z = makeUpdate c3 z
fun makeUpdate4 z = makeUpdate c4 z
fun makeUpdate5 z = makeUpdate c5 z
fun makeUpdate6 z = makeUpdate c6 z
fun makeUpdate7 z = makeUpdate c7 z
fun makeUpdate8 z = makeUpdate c8 z
fun makeUpdate9 z = makeUpdate c9 z
fun upd z = step2
(fn (s, f, (vars, ops)) =>
(fn out => vars (s (ops ()) (out, f)), ops)) z
fun set z = step2
(fn (s, v, (vars, ops)) =>
(fn out => vars (s (ops ()) (out, fn _ => v)), ops)) z
fun set2 s v = step0
(fn (vars, ops) => (fn out => vars (s (ops ()) (out, fn _ => v)), ops))
fun upd2 s f = step0
(fn (vars, ops) => (fn out => vars (s (ops ()) (out, f)), ops))
end
fun % (a, f) = f a
val s = FRU.set
val u = FRU.upd
|
