Mercurial > urweb

comparison src/effectize.sml @ 1104:72670131dace

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basis.serialize; separate file for mhash; run transactional finishers in reverse order; set needs_sig properly
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Dec 2009 11:41:57 -0500
parents dfe34fad749d
children 9d3ccb8b39ac
comparison
equal deleted inserted replaced
1103:2f42c61b8d0a 1104:72670131dace
64 64
65 fun couldWrite evs = U.Exp.exists {kind = fn _ => false, 65 fun couldWrite evs = U.Exp.exists {kind = fn _ => false,
66 con = fn _ => false, 66 con = fn _ => false,
67 exp = exp evs} 67 exp = exp evs}
68 68
69 fun exp writers readers e =
70 case e of
71 EServerCall (n, _, _) => IM.inDomain (writers, n) andalso IM.inDomain (readers, n)
72 | _ => false
73
74 fun couldWriteWithRpc writers readers = U.Exp.exists {kind = fn _ => false,
75 con = fn _ => false,
76 exp = exp writers readers}
77
69 fun exp evs e = 78 fun exp evs e =
70 case e of 79 case e of
71 EFfi ("Basis", "getCookie") => true 80 EFfi ("Basis", "getCookie") => true
72 | ENamed n => IM.inDomain (evs, n) 81 | ENamed n => IM.inDomain (evs, n)
73 | EServerCall (n, _, _) => IM.inDomain (evs, n) 82 | EServerCall (n, _, _) => IM.inDomain (evs, n)
75 84
76 fun couldReadCookie evs = U.Exp.exists {kind = fn _ => false, 85 fun couldReadCookie evs = U.Exp.exists {kind = fn _ => false,
77 con = fn _ => false, 86 con = fn _ => false,
78 exp = exp evs} 87 exp = exp evs}
79 88
80 fun doDecl (d, evs as (writers, readers)) = 89 fun doDecl (d, evs as (writers, readers, pushers)) =
81 case #1 d of 90 case #1 d of
82 DVal (x, n, t, e, s) => 91 DVal (x, n, t, e, s) =>
83 (d, (if couldWrite writers e then 92 (d, (if couldWrite writers e then
84 IM.insert (writers, n, (#2 d, s)) 93 IM.insert (writers, n, (#2 d, s))
85 else 94 else
86 writers, 95 writers,
87 if couldReadCookie readers e then 96 if couldReadCookie readers e then
88 IM.insert (readers, n, (#2 d, s)) 97 IM.insert (readers, n, (#2 d, s))
89 else 98 else
90 readers)) 99 readers,
100 if couldWriteWithRpc writers readers e then
101 IM.insert (pushers, n, (#2 d, s))
102 else
103 pushers))
91 | DValRec vis => 104 | DValRec vis =>
92 let 105 let
93 fun oneRound evs = 106 fun oneRound evs =
94 foldl (fn ((_, n, _, e, s), (changed, (writers, readers))) => 107 foldl (fn ((_, n, _, e, s), (changed, (writers, readers, pushers))) =>
95 let 108 let
96 val (changed, writers) = 109 val (changed, writers) =
97 if couldWrite writers e andalso not (IM.inDomain (writers, n)) then 110 if couldWrite writers e andalso not (IM.inDomain (writers, n)) then
98 (true, IM.insert (writers, n, (#2 d, s))) 111 (true, IM.insert (writers, n, (#2 d, s)))
99 else 112 else
102 val (changed, readers) = 115 val (changed, readers) =
103 if couldReadCookie readers e andalso not (IM.inDomain (readers, n)) then 116 if couldReadCookie readers e andalso not (IM.inDomain (readers, n)) then
104 (true, IM.insert (readers, n, (#2 d, s))) 117 (true, IM.insert (readers, n, (#2 d, s)))
105 else 118 else
106 (changed, readers) 119 (changed, readers)
120
121 val (changed, pushers) =
122 if couldWriteWithRpc writers readers e
123 andalso not (IM.inDomain (pushers, n)) then
124 (true, IM.insert (pushers, n, (#2 d, s)))
125 else
126 (changed, pushers)
107 in 127 in
108 (changed, (writers, readers)) 128 (changed, (writers, readers, pushers))
109 end) (false, evs) vis 129 end) (false, evs) vis
110 130
111 fun loop evs = 131 fun loop evs =
112 let 132 let
113 val (b, evs) = oneRound evs 133 val (b, evs) = oneRound evs
116 loop evs 136 loop evs
117 else 137 else
118 evs 138 evs
119 end 139 end
120 in 140 in
121 (d, loop (writers, readers)) 141 (d, loop (writers, readers, pushers))
122 end 142 end
123 | DExport (Link, n) => 143 | DExport (Link, n, _) =>
124 (case IM.find (writers, n) of 144 (case IM.find (writers, n) of
125 NONE => () 145 NONE => ()
126 | SOME (loc, s) => ErrorMsg.errorAt loc ("A link (" ^ s ^ ") could cause side effects; try implementing it with a form instead"); 146 | SOME (loc, s) => ErrorMsg.errorAt loc ("A link (" ^ s ^ ") could cause side effects; try implementing it with a form instead");
127 (d, evs)) 147 ((DExport (Link, n, IM.inDomain (pushers, n)), #2 d), evs))
128 | DExport (Action _, n) => 148 | DExport (Action _, n, _) =>
129 ((DExport (Action (if IM.inDomain (writers, n) then 149 ((DExport (Action (if IM.inDomain (writers, n) then
130 if IM.inDomain (readers, n) then 150 if IM.inDomain (readers, n) then
131 ReadCookieWrite 151 ReadCookieWrite
132 else 152 else
133 ReadWrite 153 ReadWrite
134 else 154 else
135 ReadOnly), n), #2 d), 155 ReadOnly), n, IM.inDomain (pushers, n)), #2 d),
136 evs) 156 evs)
137 | DExport (Rpc _, n) => 157 | DExport (Rpc _, n, _) =>
138 ((DExport (Rpc (if IM.inDomain (writers, n) then 158 ((DExport (Rpc (if IM.inDomain (writers, n) then
139 if IM.inDomain (readers, n) then 159 if IM.inDomain (readers, n) then
140 ReadCookieWrite 160 ReadCookieWrite
141 else 161 else
142 ReadWrite 162 ReadWrite
143 else 163 else
144 ReadOnly), n), #2 d), 164 ReadOnly), n, IM.inDomain (pushers, n)), #2 d),
145 evs) 165 evs)
146 | _ => (d, evs) 166 | _ => (d, evs)
147 167
148 val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty) file 168 val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty, IM.empty) file
149 in 169 in
150 file 170 file
151 end 171 end
152 172
153 end 173 end