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' =>