Mercurial > urweb
comparison src/core_util.sml @ 1663:0577be31a435
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 07 Jan 2012 15:56:22 -0500 |
parents | b4480a56cab7 |
children | e15234fbb163 |
comparison
equal
deleted
inserted
replaced
1662:edf86cef0dba | 1663:0577be31a435 |
---|---|
466 | (_, EFfi _) => GREATER | 466 | (_, EFfi _) => GREATER |
467 | 467 |
468 | (EFfiApp (f1, x1, es1), EFfiApp (f2, x2, es2)) => | 468 | (EFfiApp (f1, x1, es1), EFfiApp (f2, x2, es2)) => |
469 join (String.compare (f1, f2), | 469 join (String.compare (f1, f2), |
470 fn () => join (String.compare (x1, x2), | 470 fn () => join (String.compare (x1, x2), |
471 fn () => joinL compare (es1, es2))) | 471 fn () => joinL (fn ((e1, _), (e2, _)) => compare (e1, e2))(es1, es2))) |
472 | (EFfiApp _, _) => LESS | 472 | (EFfiApp _, _) => LESS |
473 | (_, EFfiApp _) => GREATER | 473 | (_, EFfiApp _) => GREATER |
474 | 474 |
475 | (EApp (f1, x1), EApp (f2, x2)) => | 475 | (EApp (f1, x1), EApp (f2, x2)) => |
476 join (compare (f1, f2), | 476 join (compare (f1, f2), |
583 end | 583 end |
584 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'} | 584 val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'} |
585 | 585 |
586 fun mfe ctx e acc = | 586 fun mfe ctx e acc = |
587 S.bindP (mfe' ctx e acc, fe ctx) | 587 S.bindP (mfe' ctx e acc, fe ctx) |
588 | |
589 and mfet ctx (e, t) = | |
590 S.bind2 (mfe ctx e, | |
591 fn e' => | |
592 S.map2 (mfc ctx t, | |
593 fn t' => (e', t'))) | |
588 | 594 |
589 and mfe' ctx (eAll as (e, loc)) = | 595 and mfe' ctx (eAll as (e, loc)) = |
590 case e of | 596 case e of |
591 EPrim _ => S.return2 eAll | 597 EPrim _ => S.return2 eAll |
592 | ERel _ => S.return2 eAll | 598 | ERel _ => S.return2 eAll |
601 S.map2 (ListUtil.mapfold (mfc ctx) cs, | 607 S.map2 (ListUtil.mapfold (mfc ctx) cs, |
602 fn cs' => | 608 fn cs' => |
603 (ECon (dk, n, cs', SOME e'), loc))) | 609 (ECon (dk, n, cs', SOME e'), loc))) |
604 | EFfi _ => S.return2 eAll | 610 | EFfi _ => S.return2 eAll |
605 | EFfiApp (m, x, es) => | 611 | EFfiApp (m, x, es) => |
606 S.map2 (ListUtil.mapfold (mfe ctx) es, | 612 S.map2 (ListUtil.mapfold (mfet ctx) es, |
607 fn es' => | 613 fn es' => |
608 (EFfiApp (m, x, es'), loc)) | 614 (EFfiApp (m, x, es'), loc)) |
609 | EApp (e1, e2) => | 615 | EApp (e1, e2) => |
610 S.bind2 (mfe ctx e1, | 616 S.bind2 (mfe ctx e1, |
611 fn e1' => | 617 fn e1' => |