1(* From http://www.mlton.org/FunctionalRecordUpdate *)
2structure FunctionalRecordUpdate =
3struct
4local
5  fun next g (f, z) x = g (f x, z)
6  fun  f1 (f, z) x = f (z x)
7  fun  f2 z = next  f1 z
8  fun  f3 z = next  f2 z
9  fun  f4 z = next  f3 z
10  fun  f5 z = next  f4 z
11  fun  f6 z = next  f5 z
12  fun  f7 z = next  f6 z
13  fun  f8 z = next  f7 z
14  fun  f9 z = next  f8 z
15  fun f10 z = next  f9 z
16  fun f11 z = next f10 z
17  fun f12 z = next f11 z
18  fun f13 z = next f12 z
19  fun f14 z = next f13 z
20  fun f15 z = next f14 z
21  fun f16 z = next f15 z
22  fun f17 z = next f16 z
23  fun f18 z = next f17 z
24  fun f19 z = next f18 z
25  fun f20 z = next f19 z
26  fun f21 z = next f20 z
27  fun f22 z = next f21 z
28  fun f23 z = next f22 z
29  fun f24 z = next f23 z
30
31  fun  c0 from =  from
32  fun  c1 from =  c0 (from  f1)
33  fun  c2 from =  c1 (from  f2)
34  fun  c3 from =  c2 (from  f3)
35  fun  c4 from =  c3 (from  f4)
36  fun  c5 from =  c4 (from  f5)
37  fun  c6 from =  c5 (from  f6)
38  fun  c7 from =  c6 (from  f7)
39  fun  c8 from =  c7 (from  f8)
40  fun  c9 from =  c8 (from  f9)
41  fun c10 from =  c9 (from f10)
42  fun c11 from = c10 (from f11)
43  fun c12 from = c11 (from f12)
44  fun c13 from = c12 (from f13)
45  fun c14 from = c13 (from f14)
46  fun c15 from = c14 (from f15)
47  fun c16 from = c15 (from f16)
48  fun c17 from = c16 (from f17)
49  fun c18 from = c17 (from f18)
50  fun c19 from = c18 (from f19)
51  fun c20 from = c19 (from f20)
52  fun c21 from = c20 (from f21)
53  fun c22 from = c21 (from f22)
54  fun c23 from = c22 (from f23)
55  fun c24 from = c23 (from f24)
56in
57
58structure Fold =
59struct
60  fun fold (a,f) g = g (a,f)
61  fun step0 h (a,f) =  fold (h a, f)
62  fun step1 h (a,f) b = fold (h (b,a), f)
63  fun step2 h (a,f) b c = fold (h (b,c,a), f)
64end
65
66fun makeUpdate cX (from, from', to) record =
67    let
68      fun ops () = cX from'
69      fun vars f = to f record
70    in
71      Fold.fold ((vars, ops), fn (vars, _) => vars from)
72    end
73
74fun  makeUpdate0 z = makeUpdate  c0 z
75fun  makeUpdate1 z = makeUpdate  c1 z
76fun  makeUpdate2 z = makeUpdate  c2 z
77fun  makeUpdate3 z = makeUpdate  c3 z
78fun  makeUpdate4 z = makeUpdate  c4 z
79fun  makeUpdate5 z = makeUpdate  c5 z
80fun  makeUpdate6 z = makeUpdate  c6 z
81fun  makeUpdate7 z = makeUpdate  c7 z
82fun  makeUpdate8 z = makeUpdate  c8 z
83fun  makeUpdate9 z = makeUpdate  c9 z
84fun makeUpdate10 z = makeUpdate c10 z
85fun makeUpdate11 z = makeUpdate c11 z
86fun makeUpdate12 z = makeUpdate c12 z
87fun makeUpdate13 z = makeUpdate c13 z
88fun makeUpdate14 z = makeUpdate c14 z
89fun makeUpdate15 z = makeUpdate c15 z
90fun makeUpdate16 z = makeUpdate c16 z
91fun makeUpdate17 z = makeUpdate c17 z
92fun makeUpdate18 z = makeUpdate c18 z
93fun makeUpdate19 z = makeUpdate c19 z
94fun makeUpdate20 z = makeUpdate c20 z
95fun makeUpdate21 z = makeUpdate c21 z
96fun makeUpdate22 z = makeUpdate c22 z
97fun makeUpdate23 z = makeUpdate c23 z
98fun makeUpdate24 z = makeUpdate c24 z
99
100fun $$ (a,f) = f a
101fun U s v z =
102    Fold.step0 (fn (vars,ops) =>
103                   (fn out => vars (s (ops()) (out,fn _ => v)),ops))
104               z
105end (* local *)
106
107end (* struct *)
108