30 files changed, 1954 insertions, 0 deletions

diff --git a/demo/more/dbgrid.ur b/demo/more/dbgrid.ur
new file mode 100644
index 0000000..fc59353
--- /dev/null
+++ b/demo/more/dbgrid.ur
@@ -0,0 +1,430 @@
+con rawMeta = fn t :: Type =>
+                 {New : transaction t,
+                  Inj : sql_injectable t}
+
+con colMeta' = fn (row :: {Type}) (input :: Type) (filter :: Type) =>
+                  {Header : string,
+                   Project : $row -> transaction input,
+                   Update : $row -> input -> transaction ($row),
+                   Display : input -> xbody,
+                   Edit : input -> xbody,
+                   Validate : input -> signal bool,
+                   CreateFilter : transaction filter,
+                   DisplayFilter : filter -> xbody,
+                   Filter : filter -> $row -> signal bool,
+                   Sort : option ($row -> $row -> bool)}
+
+con colMeta = fn (row :: {Type}) (global_input_filter :: (Type * Type * Type)) =>
+                 {Initialize : transaction global_input_filter.1,
+                  Handlers : global_input_filter.1 -> colMeta' row global_input_filter.2 global_input_filter.3}
+
+con aggregateMeta = fn (row :: {Type}) (acc :: Type) =>
+                       {Initial : acc,
+                        Step : $row -> acc -> acc,
+                        Display : acc -> xbody}
+
+structure Direct = struct
+    con metaBase = fn actual_input_filter :: (Type * Type * Type) =>
+                  {Display : actual_input_filter.2 -> xbody,
+                   Edit : actual_input_filter.2 -> xbody,
+                   Initialize : actual_input_filter.1 -> transaction actual_input_filter.2,
+                   Parse : actual_input_filter.2 -> signal (option actual_input_filter.1),
+                   CreateFilter : transaction actual_input_filter.3,
+                   DisplayFilter : actual_input_filter.3 -> xbody,
+                   Filter : actual_input_filter.3 -> actual_input_filter.1 -> signal bool,
+                   Sort : actual_input_filter.1 -> actual_input_filter.1 -> bool}
+
+    datatype metaBoth actual input filter =
+             NonNull of metaBase (actual, input, filter) * metaBase (option actual, input, filter)
+           | Nullable of metaBase (actual, input, filter)
+
+    con meta = fn global_actual_input_filter =>
+                  {Initialize : transaction global_actual_input_filter.1,
+                   Handlers : global_actual_input_filter.1
+                              -> metaBoth global_actual_input_filter.2 global_actual_input_filter.3
+                                          global_actual_input_filter.4}
+
+    con editableState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4)
+    fun editable [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest)
+                                                                                     (editableState ts) =
+       let
+           fun doMr (mr : metaBase (ts.2, ts.3, ts.4)) : colMeta' ([nm = ts.2] ++ rest) ts.3 ts.4 =
+               {Header = name,
+                Project = fn r => mr.Initialize r.nm,
+                Update = fn r s =>
+                            vo <- current (mr.Parse s);
+                            return (case vo of
+                                        None => r
+                                      | Some v => r -- nm ++ {nm = v}),
+                Display = mr.Display,
+                Edit = mr.Edit,
+                Validate = fn s => vo <- mr.Parse s; return (Option.isSome vo),
+                CreateFilter = mr.CreateFilter,
+                DisplayFilter = mr.DisplayFilter,
+                Filter = fn i r => mr.Filter i r.nm,
+                Sort = Some (fn r1 r2 => mr.Sort r1.nm r2.nm)} 
+       in
+           {Initialize = m.Initialize,
+            Handlers = fn data => case m.Handlers data of
+                                      NonNull (mr, _) => doMr mr
+                                    | Nullable mr => doMr mr}
+       end
+        
+    con readOnlyState (ts :: (Type * Type * Type * Type)) = (ts.1, ts.3, ts.4)
+    fun readOnly [ts] [rest] [nm :: Name] [[nm] ~ rest] name (m : meta ts) : colMeta ([nm = ts.2] ++ rest)
+                                                                                     (readOnlyState ts) =
+       let
+           fun doMr mr = {Header = name,
+                          Project = fn r => mr.Initialize r.nm,
+                          Update = fn r _ => return r,
+                          Display = mr.Display,
+                          Edit = mr.Display,
+                          Validate = fn _ => return True,
+                          CreateFilter = mr.CreateFilter,
+                          DisplayFilter = mr.DisplayFilter,
+                          Filter = fn i r => mr.Filter i r.nm,
+                          Sort = Some (fn r1 r2 => mr.Sort r1.nm r2.nm)}
+       in
+           {Initialize = m.Initialize,
+            Handlers = fn data => case m.Handlers data of
+                                      NonNull (mr, _) => doMr mr
+                                    | Nullable mr => doMr mr}
+       end
+
+    con metaBasic = fn actual_input_filter :: (Type * Type * Type) =>
+                       {Display : actual_input_filter.2 -> xbody,
+                        Edit : source actual_input_filter.2 -> xbody,
+                        Initialize : actual_input_filter.1 -> actual_input_filter.2,
+                        InitializeNull : actual_input_filter.2,
+                        IsNull : actual_input_filter.2 -> bool,
+                        Parse : actual_input_filter.2 -> option actual_input_filter.1,
+                        CreateFilter : actual_input_filter.3,
+                        DisplayFilter : source actual_input_filter.3 -> xbody,
+                        Filter : actual_input_filter.3 -> actual_input_filter.1 -> bool,
+                        FilterIsNull : actual_input_filter.3 -> bool,
+                        Sort : actual_input_filter.1 -> actual_input_filter.1 -> bool}
+
+    con basicState = source
+    con basicFilter = source
+    fun basic [ts ::: (Type * Type * Type)] (m : metaBasic ts) : meta (unit, ts.1, basicState ts.2, basicFilter ts.3) =
+        {Initialize = return (),
+         Handlers = fn () => NonNull (
+                             {Display = fn s => <xml><dyn signal={v <- signal s; return (m.Display v)}/></xml>,
+                              Edit = m.Edit,
+                              Initialize = fn v => source (m.Initialize v),
+                              Parse = fn s => v <- signal s; return (m.Parse v),
+                              CreateFilter = source m.CreateFilter,
+                              DisplayFilter = m.DisplayFilter,
+                              Filter = fn f v => f <- signal f;
+                                          return (if m.FilterIsNull f then
+                                                      True
+                                                  else
+                                                      m.Filter f v),
+                              Sort = m.Sort},
+                             {Display = fn s => <xml><dyn signal={v <- signal s; return (m.Display v)}/></xml>,
+                              Edit = m.Edit,
+                              Initialize = fn v => source (case v of
+                                                       None => m.InitializeNull
+                                                     | Some v => m.Initialize v),
+                              Parse = fn s => v <- signal s;
+                                         return (if m.IsNull v then
+                                                     Some None
+                                                 else
+                                                     case m.Parse v of
+                                                         None => None
+                                                       | Some v' => Some (Some v')),
+                              CreateFilter = source m.CreateFilter,
+                              DisplayFilter = m.DisplayFilter,
+                              Filter = fn f v => f <- signal f;
+                                          return (if m.FilterIsNull f then
+                                                      True
+                                                  else
+                                                      case v of
+                                                          None => False
+                                                        | Some v => m.Filter f v),
+                              Sort = fn x y =>
+                                        case (x, y) of
+                                            (None, _) => True
+                                          | (Some x', Some y') => m.Sort x' y'
+                                          | _ => False})}
+
+    fun nullable [global] [actual] [input] [filter] (m : meta (global, actual, input, filter)) =
+        {Initialize = m.Initialize,
+         Handlers = fn d => case m.Handlers d of
+                                Nullable _ => error <xml>Don't stack calls to Direct.nullable!</xml>
+                              | NonNull (_, ho) => Nullable ho}
+
+    type intGlobal = unit
+    type intInput = basicState string
+    type intFilter = basicFilter string
+    val int : meta (intGlobal, int, intInput, intFilter) =
+        basic {Display = fn s => <xml>{[s]}</xml>,
+               Edit = fn s => <xml><ctextbox size={5} source={s}/></xml>,
+               Initialize = fn n => show n,
+               InitializeNull = "",
+               IsNull = eq "",
+               Parse = fn v => read v,
+               CreateFilter = "",
+               DisplayFilter = fn s => <xml><ctextbox size={5} source={s}/></xml> : xbody,
+               Filter = fn s n =>
+                           case read s of
+                               None => True
+                             | Some n' => n' = n,
+               FilterIsNull = eq "",
+               Sort = le}
+
+    type stringGlobal = unit
+    type stringInput = basicState string
+    type stringFilter = basicFilter string
+    val string : meta (stringGlobal, string, stringInput, stringFilter) =
+        basic {Display = fn s => <xml>{[s]}</xml>,
+               Edit = fn s => <xml><ctextbox source={s}/></xml>,
+               Initialize = fn s => s,
+               InitializeNull = "",
+               IsNull = eq "",
+               Parse = fn s => Some s,
+               CreateFilter = "",
+               DisplayFilter = fn s => <xml><ctextbox source={s}/></xml> : xbody,
+               Filter = fn s n =>
+                           case read s of
+                               None => True
+                             | Some n' => n' = n,
+               FilterIsNull = eq "",
+               Sort = le}
+
+    type boolGlobal = unit
+    type boolInput = basicState bool
+    type boolFilter = basicFilter string
+    val bool : meta (boolGlobal, bool, boolInput, boolFilter) =
+        basic {Display = fn b => <xml>{[b]}</xml>,
+               Edit = fn s => <xml><ccheckbox source={s}/></xml>,
+               Initialize = fn b => b,
+               InitializeNull = False,
+               IsNull = fn _ => False,
+               Parse = fn b => Some b,
+               CreateFilter = "",
+               DisplayFilter = fn s => <xml><cselect source={s}>
+                 <coption/>
+                 <coption value="0">False</coption>
+                 <coption value="1">True</coption>
+               </cselect></xml> : xbody,
+               Filter = fn s b =>
+                           case s of
+                               "0" => b = False
+                             | "1" => b = True
+                             | _ => True,
+               FilterIsNull = eq "",
+               Sort = le}
+
+    functor Foreign (M : sig
+                         con row :: {Type}
+                         con t :: Type
+                         val show_t : show t
+                         val read_t : read t
+                         val eq_t : eq t
+                         val ord_t : ord t
+                         val inj_t : sql_injectable t
+                         con nm :: Name
+                         constraint [nm] ~ row
+                         table tab : ([nm = t] ++ row)
+                         val render : $([nm = t] ++ row) -> string
+                     end) = struct
+        open M
+
+        type global = list (t * string)
+        type input = source string * option (t * $row)
+        type filter = source string
+
+        val getChoices = List.mapQuery (SELECT * FROM tab AS T)
+                                       (fn r => (r.T.nm, render r.T))
+
+        fun getChoice k =
+            r <- oneRow (SELECT T.{{row}} FROM tab AS T WHERE T.{nm} = {[k]});
+            return r.T
+
+        val meta : meta (global, M.t, input, filter) =
+            {Initialize = getChoices,
+             Handlers = fn choices =>
+                           NonNull (
+                           {Display = fn (_, kr) => case kr of
+                                                          None => error <xml>Unexpected Foreign null</xml>
+                                                        | Some (k, r) => <xml>{[render ({nm = k} ++ r)]}</xml>,
+                            Edit = fn (s, kr) => 
+                                      <xml><cselect source={s}>
+                                        {List.mapX (fn (k', rend) =>
+                                                       <xml><coption value={show k'} selected={case kr of
+                                                                                                   None => False
+                                                                                                 | Some (k, _) =>
+                                                                                                   k' = k}>{[rend]}</coption>
+                                                       </xml>)
+                                                   choices}
+                                      </cselect></xml>,
+                            Initialize = fn k => s <- source (show k);
+                                            r <- rpc (getChoice k);
+                                            return (s, Some (k, r)),
+                            Parse = fn (s, _) => k <- signal s; return (read k : option t),
+                            CreateFilter = source "",
+                            DisplayFilter = fn s => 
+                                               <xml><cselect source={s}>
+                                                 <coption/>
+                                                 {List.mapX (fn (k, rend) =>
+                                                                <xml><coption value={show k}>{[rend]}</coption></xml>)
+                                                            choices}
+                                               </cselect></xml> : xbody,
+                            Filter = fn s k => s <- signal s;
+                                        return (case read s : option t of
+                                                    None => True
+                                                  | Some k' => k' = k),
+                            Sort = le},
+                           {Display = fn (_, kr) => case kr of
+                                                          None => <xml>NULL</xml>
+                                                        | Some (k, r) => <xml>{[render ({nm = k} ++ r)]}</xml>,
+                            Edit = fn (s, kr) => 
+                                      <xml><cselect source={s}>
+                                        <coption value="" selected={case kr of
+                                                                        None => True
+                                                                      | _ => False}>NULL</coption>
+                                        {List.mapX (fn (k', rend) =>
+                                                       <xml><coption value={show k'} selected={case kr of
+                                                                                                   None => False
+                                                                                                 | Some (k, _) =>
+                                                                                                   k' = k}>{[rend]}</coption>
+                                                       </xml>)
+                                                   choices}
+                                      </cselect></xml>,
+                            Initialize = fn k => case k of
+                                                     None =>
+                                                     s <- source "";
+                                                     return (s, None)
+                                                   | Some k =>
+                                                     s <- source (show k);
+                                                     r <- rpc (getChoice k);
+                                                     return (s, Some (k, r)),
+                            Parse = fn (s, _) => ks <- signal s;
+                                       return (case ks of
+                                                   "" => Some None
+                                                 | _ => case read ks : option t of
+                                                            None => None
+                                                          | Some k => Some (Some k)),
+                            CreateFilter = source "",
+                            DisplayFilter = fn s => 
+                                               <xml><cselect source={s}>
+                                                 <coption/>
+                                                 <coption value="0">NULL</coption>
+                                                 {List.mapX (fn (k, rend) =>
+                                                                <xml><coption value={"1" ^ show k}>{[rend]}</coption>
+                                                                </xml>)
+                                                            choices}
+                                               </cselect></xml> : xbody,
+                            Filter = fn s ko => s <- signal s;
+                                        return (case s of
+                                                    "" => True
+                                                  | "0" => ko = None
+                                                  | _ =>
+                                                    case read (String.substring s {Start = 1,
+                                                                                   Len = String.length s - 1})
+                                                         : option t of
+                                                        None => True
+                                                      | Some k => ko = Some k),
+                            Sort = le})}
+    end
+end
+
+con computedState = (unit, xbody, unit)
+fun computed [row] [t] (_ : show t) name (f : $row -> t) : colMeta row computedState =
+    {Initialize = return (),
+     Handlers = fn () => {Header = name,
+                          Project = fn r => return <xml>{[f r]}</xml>,
+                          Update = fn r _ => return r,
+                          Display = fn x => x,
+                          Edit = fn _ => <xml>...</xml>,
+                          Validate = fn _ => return True,
+                          CreateFilter = return (),
+                          DisplayFilter = fn _ => <xml/>,
+                          Filter = fn _ _ => return True,
+                          Sort = None}}
+fun computedHtml [row] name (f : $row -> xbody) : colMeta row computedState =
+    {Initialize = return (),
+     Handlers = fn () => {Header = name,
+                          Project = fn r => return (f r),
+                          Update = fn r _ => return r,
+                          Display = fn x => x,
+                          Edit = fn _ => <xml>...</xml>,
+                          Validate = fn _ => return True,
+                          CreateFilter = return (),
+                          DisplayFilter = fn _ => <xml/>,
+                          Filter = fn _ _ => return True,
+                          Sort = None}}
+
+functor Make(M : sig
+                 con key :: {Type}
+                 con row :: {Type}
+                 constraint key ~ row
+                 table tab : (key ++ row)
+
+                 val raw : $(map rawMeta (key ++ row))
+
+                 con cols :: {(Type * Type * Type)}
+                 val cols : $(map (colMeta (key ++ row)) cols)
+
+                 val keyFolder : folder key
+                 val rowFolder : folder row
+                 val colsFolder : folder cols
+
+                 con aggregates :: {Type}
+                 val aggregates : $(map (aggregateMeta (key ++ row)) aggregates)
+                 val aggFolder : folder aggregates
+
+                 val pageLength : option int
+             end) = struct
+    open Grid.Make(struct
+                       fun keyOf r = r --- M.row
+
+                       val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) []
+
+                       val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder
+
+                       fun ensql [env] (r : $(M.key ++ M.row)) =
+                           @map2 [rawMeta] [ident] [sql_exp env [] []]
+                            (fn [t] meta v => @sql_inject meta.Inj v)
+                            wholeRow M.raw r
+
+                       val new =
+                           row <- @Monad.mapR _ [rawMeta] [ident]
+                                   (fn [nm :: Name] [t :: Type] meta => meta.New)
+                                   wholeRow M.raw;
+                           dml (insert M.tab (ensql row));
+                           return row
+
+                       fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool =
+                         @foldR2 [rawMeta] [ident]
+                          [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool]
+                          (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
+                                           (meta : rawMeta t) (v : t)
+                                           (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool)
+                                           [rest :: {Type}] [rest ~ [nm = t] ++ key] =>
+                              (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest]}))
+                          (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE))
+                          M.keyFolder (M.raw --- map rawMeta M.row) r
+                          [_] !
+
+                       fun save key row =
+                           dml (update [M.key ++ M.row]
+                                       (ensql row)
+                                       M.tab
+                                       (selector key))
+
+                       fun delete key =
+                           dml (Basis.delete M.tab (selector key))
+
+                       val cols = M.cols
+
+                       val folder = M.colsFolder
+
+                       val aggregates = M.aggregates
+
+                       val aggFolder = M.aggFolder
+
+                       val pageLength = M.pageLength
+                   end)
+end
diff --git a/demo/more/dbgrid.urs b/demo/more/dbgrid.urs
new file mode 100644
index 0000000..7dfd3db
--- /dev/null
+++ b/demo/more/dbgrid.urs
@@ -0,0 +1,132 @@
+con rawMeta = fn t :: Type =>
+                 {New : transaction t,
+                  Inj : sql_injectable t}
+
+con colMeta' = fn (row :: {Type}) (input :: Type) (filter :: Type) =>
+                  {Header : string,
+                   Project : $row -> transaction input,
+                   Update : $row -> input -> transaction ($row),
+                   Display : input -> xbody,
+                   Edit : input -> xbody,
+                   Validate : input -> signal bool,
+                   CreateFilter : transaction filter,
+                   DisplayFilter : filter -> xbody,
+                   Filter : filter -> $row -> signal bool,
+                   Sort : option ($row -> $row -> bool)}
+
+con colMeta = fn (row :: {Type}) (global_input_filter :: (Type * Type * Type)) =>
+                 {Initialize : transaction global_input_filter.1,
+                  Handlers : global_input_filter.1 -> colMeta' row global_input_filter.2 global_input_filter.3}
+
+con aggregateMeta = fn (row :: {Type}) (acc :: Type) =>
+                       {Initial : acc,
+                        Step : $row -> acc -> acc,
+                        Display : acc -> xbody}
+
+structure Direct : sig
+    con metaBase = fn actual_input_filter :: (Type * Type * Type) =>
+                  {Display : actual_input_filter.2 -> xbody,
+                   Edit : actual_input_filter.2 -> xbody,
+                   Initialize : actual_input_filter.1 -> transaction actual_input_filter.2,
+                   Parse : actual_input_filter.2 -> signal (option actual_input_filter.1),
+                   CreateFilter : transaction actual_input_filter.3,
+                   DisplayFilter : actual_input_filter.3 -> xbody,
+                   Filter : actual_input_filter.3 -> actual_input_filter.1 -> signal bool,
+                   Sort : actual_input_filter.1 -> actual_input_filter.1 -> bool}
+
+    datatype metaBoth actual input filter =
+             NonNull of metaBase (actual, input, filter) * metaBase (option actual, input, filter)
+           | Nullable of metaBase (actual, input, filter)
+
+    con meta = fn global_actual_input_filter :: (Type * Type * Type * Type) =>
+                  {Initialize : transaction global_actual_input_filter.1,
+                   Handlers : global_actual_input_filter.1
+                              -> metaBoth global_actual_input_filter.2 global_actual_input_filter.3
+                                          global_actual_input_filter.4}
+
+    con editableState :: (Type * Type * Type * Type) -> (Type * Type * Type)
+    val editable : ts ::: (Type * Type * Type * Type) -> rest ::: {Type}
+                   -> nm :: Name -> [[nm] ~ rest] => string -> meta ts
+                                                     -> colMeta ([nm = ts.2] ++ rest)
+                                                                (editableState ts)
+
+    con readOnlyState :: (Type * Type * Type * Type) -> (Type * Type * Type)
+    val readOnly : ts ::: (Type * Type * Type * Type) -> rest ::: {Type}
+                   -> nm :: Name -> [[nm] ~ rest] => string -> meta ts
+                                                     -> colMeta ([nm = ts.2] ++ rest)
+                                                                (readOnlyState ts)
+
+    val nullable : global ::: Type -> actual ::: Type -> input ::: Type -> filter ::: Type
+                   -> meta (global, actual, input, filter)
+                   -> meta (global, option actual, input, filter)
+
+    type intGlobal
+    type intInput
+    type intFilter
+    val int : meta (intGlobal, int, intInput, intFilter)
+
+    type stringGlobal
+    type stringInput
+    type stringFilter
+    val string : meta (stringGlobal, string, stringInput, stringFilter)
+
+    type boolGlobal
+    type boolInput
+    type boolFilter
+    val bool : meta (boolGlobal, bool, boolInput, boolFilter)
+
+    functor Foreign (M : sig
+                         con row :: {Type}
+                         con t :: Type
+                         val show_t : show t
+                         val read_t : read t
+                         val eq_t : eq t
+                         val ord_t : ord t
+                         val inj_t : sql_injectable t
+                         con nm :: Name
+                         constraint [nm] ~ row
+                         table tab : ([nm = t] ++ row)
+                         val render : $([nm = t] ++ row) -> string
+                     end) : sig
+        type global
+        type input
+        type filter
+        val meta : meta (global, M.t, input, filter)
+    end
+end
+
+con computedState :: (Type * Type * Type)
+val computed : row ::: {Type} -> t ::: Type -> show t
+               -> string -> ($row -> t) -> colMeta row computedState
+val computedHtml : row ::: {Type} -> string -> ($row -> xbody) -> colMeta row computedState
+
+functor Make(M : sig
+                 con key :: {Type}
+                 con row :: {Type}
+                 constraint key ~ row
+                 table tab : (key ++ row)
+
+                 val raw : $(map rawMeta (key ++ row))
+
+                 con cols :: {(Type * Type * Type)}
+                 val cols : $(map (colMeta (key ++ row)) cols)
+
+                 val keyFolder : folder key
+                 val rowFolder : folder row
+                 val colsFolder : folder cols
+
+                 con aggregates :: {Type}
+                 val aggregates : $(map (aggregateMeta (key ++ row)) aggregates)
+                 val aggFolder : folder aggregates
+
+                 val pageLength : option int
+             end) : sig
+    type grid
+
+    val grid : transaction grid
+    val sync : grid -> transaction unit
+    val render : grid -> xbody
+
+    val showSelection : grid -> source bool
+    val selection : grid -> signal (list ($(M.key ++ M.row)))
+end
diff --git a/demo/more/dlist.ur b/demo/more/dlist.ur
new file mode 100644
index 0000000..a5af8d2
--- /dev/null
+++ b/demo/more/dlist.ur
@@ -0,0 +1,303 @@
+datatype dlist'' t =
+         Nil
+       | Cons of t * source (dlist'' t)
+
+datatype dlist' t =
+         Empty
+       | Nonempty of { Head : dlist'' t, Tail : source (source (dlist'' t)) }
+
+con dlist t = source (dlist' t)
+
+type position = transaction unit
+
+fun headPos [t] (dl : dlist t) =
+    dl' <- get dl;
+    case dl' of
+        Nonempty { Head = Cons (_, tl), Tail = tl' } =>
+        cur <- get tl;
+        set dl (case cur of
+                    Nil => Empty
+                  | _ => Nonempty {Head = cur, Tail = tl'})
+      | _ => return ()
+
+fun tailPos [t] (cur : source (dlist'' t)) new tail =
+    new' <- get new;
+    set cur new';
+
+    case new' of
+        Nil => set tail cur
+      | _ => return ()
+
+val create [t] = source Empty
+
+fun clear [t] (s : dlist t) = set s Empty
+
+fun append [t] dl v =
+    dl' <- get dl;
+    case dl' of
+        Empty =>
+        tl <- source Nil;
+        tl' <- source tl;
+        set dl (Nonempty {Head = Cons (v, tl), Tail = tl'});
+        return (headPos dl)
+                
+      | Nonempty {Tail = tl, ...} =>
+        cur <- get tl;
+        new <- source Nil;
+        set cur (Cons (v, new));
+        set tl new;
+        return (tailPos cur new tl)
+
+fun replace [t] dl ls =
+    case ls of
+        [] => set dl Empty
+      | x :: ls =>
+        tl <- source Nil;
+        let
+            fun build ls acc =
+                case ls of
+                    [] => return acc
+                  | x :: ls =>
+                    this <- source (Cons (x, acc));
+                    build ls this
+        in
+            hd <- build (List.rev ls) tl;
+            tlS <- source tl;
+            set dl (Nonempty {Head = Cons (x, hd), Tail = tlS})
+        end
+
+fun renderDyn [ctx] [ctx ~ [Dyn]] [t] (f : t -> position -> xml (ctx ++ [Dyn]) [] []) filter pos len dl = <xml>
+  <dyn signal={dl' <- signal dl;
+               case dl' of
+                   Empty => return <xml/>
+                 | Nonempty {Head = hd, Tail = tlTop} => 
+                   let
+                       fun render' prev dl'' len =
+                           case len of
+                               Some 0 => <xml/>
+                             | _ =>
+                               case dl'' of
+                                   Nil => <xml/>
+                                 | Cons (v, tl) =>
+                                   let
+                                       val pos = case prev of
+                                                     None => headPos dl
+                                                   | Some prev => tailPos prev tl tlTop
+                                   in
+                                       <xml>
+                                         <dyn signal={b <- filter v;
+                                                      return <xml>
+                                                        {if b then
+                                                             f v pos
+                                                         else
+                                                             <xml/>}
+                                                        <dyn signal={tl' <- signal tl;
+                                                                     return (render' (Some tl) tl'
+                                                                                     (if b then
+                                                                                          Option.mp (fn n => n - 1) len
+                                                                                      else
+                                                                                          len))}/>
+                                                      </xml>}/>
+                                       </xml>
+                                   end
+
+                       fun skip pos hd =
+                           case pos of
+                               0 => return hd
+                             | _ =>
+                               case hd of
+                                   Nil => return hd
+                                 | Cons (_, tl) =>
+                                   tl' <- signal tl;
+                                   skip (pos-1) tl'
+                   in
+                       case pos of
+                           None => return (render' None hd len)
+                         | Some pos =>
+                           hd <- skip pos hd;
+                           return (render' None hd len)
+                   end}/>
+</xml>
+
+fun renderFlat [ctx] [ctx ~ [Dyn]] [t] (f : t -> position -> xml (ctx ++ [Dyn]) [] [])
+    : option int -> list (t * position) -> xml (ctx ++ [Dyn]) [] [] =
+    let
+        fun renderFlat' len ls =
+            case len of
+                Some 0 => <xml/>
+              | _ =>
+                case ls of
+                    [] => <xml/>
+                  | p :: ls =>
+                    let
+                        val len =
+                            case len of
+                                None => None
+                              | Some n => Some (n - 1)
+                    in
+                        <xml>{f p.1 p.2}{renderFlat' len ls}</xml>
+                    end
+    in
+        renderFlat'
+    end
+
+val split [t] =
+    let
+        fun split' acc (ls : list t) =
+            case ls of
+                [] => acc
+              | x1 :: [] => (x1 :: acc.1, acc.2)
+              | x1 :: x2 :: ls => split' (x1 :: acc.1, x2 :: acc.2) ls
+    in
+        split' ([], [])
+    end
+
+fun merge [t] (cmp : t -> t -> signal bool) =
+    let
+        fun merge' acc (ls1 : list t) (ls2 : list t) =
+            case (ls1, ls2) of
+                ([], _) => return (List.revAppend acc ls2)
+              | (_, []) => return (List.revAppend acc ls1)
+              | (x1 :: ls1', x2 :: ls2') =>
+                b <- cmp x1 x2;
+                if b then
+                    merge' (x1 :: acc) ls1' ls2
+                else
+                    merge' (x2 :: acc) ls1 ls2'
+    in
+        merge' []
+    end
+
+fun sort [t] (cmp : t -> t -> signal bool) =
+    let
+        fun sort' (ls : list t) =
+            case ls of
+                [] => return ls
+              | _ :: [] => return ls
+              | _ =>
+                let
+                    val (ls1, ls2) = split ls
+                in
+                    ls1' <- sort' ls1;
+                    ls2' <- sort' ls2;
+                    merge cmp ls1' ls2'
+                end
+    in
+        sort'
+    end
+
+fun render [ctx] [ctx ~ [Dyn]] [t] f (r : {Filter : t -> signal bool,
+                                           Sort : signal (option (t -> t -> signal bool)),
+                                           StartPosition : signal (option int),
+                                           MaxLength : signal (option int)}) dl = <xml>
+    <dyn signal={len <- r.MaxLength;
+                 cmp <- r.Sort;
+                 pos <- r.StartPosition;
+
+                 case cmp of
+                     None => return (renderDyn f r.Filter pos len dl)
+                   | Some cmp =>
+                     dl' <- signal dl;
+                     elems <- (case dl' of
+                                   Empty => return []
+                                 | Nonempty {Head = hd, Tail = tlTop} =>
+                                   let
+                                       fun listOut prev dl'' acc =
+                                           case dl'' of
+                                               Nil => return acc
+                                             | Cons (v, tl) =>
+                                               let
+                                                   val pos = case prev of
+                                                                 None => headPos dl
+                                                               | Some prev => tailPos prev tl tlTop
+                                               in
+                                                   b <- r.Filter v;
+                                                   tl' <- signal tl;
+                                                   listOut (Some tl) tl' (if b then
+                                                                              (v, pos) :: acc
+                                                                          else
+                                                                              acc)
+                                               end
+                                   in
+                                       listOut None hd []
+                                   end);
+                     elems <- sort (fn v1 v2 => cmp v1.1 v2.1) elems;
+                     let
+                         fun skip n ls =
+                             case (n, ls) of
+                                 (0, _) => ls
+                               | (n, _ :: ls) => skip (n-1) ls
+                               | (_, []) => []
+
+                         val elems =
+                             case pos of
+                                 None => elems
+                               | Some pos => skip pos elems
+                     in
+                         return (renderFlat f len elems)
+                     end}/>
+</xml>
+
+fun delete pos = pos
+
+fun elements' [t] (dl'' : dlist'' t) : signal (list t) =
+    case dl'' of
+        Nil => return []
+      | Cons (x, dl'') =>
+        dl'' <- signal dl'';
+        tl <- elements' dl'';
+        return (x :: tl)
+
+fun elements [t] (dl : dlist t) : signal (list t) =
+    dl' <- signal dl;
+    case dl' of
+        Empty => return []
+      | Nonempty {Head = hd, ...} => elements' hd
+
+fun size' [t] (dl'' : dlist'' t) : signal int =
+    case dl'' of
+        Nil => return 0
+      | Cons (x, dl'') =>
+        dl'' <- signal dl'';
+        n <- size' dl'';
+        return (n + 1)
+
+fun size [t] (dl : dlist t) : signal int =
+    dl' <- signal dl;
+    case dl' of
+        Empty => return 0
+      | Nonempty {Head = hd, ...} => size' hd
+
+fun numPassing' [t] (f : t -> signal bool) (dl'' : dlist'' t) : signal int =
+    case dl'' of
+        Nil => return 0
+      | Cons (x, dl'') =>
+        b <- f x;
+        dl'' <- signal dl'';
+        n <- numPassing' f dl'';
+        return (if b then n + 1 else n)
+
+fun numPassing [t] (f : t -> signal bool) (dl : dlist t) : signal int =
+    dl' <- signal dl;
+    case dl' of
+        Empty => return 0
+      | Nonempty {Head = hd, ...} => numPassing' f hd
+
+fun foldl [t] [acc] (f : t -> acc -> signal acc) =
+    let
+        fun foldl'' (i : acc) (dl : dlist'' t) : signal acc =
+            case dl of
+                Nil => return i
+              | Cons (v, dl') =>
+                dl' <- signal dl';
+                i' <- f v i;
+                foldl'' i' dl'
+
+        fun foldl' (i : acc) (dl : dlist t) : signal acc =
+            dl <- signal dl;
+            case dl of
+                Empty => return i
+              | Nonempty {Head = dl, ...} => foldl'' i dl
+    in
+        foldl'
+    end
diff --git a/demo/more/dlist.urs b/demo/more/dlist.urs
new file mode 100644
index 0000000..115c72b
--- /dev/null
+++ b/demo/more/dlist.urs
@@ -0,0 +1,22 @@
+con dlist :: Type -> Type
+type position
+
+val create : t ::: Type -> transaction (dlist t)
+val clear : t ::: Type -> dlist t -> transaction unit
+val append : t ::: Type -> dlist t -> t -> transaction position
+val replace : t ::: Type -> dlist t -> list t -> transaction unit
+
+val delete : position -> transaction unit
+val elements : t ::: Type -> dlist t -> signal (list t)
+val size : t ::: Type -> dlist t -> signal int
+val numPassing : t ::: Type -> (t -> signal bool) -> dlist t -> signal int
+val foldl : t ::: Type -> acc ::: Type -> (t -> acc -> signal acc) -> acc -> dlist t -> signal acc
+
+val render : ctx ::: {Unit} -> [ctx ~ [Dyn]] => t ::: Type
+             -> (t -> position -> xml (ctx ++ [Dyn]) [] [])
+             -> {StartPosition : signal (option int),
+                 MaxLength : signal (option int),
+                 Filter : t -> signal bool,
+                 Sort : signal (option (t -> t -> signal bool)) (* <= *)}
+             -> dlist t
+             -> xml (ctx ++ [Dyn]) [] []
diff --git a/demo/more/dragList.ur b/demo/more/dragList.ur
new file mode 100644
index 0000000..df4fc4f
--- /dev/null
+++ b/demo/more/dragList.ur
@@ -0,0 +1,39 @@
+fun draggableList title items =
+    itemSources <- List.mapM source items;
+    draggingItem <- source None;
+    return <xml>
+      <h2>Great {[title]}</h2>
+      <ul>
+        {List.mapX (fn itemSource => <xml>
+          <li onmousedown={fn _ => set draggingItem (Some itemSource)}
+              onmouseup={fn _ => set draggingItem None}
+              onmouseover={fn _ => di <- get draggingItem;
+                              case di of
+                                  None => return ()
+                                | Some di => original <- get di;
+                                  movedOver <- get itemSource;
+                                  set di movedOver;
+                                  set itemSource original;
+                                  set draggingItem (Some itemSource)}>
+              <dyn signal={Monad.mp cdata (signal itemSource)}/>
+         </li></xml>) itemSources}
+      </ul>
+    </xml>
+
+fun main () =
+    bears <- draggableList "Bears" ("Pooh" :: "Paddington" :: "Rupert" :: "Edward" :: []);
+    beers <- draggableList "Beers" ("Budvar" :: "Delirium Tremens" :: "Deuchars" :: []);
+    boars <- draggableList "Boars" ("Sus scrofa scrofa"
+                                        :: "Sus scrofa ussuricus"
+                                        :: "Sus scrofa cristatus"
+                                        :: "Sus scrofa taiwanus" :: []);
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="../../dragList.css"/>
+      </head>
+      <body>
+        {bears}
+        {beers}
+        {boars}
+      </body>
+    </xml>
diff --git a/demo/more/dragList.urp b/demo/more/dragList.urp
new file mode 100644
index 0000000..42ec5c4
--- /dev/null
+++ b/demo/more/dragList.urp
@@ -0,0 +1,5 @@
+allow url ../../dragList.css
+
+$/list
+$/monad
+dragList
diff --git a/demo/more/dragList.urs b/demo/more/dragList.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/more/dragList.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
new file mode 100644
index 0000000..041115e
--- /dev/null
+++ b/demo/more/grid.ur
@@ -0,0 +1,330 @@
+con colMeta' = fn (row :: Type) (input :: Type) (filter :: Type) =>
+                  {Header : string,
+                   Project : row -> transaction input,
+                   Update : row -> input -> transaction row,
+                   Display : input -> xbody,
+                   Edit : input -> xbody,
+                   Validate : input -> signal bool,
+                   CreateFilter : transaction filter,
+                   DisplayFilter : filter -> xbody,
+                   Filter : filter -> row -> signal bool,
+                   Sort : option (row -> row -> bool)}
+
+con colMeta = fn (row :: Type) (global :: Type, input :: Type, filter :: Type) =>
+                 {Initialize : transaction global,
+                  Handlers : global -> colMeta' row input filter}                  
+
+con aggregateMeta = fn (row :: Type) (acc :: Type) =>
+                       {Initial : acc,
+                        Step : row -> acc -> acc,
+                        Display : acc -> xbody}
+
+functor Make(M : sig
+                 type row
+                 type key
+                 val keyOf : row -> key
+
+                 val list : transaction (list row)
+                 val new : transaction row
+                 val save : key -> row -> transaction unit
+                 val delete : key -> transaction unit
+
+                 con cols :: {(Type * Type * Type)}
+                 val cols : $(map (colMeta row) cols)
+
+                 val folder : folder cols
+
+                 con aggregates :: {Type}
+                 val aggregates : $(map (aggregateMeta row) aggregates)
+                 val aggFolder : folder aggregates
+
+                 val pageLength : option int
+             end) = struct
+    style tab
+    style row
+    style header
+    style data
+    style agg
+
+    fun make (row : M.row) [input] [filter] (m : colMeta' M.row input filter) : transaction input = m.Project row
+
+    fun makeAll cols row = @@Monad.exec [transaction] _ [map snd3 M.cols]
+                             (@map2 [fst3] [colMeta M.row] [fn p => transaction (snd3 p)]
+                               (fn [p] data meta => make row (meta.Handlers data))
+                               M.folder cols M.cols)
+                             (@@Folder.mp [_] [_] M.folder)
+
+    type listT = {Row : source M.row,
+                  Cols : source ($(map snd3 M.cols)),
+                  Updating : source bool,
+                  Selected : source bool}
+
+    type grid = {Cols : $(map fst3 M.cols),
+                 Rows : Dlist.dlist listT,
+                 Selection : source bool,
+                 Filters : $(map thd3 M.cols),
+                 Sort : source (option (M.row -> M.row -> bool)),
+                 Position : source int}
+
+    fun newRow cols row =
+        rowS <- source row;
+        cols <- makeAll cols row;
+        colsS <- source cols;
+        ud <- source False;
+        sd <- source False;
+        return {Row = rowS,
+                Cols = colsS,
+                Updating = ud,
+                Selected = sd}
+
+    fun addRow cols rows row =
+        r <- newRow cols row;
+        Monad.ignore (Dlist.append rows r)
+
+    val grid =
+        cols <- @Monad.mapR _ [colMeta M.row] [fst3]
+                 (fn [nm :: Name] [p :: (Type * Type * Type)] meta => meta.Initialize)
+                 M.folder M.cols;
+
+        filters <- @Monad.mapR2 _ [colMeta M.row] [fst3] [thd3]
+                    (fn [nm :: Name] [p :: (Type * Type * Type)] meta state =>
+                        (meta.Handlers state).CreateFilter)
+                    M.folder M.cols cols;
+
+        rows <- Dlist.create;
+        sel <- source False;
+        sort <- source None;
+        pos <- source 0;
+
+        return {Cols = cols,
+                Rows = rows,
+                Selection = sel,
+                Filters = filters,
+                Sort = sort,
+                Position = pos}
+
+    fun sync {Cols = cols, Rows = rows, ...} =
+        Dlist.clear rows;
+        init <- rpc M.list;
+        rs <- List.mapM (newRow cols) init;
+        Dlist.replace rows rs
+
+    fun myFilter grid all =
+        row <- signal all.Row;
+        @foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool]
+         (fn [nm :: Name] [p :: (Type * Type * Type)]
+                          [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+                          meta state filter combinedFilter row =>
+             previous <- combinedFilter row;
+             this <- (meta.Handlers state).Filter filter row;
+             return (previous && this))
+         (fn _ => return True)
+         M.folder M.cols grid.Cols grid.Filters row
+
+    fun render (grid : grid) = <xml>
+      <table class={tab}>
+        <tr class={row}>
+          <th/> <th/> <th><button value="No sort" onclick={fn _ => set grid.Sort None}/></th>
+          {@mapX2 [fst3] [colMeta M.row] [tr]
+            (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+                             data (meta : colMeta M.row p) =>
+                <xml><th class={header}>
+                  {case (meta.Handlers data).Sort of
+                       None => txt (meta.Handlers data).Header
+                     | sort => <xml><button value={(meta.Handlers data).Header}
+                                            onclick={fn _ => set grid.Sort sort}/></xml>}
+                </th></xml>)
+            M.folder grid.Cols M.cols}
+        </tr>
+
+        {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud, Selected = sd} pos =>
+                          let
+                              val delete =
+                                  Dlist.delete pos;
+                                  row <- get rowS;
+                                  rpc (M.delete (M.keyOf row))
+
+                              val update = set ud True
+
+                              val cancel =
+                                  set ud False;
+                                  row <- get rowS;
+                                  cols <- makeAll grid.Cols row;
+                                  set colsS cols
+                                  
+                              val save =
+                                  cols <- get colsS;
+                                  errors <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => option string]
+                                             (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}]
+                                                              [[nm] ~ rest] data meta v errors =>
+                                                 b <- current ((meta.Handlers data).Validate v);
+                                                 return (if b then
+                                                             errors
+                                                         else
+                                                             case errors of
+                                                                 None => Some ((meta.Handlers data).Header)
+                                                               | Some s => Some ((meta.Handlers data).Header
+                                                                                 ^ ", " ^ s)))
+                                             None M.folder grid.Cols M.cols cols;
+
+                                  case errors of
+                                      Some s => alert ("Can't save because the following columns have invalid values:\n"
+                                                       ^ s)
+                                    | None =>
+                                      set ud False;
+                                      row <- get rowS;
+                                      row' <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => M.row]
+                                               (fn [nm :: Name] [t :: (Type * Type * Type)]
+                                                                [rest :: {(Type * Type * Type)}]
+                                                                [[nm] ~ rest] data meta v row' =>
+                                                   (meta.Handlers data).Update row' v)
+                                               row M.folder grid.Cols M.cols cols;
+                                      rpc (M.save (M.keyOf row) row');
+                                      set rowS row';
+
+                                      cols <- makeAll grid.Cols row';
+                                      set colsS cols
+                          in
+                              <xml><tr class={row}>
+                                <td>
+                                  <dyn signal={b <- signal grid.Selection;
+                                               return (if b then
+                                                           <xml><ccheckbox source={sd}/></xml>
+                                                       else
+                                                           <xml/>)}/>
+                                </td>
+
+                                <td>
+                                  <dyn signal={b <- signal ud;
+                                               return (if b then
+                                                           <xml><button value="Save" onclick={fn _ => save}/></xml>
+                                                       else
+                                                           <xml><button value="Update" onclick={fn _ => update}/></xml>)}/>
+                                </td>
+
+                                <td><dyn signal={b <- signal ud;
+                                                 return (if b then
+                                                             <xml><button value="Cancel" onclick={fn _ => cancel}/></xml>
+                                                         else
+                                                             <xml><button value="Delete" onclick={fn _ => delete}/></xml>)}/>
+                                </td>
+
+                                <dyn signal={cols <- signal colsS;
+                                             return (@mapX3 [fst3] [colMeta M.row] [snd3] [_]
+                                                      (fn [nm :: Name] [t :: (Type * Type * Type)]
+                                                                       [rest :: {(Type * Type * Type)}]
+                                                                       [[nm] ~ rest] dat meta v =>
+                                                          <xml><td class={data}>
+                                                            <dyn signal={b <- signal ud;
+                                                                         return (if b then
+                                                                                     (meta.Handlers dat).Edit v
+                                                                                 else
+                                                                                     (meta.Handlers dat).Display
+                                                                                                         v)}/>
+                                                            <dyn signal={b <- signal ud;
+                                                                         if b then
+                                                                             valid <-
+                                                                             (meta.Handlers dat).Validate v;
+                                                                             return (if valid then
+                                                                                         <xml/>
+                                                                                     else
+                                                                                         <xml>!</xml>)
+                                                                         else
+                                                                             return <xml/>}/>
+                                                          </td></xml>)
+                                                      M.folder grid.Cols M.cols cols)}/>
+                                </tr></xml>
+                          end)
+                      {StartPosition = case M.pageLength of
+                                           None => return None
+                                         | Some len =>
+                                           avail <- Dlist.numPassing (myFilter grid) grid.Rows;
+                                           pos <- signal grid.Position;
+                                           return (Some (if pos >= avail then
+                                                             0
+                                                         else
+                                                             pos)),
+                       MaxLength = return M.pageLength,
+                       Filter = myFilter grid,
+                       Sort = f <- signal grid.Sort;
+                              return (Option.mp (fn f r1 r2 => r1 <- signal r1.Row;
+                                                    r2 <- signal r2.Row;
+                                                    return (f r1 r2)) f)}
+                      grid.Rows}
+
+            <dyn signal={rows <- Dlist.foldl (fn row : listT =>
+                                                 @Monad.mapR2 _ [aggregateMeta M.row] [ident] [ident]
+                                                  (fn [nm :: Name] [t :: Type] meta acc =>
+                                                      Monad.mp (fn v => meta.Step v acc)
+                                                               (signal row.Row))
+                                                  M.aggFolder M.aggregates)
+                                 (@mp [aggregateMeta M.row] [ident]
+                                  (fn [t] meta => meta.Initial)
+                                  M.aggFolder M.aggregates) grid.Rows;
+                         return <xml><tr>
+                           <th colspan={3}>Aggregates</th>
+                           {@mapX2 [aggregateMeta M.row] [ident] [_]
+                             (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc =>
+                                 <xml><td class={agg}>{meta.Display acc}</td></xml>)
+                             M.aggFolder M.aggregates rows}
+                         </tr></xml>}/>
+
+              <tr><th colspan={3}>Filters</th>
+                {@mapX3 [colMeta M.row] [fst3] [thd3] [_]
+                  (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+                                   meta state filter => <xml><td>{(meta.Handlers state).DisplayFilter filter}</td></xml>)
+                  M.folder M.cols grid.Cols grid.Filters}
+              </tr>
+          </table>
+
+          {case M.pageLength of
+               None => <xml/>
+             | Some plen => <xml>
+               <dyn signal={avail <- Dlist.numPassing (myFilter grid) grid.Rows;
+                            return (if avail <= plen then
+                                        <xml/>
+                                    else
+                                        let
+                                            val numPages = avail / plen
+                                            val numPages = if numPages * plen < avail then
+                                                               numPages + 1
+                                                           else
+                                                               numPages
+
+                                            fun pages n =
+                                                if n * plen >= avail then
+                                                    <xml/>
+                                                else
+                                                    <xml>
+                                                      <dyn signal={pos <- signal grid.Position;
+                                                                   return (if n * plen = pos then
+                                                                               <xml><b>{[n + 1]}</b></xml>
+                                                                           else
+                                                                               <xml>
+                                                                                 <button value={show (n + 1)}
+                                                                                         onclick={fn _ => set grid.Position
+                                                                                                              (n * plen)
+                                                                                                 }/></xml>)}/>
+                                                      {if (n + 1) * plen >= avail then <xml/> else <xml>|</xml>}
+                                                      {pages (n + 1)}
+                                                    </xml>
+                                        in
+                                            <xml><p><b>Pages:</b> {pages 0}</p></xml>
+                                        end)}/>
+               </xml>}
+          
+          <button value="New row" onclick={fn _ => row <- rpc M.new;
+                                              addRow grid.Cols grid.Rows row}/>
+          <button value="Refresh" onclick={fn _ => sync grid}/>
+    </xml>
+
+    fun showSelection grid = grid.Selection
+
+    fun selection grid = Dlist.foldl (fn {Row = rowS, Selected = sd, ...} ls =>
+                                         sd <- signal sd;
+                                         if sd then
+                                             row <- signal rowS;
+                                             return (row :: ls)
+                                         else
+                                             return ls) [] grid.Rows
+end
diff --git a/demo/more/grid.urp b/demo/more/grid.urp
new file mode 100644
index 0000000..a67abdb
--- /dev/null
+++ b/demo/more/grid.urp
@@ -0,0 +1,8 @@
+
+$/option
+$/monad
+$/list
+$/string
+dlist
+grid
+dbgrid
diff --git a/demo/more/grid.urs b/demo/more/grid.urs
new file mode 100644
index 0000000..32f6af1
--- /dev/null
+++ b/demo/more/grid.urs
@@ -0,0 +1,57 @@
+con colMeta' = fn (row :: Type) (input :: Type) (filter :: Type) =>
+                  {Header : string,
+                   Project : row -> transaction input,
+                   Update : row -> input -> transaction row,
+                   Display : input -> xbody,
+                   Edit : input -> xbody,
+                   Validate : input -> signal bool,
+                   CreateFilter : transaction filter,
+                   DisplayFilter : filter -> xbody,
+                   Filter : filter -> row -> signal bool,
+                   Sort : option (row -> row -> bool)}
+                  
+con colMeta = fn (row :: Type) (global :: Type, input :: Type, filter :: Type) =>
+                 {Initialize : transaction global,
+                  Handlers : global -> colMeta' row input filter}
+
+con aggregateMeta = fn (row :: Type) (acc :: Type) =>
+                       {Initial : acc,
+                        Step : row -> acc -> acc,
+                        Display : acc -> xbody}
+
+functor Make(M : sig
+                 type row
+                 type key
+                 val keyOf : row -> key
+
+                 val list : transaction (list row)
+                 val new : transaction row
+                 val save : key -> row -> transaction unit
+                 val delete : key -> transaction unit
+
+                 con cols :: {(Type * Type * Type)}
+                 val cols : $(map (colMeta row) cols)
+
+                 val folder : folder cols
+
+                 con aggregates :: {Type}
+                 val aggregates : $(map (aggregateMeta row) aggregates)
+                 val aggFolder : folder aggregates
+
+                 val pageLength : option int
+             end) : sig
+    type grid
+
+    val grid : transaction grid
+    val sync : grid -> transaction unit
+    val render : grid -> xbody
+
+    val showSelection : grid -> source bool
+    val selection : grid -> signal (list M.row)
+
+    style tab
+    style row
+    style header
+    style data
+    style agg
+end
diff --git a/demo/more/grid0.ur b/demo/more/grid0.ur
new file mode 100644
index 0000000..410554c
--- /dev/null
+++ b/demo/more/grid0.ur
@@ -0,0 +1,34 @@
+open Dbgrid
+
+sequence s
+table t : {Id : int, A : int}
+  PRIMARY KEY Id
+
+open Make(struct
+              val tab = t
+              con key = [Id = _]
+
+              val raw = {Id = {New = nextval s,
+                               Inj = _},
+                         A = {New = return 0,
+                              Inj = _}}
+
+              val cols = {Id = Direct.readOnly [#Id] "Id" Direct.int,
+                          A = Direct.editable [#A] "A" Direct.int}
+
+              val aggregates = {}
+
+              val pageLength = None
+          end)
+
+fun main () =
+    grid <- grid;
+    set (showSelection grid) True;
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="../../grid.css"/>
+      </head>
+      <body onload={sync grid}>
+        {render grid}
+      </body>
+    </xml>
diff --git a/demo/more/grid0.urp b/demo/more/grid0.urp
new file mode 100644
index 0000000..2cb16ec
--- /dev/null
+++ b/demo/more/grid0.urp
@@ -0,0 +1,7 @@
+debug
+database dbname=test
+library grid
+sql grid0.sql
+allow url ../../grid.css
+
+grid0
diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur
new file mode 100644
index 0000000..66fe2f2
--- /dev/null
+++ b/demo/more/grid1.ur
@@ -0,0 +1,78 @@
+open Dbgrid
+
+table t1 : {Id : int, A : string}
+  PRIMARY KEY Id
+
+sequence s
+table t : {Id : int, A : int, B : string, C : bool, D : int, E : option int, F : option int}
+  PRIMARY KEY Id,
+  CONSTRAINT Foreign FOREIGN KEY (D) REFERENCES t1(Id) ON DELETE CASCADE
+
+fun page (n, s) = return <xml>A = {[n]}, B = {[s]}</xml>
+
+open Make(struct
+              structure F = Direct.Foreign(struct
+                                               con nm = #Id
+                                               val tab = t1
+                                               fun render r = r.A
+                                           end)
+
+              val tab = t
+              con key = [Id = _]
+
+              val raw = {Id = {New = nextval s,
+                               Inj = _},
+                         A = {New = return 0,
+                              Inj = _},
+                         B = {New = return "",
+                              Inj = _},
+                         C = {New = return False,
+                              Inj = _},
+                         D = {New = return 0,
+                              Inj = _},
+                         E = {New = return None,
+                              Inj = _},
+                         F = {New = return None,
+                              Inj = _}}
+
+              val cols = {Id = Direct.readOnly [#Id] "Id" Direct.int,
+                          A = Direct.editable [#A] "A" Direct.int,
+                          B = Direct.editable [#B] "B" Direct.string,
+                          C = Direct.editable [#C] "C" Direct.bool,
+                          D = Direct.editable [#D] "D" F.meta,
+                          E = Direct.editable [#E] "E" (Direct.nullable Direct.int),
+                          F = Direct.editable [#F] "F" (Direct.nullable F.meta),
+                          DA = computed "2A" (fn r => 2 * r.A),
+                          Link = computedHtml "Link" (fn r => <xml><a link={page (r.A, r.B)}>Go</a></xml>)}
+
+              val aggregates = {Dummy1 = {Initial = (),
+                                          Step = fn _ _ => (),
+                                          Display = fn _ => <xml/>},
+                                Sum = {Initial = 0,
+                                       Step = fn r n => r.A + n,
+                                       Display = txt},
+                                Dummy2 = {Initial = (),
+                                          Step = fn _ _ => (),
+                                          Display = fn _ => <xml/>},
+                                And = {Initial = True,
+                                       Step = fn r b => r.C && b,
+                                       Display = txt}}
+
+              val pageLength = Some 10
+          end)
+
+fun main () =
+    grid <- grid;
+    set (showSelection grid) True;
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="../../grid.css"/>
+      </head>
+      <body onload={sync grid}>
+        {render grid}
+        <hr/>
+        <ccheckbox source={showSelection grid}/> Show selection<br/>
+        Selection: <dyn signal={ls <- selection grid;
+                                return (List.mapX (fn r => <xml>{[r.Id]}; </xml>) ls)}/>
+      </body>
+    </xml>
diff --git a/demo/more/grid1.urp b/demo/more/grid1.urp
new file mode 100644
index 0000000..a4f3337
--- /dev/null
+++ b/demo/more/grid1.urp
@@ -0,0 +1,7 @@
+debug
+database dbname=test
+library grid
+sql grid.sql
+allow url ../../grid.css
+
+grid1
diff --git a/demo/more/grid1.urs b/demo/more/grid1.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/more/grid1.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/more/orm.ur b/demo/more/orm.ur
new file mode 100644
index 0000000..468281f
--- /dev/null
+++ b/demo/more/orm.ur
@@ -0,0 +1,95 @@
+con link = fn col_parent :: (Type * Type) => col_parent.1 -> transaction (option col_parent.2)
+fun noParent [t ::: Type] (_ : t) : transaction (option unit) = return None
+
+con meta = fn (col :: Type, parent :: Type) => {
+	      Link : link (col, parent),
+	      Inj : sql_injectable col
+	      }
+
+fun local [t :: Type] (inj : sql_injectable t) : meta (t, unit) =
+    {Link = noParent,
+     Inj = inj}
+
+functor Table(M : sig
+                  con cols :: {(Type * Type)}
+                  val cols : $(map meta cols)
+                  constraint [Id] ~ cols
+                  val folder : folder cols
+              end) = struct
+    type id = int
+    con fs' = map fst M.cols
+    con fs = [Id = id] ++ fs'
+    type row' = $fs'
+    type row = $fs
+
+    fun resultsOut q = query q (fn r ls => return (r.T :: ls)) []
+    fun resultOut q = ro <- oneOrNoRows q; return (Option.mp (fn r => r .T) ro)
+
+    sequence s
+    table t : fs
+
+    val inj = _
+    val id = {Link = fn id => resultOut (SELECT * FROM t WHERE t.Id = {[id]}),
+              Inj = inj}
+
+    fun ensql [avail ::_] (r : row') : $(map (sql_exp avail [] []) fs') =
+        @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
+         (fn [ts] meta v => @sql_inject meta.Inj v)
+         M.folder M.cols r
+
+    fun create (r : row') =
+        id <- nextval s;
+        dml (insert t ({Id = sql_inject id} ++ ensql [[]] r));
+        return ({Id = id} ++ r)
+
+    fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]})
+
+    fun save r = dml (update [fs'] (ensql [[T = [Id = int] ++ map fst M.cols]] (r -- #Id)) t (WHERE T.Id = {[r.Id]}))
+
+    fun lookup id =
+        ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]});
+        return (Option.mp (fn r => r.T) ro)
+
+
+    val list = resultsOut (SELECT * FROM t)
+
+    con col = fn t => {Exp : sql_exp [T = fs] [] [] t,
+                       Inj : sql_injectable t}
+    val idCol = {Exp = sql_field [#T] [#Id], Inj = _}
+    con meta' = fn (fs :: {Type}) (col :: Type, parent :: Type) =>
+                   {Col : {Exp : sql_exp [T = fs] [] [] col,
+                           Inj : sql_injectable col},
+                    Parent : $fs -> transaction (option parent)}
+    val cols = @foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] =>
+                                 $(map (meta' (map fst (before ++ after))) before)]
+                (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}]
+                                 [[nm] ~ before] (meta : meta ts)
+                                 (acc : after :: {(Type * Type)} -> [before ~ after] =>
+                                  $(map (meta' (map fst (before ++ after))) before))
+                                 [after :: {(Type * Type)}] [[nm = ts] ++ before ~ after] =>
+                    {nm = {Col = {Exp = sql_field [#T] [nm],
+                                  Inj = meta.Inj},
+                           Parent = fn r => meta.Link r.nm}}
+                        ++ acc [[nm = ts] ++ after])
+                (fn [after :: {(Type * Type)}] [[] ~ after] => {})
+                M.folder M.cols
+                [[Id = (id, row)]] !
+
+    type filter = sql_exp [T = fs] [] [] bool
+    fun find (f : filter) = resultOut (SELECT * FROM t WHERE {f})
+    fun search (f : filter) = resultsOut (SELECT * FROM t WHERE {f})
+
+    fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) =
+        sql_binary b c.Exp (@sql_inject c.Inj v)
+    val eq = @@bin @@sql_eq
+    val ne = @@bin @@sql_ne
+    val lt = @@bin @@sql_lt
+    val le = @@bin @@sql_le
+    val gt = @@bin @@sql_gt
+    val ge = @@bin @@sql_ge
+
+    fun bb (b : sql_binary bool bool bool) (f1 : filter) (f2 : filter) =
+        sql_binary b f1 f2
+    val _and = bb sql_and
+    val or = bb sql_or
+end
diff --git a/demo/more/orm.urp b/demo/more/orm.urp
new file mode 100644
index 0000000..01a50b5
--- /dev/null
+++ b/demo/more/orm.urp
@@ -0,0 +1,3 @@
+
+$/option
+orm
diff --git a/demo/more/orm.urs b/demo/more/orm.urs
new file mode 100644
index 0000000..63f4ffc
--- /dev/null
+++ b/demo/more/orm.urs
@@ -0,0 +1,49 @@
+con link :: (Type * Type) -> Type
+val noParent : t ::: Type -> link (t, unit)
+
+con meta = fn (col :: Type, parent :: Type) => {
+	      Link : link (col, parent),
+	      Inj : sql_injectable col
+	      }
+
+val local : t :: Type -> sql_injectable t -> meta (t, unit)
+
+functor Table(M : sig
+		  con cols :: {(Type * Type)}
+		  val cols : $(map meta cols)
+		  constraint [Id] ~ cols
+		  val folder : folder cols
+	      end) : sig
+    type id
+    type row' = $(map fst M.cols)
+    type row = $([Id = id] ++ map fst M.cols)
+
+    val inj : sql_injectable id
+    val id : meta (id, row)
+
+    val create : row' -> transaction row
+    val delete : row -> transaction unit
+    val save : row -> transaction unit
+    val lookup : id -> transaction (option row)
+    val list : transaction (list row)
+
+    con col :: Type -> Type
+    val idCol : col id
+    val cols : $(map (fn (colm :: Type, parent :: Type) =>
+                         {Col : col colm,
+                          Parent : row -> transaction (option parent)}) M.cols)
+
+    type filter
+    val find : filter -> transaction (option row)
+    val search : filter -> transaction (list row)
+
+    val eq : t ::: Type -> col t -> t -> filter
+    val ne : t ::: Type -> col t -> t -> filter
+    val lt : t ::: Type -> col t -> t -> filter
+    val le : t ::: Type -> col t -> t -> filter
+    val gt : t ::: Type -> col t -> t -> filter
+    val ge : t ::: Type -> col t -> t -> filter
+
+    val _and : filter -> filter -> filter
+    val or : filter -> filter -> filter
+end
diff --git a/demo/more/orm1.ur b/demo/more/orm1.ur
new file mode 100644
index 0000000..989741d
--- /dev/null
+++ b/demo/more/orm1.ur
@@ -0,0 +1,46 @@
+open Orm
+
+structure T = Table(struct
+                        val cols = {A = local [int],
+                                    B = local [string]}
+                    end)
+
+structure S = Table(struct
+                        val cols = {C = T.id,
+                                    D = local [float]}
+                    end)
+
+fun action () =
+    r1 <- T.create {A = 3, B = "Hi"};
+    T.save (r1 -- #B ++ {B = "Bye"});
+    r2 <- T.create {A = 4, B = "Why"};
+    r3 <- T.create {A = 66, B = "Hi"};
+
+    s <- S.create {C = r1.Id, D = 45.67};
+
+    ls <- T.list;
+    ls' <- T.search (T.eq T.cols.B.Col "Hi");
+
+    lsS <- S.list;
+    lsS <- List.mapM (fn r => p <- S.cols.C.Parent r; return (r, p)) lsS;
+
+    T.delete r1;
+    T.delete r2;
+    T.delete r3;
+
+    S.delete s;
+
+    return <xml><body>
+      {List.mapX (fn r => <xml><li> {[r.A]}: {[r.B]}</li></xml>) ls}
+      <br/>
+      {List.mapX (fn r => <xml><li> {[r.A]}: {[r.B]}</li></xml>) ls'}
+      <br/>
+      {List.mapX (fn (s, ro) => <xml><li> {[s.D]}: {case ro of
+                                                        None => <xml>No parent</xml>
+                                                      | Some r => <xml>{[r.B]}</xml>}
+      </li></xml>) lsS}
+    </body></xml>
+
+fun main () = return <xml><body>
+  <form><submit action={action}/></form>
+</body></xml>
diff --git a/demo/more/orm1.urp b/demo/more/orm1.urp
new file mode 100644
index 0000000..450f57a
--- /dev/null
+++ b/demo/more/orm1.urp
@@ -0,0 +1,6 @@
+library orm
+database dbname=test
+sql test.sql
+
+$/list
+orm1
diff --git a/demo/more/orm1.urs b/demo/more/orm1.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/more/orm1.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/more/out/dragList.css b/demo/more/out/dragList.css
new file mode 100644
index 0000000..bcd892d
--- /dev/null
+++ b/demo/more/out/dragList.css
@@ -0,0 +1,18 @@
+ul {
+  width: 200px; 
+  list-style-image: url(http://script.aculo.us/images/bullet.gif);
+}
+
+li {
+  color: #7E9E50;
+  font: 20px Georgia;
+  background-color: #ECF3E1; 
+  border: 1px solid #C5DEA1;
+  cursor: move;
+  margin: 0px;
+}
+
+h2 {
+  font: 42px/30px Georgia, serif;
+  color: #7E9E50;
+}
diff --git a/demo/more/out/grid.css b/demo/more/out/grid.css
new file mode 100644
index 0000000..3563123
--- /dev/null
+++ b/demo/more/out/grid.css
@@ -0,0 +1,19 @@
+.Grid1_tab {
+        border-style: solid
+}
+
+.Grid1_header {
+        border-style: solid
+}
+
+.Grid1_row {
+        border-style: solid
+}
+
+.Grid1_data {
+        border-style: solid
+}
+
+.Grid1_agg {
+        border-style: solid
+}
\ No newline at end of file
diff --git a/demo/more/prose b/demo/more/prose
new file mode 100644
index 0000000..9c267ca
--- /dev/null
+++ b/demo/more/prose
@@ -0,0 +1,15 @@
+<p>These are some extra demo applications written in <a href="http://www.impredicative.com/ur/">Ur/Web</a>.  See <a href="http://www.impredicative.com/ur/demo/">the main demo</a> for a more tutorial-like progression through language and library features.</p>
+
+dragList.urp
+
+<p>This is an Ur/Web version of the "draggable lists" <a href="http://groups.inf.ed.ac.uk/links/examples/">demo program from Links</a>.</p>
+
+grid1.urp
+
+orm1.urp
+
+<p>Many varieties of "object-relational mapping" (ORM) can be implemented as libraries in Ur/Web, as this demo shows.</p>
+
+versioned1.urp
+
+<p>We can also build a data store abstraction that makes it possible to view old versions of records.</p>
diff --git a/demo/more/versioned.ur b/demo/more/versioned.ur
new file mode 100644
index 0000000..d08ebcb
--- /dev/null
+++ b/demo/more/versioned.ur
@@ -0,0 +1,134 @@
+functor Make(M : sig
+                 con key :: {Type}
+                 con data :: {Type}
+                 constraint key ~ data
+                 constraint [When, Version] ~ (key ++ data)
+
+                 val key : $(map sql_injectable key)
+                 val data : $(map (fn t => {Inj : sql_injectable_prim t,
+                                            Eq : eq t}) data)
+
+                 val keyFolder : folder key
+                 val dataFolder : folder data
+             end) = struct
+    type version = int
+    con all = [When = time, Version = version] ++ M.key ++ map option M.data
+    sequence s
+    table t : all
+
+    val keys = List.mapQuery (SELECT DISTINCT t.{{M.key}} FROM t) (fn r => r.T)
+    fun keysAt vr = List.mapQuery (SELECT DISTINCT t.{{M.key}} FROM t
+                                   WHERE t.Version <= {[vr]}) (fn r => r.T)
+
+    con dmeta = fn t => {Inj : sql_injectable_prim t,
+                         Eq : eq t}
+
+    fun keyRecd (r : $(M.key ++ M.data)) =
+        @map2 [sql_injectable] [ident] [sql_exp [] [] []]
+         (fn [t] => @sql_inject)
+         M.keyFolder M.key (r --- M.data)
+
+    fun insert r =
+        vr <- nextval s;
+        dml (Basis.insert t
+                          ({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
+                               ++ keyRecd r
+                               ++ @map2 [dmeta] [ident]
+                               [fn t => sql_exp [] [] [] (option t)]
+                               (fn [t] x v => @sql_inject (@sql_option_prim x.Inj)
+                                               (Some v))
+                               M.dataFolder M.data (r --- M.key)))
+
+    fun keyExp (r : $M.key) : sql_exp [T = all] [] [] bool =
+        @foldR2 [sql_injectable] [ident] [fn before => after :: {Type} -> [before ~ after]
+                                          => sql_exp [T = before ++ after] [] [] bool]
+         (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
+                          (inj : sql_injectable t) (v : t)
+                          (e : after :: {Type} -> [before ~ after]
+                           => sql_exp [T = before ++ after] [] [] bool)
+                          [after :: {Type}] [[nm = t] ++ before ~ after] =>
+             (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after]}))
+         (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
+         M.keyFolder M.key r
+         [_] !
+
+    datatype bound =
+             NoBound
+           | Lt of int
+           | Le of int
+
+    fun seek vro k =
+        let
+            fun current' vro r =
+                let
+                    val complete = @foldR [option] [fn ts => option $ts]
+                                    (fn [nm :: Name] [v :: Type] [r :: {Type}] [[nm] ~ r]
+                                                     v r =>
+                                        case (v, r) of
+                                            (Some v, Some r) => Some ({nm = v} ++ r)
+                                          | _ => None)
+                                    (Some {}) M.dataFolder r
+                in
+                    case complete of
+                        Some r => return (Some r)
+                      | None =>
+                        let
+                            val filter = case vro of
+                                             NoBound => (WHERE TRUE)
+                                           | Lt vr => (WHERE t.Version < {[vr]})
+                                           | Le vr => (WHERE t.Version <= {[vr]})
+                        in
+                            ro <- oneOrNoRows (SELECT t.Version, t.{{map option M.data}}
+                                               FROM t
+                                               WHERE {filter}
+                                                 AND {keyExp k}
+                                               ORDER BY t.When DESC
+                                               LIMIT 1);
+                            case ro of
+                                None => return None
+                              | Some r' =>
+                                let
+                                    val r = @map2 [option] [option] [option]
+                                             (fn [t ::: Type] old new =>
+                                                 case old of
+                                                     None => new
+                                                   | Some _ => old)
+                                             M.dataFolder r (r'.T -- #Version)
+                                in
+                                    current' (Lt r'.T.Version) r
+                                end
+                        end
+                end
+        in
+            current' vro (@map0 [option] (fn [t :: Type] => None : option t) M.dataFolder)
+        end
+
+    val current = seek NoBound
+    fun archive vr = seek (Le vr)
+
+    fun update r =
+        cur <- current (r --- M.data);
+        case cur of
+            None => error <xml>Tried to update nonexistent key</xml>
+          | Some cur =>
+            vr <- nextval s;
+            let
+                val r' = @map3 [dmeta] [ident] [ident] [fn t => sql_exp [] [] [] (option t)]
+                          (fn [t] (meta : dmeta t) old new =>
+                              @sql_inject (@sql_option_prim meta.Inj)
+                               (if @@eq [_] meta.Eq old new then
+                                    None
+                                else
+                                    Some new))
+                          M.dataFolder M.data cur (r --- M.key)
+                val r' = {Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
+                             ++ keyRecd r
+                             ++ r'
+            in
+                dml (Basis.insert t r')
+            end
+
+    val updateTimes = List.mapQuery (SELECT t.Version, t.When
+                                     FROM t
+                                     ORDER BY t.When) (fn r => (r.T.Version, r.T.When))
+end
diff --git a/demo/more/versioned.urp b/demo/more/versioned.urp
new file mode 100644
index 0000000..a75d6c6
--- /dev/null
+++ b/demo/more/versioned.urp
@@ -0,0 +1,4 @@
+
+$/option
+$/list
+versioned
diff --git a/demo/more/versioned.urs b/demo/more/versioned.urs
new file mode 100644
index 0000000..47f2e52
--- /dev/null
+++ b/demo/more/versioned.urs
@@ -0,0 +1,24 @@
+functor Make(M : sig
+                 con key :: {Type}
+                 con data :: {Type}
+                 constraint key ~ data
+                 constraint [When, Version] ~ (key ++ data)
+
+                 val key : $(map sql_injectable key)
+                 val data : $(map (fn t => {Inj : sql_injectable_prim t,
+                                            Eq : eq t}) data)
+
+                 val keyFolder : folder key
+                 val dataFolder : folder data
+             end) : sig
+    val insert : $(M.key ++ M.data) -> transaction unit
+    val update : $(M.key ++ M.data) -> transaction unit
+
+    val keys : transaction (list $M.key)
+    val current : $M.key -> transaction (option $M.data)
+
+    type version
+    val keysAt : version -> transaction (list $M.key)
+    val archive : version -> $M.key -> transaction (option $M.data)
+    val updateTimes : transaction (list (version * time))
+end
diff --git a/demo/more/versioned1.ur b/demo/more/versioned1.ur
new file mode 100644
index 0000000..b5b23fb
--- /dev/null
+++ b/demo/more/versioned1.ur
@@ -0,0 +1,80 @@
+open Versioned.Make(struct
+                        con key = [Id = int]
+                        con data = [Nam = string, ShoeSize = int]
+
+                        val key = {Id = _}
+                        val data = {Nam = {Inj = _,
+                                           Eq = _},
+                                    ShoeSize = {Inj = _,
+                                                Eq = _}}
+                    end)
+
+fun retro vr =
+    ks <- keysAt vr;
+    ks <- List.mapM (fn r => fso <- archive vr r; return (r.Id, fso)) ks;
+
+    return <xml><body>
+      {List.mapX (fn (k, r) => <xml><li>
+        {[k]}: {case r of
+                    None => <xml>Whoa!</xml>
+                  | Some r => <xml>{[r.Nam]}, {[r.ShoeSize]}</xml>}
+      </li></xml>) ks}
+    </body></xml>
+
+fun expandKey k =
+    name <- source "";
+    shoeSize <- source "";
+    return {Key = k, Nam = name, ShoeSize = shoeSize}
+
+fun main () =
+    ks0 <- keys;
+    ks0 <- List.mapM (fn r => expandKey r.Id) ks0;
+    ks <- source ks0;
+
+    id <- source "";
+    name <- source "";
+    shoeSize <- source "";
+
+    times <- updateTimes;
+
+    return <xml><body>
+      <dyn signal={ks <- signal ks;
+                   return (List.mapX (fn kr => <xml><div>
+                     {[kr.Key]}:
+                     <ctextbox source={kr.Nam}/>
+                     <ctextbox size={5} source={kr.ShoeSize}/>
+                     <button value="Latest" onclick={fn _ => ro <- rpc (current {Id = kr.Key});
+                                                        case ro of
+                                                            None => alert "Can't get it!"
+                                                          | Some r =>
+                                                            set kr.Nam r.Nam;
+                                                            set kr.ShoeSize (show r.ShoeSize)}/>
+                     <button value="Update" onclick={fn _ => name <- get kr.Nam;
+                                                        shoeSize <- get kr.ShoeSize;
+                                                        rpc (update {Id = kr.Key,
+                                                                     Nam = name,
+                                                                     ShoeSize = readError shoeSize})
+                                                    }/>
+                   </div></xml>) ks)}/>
+
+      <h2>Add one:</h2>
+
+      <table>
+        <tr><th>Id:</th> <td><ctextbox size={5} source={id}/></td></tr>
+        <tr><th>Name:</th> <td><ctextbox source={name}/></td></tr>
+        <tr><th>Shoe size:</th> <td><ctextbox size={5} source={shoeSize}/></td></tr>
+        <tr><th><button value="Add" onclick={fn _ => id <- get id;
+                                                name <- get name;
+                                                shoeSize <- get shoeSize;
+                                                rpc (insert {Id = readError id, Nam = name,
+                                                             ShoeSize = readError shoeSize});
+
+                                                cur <- get ks;
+                                                kr <- expandKey (readError id);
+                                                set ks (kr :: cur)}/></th></tr>
+      </table>
+
+      <h2>Archive</h2>
+
+      {List.mapX (fn (vr, tm) => <xml><li><a link={retro vr}>{[tm]}</a></li></xml>) times}
+    </body></xml>
diff --git a/demo/more/versioned1.urp b/demo/more/versioned1.urp
new file mode 100644
index 0000000..748a081
--- /dev/null
+++ b/demo/more/versioned1.urp
@@ -0,0 +1,5 @@
+library versioned
+database dbname=test
+sql versioned1.sql
+
+versioned1
diff --git a/demo/more/versioned1.urs b/demo/more/versioned1.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/more/versioned1.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page