summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/unnest.sml18
-rw-r--r--tests/localfun.ur191
2 files changed, 209 insertions, 0 deletions
diff --git a/src/unnest.sml b/src/unnest.sml
index 52d729d7..17bfd39f 100644
--- a/src/unnest.sml
+++ b/src/unnest.sml
@@ -171,6 +171,8 @@ type state = {
fun kind (_, k, st) = (k, st)
+val basis = ref 0
+
fun exp ((ks, ts), e as old, st : state) =
case e of
ELet (eds, e, t) =>
@@ -186,6 +188,21 @@ fun exp ((ks, ts), e as old, st : state) =
liftExpInExp (~by) (length subs) e
end
+ fun functionInside (t : con) =
+ case #1 t of
+ TFun _ => true
+ | CApp ((CModProj (basis', [], "transaction"), _), _) => basis' = !basis
+ | _ => false
+
+ val eds = map (fn ed =>
+ case #1 ed of
+ EDVal ((PVar (x, _), _), t, e) =>
+ if functionInside t then
+ (EDValRec [(x, t, E.liftExpInExp 0 e)], #2 ed)
+ else
+ ed
+ | _ => ed) eds
+
val (eds, (ts, maxName, ds, subs, by)) =
ListUtil.foldlMapConcat
(fn (ed, (ts, maxName, ds, subs, by)) =>
@@ -422,6 +439,7 @@ fun unnest file =
in
([(DStr (x, n, sgn, str), loc)], st)
end
+ | DFfiStr ("Basis", n, _) => (basis := n; default ())
| DFfiStr _ => default ()
| DConstraint _ => default ()
| DExport _ => default ()
diff --git a/tests/localfun.ur b/tests/localfun.ur
new file mode 100644
index 00000000..1539abb0
--- /dev/null
+++ b/tests/localfun.ur
@@ -0,0 +1,191 @@
+fun boom s =
+ let
+ val bonk =
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s
+
+ val boonk = fn () =>
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s
+
+ fun booonk () =
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s;
+ debug s
+ in
+ bonk; bonk; boonk (); boonk (); booonk (); booonk ()
+ end
+
+fun main () : transaction page =
+ boom "test";
+ return <xml/>