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