comparison src/core_util.sml @ 954:2a50da66ffd8

Basic tail recursion introduction seems to be working
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Sep 2009 16:35:11 -0400
parents ed06e25c70ef
children dfe34fad749d
comparison
equal deleted inserted replaced
953:301530da2062 954:2a50da66ffd8
536 join (Int.compare (n1, n2), 536 join (Int.compare (n1, n2),
537 fn () => join (joinL compare (es1, es2), 537 fn () => join (joinL compare (es1, es2),
538 fn () => compare (e1, e2))) 538 fn () => compare (e1, e2)))
539 | (EServerCall _, _) => LESS 539 | (EServerCall _, _) => LESS
540 | (_, EServerCall _) => GREATER 540 | (_, 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
541 548
542 | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2) 549 | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2)
543 | (EKAbs _, _) => LESS 550 | (EKAbs _, _) => LESS
544 | (_, EKAbs _) => GREATER 551 | (_, EKAbs _) => GREATER
545 552
726 S.bind2 (mfc ctx t1, 733 S.bind2 (mfc ctx t1,
727 fn t1' => 734 fn t1' =>
728 S.map2 (mfc ctx t2, 735 S.map2 (mfc ctx t2,
729 fn t2' => 736 fn t2' =>
730 (EServerCall (n, es', e', t1', t2'), loc))))) 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)))))
731 749
732 | EKAbs (x, e) => 750 | EKAbs (x, e) =>
733 S.map2 (mfe (bind (ctx, RelK x)) e, 751 S.map2 (mfe (bind (ctx, RelK x)) e,
734 fn e' => 752 fn e' =>
735 (EKAbs (x, e'), loc)) 753 (EKAbs (x, e'), loc))