Proper handling of non-function-call links

6 files changed, 85 insertions, 13 deletions

diff --git a/include/types.h b/include/types.h
index 2dfaad84..083f478a 100644
--- a/include/types.h
+++ b/include/types.h
@@ -6,6 +6,8 @@ struct __lws_0 {
 };
 
 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 --git a/lib/basis.lig b/lib/basis.lig
index dcf1713d..189b0350 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -2,6 +2,8 @@ type int
 type float
 type string
 
+type unit = {}
+
 
 con tag :: {Type} -> {Unit} -> {Unit} -> Type
 
@@ -31,4 +33,7 @@ val b : tag [] [Body] [Body]
 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 --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)]
diff --git a/tests/links.lac b/tests/links.lac
new file mode 100644
index 00000000..7a7b1e98
--- /dev/null
+++ b/tests/links.lac
@@ -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 --git a/tests/linksF.lac b/tests/linksF.lac
new file mode 100644
index 00000000..0bcfe1d1
--- /dev/null
+++ b/tests/linksF.lac
@@ -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>