aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/c/lacweb.c4
-rw-r--r--src/cjr_print.sml5
-rw-r--r--src/lacweb.grm14
-rw-r--r--src/monoize.sml15
-rw-r--r--tests/record_page.lac10
5 files changed, 43 insertions, 5 deletions
diff --git a/src/c/lacweb.c b/src/c/lacweb.c
index e7cb381a..3d79e1a3 100644
--- a/src/c/lacweb.c
+++ b/src/c/lacweb.c
@@ -471,11 +471,11 @@ lw_Basis_string lw_Basis_unurlifyString(lw_context ctx, char **s) {
char *r, *s1, *s2;
int len, n;
- len = strlen(new_s);
+ len = strlen(*s);
lw_check_heap(ctx, len + 1);
r = ctx->heap_front;
- ctx->heap_front = lw_unurlifyString_to(ctx, ctx->heap_front, new_s);
+ ctx->heap_front = lw_unurlifyString_to(ctx, ctx->heap_front, *s);
*s = new_s;
return r;
}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index a9cc9ba5..227abf2e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -914,7 +914,8 @@ fun p_file env (ds, ps) =
string "+=",
space,
string (Int.toString (size has_arg)),
- string ", ",
+ string ", (request[0] == '/' ? ++request : NULL), ",
+ newline,
case #1 t of
TDatatype _ => unurlify t
@@ -990,6 +991,8 @@ fun p_file env (ds, ps) =
string (Int.toString (size x')),
string ";",
newline,
+ string "if (request[0] == '/') ++request;",
+ newline,
case to of
NONE => box []
| SOME t => box [string "tmp->data.lw_",
diff --git a/src/lacweb.grm b/src/lacweb.grm
index a206182b..f1cb5ce3 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -89,6 +89,7 @@ fun uppercaseFirst "" = ""
| cterm of con
| ctuple of con list
| ident of con
+ | idents of con list
| rcon of (con * con) list
| rconn of (con * con) list
| rcone of (con * con) list
@@ -324,7 +325,7 @@ rcone : ([])
ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
| INT (CName (Int64.toString INT), s (INTleft, INTright))
- | path (CVar path, s (pathleft, pathright))
+ | SYMBOL (CVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
eapps : eterm (eterm)
| eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright))
@@ -369,7 +370,13 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
| FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
| STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
- | path DOT ident (EField ((EVar path, s (pathleft, pathright)), ident), s (pathleft, identright))
+ | path DOT idents (let
+ val loc = s (pathleft, identsright)
+ in
+ foldl (fn (ident, e) =>
+ (EField (e, ident), loc))
+ (EVar path, s (pathleft, pathright)) idents
+ end)
| FOLD (EFold, s (FOLDleft, FOLDright))
| XML_BEGIN xml XML_END (xml)
@@ -377,6 +384,9 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
(EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))),
s (XML_BEGINleft, XML_ENDright))
+idents : ident ([ident])
+ | ident DOT idents (ident :: idents)
+
etuple : eexp COMMA eexp ([eexp1, eexp2])
| eexp COMMA etuple (eexp :: etuple)
diff --git a/src/monoize.sml b/src/monoize.sml
index 8d7fabb8..fe360d75 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -216,7 +216,22 @@ fun fooifyExp fk env =
| _ =>
case t of
L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm)
+
| L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm)
+ | L'.TRecord ((x, t) :: xts) =>
+ let
+ val (se, fm) = fooify fm ((L'.EField (e, x), loc), t)
+ in
+ foldl (fn ((x, t), (se, fm)) =>
+ let
+ val (se', fm) = fooify fm ((L'.EField (e, x), loc), t)
+ in
+ ((L'.EStrcat (se,
+ (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc),
+ se'), loc)), loc),
+ fm)
+ end) (se, fm) xts
+ end
| L'.TDatatype (i, ref (dk, _)) =>
let
diff --git a/tests/record_page.lac b/tests/record_page.lac
new file mode 100644
index 00000000..a54a9133
--- /dev/null
+++ b/tests/record_page.lac
@@ -0,0 +1,10 @@
+type t = {A : string, B : {C : string, D : string}}
+
+val page = fn x : t => <html><body>
+ {cdata x.A},{cdata x.B.C},{cdata x.B.D}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+ <li><a link={page {A = "A", B = {C = "B", D = "C"}}}>First</a></li>
+ <li><a link={page {A = "D", B = {C = "E", D = "F"}}}>Second</a></li>
+</body></html> \ No newline at end of file