diff src/cjr_print.sml @ 143:4b9c2bd6157c

Almost ready to have a form work
author Adam Chlipala <adamc@hcoop.net>
date Sun, 20 Jul 2008 13:30:19 -0400
parents 133fa2d51bb4
children f0d3402184d1
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Jul 20 12:21:30 2008 -0400
+++ b/src/cjr_print.sml	Sun Jul 20 13:30:19 2008 -0400
@@ -208,13 +208,48 @@
                  newline]
         end
 
-fun unurlify (t, loc) =
+fun unurlify env (t, loc) =
     case t of
         TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)"
       | TFfi ("Basis", "float") => string "lw_unurlifyFloat(&request)"
       | TFfi ("Basis", "string") => string "lw_unurlifyString(ctx, &request)"
 
       | TRecord 0 => string "lw_unit_v"
+      | TRecord i =>
+        let
+            val xts = E.lookupStruct env i
+        in
+            box [string "({",
+                 newline,
+                 box (map (fn (x, t) =>
+                              box [p_typ env t,
+                                   space,
+                                   string x,
+                                   space,
+                                   string "=",
+                                   space,
+                                   unurlify env t,
+                                   string ";",
+                                   newline]) xts),
+                 string "struct",
+                 space,
+                 string "__lws_",
+                 string (Int.toString i),
+                 space,
+                 string "__lw_tmp",
+                 space,
+                 string "=",
+                 space,
+                 string "{",
+                 space,
+                 p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts,
+                 space,
+                 string "};",
+                 newline,
+                 string "__lw_tmp;",
+                 newline,
+                 string "})"]
+        end
 
       | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
               space)
@@ -241,7 +276,7 @@
                                                     space,
                                                     string "=",
                                                     space,
-                                                    unurlify t,
+                                                    unurlify env t,
                                                     string ";",
                                                     newline]) ts),
               p_enamed env n,