# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1215979885 14400
# Node ID 7fdc146b2bc2b3f264efe3c77b047213a3cf8f80
# Parent  7207f794b916b05839362b5ea93dc6d65963d11c
Proper handling of non-function-call links

diff -r 7207f794b916 -r 7fdc146b2bc2 include/types.h
--- a/include/types.h	Sun Jul 13 15:47:18 2008 -0400
+++ b/include/types.h	Sun Jul 13 16:11:25 2008 -0400
@@ -6,6 +6,8 @@
 };
 
 typedef struct __lws_0 lw_unit;
+typedef lw_unit lw_Basis_unit;
 
 typedef struct lw_context *lw_context;
 
+typedef lw_Basis_string lw_Basis_xhtml;
diff -r 7207f794b916 -r 7fdc146b2bc2 lib/basis.lig
--- a/lib/basis.lig	Sun Jul 13 15:47:18 2008 -0400
+++ b/lib/basis.lig	Sun Jul 13 16:11:25 2008 -0400
@@ -2,6 +2,8 @@
 type float
 type string
 
+type unit = {}
+
 
 con tag :: {Type} -> {Unit} -> {Unit} -> Type
 
@@ -31,4 +33,7 @@
 val i : tag [] [Body] [Body]
 val font : tag [Size = int, Face = string] [Body] [Body]
 
+val h1 : tag [] [Body] [Body]
+val li : tag [] [Body] [Body]
+
 val a : tag [Link = xhtml] [Body] [Body]
diff -r 7207f794b916 -r 7fdc146b2bc2 src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Jul 13 15:47:18 2008 -0400
+++ b/src/cjr_print.sml	Sun Jul 13 16:11:25 2008 -0400
@@ -181,6 +181,8 @@
          p_enamed env n,
          string "(ctx, lw_unit_v);",
          newline,
+         string "return;",
+         newline,
          string "}",
          newline]
 
diff -r 7207f794b916 -r 7fdc146b2bc2 src/tag.sml
--- 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)]
diff -r 7207f794b916 -r 7fdc146b2bc2 tests/links.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/links.lac	Sun Jul 13 16:11:25 2008 -0400
@@ -0,0 +1,24 @@
+val pC : xhtml = <html><body>
+        <h1>Page C</h1>
+</body></html>
+
+val pB : xhtml = <html><body>
+        <h1>Page B</h1>
+
+        <li> <a link={pC}>C</a></li>
+</body></html>
+
+val pA : xhtml = <html><body>
+        <h1>Page A</h1>
+
+        <li> <a link={pB}>B</a></li>
+        <li> <a link={pC}>C</a></li>
+</body></html>
+
+val main : unit -> xhtml = fn () => <html><body>
+        <h1>Main</h1>
+
+        <li> <a link={pA}>A</a></li>
+        <li> <a link={pB}>B</a></li>
+        <li> <a link={pC}>C</a></li>
+</body></html>
diff -r 7207f794b916 -r 7fdc146b2bc2 tests/linksF.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/linksF.lac	Sun Jul 13 16:11:25 2008 -0400
@@ -0,0 +1,24 @@
+val pC : unit -> xhtml = fn () => <html><body>
+        <h1>Page C</h1>
+</body></html>
+
+val pB : unit -> xhtml = fn () => <html><body>
+        <h1>Page B</h1>
+
+        <li> <a link={pC ()}>C</a></li>
+</body></html>
+
+val pA : unit -> xhtml = fn () => <html><body>
+        <h1>Page A</h1>
+
+        <li> <a link={pB ()}>B</a></li>
+        <li> <a link={pC ()}>C</a></li>
+</body></html>
+
+val main : unit -> xhtml = fn () => <html><body>
+        <h1>Main</h1>
+
+        <li> <a link={pA ()}>A</a></li>
+        <li> <a link={pB ()}>B</a></li>
+        <li> <a link={pC ()}>C</a></li>
+</body></html>