summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-13 16:11:25 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-13 16:11:25 -0400
commit97cc749872a8baf53bb34ef1b536b82f6aa7f1c7 (patch)
treec297f92dea86916471d18bb3c987834935bfcce2 /src
parentf0b8905c1239b9b801c01cff28302cbd8d362f6e (diff)
Proper handling of non-function-call links
Diffstat (limited to 'src')
-rw-r--r--src/cjr_print.sml2
-rw-r--r--src/tag.sml41
2 files changed, 30 insertions, 13 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 980be593..b037137e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -181,6 +181,8 @@ fun p_page env (s, n) =
p_enamed env n,
string "(ctx, lw_unit_v);",
newline,
+ string "return;",
+ newline,
string "}",
newline]
diff --git a/src/tag.sml b/src/tag.sml
index 9004a55b..e451281a 100644
--- a/src/tag.sml
+++ b/src/tag.sml
@@ -171,20 +171,35 @@ fun tag file =
val (fnam, t, _, tag) = E.lookupENamed env f
val (args, result) = unravel t
- val (app, _) = foldl (fn (t, (app, n)) =>
- ((EApp (app, (ERel n, loc)), loc),
- n - 1))
- ((ENamed f, loc), length args - 1) args
- val body = (EWrite app, loc)
val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
- val (abs, _, t) = foldr (fn (t, (abs, n, rest)) =>
- ((EAbs ("x" ^ Int.toString n,
- t,
- rest,
- abs), loc),
- n + 1,
- (TFun (t, rest), loc)))
- (body, 0, unit) args
+
+ val (abs, t) =
+ case args of
+ [] =>
+ let
+ val body = (EWrite (ENamed f, loc), loc)
+ in
+ ((EAbs ("x", unit, unit, body), loc),
+ (TFun (unit, unit), loc))
+ end
+ | _ =>
+ let
+ val (app, _) = foldl (fn (t, (app, n)) =>
+ ((EApp (app, (ERel n, loc)), loc),
+ n - 1))
+ ((ENamed f, loc), length args - 1) args
+ val body = (EWrite app, loc)
+ val (abs, _, t) = foldr (fn (t, (abs, n, rest)) =>
+ ((EAbs ("x" ^ Int.toString n,
+ t,
+ rest,
+ abs), loc),
+ n + 1,
+ (TFun (t, rest), loc)))
+ (body, 0, unit) args
+ in
+ (abs, t)
+ end
in
[(DVal ("wrap_" ^ fnam, cn, t, abs, tag), loc),
(DExport cn, loc)]