diff src/cjr_print.sml @ 704:70cbdcf5989b

UNIQUE constraints
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 12:24:31 -0400
parents 655bcc9b77e0
children d8217b4cb617
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Apr 05 16:17:32 2009 -0400
+++ b/src/cjr_print.sml	Tue Apr 07 12:24:31 2009 -0400
@@ -1435,7 +1435,7 @@
             val wontLeakAnything = notLeaky env false state
         in
             box [if wontLeakAnything then
-                     string "uw_begin_region(ctx), "
+                     string "(uw_begin_region(ctx), "
                  else
                      box [],
                  string "({",
@@ -1585,7 +1585,11 @@
                      box [],
                  string "acc;",
                  newline,
-                 string "})"]
+                 string "})",
+                 if wontLeakAnything then
+                     string ")"
+                 else
+                     box []]
         end
 
       | EDml {dml, prepared} =>
@@ -1937,10 +1941,19 @@
                  p_list_sep newline (p_fun env) vis,
                  newline]
         end
-      | DTable (x, _) => box [string "/* SQL table ",
-                              string x,
-                              string " */",
-                              newline]
+      | DTable (x, _, csts) => box [string "/* SQL table ",
+                                    string x,
+                                    space,
+                                    string "constraints",
+                                    space,
+                                    p_list (fn (x, v) => box [string x,
+                                                              space,
+                                                              string ":",
+                                                              space,
+                                                              string v]) csts,
+                                    space,
+                                    string " */",
+                                    newline]
       | DSequence x => box [string "/* SQL sequence ",
                             string x,
                             string " */",
@@ -2454,7 +2467,7 @@
 
         val pds' = map p_page ps
 
-        val tables = List.mapPartial (fn (DTable (s, xts), _) => SOME (s, xts)
+        val tables = List.mapPartial (fn (DTable (s, xts, _), _) => SOME (s, xts)
                                        | _ => NONE) ds
         val sequences = List.mapPartial (fn (DSequence s, _) => SOME s
                                           | _ => NONE) ds
@@ -2798,7 +2811,7 @@
                        (fn (dAll as (d, _), env) =>
                            let
                                val pp = case d of
-                                            DTable (s, xts) =>
+                                            DTable (s, xts, csts) =>
                                             box [string "CREATE TABLE ",
                                                  string s,
                                                  string "(",
@@ -2807,6 +2820,20 @@
                                                                  string (CharVector.map Char.toLower x),
                                                                  space,
                                                                  p_sqltype env (t, ErrorMsg.dummySpan)]) xts,
+                                                 case csts of
+                                                     [] => box []
+                                                   | _ => box [string ","],
+                                                 cut,
+                                                 p_list_sep (box [string ",", newline])
+                                                            (fn (x, c) =>
+                                                                box [string "CONSTRAINT",
+                                                                     space,
+                                                                     string s,
+                                                                     string "_",
+                                                                     string x,
+                                                                     space,
+                                                                     string c]) csts,
+                                                 newline,
                                                  string ");",
                                                  newline,
                                                  newline]