Mercurial > urweb

comparison src/mono_util.sml @ 164:6847741e1f5f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Datatypes through monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 13:32:07 -0400
parents f0d3402184d1
children 25b169416ea8
comparison
equal deleted inserted replaced
163:80192edca30d 164:6847741e1f5f
256 fun mfd ctx d acc = 256 fun mfd ctx d acc =
257 S.bindP (mfd' ctx d acc, fd ctx) 257 S.bindP (mfd' ctx d acc, fd ctx)
258 258
259 and mfd' ctx (dAll as (d, loc)) = 259 and mfd' ctx (dAll as (d, loc)) =
260 case d of 260 case d of
261 DVal vi => 261 DDatatype (x, n, xncs) =>
262 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
263 case c of
264 NONE => S.return2 (x, n, c)
265 | SOME c =>
266 S.map2 (mft c,
267 fn c' => (x, n, SOME c'))) xncs,
268 fn xncs' =>
269 (DDatatype (x, n, xncs'), loc))
270 | DVal vi =>
262 S.map2 (mfvi ctx vi, 271 S.map2 (mfvi ctx vi,
263 fn vi' => 272 fn vi' =>
264 (DVal vi', loc)) 273 (DVal vi', loc))
265 | DValRec vis => 274 | DValRec vis =>
266 S.map2 (ListUtil.mapfold (mfvi ctx) vis, 275 S.map2 (ListUtil.mapfold (mfvi ctx) vis,
311 S.bind2 (mfd ctx d, 320 S.bind2 (mfd ctx d,
312 fn d' => 321 fn d' =>
313 let 322 let
314 val ctx' = 323 val ctx' =
315 case #1 d' of 324 case #1 d' of
316 DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s)) 325 DDatatype (x, n, xncs) =>
326 let
327 val ctx = bind (ctx, NamedT (x, n, NONE))
328 val t = (TNamed n, #2 d')
329 in
330 foldl (fn ((x, n, to), ctx) =>
331 let
332 val t = case to of
333 NONE => t
334 | SOME t' => (TFun (t', t), #2 d')
335 in
336 bind (ctx, NamedE (x, n, t, NONE, ""))
337 end)
338 ctx xncs
339 end
340 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
317 | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) => 341 | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) =>
318 bind (ctx, NamedE (x, n, t, SOME e, s))) ctx vis 342 bind (ctx, NamedE (x, n, t, SOME e, s))) ctx vis
319 | DExport _ => ctx 343 | DExport _ => ctx
320 in 344 in
321 S.map2 (mff ctx' ds', 345 S.map2 (mff ctx' ds',