changeset 200:5dbba661deab

Urlifying records
author Adam Chlipala <adamc@hcoop.net>
date Sat, 09 Aug 2008 20:08:29 -0400
parents c938fe391c84
children f2cac0dba9bf
files src/c/lacweb.c src/cjr_print.sml src/lacweb.grm src/monoize.sml tests/record_page.lac
diffstat 5 files changed, 43 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/src/c/lacweb.c	Sat Aug 09 19:46:12 2008 -0400
+++ b/src/c/lacweb.c	Sat Aug 09 20:08:29 2008 -0400
@@ -471,11 +471,11 @@
   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;
 }
--- a/src/cjr_print.sml	Sat Aug 09 19:46:12 2008 -0400
+++ b/src/cjr_print.sml	Sat Aug 09 20:08:29 2008 -0400
@@ -914,7 +914,8 @@
                          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 @@
                                  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_",
--- a/src/lacweb.grm	Sat Aug 09 19:46:12 2008 -0400
+++ b/src/lacweb.grm	Sat Aug 09 20:08:29 2008 -0400
@@ -89,6 +89,7 @@
  | 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 @@
 
 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 @@
        | 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 @@
                                                (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)
 
--- a/src/monoize.sml	Sat Aug 09 19:46:12 2008 -0400
+++ b/src/monoize.sml	Sat Aug 09 20:08:29 2008 -0400
@@ -216,7 +216,22 @@
               | _ =>
                 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/record_page.lac	Sat Aug 09 20:08:29 2008 -0400
@@ -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