diff src/tag.sml @ 119:7fdc146b2bc2

Proper handling of non-function-call links
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 16:11:25 -0400
parents 94856a3b4752
children fd98dd10dce7
line wrap: on
line diff
--- a/src/tag.sml	Sun Jul 13 15:47:18 2008 -0400
+++ b/src/tag.sml	Sun Jul 13 16:11:25 2008 -0400
@@ -171,20 +171,35 @@
                                             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)]