changeset 1073:b2311dfb3158

Initializers and setval
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Dec 2009 14:20:41 -0500
parents 9001966ae1c8
children d89f98f0b4bb
files CHANGELOG lib/ur/basis.urs src/checknest.sml src/cjr.sml src/cjr_env.sml src/cjr_print.sml src/cjrize.sml src/core.sml src/core_env.sml src/core_print.sml src/core_util.sml src/corify.sml src/elab.sml src/elab_env.sml src/elab_print.sml src/elab_util.sml src/elaborate.sml src/elisp/urweb-defs.el src/elisp/urweb-mode.el src/expl.sml src/expl_env.sml src/expl_print.sml src/explify.sml src/jscomp.sml src/mono.sml src/mono_env.sml src/mono_print.sml src/mono_reduce.sml src/mono_shake.sml src/mono_util.sml src/monoize.sml src/mysql.sml src/postgres.sml src/prepare.sml src/reduce.sml src/reduce_local.sml src/scriptcheck.sml src/settings.sig src/settings.sml src/shake.sml src/source.sml src/source_print.sml src/sqlite.sml src/unnest.sml src/urweb.grm src/urweb.lex tests/init.ur tests/init.urp
diffstat 48 files changed, 286 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGELOG	Sun Dec 13 13:00:55 2009 -0500
+++ b/CHANGELOG	Sun Dec 13 14:20:41 2009 -0500
@@ -6,6 +6,7 @@
 - More syntactic sugar for SQL
 - Typing of SQL queries no longer exposes which tables were used in joins but
   had none of their fields projected
+- Module-level initializers
 
 ========
 20091203
--- a/lib/ur/basis.urs	Sun Dec 13 13:00:55 2009 -0500
+++ b/lib/ur/basis.urs	Sun Dec 13 14:20:41 2009 -0500
@@ -523,6 +523,7 @@
 
 type sql_sequence
 val nextval : sql_sequence -> transaction int
+val setval : sql_sequence -> int -> transaction unit
 
 
 (** XML *)
--- a/src/checknest.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/checknest.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -87,6 +87,7 @@
                         SOME {id, ...} => IS.add (s, id)
                       | _ => s
                 end
+              | ESetval {seq, count} => IS.union (eu seq, eu count)
 
               | EUnurlify (e, _) => eu e
     in
@@ -144,6 +145,9 @@
               | ENextval {seq, prepared} =>
                 (ENextval {seq = ae seq,
                            prepared = prepared}, loc)
+              | ESetval {seq, count} =>
+                (ESetval {seq = ae seq,
+                          count = ae count}, loc)
 
               | EUnurlify (e, t) => (EUnurlify (ae e, t), loc)
     in
--- a/src/cjr.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/cjr.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -95,6 +95,7 @@
                    prepared : {id : int, dml : string} option }
        | ENextval of { seq : exp,
                        prepared : {id : int, query : string} option }
+       | ESetval of { seq : exp, count : exp }
        | EUnurlify of exp * typ
 
 withtype exp = exp' located
@@ -117,6 +118,8 @@
        | DCookie of string
        | DStyle of string
 
+       | DInitializer of exp
+
 withtype decl = decl' located
 
 datatype sidedness =
--- a/src/cjr_env.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/cjr_env.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -171,5 +171,6 @@
       | DJavaScript _ => env
       | DCookie _ => env
       | DStyle _ => env
+      | DInitializer _ => env
 
 end
--- a/src/cjr_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/cjr_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -1849,6 +1849,20 @@
              newline,
              string "})"]
 
+      | ESetval {seq, count} =>
+        box [string "({",
+             newline,
+
+             #setval (Settings.currentDbms ()) {loc = loc,
+                                                seqE = p_exp env seq,
+                                                count = p_exp env count},
+             newline,
+             newline,
+
+             string "uw_unit_v;",
+             newline,
+             string "})"]
+
       | EUnurlify (e, t) =>
         let
             fun getIt () =
@@ -2085,6 +2099,8 @@
                          space,
                          string "*/"]
 
+      | DInitializer _ => box []
+
 datatype 'a search =
          Found of 'a
        | NotFound
@@ -2716,6 +2732,8 @@
                       newline],
                  string "}",
                  newline]
+
+        val initializers = List.mapPartial (fn (DInitializer e, _) => SOME e | _ => NONE) ds
     in
         box [string "#include <stdio.h>",
              newline,
@@ -2849,7 +2867,10 @@
 
                       string "void uw_initializer(uw_context ctx) {",
                       newline,
-                      box [p_enamed env (!initialize),
+                      box [p_list_sep (box []) (fn e => box [p_exp env e,
+                                                             string ";",
+                                                             newline]) initializers,
+                           p_enamed env (!initialize),
                            string "(ctx, uw_unit_v);",
                            newline],
                       string "}",
--- a/src/cjrize.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/cjrize.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -468,6 +468,13 @@
         in
             ((L'.ENextval {seq = e, prepared = NONE}, loc), sm)
         end
+      | L.ESetval (e1, e2) =>
+        let
+            val (e1, sm) = cifyExp (e1, sm)
+            val (e2, sm) = cifyExp (e2, sm)
+        in
+            ((L'.ESetval {seq = e1, count = e2}, loc), sm)
+        end
 
       | L.EUnurlify (e, t) =>
         let
@@ -653,6 +660,16 @@
       | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm)
       | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm)
       | L.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm)
+      | L.DInitializer e =>
+        (case #1 e of
+             L.EAbs (_, _, _, e) =>
+             let
+                 val (e, sm) = cifyExp (e, sm)
+             in
+                 (SOME (L'.DInitializer e, loc), NONE, sm)
+             end
+           | _ => (ErrorMsg.errorAt loc "Initializer has not been fully determined";
+                   (NONE, NONE, sm)))
 
 fun cjrize ds =
     let
--- a/src/core.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/core.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -134,6 +134,7 @@
        | DDatabase of string
        | DCookie of string * int * con * string
        | DStyle of string * int * string
+       | DInitializer of exp
 
 withtype decl = decl' located
 
--- a/src/core_env.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/core_env.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -348,6 +348,7 @@
         in
             pushENamed env x n t NONE s
         end
+      | DInitializer _ => env
 
 fun patBinds env (p, loc) =
     case p of
--- a/src/core_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/core_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -611,6 +611,9 @@
                                  string "as",
                                  space,
                                  string s]
+      | DInitializer e => box [string "initializer",
+                               space,
+                               p_exp env e]
 
 fun p_file env file =
     let
--- a/src/core_util.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/core_util.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -971,6 +971,10 @@
                      fn c' =>
                         (DCookie (x, n, c', s), loc))
               | DStyle _ => S.return2 dAll
+              | DInitializer e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (DInitializer e', loc))
 
         and mfvi ctx (x, n, t, e, s) =
             S.bind2 (mfc ctx t,
@@ -1125,6 +1129,7 @@
                                         in
                                             bind (ctx, NamedE (x, n, t, NONE, s))
                                         end
+                                      | DInitializer _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
                                      fn ds' =>
@@ -1187,7 +1192,8 @@
                           | DView (_, n, _, _, _) => Int.max (n, count)
                           | DDatabase _ => count
                           | DCookie (_, n, _, _) => Int.max (n, count)
-                          | DStyle (_, n, _) => Int.max (n, count)) 0
+                          | DStyle (_, n, _) => Int.max (n, count)
+                          | DInitializer _ => count) 0
               
 end
 
--- a/src/corify.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/corify.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -1064,6 +1064,9 @@
             ([(L'.DStyle (x, n, s), loc)], st)
         end
 
+      | L.DInitializer e =>
+        ([(L'.DInitializer (corifyExp st e), loc)], st)
+
 and corifyStr mods ((str, _), st) =
     case str of
         L.StrConst ds =>
@@ -1120,7 +1123,8 @@
                              | L.DView (_, _, n', _, _) => Int.max (n, n')
                              | L.DDatabase _ => n
                              | L.DCookie (_, _, n', _) => Int.max (n, n')
-                             | L.DStyle (_, _, n') => Int.max (n, n'))
+                             | L.DStyle (_, _, n') => Int.max (n, n')
+                             | L.DInitializer _ => n)
                        0 ds
 
 and maxNameStr (str, _) =
--- a/src/elab.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elab.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -170,6 +170,7 @@
        | DDatabase of string
        | DCookie of int * string * int * con
        | DStyle of int * string * int
+       | DInitializer of exp
 
      and str' =
          StrConst of decl list
--- a/src/elab_env.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elab_env.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -1622,5 +1622,6 @@
         in
             pushENamedAs env x n t
         end
+      | DInitializer _ => env
 
 end
--- a/src/elab_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elab_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -799,6 +799,9 @@
       | DStyle (_, x, n) => box [string "style",
                                  space,
                                  p_named x n]
+      | DInitializer e => box [string "initializer",
+                               space,
+                               p_exp env e]
 
 and p_str env (str, _) =
     case str of
--- a/src/elab_util.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elab_util.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -853,7 +853,8 @@
                                                    bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "cookie"), loc),
                                                                                 c), loc)))
                                                  | DStyle (tn, x, n) =>
-                                                   bind (ctx, NamedE (x, (CModProj (n, [], "css_class"), loc))),
+                                                   bind (ctx, NamedE (x, (CModProj (n, [], "css_class"), loc)))
+                                                 | DInitializer _ => ctx,
                                                mfd ctx d)) ctx ds,
                      fn ds' => (StrConst ds', loc))
               | StrVar _ => S.return2 strAll
@@ -978,6 +979,10 @@
                         fn c' =>
                            (DCookie (tn, x, n, c'), loc))
               | DStyle _ => S.return2 dAll
+              | DInitializer e =>
+                S.map2 (mfe ctx e,
+                        fn e' =>
+                           (DInitializer e', loc))
 
         and mfvi ctx (x, n, c, e) =
             S.bind2 (mfc ctx c,
@@ -1120,6 +1125,7 @@
       | DDatabase _ => 0
       | DCookie (n1, _, n2, _) => Int.max (n1, n2)
       | DStyle (n1, _, n2) => Int.max (n1, n2)
+      | DInitializer _ => 0
 and maxNameStr (str, _) =
     case str of
         StrConst ds => maxName ds
--- a/src/elaborate.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elaborate.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -2548,6 +2548,7 @@
       | L'.DDatabase _ => []
       | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)]
       | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)]
+      | L'.DInitializer _ => []
 
 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
     ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
@@ -3668,6 +3669,15 @@
                 in
                     ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs))
                 end
+              | L.DInitializer e =>
+                let
+                    val (e', t, gs) = elabExp (env, denv) e
+                    val t' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc),
+                                       (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc)
+                in
+                    checkCon env e' t t';
+                    ([(L'.DInitializer e', loc)], (env, denv, gs))
+                end
 
         (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
     in
--- a/src/elisp/urweb-defs.el	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elisp/urweb-defs.el	Sun Dec 13 14:20:41 2009 -0500
@@ -108,7 +108,7 @@
                  "datatype" "type" "open" "include"
                  urweb-module-head-syms
                  "con" "map" "where" "extern" "constraint" "constraints"
-                 "table" "sequence" "class" "cookie")
+                 "table" "sequence" "class" "cookie" "initializer")
   "Symbols starting an sexp.")
 
 ;; (defconst urweb-not-arg-start-re
@@ -134,7 +134,8 @@
      (,urweb-=-starter-syms nil)
      (("case" "datatype" "if" "then" "else"
        "let" "open" "sig" "struct" "type" "val"
-       "con" "constraint" "table" "sequence" "class" "cookie")))))
+       "con" "constraint" "table" "sequence" "class" "cookie"
+       "initializer")))))
 
 (defconst urweb-starters-indent-after
   (urweb-syms-re "let" "in" "struct" "sig")
@@ -188,7 +189,8 @@
   (append urweb-module-head-syms
 	  '("datatype" "fun"
 	    "open" "type" "val" "and"
-	    "con" "constraint" "table" "sequence" "class" "cookie"))
+	    "con" "constraint" "table" "sequence" "class" "cookie"
+            "initializer"))
   "The starters of new expressions.")
 
 (defconst urweb-exptrail-syms
--- a/src/elisp/urweb-mode.el	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/elisp/urweb-mode.el	Sun Dec 13 14:20:41 2009 -0500
@@ -136,7 +136,7 @@
 	       "datatype" "else" "end" "extern" "fn" "map"
 	       "fun" "functor" "if" "include"
 	       "of" "open" "let" "in"
-	       "rec" "sequence" "sig" "signature" "cookie" "style"
+	       "rec" "sequence" "sig" "signature" "cookie" "style" "initializer"
 	       "struct" "structure" "table" "view" "then" "type" "val" "where"
 	       "with"
 
@@ -226,7 +226,7 @@
     ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
      (1 font-lock-keyword-face)
      (3 (amAttribute font-lock-type-def-face)))
-    ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
+    ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|initializer\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
      (1 font-lock-keyword-face)
      (3 (amAttribute font-lock-variable-name-face)))
     ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
--- a/src/expl.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/expl.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -147,6 +147,7 @@
        | DDatabase of string
        | DCookie of int * string * int * con
        | DStyle of int * string * int
+       | DInitializer of exp
 
      and str' =
          StrConst of decl list
--- a/src/expl_env.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/expl_env.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -343,6 +343,7 @@
         in
             pushENamed env x n t
         end
+      | DInitializer _ => env
 
 fun sgiBinds env (sgi, loc) =
     case sgi of
--- a/src/expl_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/expl_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -713,6 +713,9 @@
       | DStyle (_, x, n) => box [string "style",
                                  space,
                                  p_named x n]
+      | DInitializer e => box [string "initializer",
+                               space,
+                               p_exp env e]
 
 and p_str env (str, _) =
     case str of
--- a/src/explify.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/explify.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -195,6 +195,7 @@
       | L.DDatabase s => SOME (L'.DDatabase s, loc)
       | L.DCookie (nt, x, n, c) => SOME (L'.DCookie (nt, x, n, explifyCon c), loc)
       | L.DStyle (nt, x, n) => SOME (L'.DStyle (nt, x, n), loc)
+      | L.DInitializer e => SOME (L'.DInitializer (explifyExp e), loc)
 
 and explifyStr (str, loc) =
     case str of
--- a/src/jscomp.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/jscomp.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -868,6 +868,7 @@
                           | EQuery _ => unsupported "Query"
                           | EDml _ => unsupported "DML"
                           | ENextval _ => unsupported "Nextval"
+                          | ESetval _ => unsupported "Nextval"
                           | EUnurlify _ => unsupported "EUnurlify"
                           | EReturnBlob _ => unsupported "EUnurlify"
                           | ERedirect _ => unsupported "ERedirect"
@@ -1142,6 +1143,13 @@
                  in
                      ((ENextval e, loc), st)
                  end
+               | ESetval (e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((ESetval (e1, e2), loc), st)
+                 end
 
                | EUnurlify (e, t) =>
                  let
--- a/src/mono.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -106,6 +106,7 @@
                      initial : exp }
        | EDml of exp
        | ENextval of exp
+       | ESetval of exp * exp
 
        | EUnurlify of exp * typ
 
@@ -138,6 +139,8 @@
        | DCookie of string
        | DStyle of string
 
+       | DInitializer of exp
+
 withtype decl = decl' located
 
 type file = decl list
--- a/src/mono_env.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono_env.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -129,6 +129,7 @@
       | DJavaScript _ => env
       | DCookie _ => env
       | DStyle _ => env
+      | DInitializer _ => env
 
 fun patBinds env (p, loc) =
     case p of
--- a/src/mono_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -320,6 +320,12 @@
       | ENextval e => box [string "nextval(",
                            p_exp env e,
                            string ")"]
+      | ESetval (e1, e2) => box [string "setval(",
+                                 p_exp env e1,
+                                 string ",",
+                                 space,
+                                 p_exp env e2,
+                                 string ")"]
       | EUnurlify (e, _) => box [string "unurlify(",
                                  p_exp env e,
                                  string ")"]
@@ -485,6 +491,9 @@
       | DStyle s => box [string "style",
                          space,
                          string s]
+      | DInitializer e => box [string "initializer",
+                               space,
+                               p_exp env e]
 
                           
 fun p_file env file =
--- a/src/mono_reduce.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono_reduce.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -51,6 +51,7 @@
                               | EQuery _ => true
                               | EDml _ => true
                               | ENextval _ => true
+                              | ESetval _ => true
                               | EFfiApp (m, x, _) => Settings.isEffectful (m, x)
                               | EServerCall _ => true
                               | ERecv _ => true
@@ -75,6 +76,7 @@
       | EQuery _ => true
       | EDml _ => true
       | ENextval _ => true
+      | ESetval _ => true
       | EUnurlify _ => true
       | EAbs _ => false
 
@@ -448,6 +450,7 @@
 
                       | EDml e => summarize d e @ [WriteDb]
                       | ENextval e => summarize d e @ [WriteDb]
+                      | ESetval (e1, e2) => summarize d e1 @ summarize d e2 @ [WriteDb]
                       | EUnurlify (e, _) => summarize d e
                       | EJavaScript (_, e) => summarize d e
                       | ESignalReturn e => summarize d e
--- a/src/mono_shake.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono_shake.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -43,10 +43,22 @@
 
 fun shake file =
     let
-        val page_es = List.foldl
-                          (fn ((DExport (_, _, n, _, _), _), page_es) => n :: page_es
-                            | ((DDatabase {expunge = n1, initialize = n2, ...}, _), page_es) => n1 :: n2 :: page_es
-                            | (_, page_es) => page_es) [] file
+        val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) =>
+                                            case c of
+                                                TDatatype (n, _) => (IS.add (cs, n), es)
+                                              | _ => st,
+                                   exp = fn (e, st as (cs, es)) =>
+                                            case e of
+                                                ENamed n => (cs, IS.add (es, n))
+                                              | _ => st}
+
+        val (page_cs, page_es) =
+            List.foldl
+                (fn ((DExport (_, _, n, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
+                  | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) =>
+                    (page_cs, IS.addList (page_es, [n1, n2]))
+                  | ((DInitializer e, _), st) => usedVars st e
+                  | (_, st) => st) (IS.empty, IS.empty) file
 
         val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) =>
                                      (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef)
@@ -61,7 +73,8 @@
                                    | ((DDatabase _, _), acc) => acc
                                    | ((DJavaScript _, _), acc) => acc
                                    | ((DCookie _, _), acc) => acc
-                                   | ((DStyle _, _), acc) => acc)
+                                   | ((DStyle _, _), acc) => acc
+                                   | ((DInitializer _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
         fun typ (c, s) =
@@ -104,12 +117,18 @@
 
         and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s
 
-        val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)}
+        val s = {con = page_cs, exp = page_es}
 
-        val s = foldl (fn (n, s) =>
-                          case IM.find (edef, n) of
-                              NONE => raise Fail "Shake: Couldn't find 'val'"
-                            | SOME (t, e) => shakeExp s e) s page_es
+        val s = IS.foldl (fn (n, s) =>
+                             case IM.find (cdef, n) of
+                                 NONE => raise Fail "MonoShake: Couldn't find 'datatype'"
+                               | SOME xncs => foldl (fn ((_, _, SOME c), s) => shakeTyp s c
+                                                      | _ => s) s xncs) s page_cs
+
+        val s = IS.foldl (fn (n, s) =>
+                             case IM.find (edef, n) of
+                                 NONE => raise Fail "MonoShake: Couldn't find 'val'"
+                               | SOME (t, e) => shakeExp s e) s page_es
     in
         List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts
                       | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
@@ -121,7 +140,8 @@
                       | (DDatabase _, _) => true
                       | (DJavaScript _, _) => true
                       | (DCookie _, _) => true
-                      | (DStyle _, _) => true) file
+                      | (DStyle _, _) => true
+                      | (DInitializer _, _) => true) file
     end
 
 end
--- a/src/mono_util.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mono_util.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -340,6 +340,12 @@
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (ENextval e', loc))
+              | ESetval (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                     fn e1' =>
+                        S.map2 (mfe ctx e2,
+                             fn e2' =>
+                                (ESetval (e1', e2'), loc)))
               | EUnurlify (e, t) =>
                 S.bind2 (mfe ctx e,
                      fn e' =>
@@ -522,6 +528,10 @@
               | DJavaScript _ => S.return2 dAll
               | DCookie _ => S.return2 dAll
               | DStyle _ => S.return2 dAll
+              | DInitializer e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (DInitializer e', loc))
 
         and mfvi ctx (x, n, t, e, s) =
             S.bind2 (mft t,
@@ -608,6 +618,7 @@
                                       | DJavaScript _ => ctx
                                       | DCookie _ => ctx
                                       | DStyle _ => ctx
+                                      | DInitializer _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
                                      fn ds' =>
@@ -660,7 +671,8 @@
                           | DDatabase _ => count
                           | DJavaScript _ => count
                           | DCookie _ => count
-                          | DStyle _ => count) 0
+                          | DStyle _ => count
+                          | DInitializer _ => count) 0
 
 end
 
--- a/src/monoize.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/monoize.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -2475,6 +2475,13 @@
             in
                 ((L'.ENextval e, loc), fm)
             end
+          | L.EFfiApp ("Basis", "setval", [e1, e2]) =>
+            let
+                val (e1, fm) = monoExp (env, st, fm) e1
+                val (e2, fm) = monoExp (env, st, fm) e2
+            in
+                ((L'.ESetval (e1, e2), loc), fm)
+            end
 
           | L.EApp (
             (L.ECApp (
@@ -3471,6 +3478,14 @@
                       [(L'.DStyle s, loc),
                        (L'.DVal (x, n, t', e, s), loc)])
             end
+          | L.DInitializer e =>
+            let
+                val (e, fm) = monoExp (env, St.empty, fm) e
+            in
+                SOME (env,
+                      fm,
+                      [(L'.DInitializer e, loc)])
+            end
     end
 
 datatype expungable = Client | Channel
--- a/src/mysql.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/mysql.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -1503,6 +1503,8 @@
 
 fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called"
 
+fun setval _ = raise Fail "MySQL.setval called"
+
 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
                                               | #"\\" => "\\\\"
                                               | ch =>
@@ -1529,6 +1531,7 @@
                   dmlPrepared = dmlPrepared,
                   nextval = nextval,
                   nextvalPrepared = nextvalPrepared,
+                  setval = setval,
                   sqlifyString = sqlifyString,
                   p_cast = p_cast,
                   p_blank = p_blank,
--- a/src/postgres.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/postgres.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -867,6 +867,48 @@
                                                 string (String.toString query),
                                                 string "\""]}]
 
+fun setvalCommon {loc, query} =
+    box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
+         newline,
+         newline,
+
+         string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+         newline,
+         box [string "PQclear(res);",
+              newline,
+              string "uw_error(ctx, FATAL, \"",
+              string (ErrorMsg.spanToString loc),
+              string ": Query failed:\\n%s\\n%s\", ",
+              query,
+              string ", PQerrorMessage(conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "PQclear(res);",
+         newline]
+
+fun setval {loc, seqE, count} =
+    let
+        val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
+                         seqE,
+                         string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
+                         count,
+                         string "), \")\"))))"]
+    in
+        box [string "char *query = ",
+             query,
+             string ";",
+             newline,
+             string "PGconn *conn = uw_get_db(ctx);",
+             newline,
+             string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
+             newline,
+             newline,
+             setvalCommon {loc = loc, query = string "query"}]
+    end
+
 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
                                                | #"\\" => "\\\\"
                                                | ch =>
@@ -892,6 +934,7 @@
                   dmlPrepared = dmlPrepared,
                   nextval = nextval,
                   nextvalPrepared = nextvalPrepared,
+                  setval = setval,
                   sqlifyString = sqlifyString,
                   p_cast = p_cast,
                   p_blank = p_blank,
--- a/src/prepare.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/prepare.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -273,6 +273,14 @@
         else
             (e, st)
 
+      | ESetval {seq = e1, count = e2} =>
+        let
+            val (e1, st) = prepExp (e1, st)
+            val (e2, st) = prepExp (e2, st)
+        in
+            ((ESetval {seq = e1, count = e2}, loc), st)
+        end
+
       | EUnurlify (e, t) =>
         let
             val (e, st) = prepExp (e, st)
@@ -317,6 +325,12 @@
       | DJavaScript _ => (d, st)
       | DCookie _ => (d, st)
       | DStyle _ => (d, st)
+      | DInitializer e =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((DInitializer e, loc), st)
+        end
 
 fun prepare (ds, ps) =
     let
--- a/src/reduce.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/reduce.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -804,6 +804,15 @@
               | DDatabase _ => (d, st)
               | DCookie (s, n, c, s') => ((DCookie (s, n, con namedC [] c, s'), loc), st)
               | DStyle (s, n, s') => ((DStyle (s, n, s'), loc), st)
+              | DInitializer e =>
+                let
+                    val e = exp (namedC, namedE) [] e
+                in
+                    ((DInitializer e, loc),
+                     (polyC,
+                      namedC,
+                      namedE))
+                end
 
         val (file, _) = ListUtil.foldlMap doDecl (IS.empty, IM.empty, IM.empty) file
     in
--- a/src/reduce_local.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/reduce_local.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -251,6 +251,7 @@
               | DDatabase _ => d
               | DCookie _ => d
               | DStyle _ => d
+              | DInitializer e => (DInitializer (exp [] e), loc)
     in
         map doDecl file
     end
--- a/src/scriptcheck.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/scriptcheck.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -114,6 +114,7 @@
                                                               orelse hasClient initial
                       | EDml {dml, ...} => hasClient dml
                       | ENextval {seq, ...} => hasClient seq
+                      | ESetval {seq, count, ...} => hasClient seq orelse hasClient count
                       | EUnurlify (e, _) => hasClient e
             in
                 hasClient
--- a/src/settings.sig	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/settings.sig	Sun Dec 13 14:20:41 2009 -0500
@@ -147,6 +147,7 @@
                         inputs : sql_type list} -> Print.PD.pp_desc,
          nextval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, seqName : string option} -> Print.PD.pp_desc,
          nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc,
+         setval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, count : Print.PD.pp_desc} -> Print.PD.pp_desc,
          sqlifyString : string -> string,
          p_cast : string * sql_type -> string,
          p_blank : int * sql_type -> string (* Prepared statement input *),
--- a/src/settings.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/settings.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -79,6 +79,7 @@
 
 val effectfulBase = basis ["dml",
                            "nextval",
+                           "setval",
                            "set_cookie",
                            "clear_cookie",
                            "new_client_source",
@@ -120,6 +121,7 @@
                         "query",
                         "dml",
                         "nextval",
+                        "setval",
                         "channel",
                         "send"]
 val server = ref serverBase
@@ -355,6 +357,7 @@
                     inputs : sql_type list} -> Print.PD.pp_desc,
      nextval : {loc : ErrorMsg.span, seqName : string option, seqE : Print.PD.pp_desc} -> Print.PD.pp_desc,
      nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc,
+     setval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, count : Print.PD.pp_desc} -> Print.PD.pp_desc,
      sqlifyString : string -> string,
      p_cast : string * sql_type -> string,
      p_blank : int * sql_type -> string,
@@ -382,6 +385,7 @@
                   dmlPrepared = fn _ => Print.box [],
                   nextval = fn _ => Print.box [],
                   nextvalPrepared = fn _ => Print.box [],
+                  setval = fn _ => Print.box [],
                   sqlifyString = fn s => s,
                   p_cast = fn _ => "",
                   p_blank = fn _ => "",
--- a/src/shake.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/shake.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -79,6 +79,7 @@
                     in
                         (usedE, usedC)
                     end
+                  | ((DInitializer e, _), st) => usedVars st e
                   | (_, acc) => acc) (IS.empty, IS.empty) file
 
         val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
@@ -104,7 +105,8 @@
                                    | ((DCookie (_, n, c, _), _), (cdef, edef)) =>
                                      (cdef, IM.insert (edef, n, ([], c, dummye)))
                                    | ((DStyle (_, n, _), _), (cdef, edef)) =>
-                                     (cdef, IM.insert (edef, n, ([], dummyt, dummye))))
+                                     (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
+                                   | ((DInitializer _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
         fun kind (_, s) = s
@@ -183,7 +185,8 @@
                       | (DTable _, _) => true
                       | (DDatabase _, _) => true
                       | (DCookie _, _) => true
-                      | (DStyle _, _) => true) file
+                      | (DStyle _, _) => true
+                      | (DInitializer _, _) => true) file
     end
 
 end
--- a/src/source.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/source.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -167,6 +167,7 @@
        | DDatabase of string
        | DCookie of string * con
        | DStyle of string
+       | DInitializer of exp
 
      and str' =
          StrConst of decl list
--- a/src/source_print.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/source_print.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -662,6 +662,9 @@
       | DStyle x => box [string "style",
                          space,
                          string x]
+      | DInitializer e => box [string "initializer",
+                               space,
+                               p_exp e]
 
 and p_str (str, _) =
     case str of
--- a/src/sqlite.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/sqlite.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -757,6 +757,7 @@
          newline]
 
 fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
+fun setval _ = raise Fail "SQLite.setval called"
 
 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "''"
                                               | ch =>
@@ -783,6 +784,7 @@
                   dmlPrepared = dmlPrepared,
                   nextval = nextval,
                   nextvalPrepared = nextvalPrepared,
+                  setval = setval,
                   sqlifyString = sqlifyString,
                   p_cast = p_cast,
                   p_blank = p_blank,
--- a/src/unnest.sml	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/unnest.sml	Sun Dec 13 14:20:41 2009 -0500
@@ -422,6 +422,7 @@
                   | DDatabase _ => default ()
                   | DCookie _ => default ()
                   | DStyle _ => default ()
+                  | DInitializer _ => explore ()
             end
 
         and doStr (all as (str, loc), st) =
--- a/src/urweb.grm	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/urweb.grm	Sun Dec 13 14:20:41 2009 -0500
@@ -201,7 +201,7 @@
  | LET | IN
  | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL | SELECT1
  | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | VIEW
- | COOKIE | STYLE
+ | COOKIE | STYLE | INITIALIZER
  | CASE | IF | THEN | ELSE | ANDALSO | ORELSE
 
  | XML_BEGIN of string | XML_END | XML_BEGIN_END of string
@@ -479,6 +479,7 @@
                                          end)
        | COOKIE SYMBOL COLON cexp       ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))])
        | STYLE SYMBOL                   ([(DStyle SYMBOL, s (STYLEleft, SYMBOLright))])
+       | INITIALIZER eexp               ([(DInitializer eexp, s (INITIALIZERleft, eexpright))])
 
 dtype  : SYMBOL dargs EQ barOpt dcons   (SYMBOL, dargs, dcons)
 
--- a/src/urweb.lex	Sun Dec 13 13:00:55 2009 -0500
+++ b/src/urweb.lex	Sun Dec 13 14:20:41 2009 -0500
@@ -402,6 +402,7 @@
 <INITIAL> "class"     => (Tokens.CLASS (pos yypos, pos yypos + size yytext));
 <INITIAL> "cookie"    => (Tokens.COOKIE (pos yypos, pos yypos + size yytext));
 <INITIAL> "style"     => (Tokens.STYLE (pos yypos, pos yypos + size yytext));
+<INITIAL> "initializer" => (Tokens.INITIALIZER (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "Type"      => (Tokens.TYPE (pos yypos, pos yypos + size yytext));
 <INITIAL> "Name"      => (Tokens.NAME (pos yypos, pos yypos + size yytext));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/init.ur	Sun Dec 13 14:20:41 2009 -0500
@@ -0,0 +1,6 @@
+sequence seq
+table fred : {A : int, B : int}
+
+initializer
+    setval seq 1;
+    dml (INSERT INTO fred (A, B) VALUES (0, 1))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/init.urp	Sun Dec 13 14:20:41 2009 -0500
@@ -0,0 +1,5 @@
+debug
+database dbname=init
+sql init.sql
+
+init