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