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