diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-09-17 16:35:11 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-17 16:35:11 -0400 |
| commit | ae83d3e44959b43c167ba83736055bf94ace3113 (patch) | |
| tree | 9d7a2e3bc1dff89e7399d555415ffae5c45c8b52 /src/core_util.sml | |
| parent | bf1a78ce9a5d60f8f4c40d0087f6caf90c10a796 (diff) | |
Basic tail recursion introduction seems to be working
Diffstat (limited to 'src/core_util.sml')
| -rw-r--r-- | src/core_util.sml | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/src/core_util.sml b/src/core_util.sml index 197f688a..4722eca1 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -539,6 +539,13 @@ fun compare ((e1, _), (e2, _)) = | (EServerCall _, _) => LESS | (_, EServerCall _) => GREATER + | (ETailCall (n1, es1, e1, _, _), ETailCall (n2, es2, e2, _, _)) => + join (Int.compare (n1, n2), + fn () => join (joinL compare (es1, es2), + fn () => compare (e1, e2))) + | (ETailCall _, _) => LESS + | (_, ETailCall _) => GREATER + | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2) | (EKAbs _, _) => LESS | (_, EKAbs _) => GREATER @@ -729,6 +736,17 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} = fn t2' => (EServerCall (n, es', e', t1', t2'), loc))))) + | ETailCall (n, es, e, t1, t2) => + S.bind2 (ListUtil.mapfold (mfe ctx) es, + fn es' => + S.bind2 (mfe ctx e, + fn e' => + S.bind2 (mfc ctx t1, + fn t1' => + S.map2 (mfc ctx t2, + fn t2' => + (ETailCall (n, es', e', t1', t2'), loc))))) + | EKAbs (x, e) => S.map2 (mfe (bind (ctx, RelK x)) e, fn e' => |