diff src/cjr_print.sml @ 166:a991431b77eb

Start of unurlify for datatypes
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 14:28:44 -0400
parents e52dfb1e6b19
children 2be573fec9a6
line wrap: on
line diff
--- a/src/cjr_print.sml	Tue Jul 29 13:50:53 2008 -0400
+++ b/src/cjr_print.sml	Tue Jul 29 14:28:44 2008 -0400
@@ -53,7 +53,7 @@
 
 val debug = ref false
 
-val dummyTyp = (TNamed 0, ErrorMsg.dummySpan)
+val dummyTyp = (TDatatype 0, ErrorMsg.dummySpan)
 
 fun p_typ' par env (t, loc) =
     case t of
@@ -69,11 +69,11 @@
                           space,
                           string "__lws_",
                           string (Int.toString i)]
-      | TNamed n =>
+      | TDatatype n =>
         (box [string "struct",
               space,
-              string ("__lwt_" ^ #1 (E.lookupTNamed env n) ^ "_" ^ Int.toString n ^ "*")]
-         handle CjrEnv.UnboundNamed _ => string ("__lwt_UNBOUND__" ^ Int.toString n))
+              string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")]
+         handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
       | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
 
 and p_typ env = p_typ' false env
@@ -445,6 +445,58 @@
                          string "})"]
                 end
 
+              | TDatatype i =>
+                let
+                    val (x, xncs) = E.lookupDatatype env i
+
+                    fun doEm xncs =
+                        case xncs of
+                            [] => string "Uh oh"
+                          | (x, n, to) :: rest =>
+                            box [string "(!strcmp(request, \"",
+                                 string x,
+                                 string "\") ? ({",
+                                 newline,
+                                 string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
+                                 space,
+                                 string "__lw_tmp;",
+                                 newline,
+                                 string "__lw_tmp.tag",
+                                 space,
+                                 string "=",
+                                 space,
+                                 string ("__lwc_" ^ x ^ "_" ^ Int.toString n),
+                                 string ";",
+                                 newline,
+                                 string "request",
+                                 space,
+                                 string "+=",
+                                 space,
+                                 string (Int.toString (size x)),
+                                 string ";",
+                                 newline,
+                                 case to of
+                                     NONE => box []
+                                   | SOME t => box [string "__lw_tmp.data.",
+                                                    string x,
+                                                    space,
+                                                    string "=",
+                                                    space,
+                                                    unurlify t,
+                                                    string ";",
+                                                    newline],
+                                 string "__lw_tmp;",
+                                 newline,
+                                 string "})",
+                                 space,
+                                 string ":",
+                                 space,
+                                 doEm rest,
+                                 string ")"]
+                in
+                    doEm xncs
+                end
+
               | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
                       space)