Mercurial > urweb

comparison src/core_util.sml @ 23:bfa2e9ae4df8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tree-shaking
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Jun 2008 17:15:09 -0400
parents 067029c748e9
children 4ab19c19665f
comparison
equal deleted inserted replaced
22:d8850cc06d24 23:bfa2e9ae4df8
162 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), 162 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
163 bind = bind} ctx c () of 163 bind = bind} ctx c () of
164 S.Continue (c, ()) => c 164 S.Continue (c, ()) => c
165 | S.Return _ => raise Fail "CoreUtil.Con.mapB: Impossible" 165 | S.Return _ => raise Fail "CoreUtil.Con.mapB: Impossible"
166 166
167 fun fold {kind, con} s c =
168 case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
169 con = fn c => fn s => S.Continue (c, con (c, s))} c s of
170 S.Continue (_, s) => s
171 | S.Return _ => raise Fail "CoreUtil.Con.fold: Impossible"
172
167 fun exists {kind, con} k = 173 fun exists {kind, con} k =
168 case mapfold {kind = fn k => fn () => 174 case mapfold {kind = fn k => fn () =>
169 if kind k then 175 if kind k then
170 S.Return () 176 S.Return ()
171 else 177 else
279 con = fn c => fn () => S.Continue (con c, ()), 285 con = fn c => fn () => S.Continue (con c, ()),
280 exp = fn e => fn () => S.Continue (exp e, ())} e () of 286 exp = fn e => fn () => S.Continue (exp e, ())} e () of
281 S.Return () => raise Fail "Core_util.Exp.map" 287 S.Return () => raise Fail "Core_util.Exp.map"
282 | S.Continue (e, ()) => e 288 | S.Continue (e, ()) => e
283 289
290 fun fold {kind, con, exp} s e =
291 case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
292 con = fn c => fn s => S.Continue (c, con (c, s)),
293 exp = fn e => fn s => S.Continue (e, exp (e, s))} e s of
294 S.Continue (_, s) => s
295 | S.Return _ => raise Fail "CoreUtil.Exp.fold: Impossible"
296
284 fun exists {kind, con, exp} k = 297 fun exists {kind, con, exp} k =
285 case mapfold {kind = fn k => fn () => 298 case mapfold {kind = fn k => fn () =>
286 if kind k then 299 if kind k then
287 S.Return () 300 S.Return ()
288 else 301 else
340 fn e' => 353 fn e' =>
341 (DVal (x, n, t', e'), loc))) 354 (DVal (x, n, t', e'), loc)))
342 in 355 in
343 mfd 356 mfd
344 end 357 end
358
359 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
360 mapfoldB {kind = fk,
361 con = fn () => fc,
362 exp = fn () => fe,
363 decl = fn () => fd,
364 bind = fn ((), _) => ()} ()
365
366 fun fold {kind, con, exp, decl} s d =
367 case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
368 con = fn c => fn s => S.Continue (c, con (c, s)),
369 exp = fn e => fn s => S.Continue (e, exp (e, s)),
370 decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
371 S.Continue (_, s) => s
372 | S.Return _ => raise Fail "CoreUtil.Decl.fold: Impossible"
345 373
346 end 374 end
347 375
348 structure File = struct 376 structure File = struct
349 377
372 end) 400 end)
373 in 401 in
374 mff 402 mff
375 end 403 end
376 404
405 fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
406 mapfoldB {kind = fk,
407 con = fn () => fc,
408 exp = fn () => fe,
409 decl = fn () => fd,
410 bind = fn ((), _) => ()} ()
411
377 fun mapB {kind, con, exp, decl, bind} ctx ds = 412 fun mapB {kind, con, exp, decl, bind} ctx ds =
378 case mapfoldB {kind = fn k => fn () => S.Continue (kind k, ()), 413 case mapfoldB {kind = fn k => fn () => S.Continue (kind k, ()),
379 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), 414 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
380 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()), 415 exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
381 decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()), 416 decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()),
382 bind = bind} ctx ds () of 417 bind = bind} ctx ds () of
383 S.Continue (ds, ()) => ds 418 S.Continue (ds, ()) => ds
384 | S.Return _ => raise Fail "CoreUtil.File.mapB: Impossible" 419 | S.Return _ => raise Fail "CoreUtil.File.mapB: Impossible"
385 420
386 end 421 fun fold {kind, con, exp, decl} s d =
387 422 case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
388 end 423 con = fn c => fn s => S.Continue (c, con (c, s)),
424 exp = fn e => fn s => S.Continue (e, exp (e, s)),
425 decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
426 S.Continue (_, s) => s
427 | S.Return _ => raise Fail "CoreUtil.File.fold: Impossible"
428
429 end
430
431 end