comparison src/core_util.sml @ 1020:dfe34fad749d

RPC uses VM support for call/cc
author Adam Chlipala <adamc@hcoop.net>
date Sun, 25 Oct 2009 14:07:10 -0400
parents 2a50da66ffd8
children b2311dfb3158
comparison
equal deleted inserted replaced
1019:68ba074e260f 1020:dfe34fad749d
530 join (compare (x1, x2), 530 join (compare (x1, x2),
531 fn () => compare (e1, e2)) 531 fn () => compare (e1, e2))
532 | (ELet _, _) => LESS 532 | (ELet _, _) => LESS
533 | (_, ELet _) => GREATER 533 | (_, ELet _) => GREATER
534 534
535 | (EServerCall (n1, es1, e1, _, _), EServerCall (n2, es2, e2, _, _)) => 535 | (EServerCall (n1, es1, _), EServerCall (n2, es2, _)) =>
536 join (Int.compare (n1, n2), 536 join (Int.compare (n1, n2),
537 fn () => join (joinL compare (es1, es2), 537 fn () => joinL compare (es1, es2))
538 fn () => compare (e1, e2)))
539 | (EServerCall _, _) => LESS 538 | (EServerCall _, _) => LESS
540 | (_, EServerCall _) => GREATER 539 | (_, EServerCall _) => GREATER
541
542 | (ETailCall (n1, es1, e1, _, _), ETailCall (n2, es2, e2, _, _)) =>
543 join (Int.compare (n1, n2),
544 fn () => join (joinL compare (es1, es2),
545 fn () => compare (e1, e2)))
546 | (ETailCall _, _) => LESS
547 | (_, ETailCall _) => GREATER
548 540
549 | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2) 541 | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2)
550 | (EKAbs _, _) => LESS 542 | (EKAbs _, _) => LESS
551 | (_, EKAbs _) => GREATER 543 | (_, EKAbs _) => GREATER
552 544
723 fn e1' => 715 fn e1' =>
724 S.map2 (mfe (bind (ctx, RelE (x, t'))) e2, 716 S.map2 (mfe (bind (ctx, RelE (x, t'))) e2,
725 fn e2' => 717 fn e2' =>
726 (ELet (x, t', e1', e2'), loc)))) 718 (ELet (x, t', e1', e2'), loc))))
727 719
728 | EServerCall (n, es, e, t1, t2) => 720 | EServerCall (n, es, t) =>
729 S.bind2 (ListUtil.mapfold (mfe ctx) es, 721 S.bind2 (ListUtil.mapfold (mfe ctx) es,
730 fn es' => 722 fn es' =>
731 S.bind2 (mfe ctx e, 723 S.map2 (mfc ctx t,
732 fn e' => 724 fn t' =>
733 S.bind2 (mfc ctx t1, 725 (EServerCall (n, es', t'), loc)))
734 fn t1' =>
735 S.map2 (mfc ctx t2,
736 fn t2' =>
737 (EServerCall (n, es', e', t1', t2'), loc)))))
738
739 | ETailCall (n, es, e, t1, t2) =>
740 S.bind2 (ListUtil.mapfold (mfe ctx) es,
741 fn es' =>
742 S.bind2 (mfe ctx e,
743 fn e' =>
744 S.bind2 (mfc ctx t1,
745 fn t1' =>
746 S.map2 (mfc ctx t2,
747 fn t2' =>
748 (ETailCall (n, es', e', t1', t2'), loc)))))
749 726
750 | EKAbs (x, e) => 727 | EKAbs (x, e) =>
751 S.map2 (mfe (bind (ctx, RelK x)) e, 728 S.map2 (mfe (bind (ctx, RelK x)) e,
752 fn e' => 729 fn e' =>
753 (EKAbs (x, e'), loc)) 730 (EKAbs (x, e'), loc))