Mercurial > urweb
comparison src/mono_util.sml @ 100:f0f59e918cac
page declaration, up through monoize
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 10 Jul 2008 10:11:35 -0400 |
parents | 82aaa1c406d3 |
children | 5f04adf47f48 |
comparison
equal
deleted
inserted
replaced
99:5182f0c80d2e | 100:f0f59e918cac |
---|---|
203 S.bind2 (mft t, | 203 S.bind2 (mft t, |
204 fn t' => | 204 fn t' => |
205 S.map2 (mfe ctx e, | 205 S.map2 (mfe ctx e, |
206 fn e' => | 206 fn e' => |
207 (DVal (x, n, t', e'), loc))) | 207 (DVal (x, n, t', e'), loc))) |
208 | DPage (xts, e) => | |
209 S.bind2 (ListUtil.mapfold (fn (x, t) => | |
210 S.map2 (mft t, | |
211 fn t' => | |
212 (x, t'))) xts, | |
213 fn xts' => | |
214 S.map2 (mfe ctx e, | |
215 fn e' => | |
216 (DPage (xts', e'), loc))) | |
208 in | 217 in |
209 mfd | 218 mfd |
210 end | 219 end |
211 | 220 |
212 fun mapfold {typ = fc, exp = fe, decl = fd} = | 221 fun mapfold {typ = fc, exp = fe, decl = fd} = |
237 nil => S.return2 nil | 246 nil => S.return2 nil |
238 | d :: ds' => | 247 | d :: ds' => |
239 S.bind2 (mfd ctx d, | 248 S.bind2 (mfd ctx d, |
240 fn d' => | 249 fn d' => |
241 let | 250 let |
242 val b = | 251 val ctx' = |
243 case #1 d' of | 252 case #1 d' of |
244 DVal (x, n, t, e) => NamedE (x, n, t, SOME e) | 253 DVal (x, n, t, e) => bind (ctx, NamedE (x, n, t, SOME e)) |
245 val ctx' = bind (ctx, b) | 254 | DPage _ => ctx |
246 in | 255 in |
247 S.map2 (mff ctx' ds', | 256 S.map2 (mff ctx' ds', |
248 fn ds' => | 257 fn ds' => |
249 d' :: ds') | 258 d' :: ds') |
250 end) | 259 end) |