Import urweb_20170720+dfsg.orig.tar.gz

[dgit import orig urweb_20170720+dfsg.orig.tar.gz]

1207 files changed, 95402 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b30fa84
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,78 @@
+*~
+.cm
+src/.cm
+
+bin/*
+
+src/urweb.cm
+src/urweb.mlb
+
+*.lex.*
+*.grm.*
+*.o
+.deps
+.libs
+*.lo
+*.la
+*.mlton.grm
+*.mlton.lex
+
+src/config.sml
+
+*.exe
+
+*.cache
+*.log
+*.status
+
+demo/out/*.html
+demo/demo.*
+
+demo/more/out/*.html
+demo/more/demo.*
+
+doc/*.html
+doc/*.out
+
+*.sql
+*mlmon.out
+
+*.aux
+*.dvi
+*.pdf
+*.ps
+*.toc
+
+.depend
+Makefile.coq
+*.vo
+*.v.d
+*.glob
+
+xml/parse
+xml/entities.sml
+
+Makefile.in
+src/c/Makefile.in
+ar-lib
+*.m4
+m4/libtool.m4
+m4/lt*.m4
+config.*
+configure
+depcomp
+compile
+install-sh
+ltmain.sh
+missing
+
+tests/*.db
+
+syntax: regexp
+
+Makefile
+src/c/Makefile
+libtool
+include/urweb/config.h
+include/urweb/config.h.in
+include/urweb/stamp-h1
diff --git a/.mailmap b/.mailmap
new file mode 100644
index 0000000..abfaa56
--- /dev/null
+++ b/.mailmap
@@ -0,0 +1 @@
+<bbaren@mit.edu> <bbaren at mit.edu>
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..df4e4ab
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,28 @@
+language: c
+
+os:
+  - linux
+  - osx
+
+compiler:
+  - clang
+  - gcc
+
+# when https://github.com/travis-ci/apt-package-whitelist/issues/792 is closed, use the container-based infrastructure
+#sudo: false
+#addons:
+#  apt:
+#    packages:
+#    - mlton
+
+before_install:
+  - export CONFIGURE_ARGS=""
+  - if command -v apt-get &>/dev/null; then sudo apt-get update -qq; fi
+  - if command -v apt-get &>/dev/null; then sudo apt-get install -y mlton; fi
+  - if command -v brew &>/dev/null; then brew update; fi
+  - if command -v brew &>/dev/null; then brew uninstall libtool; fi
+  - if command -v brew &>/dev/null; then brew install libtool; fi
+  - if command -v brew &>/dev/null; then brew install openssl mlton; fi
+  - if command -v brew &>/dev/null; then export CONFIGURE_ARGS="--with-openssl=/usr/local/opt/openssl"; fi
+
+script: ./autogen.sh && ./configure $CONFIGURE_ARGS && make && make test
diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
index 0000000..94d3b0a
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,758 @@
+========
+20170720
+========
+
+- New .urp directive: 'jsModule'
+- New compiler command-line option: '-js'
+- New HTML attribute for <button>: 'disabled'
+- Allow inexhaustive patterns for lefthand sides of top-level 'val' declarations
+- New standard-library functions: 'List.appi' and 'Option.app'
+- Support for Emacs bg-build mode
+- Bug fixes and improvements to error messages
+
+========
+20170105
+========
+
+- Allow qualified variable references in record literals
+- Add 'placeholder' attribute for textareas
+- Add more explicit build instructions to main demo
+- Bug fixes
+
+========
+20161022
+========
+
+- Add Json module to standard library
+- Make HTML5 the default and add 'xhtml' .urp directive
+- Remove 'Value' attributes for AJAX-y UI widgets, because they should use 'Source' instead
+- Change compiler to support reproducible builds, via replacement of timestamp
+  calculation with different methods or use of content hashes
+- IPv6 support in HTTP-server binaries, via '-A' command-line option
+- New Top function: mapUX_rev
+- Bug fixes and documentation improvements
+
+========
+20160805
+========
+
+- Compatibility fixes for C compilers and OpenSSL
+- Starting to change SQL functions to return results in most natural order
+  - Step 1: queryL
+- Bug fixes
+
+========
+20160621
+========
+
+- Client-side: detect session timeout and ask the user to reload
+- New Basis math functions: abs, acos, asin, atan, atan2, cos, exp, floor, log, pow, sqrt, sin
+- Compatibility fixes for newer C and SML compilers
+- Bug fixes
+
+========
+20160515
+========
+
+- Support for HTML <meta> tags
+- Resource-integrity attributes for HTML <link>
+- Bug fixes and optimization improvements
+
+========
+20160306
+========
+
+- Allow '\r' in string and character literals
+- New standard library functions: List.span and List.groupBy
+- Bug fixes
+
+========
+20160213
+========
+
+- .urp 'library' directive: only process a given library the first time it is referenced
+- For maintenance of Ur/Web project source code, switched from Mercurial to Git
+- Added Travis integration
+- Bug fixes and improvements to type inference and compatibility
+
+========
+20151220
+========
+
+- New .urp directive: 'jsFile'
+- Merged an experimental automatic caching optimization, triggered with '-sqlcache'
+- Bug fixes
+
+========
+20151122
+========
+
+- Daemon mode now supports shared caching of libraries across projects.
+- Change behavior of SQL equality to do the intuitive thing for nullable types.
+- Basis.fromMilliseconds
+- Bug fixes and improvements to type inference and error messages
+
+========
+20151018
+========
+
+- Applications now reconnect to database server automatically after losing connection.
+- Bug fixes and improvements to compatibility, documentation, and error messages
+
+========
+20150819
+========
+
+- Allow mouse and key events for <body>
+- Add HTML 'align' attribute
+- Add onChange handler to radioOption
+- New literal [_LOC_] that is replaced with textual information on location in source file
+- Add a simple 'make test' target
+- Bug fixes and documentation improvements
+
+========
+20150520
+========
+
+- Change default behavior of client-side GUI event handlers:
+  By default, events are now passed to handlers on parent DOM nodes as well,
+  just like in normal JavaScript.
+  Call [preventDefault] or [stopPropagation] to tweak that behavior.
+  WARNING: This change may break backward compatibility!
+- URIs specified with 'file' .urp directive are implicitly allowed to be referenced.
+- New HTML tags: <fieldset>, <legend>
+- New urweb-mode Emacs command: 'urweb-close-matching-tag'
+- Bug fixes
+
+========
+20150412
+========
+
+- Several new infix operators for function composition, etc.
+- Hexadecimal integer literals
+- New HTML events: 'oncontextmenu', 'onmouseenter', and 'onmouseleave'
+- New HTML attributes: 'download'
+- Bug fixes and optimization improvements
+
+========
+20150214
+========
+
+- Bug fixes and improvements to type inference and optimization
+
+========
+20150103
+========
+
+- New antiquote syntax for 'ORDER BY' clauses
+- New standard library function: List.mem
+- Bug fixes and improvements to type inference
+
+========
+20141206
+========
+
+- New HTML5 form widget tags and attributes
+- New command-line option for HTTP servers: '-T', to set recv() timeout
+- New C function uw_remoteSock() for use in FFI code
+- Bug fixes and improvements to type inference and optimization
+
+========
+20140830
+========
+
+- New HTML attribute: 'role'
+- Bug fixes
+
+========
+20140819
+========
+
+- Improvements to HTML model
+- Bug fixes and optimization improvements
+
+========
+20140807
+========
+
+- New .urp directive: 'file'
+- Support for 'aria-*' attributes in HTML
+- Default value of 'jsFunc' for less-safe FFI
+- Client-side implementation of Basis function 'strsindex'
+- Bug fixes and improvements to type inference and documentation
+
+========
+20140704
+========
+
+- New syntactic shorthand for antiquoting subqueries
+- New Top members: max and min
+- 'sql_injectable_prim' instance for 'url'
+- Bug fixes
+
+========
+20140615
+========
+
+- New syntactic sugar: 'let E where DS end' for 'let DS in E end'
+- Add 'onChange' attributes to more tags.
+- New standard library function: String.trim
+- Start treating Ur/Web tag <button> as real HTML tag <button>,
+  with special handling of 'value' attribute as tag content.
+- Bug fixes
+
+========
+20140531
+========
+
+- Parsing extension: monadic bind supports patterns, like "(x, y) <- a; b"
+- New, optional less safe FFI
+- New HTML tags: <tbody>, <tfoot>, <thead>
+- HTML5 data-* attributes
+- HTML5 semantic tags
+- Syntactic sugar extension: allow parens grouping joins in FROM clauses
+- Bug fixes and documentation improvements
+
+========
+20140426
+========
+
+- New Basis functions having to do with dates and times, wrapped nicely in new
+  Datetime module of standard library
+- New .urp directives: 'html5', 'neverInline', 'noMangleSql'
+- New command-line arguments: '-explainEmbed', '-stop'
+- Changes to C FFI interface, especially for uw_register_transactional()
+- 'Basis.getEnv' now always calls UNIX getenv() outside a page handler.
+- Changed <active> to avoid generating an empty <span> for empty content.
+- New HTML tag: <pre>
+- Bug fixes and improvements to type inference, optimizations, and documentation
+
+========
+20131231
+========
+
+- Performance optimizations for Ur/Web's standalone HTTP servers
+- New command-line options for those servers: '-k' and '-q'
+- New HTML pseudo-tag: <script>
+- Trying to recv() from a different client's channel now triggers a run-time
+  error.
+- New compiler command-line argument: -print-cinclude
+- Bug fixes and improvements to optimizations, error messages, and documentation
+
+========
+20131124
+========
+
+- Extend 'where con' to allow descending into submodule structure
+- Type inference improvements
+- Treat transactional FFI functions as effectful by default,
+  so that 'effectful'/'benignEffectful' .urp directives aren't necessary
+- Interpret 'table' signature items more flexibly,
+  automatically adding (Ur) constraints to support
+  a kind of subtyping over (SQL) constraint sets
+- New header file scheme to support FFI code in either of C or C++
+- New command-line arguments: -ccompiler, -print-ccompiler
+- More HTML tags: <dd>, <dl>, <dt>, <em>, and <strong>
+- Add 'rel' attribute to <a>
+- New type synonym 'xhead'
+- Refactored the development Mercurial repository to remove autogenerated files
+- More integration with Autotools distribution functionality
+- Improvements to documentation and compiler error messages
+- Bug fixes and optimization improvements
+
+========
+20130421
+========
+
+- Allow any FFI module to declare new HTML tags
+- Ignore polymorphism in JavaScript calls to custom FFI functions, allowing a
+  kind of simple dynamic typing (unsafe, of course)
+- Add some name-mangling rules to allow XML attribute 'name' and attributes with
+  dashes
+- New Basis members: pow and tryRpc
+- Add 'placeholder' attribute for <password>
+- New standard library functions: Option.unsafeGet
+- Add ./configure MLTONARGS option for MLTON arguments
+- Bug fixes and documentation improvements
+
+========
+20120925
+========
+
+- Changes to optimization/compilation strategy that can speed up compilation and
+  reduce code size dramatically
+- New .urp directives: 'coreInline' and 'monoInline'
+- 'show' instance for 'sql_query'
+- Improvements to compiler error messages
+- Bug fixes and optimization improvements
+
+========
+20120807
+========
+
+- Client-side mouse and keyboard event handlers are now functions over records.
+- More flexibility in local type class instances
+- Remove 'class' declaration; use 'con' instead now.
+- SQL window functions
+- New HTML pseudo-tag: <active>
+- New Basis members: getenv (and associated functions), giveFocus
+- New Top member: postFields (to process POST form data when called by some external script)
+- HTTP daemons take '-a' option to set IP address to listen on
+- More global mouse event hooks
+- Bug fixes and performance improvements
+
+========
+20120519
+========
+
+- Compatibility fixes for new Automake and GCC versions
+- Allow synchronous RPC's in 'onunload' code
+- Start of special cases for parsing CSS class names: interpret "table" as identifier 'tabl'
+  (since 'table' is an Ur/Web keyword)
+- Bug fixes and improvements to type inference and optimization
+
+========
+20120512
+========
+
+- New support for CSS style code embedded in Ur/Web programs.
+  Two recommended usage methods:
+  1. Use 'style' attributes with normal CSS syntax inside string literals.
+  2. Generate styles programmatically with the Style module of the Gui library
+     (distributed separately).
+- 'dynStyle' attribute, which is to 'style' as 'dynClass' is to 'class'
+- Parsing of standard syntax for 'class' attributes, via specially interpreted
+  string literals
+- New optional suffix for 'rewrite' in .urp files: [-]
+- Compiler error message improvements, including simplification of types
+- New command line parameters: '-boot', '-dumpTypesOnError', '-unifyMore'
+- New .urp directives: 'linker'
+- Support for speeding up compilation by caching type inference results:
+  Run 'urweb daemon start' to spawn a background process,
+  'urweb daemon stop' to kill it.
+- Enforcement of uniqueness of top-level module names across a project
+- Adjust error message format to match Emacs compilation mode defaults
+- More HTML attributes added
+- New antiquote syntax for 'PRIMARY KEY'
+- Bug fixes and improvements to type inference and platform compatibility
+
+========
+20120329
+========
+
+- New JavaScript FFI function: setInnerHTML
+- Bug fixes
+- Documentation improvements
+
+========
+20120310
+========
+
+- 'ORDER BY RANDOM'
+- New Basis members: diffInMilliseconds, toMilliseconds
+- <radio> widget now returns 'option string' instead of 'string'
+- '-dumpSource' command-line flag
+- Bug fixes and optimization improvements
+
+========
+20120110
+========
+
+- Improvements to type inference and error messages
+- New 'dynClass' pseudo-attribute for most HTML tags
+- New 't.*' notation for selecting all columns of a table
+- New SQL functions: 'lower' and 'upper'
+- 'timeFormat' .urp directive
+- Client-side 'debug' and 'naughtyDebug' calls use a browser debug console, if available
+- Allow 'source' values to be returned by RPCs
+- Change the HTML context classification scheme in 'Basis'
+- Rename 'Top.id' to 'ident' to avoid clash with 'Basis.id'
+- More client-side function implementations
+- Some expanded reference manual sections
+- Tweak to linker command line argument order (to prevent issues with new Ubuntu versions)
+- Bug fixes
+
+========
+20111127
+========
+
+- Improvements to type inference and error messages
+- New Basis members: ceil, float, null, round, trunc
+- New SQL expression forms: 'IF..THEN..ELSE', 'COALESCE', and 'LIKE'
+- Support for the full set of HTML character entities
+- Client-side versions of some time-related functions
+- New URWEB_PG_CON environment variable
+- Allow arguments for 'con' signature items, not just declarations
+- Bug fixes and performance improvements
+- Tweaks for idiosyncrasies of OS X (like deprecated OpenSSL)
+
+========
+20110917
+========
+
+- Start of official tutorial
+- Compiler support for generating nice tutorial HTML from literate source files
+- New protocol 'static' for generating static pages
+- Replace GCCARGS 'configure' variable with CCARGS
+- Better support for compilation with Clang (including on OS X)
+- Fancier 'configure' script with versioning
+- Applications consult URWEB_STACK_SIZE environment variable to determine thread
+  stack size
+- HTML tag IDs now drawn from an abstract type
+- New Basis functions: diffInSeconds, mkMonad, onClick, onDblclick, onKeydown,
+  onKeypress, onKeyup, onMousedown, onMouseup, preventDefault, stopPropagation,
+  toSeconds
+- Add <image> tag
+- Add 'target' attribute for <a>
+- New compiler command-line option: -dumpTypes
+- New syntactic sugar for computed ORDER BY clauses
+- Bug fixes and optimization improvements
+
+========
+20110715
+========
+
+- Treat local variables the same as module-level variables, for the purpose of
+  implicit argument insertion
+- New 'noXsrfProtection' directive for .urp files
+- Non-debug builds omit source location information in error messages shown to
+  the user (but keep that information in log entries)
+- Basis.getHeader and Basis.setHeader
+- Basis.show_css_class
+- Basis.currentUrlHasQueryString
+- Make Basis.rand cryptographically secure
+- Client-side versions of Basis.now and Basis.show_time
+- Bug fixes
+- Improvements to auto-configuration and build process (now builds with LLVM's
+  Clang!)
+- Clarifications in the manual
+
+========
+20110517
+========
+
+- Cygwin compatibility
+- Compatibility with Gentoo packaging process, including a .ebuild file
+- Change typing of SQL subqueries, to indicate that they may always return NULL
+  (for no rows)
+- Syntactic sugar for GROUP BY with variable numbers of columns
+  (using 'tab.{{c}}', where 'c :: {Type}')
+- 'ALL' for SQL relational operators
+- Add nullable types to the class for valid operands for SQL arithmetic
+- 'alt' attribute for <img>
+- <sup> and <sub> HTML tags
+- Allow 'debug' and 'naughtyDebug' in client-side code, implemented with 'alert'
+- Bug fixes and optimization improvements
+
+========
+20110123
+========
+
+- Changes to encoding of SQL aggregate functions: nullable types may be
+  aggregated, and non-COUNT aggregates return nullable results.
+- SQL subqueries may apply aggregate functions to columns bound in enclosing
+  queries.
+- Switch from libmhash to OpenSSL.
+- 'cdataChar', for injecting arbitrary character codes into XML
+- 'crypt', for access to the standard UNIX password encryption routine
+- 'readUtc', for parsing time strings in the UTC time zone
+- Built-in 'time' type now stores microseconds (which for now are only used in
+  connection with Postgres timestamps).
+- Client-side URL blessing and redirection
+- 'currentUrlHasPost' function
+- Transactional 'free' functions now passed an argument indicating whether the
+  runtime system expects to retry the transaction.
+- Change tasks to allow task kind-specific inputs
+- Add 'clientLeaves' and 'periodic' task kinds
+- Support for externally-callable pages, via the 'postBody' and 'queryString'
+  types and the 'effectfulUrl' function
+- 'minHeap' and 'alwaysInline' .urp options
+- '-prefix' command-line option
+- Comments in .urp files (lines starting with '#')
+- Miscellaneous additions to the standard library
+- Bug fixes and improvements to type inference and optimization
+
+========
+20101102
+========
+
+- Polymorphic variants (see Basis.variant)
+- New 'onError' directive for .urp files
+- (* *) and <!-- --> comments in XML
+- Basis.classes, Basis.confirm, and Basis.tryDml
+- New notations ::_ and :::_, for constructor parameters of unknown kind
+- Invocations like 'urweb foo' will compile foo.ur as a single-file project,
+  even if no foo.urp exists
+- '-limit' command-line flag and 'limit' .urp directive
+- Bug fixes and optimization improvements
+
+========
+20100603
+========
+
+- Changed URL escaping convention, to avoid confusing proxies.
+  The new convention is like the normal one, but with '.' instead of '%'.
+- Changed JavaScript compilation of recursive functions to use thunks.
+  This change avoids most costs of functions not referenced on particular
+  pages, reducing loading time dramatically.
+- Support HTTP caching of application-specific JavaScript code
+- Bug fixes
+
+========
+20100506
+========
+
+- New experimental checker for information flow and access control policies
+  (See demo at http://www.impredicative.com/ur/scdv/)
+
+========
+20100401
+========
+
+- Subquery expressions and FROM items
+- Low-level support for SELECT with no FROM clause
+- Fixes for DBMS-portability of relational operators
+
+========
+20100325
+========
+
+- -verbose flag
+- COUNT(col) SQL aggregate function
+- 'benignEffectful' and 'safeGet' .urp commands
+- Remove Basis.getRequestHeader, since it can be used to circumvent cookie
+  security
+- Rename Top.foldR*X to map*X
+- Bug fixes and optimization improvements
+
+========
+20100213
+========
+
+- Improvements to 'configure'; should now fail if any uncommon but required
+  package is missing
+- Other fixes to configuration, build system, and C code portability
+- sigfile .urp directive & -sigfile command-line option
+- .urp files with no directives no longer need to begin with blank lines.
+- Other bug fixes
+
+========
+20100130
+========
+
+- Conversion to an Automake-based build system, for greater portability in
+  building shared libraries
+- -path and -root command-line flags
+- Exported page handling functions (i.e., those page-generating functions
+  appearing in the main module's signature) may now take any number of
+  arguments, including 0.
+
+========
+20100112
+========
+
+- Basis.serialized type family, for storing more types in the database
+- Basis.textBlob, for building blobs from strings
+- Basis.debug function, for server-side debug printing
+- Bug fixes & optimization improvements
+
+========
+20091230
+========
+
+- Automatic insertion of implicit arguments in more positions
+- Reifying expressions as URLs and redirecting to them explicitly
+- 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
+- Tasks
+- Dynamic linking of the runtime system
+- Optimization improvements
+- Bug fixes
+
+========
+20091203
+========
+
+- Extended cookie interface (breaks backward compatibility for 'setCookie')
+- Bug fixes
+- Extended UTF-8 characters in HTML
+
+========
+20091124
+========
+
+- Improved Internet Explorer compatibility
+
+========
+20091108
+========
+
+- Bug fixes
+- Optimization improvements
+- Removed a restriction that prevented some RPCs and calls to sleep or recv
+  from compiling
+
+========
+20091012
+========
+
+- Small bug fixes affecting MySQL and SQLite
+
+========
+20091009
+========
+
+- Bug fixes
+- Improvement to choice of line number to cite in record unification error
+  messages
+- SELECT DISTINCT
+- New extra demos: orm1 and versioned1
+
+========
+20090926
+========
+
+- Reimplemented client-side code generation to use an interpreter, rather than
+  compilation to JavaScript; this avoids common browser flaws: lack of
+  optimization of tail calls and occasional bugs in closure handling.
+- Bug fixes
+
+========
+20090919
+========
+
+- Bug fixes
+- Optimization improvements
+- Expanded grid demo in demo/more: optional columns, sorting, filtering,
+  paging, selecting rows, aggregate row
+
+========
+20090912
+========
+
+- Bug fixes
+- Optimization improvements
+- New set of extra demos in demo/more
+
+========
+20090825
+========
+
+- Many bug fixes
+- Remote procedure calls must be marked with the new 'rpc' function.
+- Some tweaks to enable usage on OSX (suggested by Paul Snively)
+
+========
+20090718
+========
+
+- New application protocols: CGI and FastCGI
+- New database backends: MySQL and SQLite
+- More JavaScript events added to tags in standard library
+- New manual section on using the foreign function interface (FFI)
+
+========
+20090623
+========
+
+- Many bug fixes
+- Mutually-recursive datatypes
+- SML-style pattern-matching syntax for "fun", "fn", and local "val"
+- Backwards-incompatible change to syntax of formal constructor parameters to
+  value-level functions, to support the previous change
+- Path map support inspired by SML/NJ CM and MLton ML Basis
+- Start of some new standard library modules
+- Some improvements to JavaScript runtime, including better error handling
+
+========
+20090505
+========
+
+- Reimplement constructor class resolution to be more general and Prolog-like
+- SQL table constraints
+- URLs
+- Client-side error handling callbacks
+- CSS
+- Signing cookie values cryptographically to thwart cross site request forgery
+- Blobs and HTTP file upload
+- SQL outer joins
+- SQL views
+- Subforms
+- C and JavaScript FFI
+- Path rewriting
+
+========
+20090405
+========
+
+- Asynchronous message-passing and the associated server-side client
+  bookkeeping
+- Reimplement parts of the client-side runtime system to avoid space leaks
+- spawn and sleep
+- Expand the constructor class instance rule format
+
+========
+20090312
+========
+
+- Replace type-level "fold" with "map"
+- Replace expression-level "fold" with folders, defined in Top and
+  supported by some special compiler inference
+- Replace guarded constructors with guarded types, introduced only by
+  guarded expression abstraction, and with a new explicit application form
+- Kind polymorphism
+- Generalize type classes to constructor classes
+- Initial compilation of client-side code to JavaScript
+- Initial support for mixed client- and server-side programming (i.e., "AJAX")
+- src/coq: Coq formalization of a core Ur-like calculus
+
+========
+20081209
+========
+
+- Optimization: Fusing page writes with calls to recursive functions
+- Optimization of bottleneck compiler phases
+- Reference manual
+- SQL arithmetic operators
+
+========
+20081120
+========
+
+- Fix bug that sometimes led to omission of initial "<html>" in pages
+- Take advantage of nested functions in some demos
+- "profile" option that may appear in .urp files, to enable gprof profiling
+- "-guided-demo" option that works like "-demo" but uses less screen space for
+  prose
+
+========
+20081118
+========
+
+- Nested function definitions
+- Primitive "time" type
+- Nullable SQL columns (via "option")
+- Cookies
+- Compiler: Specialization of functions to known arguments (especially of
+  function type)
+
+========
+20081028
+========
+
+- Add GCCARGS configure option
+
+========
+20081027
+========
+
+- On missing inputs, print an error message, but don't exit the web server.
+- Remove need for "() <-" notation.
+
+========
+20081026
+========
+
+- Change 'sed' call to work on OSX.
+- Avoid including or linking libpq files on apps that don't use SQL.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..78f1e4b
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+Copyright (c) 2008-2011, Adam Chlipala
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+- The names of contributors may not be used to endorse or promote products
+  derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..f0392de
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,144 @@
+ACLOCAL_AMFLAGS = -I m4
+
+BIN       = @BIN@
+SRCLIB    = @SRCLIB@
+INCLUDE   = @INCLUDE@
+SITELISP  = @SITELISP@
+VERSION   = @VERSION@
+MLTONARGS = @MLTONARGS@
+
+LIB_UR   = $(SRCLIB)/ur
+LIB_C    = $(SRCLIB)/c
+LIB_JS   = $(SRCLIB)/js
+
+all-local: smlnj mlton
+
+SUBDIRS = src/c
+
+.PHONY: smlnj mlton package reauto test
+
+smlnj: src/urweb.cm xml/entities.sml
+mlton: bin/urweb
+mlton-tc: bin/urwebtc
+
+clean-local:
+	rm -f bin/urweb src/urweb.mlton.* \
+		src/urweb.cm src/urweb.mlb xml/parse xml/entities.sml
+	rm -rf .cm src/.cm
+
+src/urweb.cm: src/prefix.cm src/sources
+	cat $^ | sed -e 's/$$(SRC)\///g' > $@
+
+src/urweb.mlb: src/prefix.mlb src/sources src/suffix.mlb
+	sed -e 's/^\(.*\).grm$$/$$(BUILD)\/\1.mlton.grm.sig:\1.mlton.grm.sml/' -e 'y/:/\n/' \
+		-e 's/^\(.*\).lex$$/$$(BUILD)\/\1.mlton.lex.sml/' \
+	$^ > $@
+
+src/urweb.mlton.lex: src/urweb.lex
+	cp $< $@
+src/urweb.mlton.grm: src/urweb.grm
+	cp $< $@
+
+src/urweb.mlton.lex.sml: src/urweb.mlton.lex
+	mllex $<
+
+src/urweb.mlton.grm.sig src/urweb.mlton.grm.sml: src/urweb.mlton.grm
+	mlyacc $<
+
+MLTON = mlton
+
+#ifdef DEBUG
+#	MLTON += -const 'Exn.keepHistory true'
+#endif
+
+#ifdef PROFILE
+#	MLTON += -profile $(PROFILE)
+#endif
+
+bin/urweb: src/compiler.mlb xml/entities.sml \
+		src/urweb.mlb $(srcdir)/src/*.sig $(srcdir)/src/*.sml src/config.sml \
+		src/urweb.mlton.lex.sml \
+		src/urweb.mlton.grm.sig src/urweb.mlton.grm.sml
+	mkdir -p bin
+	$(MLTON) $(MLTONARGS) -mlb-path-var 'SRC $(abs_srcdir)/src' -mlb-path-var 'BUILD $(abs_builddir)/src' -output $@ $<
+bin/urwebtc: src/compiler.mlb xml/entities.sml \
+		src/urweb.mlb $(srcdir)/src/*.sig $(srcdir)/src/*.sml src/config.sml \
+		src/urweb.mlton.lex.sml \
+		src/urweb.mlton.grm.sig src/urweb.mlton.grm.sml
+	mkdir -p bin
+	$(MLTON) $(MLTONARGS) -prefer-abs-paths true -show-def-use compiler.du -stop tc -mlb-path-var 'SRC $(abs_srcdir)/src' -mlb-path-var 'BUILD $(abs_builddir)/src' -output $@ $<
+
+xml/entities.sml: xml/parse xml/xhtml-lat1.ent xml/xhtml-special.ent xml/xhtml-symbol.ent
+	$^ > $@
+
+xml/parse: xml/parse.sml
+	mkdir -p xml
+	$(MLTON) $(MLTONARGS) -output $@ $<
+
+install-exec-emacs:
+if USE_EMACS
+	mkdir -p $(DESTDIR)$(SITELISP)
+	cp $(srcdir)/src/elisp/*.el $(DESTDIR)$(SITELISP)/
+endif
+
+install-exec-local-main:
+	mkdir -p $(DESTDIR)$(BIN)
+	install bin/urweb $(DESTDIR)$(BIN)/
+	mkdir -p $(DESTDIR)$(LIB_UR)
+	cp $(srcdir)/lib/ur/*.urs $(DESTDIR)$(LIB_UR)/
+	cp $(srcdir)/lib/ur/*.ur $(DESTDIR)$(LIB_UR)/
+	mkdir -p $(DESTDIR)$(LIB_JS)
+	cp $(srcdir)/lib/js/*.js $(DESTDIR)$(LIB_JS)/
+	mkdir -p $(DESTDIR)$(INCLUDE)
+	cp $(srcdir)/include/urweb/*.h $(DESTDIR)$(INCLUDE)/
+
+install-exec-local: install-exec-local-main install-exec-emacs
+	-ldconfig
+
+uninstall-emacs:
+if USE_EMACS
+	rm -f $(DESTDIR)$(SITELISP)/urweb-compat.el $(DESTDIR)$(SITELISP)/urweb-mode.el $(DESTDIR)$(SITELISP)/urweb-move.el \
+		$(DESTDIR)$(SITELISP)/urweb-defs.el $(DESTDIR)$(SITELISP)/urweb-mode-startup.el $(DESTDIR)$(SITELISP)/urweb-util.el
+endif
+
+uninstall-local-main:
+	rm -f $(DESTDIR)$(BIN)/urweb $(DESTDIR)$(LIB_UR)/basis.urs $(DESTDIR)$(LIB_UR)/char.urs $(DESTDIR)$(LIB_UR)/datetime.urs		\
+		$(DESTDIR)$(LIB_UR)/listPair.urs $(DESTDIR)$(LIB_UR)/list.urs $(DESTDIR)$(LIB_UR)/monad.urs					\
+		$(DESTDIR)$(LIB_UR)/option.urs $(DESTDIR)$(LIB_UR)/string.urs $(DESTDIR)$(LIB_UR)/top.urs $(DESTDIR)$(LIB_UR)/char.ur		\
+		$(DESTDIR)$(LIB_UR)/datetime.ur $(DESTDIR)$(LIB_UR)/listPair.ur $(DESTDIR)$(LIB_UR)/list.ur $(DESTDIR)$(LIB_UR)/monad.ur	\
+		$(DESTDIR)$(LIB_UR)/option.ur $(DESTDIR)$(LIB_UR)/string.ur $(DESTDIR)$(LIB_UR)/top.ur $(DESTDIR)$(LIB_JS)/urweb.js		\
+		$(DESTDIR)$(INCLUDE)/config.h $(DESTDIR)$(INCLUDE)/queue.h $(DESTDIR)$(INCLUDE)/request.h $(DESTDIR)$(INCLUDE)/types.h		\
+		$(DESTDIR)$(INCLUDE)/urweb.h $(DESTDIR)$(INCLUDE)/types_cpp.h $(DESTDIR)$(INCLUDE)/urweb_cpp.h
+
+uninstall-local: uninstall-local-main uninstall-emacs
+
+EXTRA_DIST = demo doc lib/js lib/ur xml \
+	src/coq src/*.sig src/*.sml src/*.mlb src/config.sml.in src/elisp src/*.cm src/sources src/*.grm src/*.lex \
+	CHANGELOG LICENSE urweb.ebuild include/urweb/*.h bin
+
+TESTDB = /tmp/urweb.db
+TESTPID = /tmp/urweb.pid
+
+test:
+	bin/urweb -boot -noEmacs -dbms sqlite -db $(TESTDB) -demo /Demo demo
+	rm -f $(TESTDB)
+	sqlite3 $(TESTDB) < demo/demo.sql
+	demo/demo.exe -q -a 127.0.0.1 & echo $$! > $(TESTPID)
+	sleep 1
+	(curl -s 'http://localhost:8080/Demo/Hello/main' | diff tests/hello.html -) || (kill `cat $(TESTPID)`; echo "Test 'Hello' failed"; /bin/false)
+	(curl -s 'http://localhost:8080/Demo/Crud1/create?A=1&B=2&C=3&D=4' | diff tests/crud1.html -) || (kill `cat $(TESTPID)`; echo "Test 'Crud1' failed"; /bin/false)
+	kill `cat $(TESTPID)`
+	if (ifconfig lo | grep -q inet6); \
+	then \
+		echo "Running IPv6 tests."; \
+		rm -f $(TESTDB); \
+		sqlite3 $(TESTDB) < demo/demo.sql; \
+		demo/demo.exe -q -A ::1 & echo $$! > $(TESTPID); \
+		sleep 1; \
+		(curl -g -6 -s 'http://[::1]:8080/Demo/Hello/main' | diff tests/hello.html -) || (kill `cat $(TESTPID)`; echo "Test 'Hello' failed"; /bin/false); \
+		(curl -g -6 -s 'http://[::1]:8080/Demo/Crud1/create?A=1&B=2&C=3&D=4' | diff tests/crud1.html -) || (kill `cat $(TESTPID)`; echo "Test 'Crud1' failed"; /bin/false); \
+		kill `cat $(TESTPID)`; \
+	else \
+		echo "Skipped IPv6 tests."; \
+	fi
+	echo Tests succeeded.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..3bfd94a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,21 @@
+[![Build Status](https://api.travis-ci.org/urweb/urweb.png?branch=master)](https://travis-ci.org/urweb/urweb)
+
+# The Ur/Web Programming Language
+
+Implementation of a domain-specific functional programming language for web applications.  Please see [the Ur/Web project web site](http://www.impredicative.com/ur/) for much more information!  Here's a summary:
+
+Ur is a programming language in the tradition of ML and Haskell, but featuring a significantly richer type system. Ur is functional, pure, statically typed, and strict. Ur supports a powerful kind of metaprogramming based on row types.
+
+Ur/Web is Ur plus a special standard library and associated rules for parsing and optimization. Ur/Web supports construction of dynamic web applications backed by SQL databases. The signature of the standard library is such that well-typed Ur/Web programs "don't go wrong" in a very broad sense. Not only do they not crash during particular page generations, but they also may not:
+
+* Suffer from any kinds of code-injection attacks
+* Return invalid HTML
+* Contain dead intra-application links
+* Have mismatches between HTML forms and the fields expected by their handlers
+* Include client-side code that makes incorrect assumptions about the "AJAX"-style services that the remote web server provides
+* Attempt invalid SQL queries
+* Use improper marshaling or unmarshaling in communication with SQL databases or between browsers and web servers
+
+This type safety is just the foundation of the Ur/Web methodology. It is also possible to use metaprogramming to build significant application pieces by analysis of type structure. For instance, the demo includes an ML-style functor for building an admin interface for an arbitrary SQL table. The type system guarantees that the admin interface sub-application that comes out will always be free of the above-listed bugs, no matter which well-typed table description is given as input.
+
+The Ur/Web compiler also produces very efficient object code that does not use garbage collection. These compiled programs will often be even more efficient than what most programmers would bother to write in C. For example, the standalone web server generated for the demo uses less RAM than the bash shell. The compiler also generates JavaScript versions of client-side code, with no need to write those parts of applications in a different language.
diff --git a/autogen.sh b/autogen.sh
new file mode 100755
index 0000000..3ebda42
--- /dev/null
+++ b/autogen.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+autoreconf -fvi
diff --git a/build.bgb b/build.bgb
new file mode 100644
index 0000000..3898ee0
--- /dev/null
+++ b/build.bgb
@@ -0,0 +1,3 @@
+(bg-build
+ :name  "Compiler"
+ :shell "nice -n5 make bin/urwebtc")
diff --git a/caching-tests/bench.lua b/caching-tests/bench.lua
new file mode 100644
index 0000000..6799ca8
--- /dev/null
+++ b/caching-tests/bench.lua
@@ -0,0 +1,25 @@
+math.randomseed(os.time())
+
+p = 0.25
+n = 2000
+
+function init(args)
+  if args[1] then
+    p = tonumber(args[1])
+  end
+  if args[2] then
+    n = tonumber(args[2])
+  end
+end
+
+function request()
+  path = "/Bench/"
+  if math.random() < p then
+    path = path .. "flush"
+  else
+    path = path .. "check"
+  end
+  id = math.random(n)
+  path = path .. "/" .. id
+  return wrk.format(nil, path)
+end
diff --git a/caching-tests/bench.ur b/caching-tests/bench.ur
new file mode 100644
index 0000000..2661bd0
--- /dev/null
+++ b/caching-tests/bench.ur
@@ -0,0 +1,16 @@
+table tab : {Id : int, Val : int} PRIMARY KEY Id
+
+fun check id =
+    res <- oneOrNoRows (SELECT tab.Val FROM tab WHERE tab.Id = {[id]});
+    return <xml><body>
+      Value at {[id]} is
+      {case res of
+           None => <xml>unknown</xml>
+         | Some row => <xml>{[row.Tab.Val]}</xml>}.
+    </body></xml>
+
+fun flush id =
+    dml (UPDATE tab SET Val = Val + 1 WHERE Id = {[id]});
+    return <xml><body>
+      Incremented value at {[id]} (if it exists).
+    </body></xml>
diff --git a/caching-tests/bench.urp b/caching-tests/bench.urp
new file mode 100644
index 0000000..2155221
--- /dev/null
+++ b/caching-tests/bench.urp
@@ -0,0 +1,6 @@
+database host=localhost
+sql bench.sql
+safeGet Bench/flush
+minHeap 4096
+
+bench
diff --git a/caching-tests/bench.urs b/caching-tests/bench.urs
new file mode 100644
index 0000000..5f3d2ee
--- /dev/null
+++ b/caching-tests/bench.urs
@@ -0,0 +1,2 @@
+val check : int -> transaction page
+val flush : int -> transaction page
diff --git a/caching-tests/some-results.txt b/caching-tests/some-results.txt
new file mode 100644
index 0000000..2b314a5
--- /dev/null
+++ b/caching-tests/some-results.txt
@@ -0,0 +1,198 @@
+~/Dev/UrWeb/caching-tests
+$ urweb bench
+~/Dev/UrWeb/caching-tests
+$ ./bench.exe -q &
+[1] 24466
+~/Dev/UrWeb/caching-tests
+$ Initializing
+Initializing
+Initializing
+wrk -d 2 http://localhost:8080/Bench/ -s bench.lua -- 0.5
+Running 2s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency     1.41ms  320.22us   2.86ms   68.44%
+    Req/Sec     3.32k   696.42     4.25k    78.05%
+  13526 requests in 2.10s, 4.81MB read
+Requests/sec:   6439.96
+Transfer/sec:      2.29MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency     1.08ms  250.98us   2.64ms   66.33%
+    Req/Sec     4.34k   704.72     6.84k    81.09%
+  86850 requests in 10.10s, 30.70MB read
+Requests/sec:   8598.75
+Transfer/sec:      3.04MB
+~/Dev/UrWeb/caching-tests
+$ fg
+./bench.exe -q
+  C-c C-cExiting....
+~/Dev/UrWeb/caching-tests
+$ ./bench.exe -q -t 2 &
+[1] 24514
+~/Dev/UrWeb/caching-tests
+$ Initializing
+Initializing
+Initializing
+Initializing
+
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   370.59us   90.83us   2.14ms   71.69%
+    Req/Sec    11.34k     1.19k   16.34k    72.64%
+  226734 requests in 10.10s, 80.15MB read
+Requests/sec:  22449.54
+Transfer/sec:      7.94MB
+~/Dev/UrWeb/caching-tests
+$ fg
+./bench.exe -q -t 2
+  C-c C-cExiting....
+~/Dev/UrWeb/caching-tests
+$ urweb bench -sqlcache
+~/Dev/UrWeb/caching-tests
+$ ./bench.exe -q &
+[1] 24548
+~/Dev/UrWeb/caching-tests
+$ Initializing
+Initializing
+Initializing
+
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency     0.98ms  322.48us   4.68ms   71.58%
+    Req/Sec     4.71k   706.11     7.06k    69.31%
+  94654 requests in 10.10s, 33.46MB read
+Requests/sec:   9371.66
+Transfer/sec:      3.31MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency     0.86ms  354.48us   7.31ms   71.15%
+    Req/Sec     5.21k   740.74     7.83k    68.81%
+  104823 requests in 10.10s, 37.06MB read
+Requests/sec:  10378.81
+Transfer/sec:      3.67MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   703.16us  339.13us   2.82ms   68.28%
+    Req/Sec     6.10k     0.96k   10.43k    83.08%
+  121961 requests in 10.10s, 43.12MB read
+Requests/sec:  12074.21
+Transfer/sec:      4.27MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   637.87us  348.05us   2.81ms   68.34%
+    Req/Sec     6.63k     1.12k   10.99k    73.76%
+  133289 requests in 10.10s, 47.12MB read
+Requests/sec:  13197.03
+Transfer/sec:      4.67MB
+~/Dev/UrWeb/caching-tests
+$ fg
+./bench.exe -q
+  C-c C-cExiting....
+~/Dev/UrWeb/caching-tests
+$ ./bench.exe -q -t 2 &
+[1] 24616
+~/Dev/UrWeb/caching-tests
+$ Initializing
+Initializing
+Initializing
+Initializing
+
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency     0.98ms  436.87us   8.57ms   73.73%
+    Req/Sec     4.69k     1.05k    7.41k    62.87%
+  94186 requests in 10.10s, 33.30MB read
+Requests/sec:   9325.40
+Transfer/sec:      3.30MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   679.74us  357.72us   7.69ms   72.78%
+    Req/Sec     6.36k     1.23k    9.83k    70.65%
+  127238 requests in 10.10s, 44.98MB read
+Requests/sec:  12598.06
+Transfer/sec:      4.45MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   598.29us  351.32us   3.00ms   69.43%
+    Req/Sec     6.86k     1.01k   11.33k    75.50%
+  136554 requests in 10.00s, 48.28MB read
+Requests/sec:  13655.22
+Transfer/sec:      4.83MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   521.06us  331.23us   3.73ms   68.90%
+    Req/Sec     7.49k     1.20k   12.64k    85.07%
+  149875 requests in 10.10s, 52.98MB read
+Requests/sec:  14839.52
+Transfer/sec:      5.25MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   504.89us  347.06us   5.62ms   69.33%
+    Req/Sec     7.64k     0.94k   11.95k    69.80%
+  153398 requests in 10.10s, 54.23MB read
+Requests/sec:  15189.01
+Transfer/sec:      5.37MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   454.99us  315.26us   2.87ms   68.79%
+    Req/Sec     8.24k     1.20k   12.83k    80.10%
+  164779 requests in 10.10s, 58.25MB read
+Requests/sec:  16314.84
+Transfer/sec:      5.77MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   466.26us  326.63us   2.86ms   68.52%
+    Req/Sec     8.07k     1.04k   13.56k    74.13%
+  161404 requests in 10.10s, 57.06MB read
+Requests/sec:  15981.72
+Transfer/sec:      5.65MB
+~/Dev/UrWeb/caching-tests
+$ wrk http://localhost:8080/Bench/ -s bench.lua -- 0.1 100000
+Running 10s test @ http://localhost:8080/Bench/
+  2 threads and 10 connections
+  Thread Stats   Avg      Stdev     Max   +/- Stdev
+    Latency   458.75us  319.02us   3.11ms   68.07%
+    Req/Sec     8.15k   768.18    11.30k    69.80%
+  163930 requests in 10.10s, 57.95MB read
+Requests/sec:  16231.27
+Transfer/sec:      5.74MB
diff --git a/caching-tests/test.ur b/caching-tests/test.ur
new file mode 100644
index 0000000..e0dab92
--- /dev/null
+++ b/caching-tests/test.ur
@@ -0,0 +1,111 @@
+table tab : {Id : int, Val : int, Foo : int} PRIMARY KEY Id
+
+fun cache id =
+    res <- oneOrNoRows (SELECT A.Val FROM (tab AS A JOIN tab AS B ON A.Id = B.Id)
+                                     WHERE B.Id = {[id]});
+    return <xml><body>
+      cache
+      {case res of
+           None => <xml>?</xml>
+         | Some row => <xml>{[row.A.Val]}</xml>}
+    </body></xml>
+
+(* fun cacheAlt id = *)
+(*     res <- oneOrNoRows (SELECT Q.Id *)
+(*                         FROM (SELECT Tab.Id AS Id FROM tab WHERE Tab.Id = {[id]}) *)
+(*                         AS Q); *)
+(*     return <xml><body> *)
+(*       cacheAlt *)
+(*       {case res of *)
+(*            None => <xml>?</xml> *)
+(*          | Some row => <xml>{[row.Q.Id]}</xml>} *)
+(*     </body></xml> *)
+
+(* fun sillyRecursive {Id = id : int, FooBar = fooBar} = *)
+(*     if fooBar <= 0 *)
+(*     then 0 *)
+(*     else 1 + sillyRecursive {Id = id, FooBar = fooBar - 1} *)
+
+(* fun cacheR (r : {Id : int, FooBar : int}) = *)
+(*     res <- oneOrNoRows (SELECT tab.Val *)
+(*                         FROM tab *)
+(*                         WHERE tab.Id = {[r.Id]}); *)
+(*     return <xml><body> *)
+(*       cacheR {[r.FooBar]} *)
+(*       {case res of *)
+(*            None => <xml>?</xml> *)
+(*          | Some row => <xml>{[row.Tab.Val]}</xml>} *)
+(*     </body></xml> *)
+
+(* fun cache2 id v = *)
+(*     res <- oneOrNoRows (SELECT tab.Val *)
+(*                         FROM tab *)
+(*                         WHERE tab.Id = {[id]} AND tab.Val = {[v]}); *)
+(*     return <xml><body> *)
+(*       Reading {[id]}. *)
+(*       {case res of *)
+(*            None => <xml>Nope, that's not it.</xml> *)
+(*          | Some _ => <xml>Hooray! You guessed it!</xml>} *)
+(*     </body></xml> *)
+
+(* fun cache2 id1 id2 = *)
+(*     res1 <- oneOrNoRows (SELECT tab.Val *)
+(*                          FROM tab *)
+(*                          WHERE tab.Id = {[id1]}); *)
+(*     res2 <- oneOrNoRows (SELECT tab.Val *)
+(*                          FROM tab *)
+(*                          WHERE tab.Id = {[id2]}); *)
+(*     return <xml><body> *)
+(*       Reading {[id1]} and {[id2]}. *)
+(*       {case (res1, res2) of *)
+(*            (Some _, Some _) => <xml>Both are there.</xml> *)
+(*          | _ => <xml>One of them is missing.</xml>} *)
+(*     </body></xml> *)
+
+fun flush id =
+    dml (UPDATE tab
+         SET Val = Val * (Id + 2) / Val - 3
+         WHERE Id = {[id]} OR Id = {[id - 1]} OR Id = {[id + 1]});
+    return <xml><body>
+      Changed {[id]}!
+    </body></xml>
+
+(* fun flash id = *)
+(*     dml (UPDATE tab *)
+(*          SET Foo = Val *)
+(*          WHERE Id = {[id]} OR Id = {[id - 1]} OR Id = {[id + 1]}); *)
+(*     return <xml><body> *)
+(*       Maybe changed {[id]}? *)
+(*     </body></xml> *)
+
+(* fun floosh id = *)
+(*     dml (UPDATE tab *)
+(*          SET Id = {[id + 1]} *)
+(*          WHERE Id = {[id]} OR Id = {[id - 1]} OR Id = {[id + 1]}); *)
+(*     return <xml><body> *)
+(*       Shifted {[id]}! *)
+(*     </body></xml> *)
+
+(* val flush17 = *)
+(*     dml (UPDATE tab *)
+(*          SET Val = Val * (Id + 2) / Val - 3 *)
+(*          WHERE Id = 17); *)
+(*     return <xml><body> *)
+(*       Changed specifically 17! *)
+(*     </body></xml> *)
+
+(* fun flush id = *)
+(*     res <- oneOrNoRows (SELECT tab.Val *)
+(*                         FROM tab *)
+(*                         WHERE tab.Id = {[id]}); *)
+(*     (case res of *)
+(*          None => dml (INSERT INTO tab (Id, Val) *)
+(*                       VALUES ({[id]}, 0)) *)
+(*        | Some row => dml (UPDATE tab *)
+(*                           SET Val = {[row.Tab.Val + 1]} *)
+(*                           WHERE Id = {[id]} OR Id = {[id + 1]})); *)
+(*     return <xml><body> *)
+(*       {case res of *)
+(*            None => <xml>Initialized {[id]}!</xml> *)
+(*          | Some row => <xml>Incremented {[id]}!</xml>} *)
+(*     </body></xml> *)
diff --git a/caching-tests/test.urp b/caching-tests/test.urp
new file mode 100644
index 0000000..2cb9e71
--- /dev/null
+++ b/caching-tests/test.urp
@@ -0,0 +1,9 @@
+database host=localhost
+sql test.sql
+safeGet Test/flush
+# safeGet Test/flash
+# safeGet Test/floosh
+# safeGet Test/flush17
+minHeap 4096
+
+test
diff --git a/caching-tests/test.urs b/caching-tests/test.urs
new file mode 100644
index 0000000..d6e8dd2
--- /dev/null
+++ b/caching-tests/test.urs
@@ -0,0 +1,8 @@
+val cache : int -> transaction page
+(* val cacheAlt : int -> transaction page *)
+(* val cacheR : {Id : int, FooBar : int} -> transaction page *)
+(* val cache2 : int -> int -> transaction page *)
+val flush : int -> transaction page
+(* val flash : int -> transaction page *)
+(* val floosh : int -> transaction page *)
+(* val flush17 : transaction page *)
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..5786c58
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,156 @@
+AC_INIT([urweb], [20170720])
+WORKING_VERSION=0
+AC_USE_SYSTEM_EXTENSIONS
+
+# automake 1.12 requires this, but automake 1.11 doesn't recognize it
+m4_ifdef([AM_PROG_AR], [AM_PROG_AR])
+
+AC_CONFIG_MACRO_DIR([m4])
+AM_INIT_AUTOMAKE([-Wall -Werror foreign no-define])
+AC_PROG_CC()
+AC_PROG_LIBTOOL()
+AC_CONFIG_HEADERS([include/urweb/config.h])
+
+AX_PTHREAD([echo >/dev/null], [echo "Your C compiler does not support POSIX threads."; exit 1])
+AX_TLS([echo >/dev/null], [echo "Your C compiler does not support thread-local storage."; exit 1])
+
+AX_CHECK_OPENSSL([echo >/dev/null], [echo "You must install OpenSSL development files."; exit 1])
+
+AC_CHECK_PROG(MLTON, mlton, yes, [])
+
+if test [-z $MLTON]; then
+    echo "You must install MLton."
+    exit 1
+fi
+
+AC_CHECK_PROG(MLLEX, mllex, yes, [])
+
+if test [-z $MLLEX]; then
+    echo "You must install MLton (to get mllex)."
+    exit 1
+fi
+
+AC_CHECK_PROG(MLYACC, mlyacc, yes, [])
+
+if test [-z $MLYACC]; then
+    echo "You must install MLton (to get mlyacc)."
+    exit 1
+fi
+
+if test [$prefix = "NONE"]; then
+    prefix=/usr/local
+fi
+
+if test [-z $BIN]; then
+    BIN=$prefix/bin
+fi
+
+if test [-z $LIB]; then
+    LIB=$prefix/lib
+fi
+
+if test [-z $SRCLIB]; then
+    SRCLIB=$prefix/lib/urweb
+fi
+
+if test [-z $INCLUDE]; then
+    INCLUDE=$prefix/include/urweb
+fi
+
+if test [-z $SITELISP]; then
+    SITELISP=$prefix/share/emacs/site-lisp/urweb-mode
+fi
+
+AC_ARG_WITH([emacs],
+            [AS_HELP_STRING([--without-emacs],
+              [disable installation of Emacs mode])],
+            [],
+            [with_emacs=yes])
+
+AM_CONDITIONAL(USE_EMACS, test "x$with_emacs" = xyes)
+
+if test [-z $PGHEADER]; then
+   AC_CHECK_HEADERS([postgresql/libpq-fe.h],
+                    [PGHEADER=postgresql/libpq-fe.h])
+fi
+
+if test [-z $PGHEADER]; then
+   PGHEADER=libpq-fe.h
+fi
+
+if test [-z $MSHEADER]; then
+   AC_CHECK_HEADERS([mysql/mysql.h],
+                    [MSHEADER=mysql/mysql.h])
+fi
+
+if test [-z $MSHEADER]; then
+   MSHEADER=mysql.h
+fi
+
+if test [-z $SQHEADER]; then
+   SQHEADER=sqlite3.h
+fi
+
+if test [$WORKING_VERSION = "1"]; then
+   VERSION="$VERSION + `git log -1 --format="%H" || echo ?`"
+fi
+
+# Check if pthread_t is a scalar or pointer type so we can use the correct
+# OpenSSL functions on it.
+AC_MSG_CHECKING([if pthread_t is a pointer type])
+AC_COMPILE_IFELSE(
+  [AC_LANG_PROGRAM(
+     [[
+#include <pthread.h>
+     ]],
+     [[
+pthread_t a;
+*a;
+     ]])],
+  AC_DEFINE([PTHREAD_T_IS_POINTER], [1], [Define if pthread_t is a pointer.])
+    AC_MSG_RESULT(yes),
+  AC_MSG_RESULT(no))
+
+AC_SUBST(CC)
+AC_SUBST(BIN)
+AC_SUBST(LIB)
+AC_SUBST(SRCLIB)
+AC_SUBST(INCLUDE)
+AC_SUBST(SITELISP)
+AC_SUBST(CCARGS)
+AC_SUBST(MLTONARGS)
+AC_SUBST(PGHEADER)
+AC_SUBST(MSHEADER)
+AC_SUBST(SQHEADER)
+AC_SUBST(VERSION)
+AC_SUBST(PTHREAD_CFLAGS)
+AC_SUBST(PTHREAD_LIBS)
+
+AC_CONFIG_FILES([
+        Makefile
+        src/c/Makefile
+        src/config.sml
+])
+
+AC_OUTPUT()
+
+cat <<EOF
+
+Ur/Web configuration:
+  bin directory:       BIN            $BIN
+  lib directory:       LIB            $LIB
+  src lib directory:   SRCLIB         $SRCLIB
+  include directory:   INCLUDE        $INCLUDE
+  site-lisp directory: SITELISP       $SITELISP
+  C compiler:          CC             $CC
+  Extra CC args:       CCARGS         $CCARGS
+  Extra MLTON args:    MLTONARGS      $MLTONARGS
+  Postgres C header:   PGHEADER       $PGHEADER
+  MySQL C header:      MSHEADER       $MSHEADER
+  SQLite C header:     SQHEADER       $SQHEADER
+  OpenSSL:             OPENSSL_LIBS   $OPENSSL_LIBS
+  pthreads:            PTHREAD_CFLAGS $PTHREAD_CFLAGS
+                       PTHREAD_LIBS   $PTHREAD_LIBS
+
+  Version:             $VERSION
+EOF
diff --git a/demo/alert.ur b/demo/alert.ur
new file mode 100644
index 0000000..dcd8c20
--- /dev/null
+++ b/demo/alert.ur
@@ -0,0 +1,3 @@
+fun main () = return <xml><body>
+  <button value="Click me!" onclick={fn _ => alert "You clicked me!"}/>
+</body></xml>
diff --git a/demo/alert.urp b/demo/alert.urp
new file mode 100644
index 0000000..34016b9
--- /dev/null
+++ b/demo/alert.urp
@@ -0,0 +1 @@
+alert
diff --git a/demo/alert.urs b/demo/alert.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/alert.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/batch.ur b/demo/batch.ur
new file mode 100644
index 0000000..74a5346
--- /dev/null
+++ b/demo/batch.ur
@@ -0,0 +1,82 @@
+datatype list t = Nil | Cons of t * list t
+
+table t : {Id : int, A : string}
+  PRIMARY KEY Id
+
+fun allRows () =
+    query (SELECT * FROM t)
+    (fn r acc => return (Cons ((r.T.Id, r.T.A), acc)))
+    Nil
+
+fun doBatch ls =
+    case ls of
+        Nil => return ()
+      | Cons ((id, a), ls') =>
+        dml (INSERT INTO t (Id, A) VALUES ({[id]}, {[a]}));
+        doBatch ls'
+
+fun del id =
+    dml (DELETE FROM t WHERE t.Id = {[id]})
+
+fun show withDel lss =
+    let
+        fun show' ls =
+            case ls of
+                Nil => <xml/>
+              | Cons ((id, a), ls) => <xml>
+                <tr><td>{[id]}</td> <td>{[a]}</td> {if withDel then
+                                                        <xml><td><button value="Delete" onclick={fn _ => rpc (del id)}/>
+                                                        </td></xml>
+                                                    else
+                                                        <xml/>} </tr>
+                {show' ls}
+              </xml>
+    in
+        <xml><dyn signal={ls <- signal lss; return <xml><table>
+          <tr> <th>Id</th> <th>A</th> </tr>
+          {show' ls}
+        </table></xml>}/></xml>
+    end
+
+fun main () =
+    lss <- source Nil;
+    batched <- source Nil;
+
+    id <- source "";
+    a <- source "";
+
+    let
+        fun add () =
+            id <- get id;
+            a <- get a;
+            ls <- get batched;
+
+            set batched (Cons ((readError id, a), ls))
+
+        fun exec () =
+            ls <- get batched;
+
+            rpc (doBatch ls);
+            set batched Nil
+    in
+        return <xml><body>
+          <h2>Rows</h2>
+
+          {show True lss}
+
+          <button value="Update" onclick={fn _ => ls <- rpc (allRows ()); set lss ls}/><br/>
+          <br/>
+
+          <h2>Batch new rows to add</h2>
+
+          <table>
+            <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
+            <tr> <th>A:</th> <td><ctextbox source={a}/></td> </tr>
+            <tr> <th/> <td><button value="Batch it" onclick={fn _ => add ()}/></td> </tr>
+          </table>
+
+          <h2>Already batched:</h2>
+          {show False batched}
+          <button value="Execute" onclick={fn _ => exec ()}/>
+        </body></xml>
+    end
diff --git a/demo/batch.urp b/demo/batch.urp
new file mode 100644
index 0000000..00a7b25
--- /dev/null
+++ b/demo/batch.urp
@@ -0,0 +1,3 @@
+database dbname=test
+
+batch
diff --git a/demo/batch.urs b/demo/batch.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/batch.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/batchFun.ur b/demo/batchFun.ur
new file mode 100644
index 0000000..2147868
--- /dev/null
+++ b/demo/batchFun.ur
@@ -0,0 +1,155 @@
+con colMeta = fn (db :: Type, state :: Type) =>
+                 {Nam : string,
+                  Show : db -> xbody,
+                  Inject : sql_injectable db,
+
+                  NewState : transaction state,
+                  Widget : state -> xbody,
+                  ReadState : state -> transaction db}
+con colsMeta = fn cols => $(map colMeta cols)
+
+fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
+            name : colMeta (t, source string) =
+    {Nam = name,
+     Show = txt,
+     Inject = _,
+
+     NewState = source "",
+     Widget = fn s => <xml><ctextbox source={s}/></xml>,
+     ReadState = fn s => v <- get s; return (readError v)}
+
+val int = default
+val float = default
+val string = default
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 val fl : folder cols
+                          
+                 table tab : ([Id = int] ++ map fst cols)
+                           
+                 val title : string
+                             
+                 val cols : colsMeta cols
+             end) = struct
+
+    val t = M.tab
+
+    datatype list t = Nil | Cons of t * list t
+
+    fun allRows () =
+        query (SELECT * FROM t)
+              (fn r acc => return (Cons (r.T, acc)))
+              Nil
+
+    fun add r =
+        dml (insert t
+                    (@foldR2 [fst] [colMeta]
+                      [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
+                      (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] input col acc =>
+                          acc ++ {nm = @sql_inject col.Inject input})
+                      {} M.fl (r -- #Id) M.cols
+                      ++ {Id = (SQL {[r.Id]})}))
+
+    fun doBatch ls =
+        case ls of
+            Nil => return ()
+          | Cons (r, ls') =>
+            add r;
+            doBatch ls'
+
+    fun del id =
+        dml (DELETE FROM t WHERE t.Id = {[id]})
+
+    fun show withDel lss =
+        let
+            fun show' ls =
+                case ls of
+                    Nil => <xml/>
+                  | Cons (r, ls) => <xml>
+                    <tr>
+                      <td>{[r.Id]}</td>
+                      {@mapX2 [colMeta] [fst] [_]
+                        (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m v =>
+                            <xml><td>{m.Show v}</td></xml>)
+                        M.fl M.cols (r -- #Id)}
+                      {if withDel then
+                           <xml><td><button value="Delete" onclick={fn _ => rpc (del r.Id)}/></td></xml>
+                       else
+                           <xml/>}
+                    </tr>
+                    {show' ls}
+                  </xml>
+        in
+            <xml><dyn signal={ls <- signal lss; return <xml><table>
+              <tr>
+                <th>Id</th>
+                {@mapX [colMeta] [tr]
+                  (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m =>
+                      <xml><th>{[m.Nam]}</th></xml>)
+                  M.fl M.cols}
+              </tr>
+              {show' ls}
+            </table></xml>}/></xml>
+        end
+
+    fun main () =
+        lss <- source Nil;
+        batched <- source Nil;
+
+        id <- source "";
+        inps <- @foldR [colMeta] [fn r => transaction ($(map snd r))]
+                 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m acc =>
+                     s <- m.NewState;
+                     r <- acc;
+                     return ({nm = s} ++ r))
+                 (return {})
+                 M.fl M.cols;
+        
+        let
+            fun add () =
+                id <- get id;
+                vs <- @foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
+                       (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m s acc =>
+                           v <- m.ReadState s;
+                           r <- acc;
+                           return ({nm = v} ++ r))
+                       (return {})
+                       M.fl M.cols inps;
+                ls <- get batched;
+
+                set batched (Cons ({Id = readError id} ++ vs, ls))
+
+            fun exec () =
+                ls <- get batched;
+
+                rpc (doBatch ls);
+                set batched Nil
+        in
+            return <xml><body>
+              <h2>Rows</h2>
+
+              {show True lss}
+
+              <button value="Update" onclick={fn _ => ls <- rpc (allRows ()); set lss ls}/><br/>
+              <br/>
+
+              <h2>Batch new rows to add</h2>
+
+              <table>
+                <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
+                {@mapX2 [colMeta] [snd] [_]
+                  (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m s =>
+                      <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
+                  M.fl M.cols inps}
+                <tr> <th/> <td><button value="Batch it" onclick={fn _ => add ()}/></td> </tr>
+              </table>
+
+              <h2>Already batched:</h2>
+              {show False batched}
+              <button value="Execute" onclick={fn _ => exec ()}/>
+            </body></xml>
+        end
+
+end
diff --git a/demo/batchFun.urp b/demo/batchFun.urp
new file mode 100644
index 0000000..a646565
--- /dev/null
+++ b/demo/batchFun.urp
@@ -0,0 +1 @@
+batchFun
diff --git a/demo/batchFun.urs b/demo/batchFun.urs
new file mode 100644
index 0000000..56e1e88
--- /dev/null
+++ b/demo/batchFun.urs
@@ -0,0 +1,27 @@
+con colMeta = fn (db :: Type, state :: Type) =>
+                 {Nam : string,
+                  Show : db -> xbody,
+                  Inject : sql_injectable db,
+
+                  NewState : transaction state,
+                  Widget : state -> xbody,
+                  ReadState : state -> transaction db}
+con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
+
+val int : string -> colMeta (int, source string)
+val float : string -> colMeta (float, source string)
+val string : string -> colMeta (string, source string)
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 val fl : folder cols
+
+                 table tab : ([Id = int] ++ map fst cols)
+
+                 val title : string
+
+                 val cols : colsMeta cols
+             end) : sig
+    val main : unit -> transaction page
+end
diff --git a/demo/batchG.ur b/demo/batchG.ur
new file mode 100644
index 0000000..d0071d7
--- /dev/null
+++ b/demo/batchG.ur
@@ -0,0 +1,9 @@
+table t : {Id : int, A : string, B : float}
+  PRIMARY KEY Id
+
+open BatchFun.Make(struct
+                       val tab = t
+                       val title = "BatchG"
+                       val cols = {A = BatchFun.string "A",
+                                   B = BatchFun.float "B"}
+                   end)
diff --git a/demo/batchG.urp b/demo/batchG.urp
new file mode 100644
index 0000000..ba4ce18
--- /dev/null
+++ b/demo/batchG.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql batchG.sql
+
+batchFun
+batchG
diff --git a/demo/batchG.urs b/demo/batchG.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/batchG.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/broadcast.ur b/demo/broadcast.ur
new file mode 100644
index 0000000..0b04b13
--- /dev/null
+++ b/demo/broadcast.ur
@@ -0,0 +1,29 @@
+functor Make(M : sig type t end) = struct
+    sequence s
+    table t : {Id : int, Client : client, Channel : channel M.t}
+      PRIMARY KEY (Id, Client)
+
+    type topic = int
+
+    val inj : sql_injectable topic = _
+
+    val create = nextval s
+
+    fun subscribe id =
+        cli <- self;
+        ro <- oneOrNoRows (SELECT t.Channel FROM t WHERE t.Id = {[id]} AND t.Client = {[cli]});
+        case ro of
+            None =>
+            ch <- channel;
+            dml (INSERT INTO t (Id, Client, Channel) VALUES ({[id]}, {[cli]}, {[ch]}));
+            return ch
+          | Some r => return r.T.Channel
+
+    fun send id msg =
+        queryI (SELECT t.Channel FROM t WHERE t.Id = {[id]})
+        (fn r => Basis.send r.T.Channel msg)
+
+    fun subscribers id =
+        r <- oneRow (SELECT COUNT( * ) AS N FROM t WHERE t.Id = {[id]});
+        return r.N
+end
diff --git a/demo/broadcast.urs b/demo/broadcast.urs
new file mode 100644
index 0000000..9a4d0bb
--- /dev/null
+++ b/demo/broadcast.urs
@@ -0,0 +1,11 @@
+functor Make(M : sig type t end) : sig
+    type topic
+
+    val inj : sql_injectable topic
+
+    val create : transaction topic
+    val subscribe : topic -> transaction (channel M.t)
+    val send : topic -> M.t -> transaction unit
+
+    val subscribers : topic -> transaction int
+end
diff --git a/demo/buffer.ur b/demo/buffer.ur
new file mode 100644
index 0000000..27e2b80
--- /dev/null
+++ b/demo/buffer.ur
@@ -0,0 +1,25 @@
+datatype lines = End | Line of string * source lines
+
+type t = { Head : source lines, Tail : source (source lines) }
+
+val create =
+    head <- source End;
+    tail <- source head;
+    return {Head = head, Tail = tail}
+
+fun renderL lines =
+    case lines of
+        End => <xml/>
+      | Line (line, linesS) => <xml>{[line]}<br/><dyn signal={renderS linesS}/></xml>
+
+and renderS linesS =
+    lines <- signal linesS;
+    return (renderL lines)
+
+fun render t = renderS t.Head
+
+fun write t s =
+    oldTail <- get t.Tail;
+    newTail <- source End;
+    set oldTail (Line (s, newTail));
+    set t.Tail newTail
diff --git a/demo/buffer.urs b/demo/buffer.urs
new file mode 100644
index 0000000..58312bb
--- /dev/null
+++ b/demo/buffer.urs
@@ -0,0 +1,5 @@
+type t
+
+val create : transaction t
+val render : t -> signal xbody
+val write : t -> string -> transaction unit
diff --git a/demo/chat.ur b/demo/chat.ur
new file mode 100644
index 0000000..720130b
--- /dev/null
+++ b/demo/chat.ur
@@ -0,0 +1,92 @@
+structure Room = Broadcast.Make(struct
+                                    type t = string
+                                end)
+
+sequence s
+table t : { Id : int, Title : string, Room : Room.topic }
+  PRIMARY KEY Id
+
+fun chat id () =
+    r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
+    ch <- Room.subscribe r.T.Room;
+
+    newLine <- source "";
+    buf <- Buffer.create;
+
+    let
+        fun onload () =
+            let
+                fun listener () =
+                    s <- recv ch;
+                    Buffer.write buf s;
+                    listener ()
+            in
+                listener ()
+            end
+
+        fun getRoom () =
+            r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
+            return r.T.Room
+
+        fun speak line =
+            room <- getRoom ();
+            Room.send room line
+
+        fun doSpeak () =
+            line <- get newLine;
+            set newLine "";
+            rpc (speak line)
+    in
+        return <xml><body onload={onload ()}>
+          <h1>{[r.T.Title]}</h1>
+
+          <button value="Send:" onclick={fn _ => doSpeak ()}/> <ctextbox source={newLine}/>
+
+          <h2>Messages</h2>
+
+          <dyn signal={Buffer.render buf}/>
+          
+        </body></xml>            
+    end
+
+fun list () =
+    queryX' (SELECT * FROM t)
+    (fn r =>
+        count <- Room.subscribers r.T.Room;
+        return <xml><tr>
+          <td>{[r.T.Id]}</td>
+          <td>{[r.T.Title]}</td>
+          <td>{[count]}</td>
+          <td><form><submit action={chat r.T.Id} value="Enter"/></form></td>
+          <td><form><submit action={delete r.T.Id} value="Delete"/></form></td>
+        </tr></xml>)
+
+and delete id () =
+    dml (DELETE FROM t WHERE Id = {[id]});
+    main ()
+
+and main () =
+    let
+        fun create r =
+            id <- nextval s;
+            room <- Room.create;
+            dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
+            main ()
+    in
+        ls <- list ();
+        return <xml><body>
+          <h1>Current Channels</h1>
+
+          <table>
+            <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
+            {ls}
+          </table>
+          
+          <h1>New Channel</h1>
+          
+          <form>
+            Title: <textbox{#Title}/><br/>
+            <submit action={create}/>
+          </form>
+        </body></xml>
+    end
diff --git a/demo/chat.urp b/demo/chat.urp
new file mode 100644
index 0000000..29da66b
--- /dev/null
+++ b/demo/chat.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql chat.sql
+
+broadcast
+buffer
+chat
diff --git a/demo/chat.urs b/demo/chat.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/chat.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/constraints.ur b/demo/constraints.ur
new file mode 100644
index 0000000..bcd88bb
--- /dev/null
+++ b/demo/constraints.ur
@@ -0,0 +1,38 @@
+table t : { Id : int, Nam : string, Parent : option int }
+  PRIMARY KEY Id,
+  CONSTRAINT Nam UNIQUE Nam,
+  CONSTRAINT Id CHECK Id >= 0,
+  CONSTRAINT Parent FOREIGN KEY Parent REFERENCES t(Id)
+
+fun main () =
+    list <- queryX (SELECT * FROM t)
+            (fn r => <xml><tr>
+              <td>{[r.T.Id]}</td>
+              <td>{[r.T.Nam]}</td>
+              <td>{case r.T.Parent of
+                       None => <xml>NULL</xml>
+                     | Some id => <xml>{[id]}</xml>}</td>
+            </tr></xml>);
+    return <xml><body>
+      <table>
+        <tr> <th>Id</th> <th>Name</th> <th>Parent</th> </tr>
+        {list}
+      </table>
+
+      <form>
+        <table>
+          <tr> <th>Id:</th> <td><textbox{#Id}/></td> </tr>
+          <tr> <th>Name:</th> <td><textbox{#Nam}/></td> </tr>
+          <tr> <th>Parent:</th> <td><textbox{#Parent}/></td> </tr>
+          <tr> <th/> <td><submit action={add}/></td> </tr>
+        </table>
+      </form>
+    </body></xml>
+
+and add r =
+    dml (INSERT INTO t (Id, Nam, Parent)
+           VALUES ({[readError r.Id]}, {[r.Nam]},
+               {[case r.Parent of
+                   "" => None
+                 | s => Some (readError s)]}));
+    main ()
diff --git a/demo/constraints.urp b/demo/constraints.urp
new file mode 100644
index 0000000..d5b991b
--- /dev/null
+++ b/demo/constraints.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql constraints.sql
+
+constraints
diff --git a/demo/constraints.urs b/demo/constraints.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/constraints.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/cookie.ur b/demo/cookie.ur
new file mode 100644
index 0000000..7e01115
--- /dev/null
+++ b/demo/cookie.ur
@@ -0,0 +1,44 @@
+cookie c : {A : string, B : float, C : int}
+
+fun set r =
+    setCookie c {Value = {A = r.A, B = readError r.B, C = readError r.C},
+                 Expires = None,
+                 Secure = False};
+    return <xml>Cookie set.</xml>
+
+fun setExp r =
+    setCookie c {Value = {A = r.A, B = readError r.B, C = readError r.C},
+                 Expires = Some (readError "2012-11-6 00:00:00"),
+                 Secure = False};
+    return <xml>Cookie set robustly.</xml>
+
+fun delete () =
+    clearCookie c;
+    return <xml>Cookie cleared.</xml>
+
+fun main () =
+    ro <- getCookie c;
+    return <xml><body>
+      {case ro of
+           None => <xml>No cookie set.</xml>
+         | Some v => <xml>
+           Cookie: A = {[v.A]}, B = {[v.B]}, C = {[v.C]}<br/>
+           <form><submit value="Delete" action={delete}/></form>
+         </xml>}
+      <br/><br/>
+
+      <form>
+        A: <textbox{#A}/><br/>
+        B: <textbox{#B}/><br/>
+        C: <textbox{#C}/><br/>
+        <submit action={set}/>
+      </form><br/>
+
+      <form>
+        <b>Version that expires on November 6, 2012:</b><br/>
+        A: <textbox{#A}/><br/>
+        B: <textbox{#B}/><br/>
+        C: <textbox{#C}/><br/>
+        <submit action={setExp}/>
+      </form>
+    </body></xml>
diff --git a/demo/cookie.urp b/demo/cookie.urp
new file mode 100644
index 0000000..871bb87
--- /dev/null
+++ b/demo/cookie.urp
@@ -0,0 +1 @@
+cookie
diff --git a/demo/cookie.urs b/demo/cookie.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/cookie.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/cookieSec.ur b/demo/cookieSec.ur
new file mode 100644
index 0000000..98615c7
--- /dev/null
+++ b/demo/cookieSec.ur
@@ -0,0 +1,39 @@
+cookie username : string
+
+table lastVisit : { User : string, When : time }
+  PRIMARY KEY User
+
+fun main () =
+    userO <- getCookie username;
+
+    list <- queryX (SELECT * FROM lastVisit)
+                   (fn r => <xml><tr><td>{[r.LastVisit.User]}</td> <td>{[r.LastVisit.When]}</td></tr></xml>);
+
+    return <xml><body>
+      Cookie: {[userO]}<br/>
+
+      <table>
+        <tr><th>User</th> <th>Last Visit</th></tr>
+        {list}
+      </table>
+
+      <h2>Set cookie value</h2>
+      <form><textbox{#User}/> <submit action={set}/></form>
+
+      <h2>Record your visit</h2>
+      <form><submit action={imHere}/></form>
+    </body></xml>
+
+and set r =
+    setCookie username {Value = r.User, Expires = None, Secure = False};
+    main ()
+
+and imHere () =
+    userO <- getCookie username;
+    case userO of
+        None => return <xml>You don't have a cookie set!</xml>
+      | Some user =>
+        dml (DELETE FROM lastVisit WHERE User = {[user]});
+        dml (INSERT INTO lastVisit (User, When) VALUES ({[user]}, CURRENT_TIMESTAMP));
+        main ()
+
diff --git a/demo/cookieSec.urp b/demo/cookieSec.urp
new file mode 100644
index 0000000..7475551
--- /dev/null
+++ b/demo/cookieSec.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql cookieSec.sql
+
+cookieSec
diff --git a/demo/cookieSec.urs b/demo/cookieSec.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/cookieSec.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/counter.ur b/demo/counter.ur
new file mode 100644
index 0000000..23768ad
--- /dev/null
+++ b/demo/counter.ur
@@ -0,0 +1,8 @@
+(* Workhorse function, which [main] will call *)
+fun counter n = return <xml><body>
+  Current counter: {[n]}<br/>
+  <a link={counter (n + 1)}>Increment</a><br/>
+  <a link={counter (n - 1)}>Decrement</a>
+</body></xml>
+
+fun main () = counter 0
diff --git a/demo/counter.urp b/demo/counter.urp
new file mode 100644
index 0000000..e64bdbf
--- /dev/null
+++ b/demo/counter.urp
@@ -0,0 +1 @@
+counter
diff --git a/demo/counter.urs b/demo/counter.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/counter.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/crud.ur b/demo/crud.ur
new file mode 100644
index 0000000..4d2753e
--- /dev/null
+++ b/demo/crud.ur
@@ -0,0 +1,173 @@
+con colMeta = fn (db :: Type, widget :: Type) =>
+                 {Nam : string,
+                  Show : db -> xbody,
+                  Widget : nm :: Name -> xml form [] [nm = widget],
+                  WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
+                  Parse : widget -> db,
+                  Inject : sql_injectable db}
+con colsMeta = fn cols => $(map colMeta cols)
+
+fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
+            name : colMeta (t, string) =
+    {Nam = name,
+     Show = txt,
+     Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
+     WidgetPopulated = fn [nm :: Name] n =>
+                          <xml><textbox{nm} value={show n}/></xml>,
+     Parse = readError,
+     Inject = _}
+
+val int = default
+val float = default
+val string = default
+
+fun bool name = {Nam = name,
+                 Show = txt,
+                 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
+                 WidgetPopulated = fn [nm :: Name] b =>
+                                      <xml><checkbox{nm} checked={b}/></xml>,
+                 Parse = fn x => x,
+                 Inject = _}
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 val fl : folder cols
+
+                 table tab : ([Id = int] ++ map fst cols)
+
+                 val title : string
+
+                 val cols : colsMeta cols
+             end) = struct
+
+    val tab = M.tab
+
+    sequence seq
+
+    fun list () =
+        rows <- queryX (SELECT * FROM tab AS T)
+                       (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
+                         <tr>
+                           <td>{[fs.T.Id]}</td>
+                           {@mapX2 [fst] [colMeta] [tr]
+                             (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v col => <xml>
+                               <td>{col.Show v}</td>
+                             </xml>)
+                             M.fl (fs.T -- #Id) M.cols}
+                           <td>
+                             <a link={upd fs.T.Id}>[Update]</a>
+                             <a link={confirm fs.T.Id}>[Delete]</a>
+                           </td>
+                         </tr>
+                       </xml>);
+        return <xml>
+          <table border={1}>
+            <tr>
+              <th>ID</th>
+              {@mapX [colMeta] [tr]
+                (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] col => <xml>
+                  <th>{cdata col.Nam}</th>
+                </xml>)
+                M.fl M.cols}
+            </tr>
+            {rows}
+          </table>
+
+          <br/><hr/><br/>
+
+          <form>
+            {@foldR [colMeta] [fn cols => xml form [] (map snd cols)]
+              (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] (col : colMeta t) acc => <xml>
+                <li> {cdata col.Nam}: {col.Widget [nm]}</li>
+                {useMore acc}
+              </xml>)
+              <xml/>
+              M.fl M.cols}
+            
+            <submit action={create}/>
+          </form>
+        </xml>
+
+    and create (inputs : $(map snd M.cols)) =
+        id <- nextval seq;
+        dml (insert tab
+                    (@foldR2 [snd] [colMeta]
+                      [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
+                      (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
+                       fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
+                      {} M.fl inputs M.cols
+                     ++ {Id = (SQL {[id]})}));
+        ls <- list ();
+        return <xml><body>
+          <p>Inserted with ID {[id]}.</p>
+
+          {ls}
+        </body></xml>
+
+    and upd (id : int) =
+        let
+            fun save (inputs : $(map snd M.cols)) =
+                dml (update [map fst M.cols]
+                            (@foldR2 [snd] [colMeta]
+                              [fn cols => $(map (fn t => sql_exp [T = [Id = int] ++ map fst M.cols] [] [] t.1) cols)]
+                              (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
+                               fn input col acc => acc ++ {nm =
+                                                           @sql_inject col.Inject (col.Parse input)})
+                              {} M.fl inputs M.cols)
+                            tab (WHERE T.Id = {[id]}));
+                ls <- list ();
+                return <xml><body>
+                  <p>Saved!</p>
+
+                  {ls}
+                </body></xml>
+        in
+            fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]});
+            case fso : (Basis.option {Tab : $(map fst M.cols)}) of
+                None => return <xml><body>Not found!</body></xml>
+              | Some fs => return <xml><body><form>
+                {@foldR2 [fst] [colMeta] [fn cols => xml form [] (map snd cols)]
+                  (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v (col : colMeta t)
+                                   (acc : xml form [] (map snd rest)) =>
+                      <xml>
+                        <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+                        {useMore acc}
+                      </xml>)
+                  <xml/>
+                  M.fl fs.Tab M.cols}
+
+                <submit action={save}/>
+              </form></body></xml>
+        end
+
+    and confirm (id : int) =
+        let
+            fun delete () =
+                dml (DELETE FROM tab WHERE Id = {[id]});
+                ls <- list ();
+                return <xml><body>
+                  <p>The deed is done.</p>
+                  
+                  {ls}
+                </body></xml>
+        in
+            return <xml><body>
+              <p>Are you sure you want to delete ID #{[id]}?</p>
+              
+              <form><submit action={delete} value="I was born sure!"/></form>
+            </body></xml>
+        end
+
+    and main () =
+        ls <- list ();
+        return <xml><head>
+          <title>{cdata M.title}</title>
+        </head><body>
+
+          <h1>{cdata M.title}</h1>
+
+          {ls}
+        </body></xml>
+
+end
diff --git a/demo/crud.urp b/demo/crud.urp
new file mode 100644
index 0000000..223bc7a
--- /dev/null
+++ b/demo/crud.urp
@@ -0,0 +1,2 @@
+
+crud
diff --git a/demo/crud.urs b/demo/crud.urs
new file mode 100644
index 0000000..3690d31
--- /dev/null
+++ b/demo/crud.urs
@@ -0,0 +1,27 @@
+con colMeta = fn (db :: Type, widget :: Type) =>
+                 {Nam : string,
+                  Show : db -> xbody,
+                  Widget : nm :: Name -> xml form [] [nm = widget],
+                  WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
+                  Parse : widget -> db,
+                  Inject : sql_injectable db}
+con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
+
+val int : string -> colMeta (int, string)
+val float : string -> colMeta (float, string)
+val string : string -> colMeta (string, string)
+val bool : string -> colMeta (bool, bool)
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 val fl : folder cols
+
+                 table tab : ([Id = int] ++ map fst cols)
+
+                 val title : string
+
+                 val cols : colsMeta cols
+             end) : sig
+    val main : unit -> transaction page
+end
diff --git a/demo/crud1.ur b/demo/crud1.ur
new file mode 100644
index 0000000..796c063
--- /dev/null
+++ b/demo/crud1.ur
@@ -0,0 +1,13 @@
+table t1 : {Id : int, A : int, B : string, C : float, D : bool}
+  PRIMARY KEY Id
+
+open Crud.Make(struct
+                   val tab = t1
+                             
+                   val title = "Crud1"
+                               
+                   val cols = {A = Crud.int "A",
+                               B = Crud.string "B",
+                               C = Crud.float "C",
+                               D = Crud.bool "D"}
+               end)
diff --git a/demo/crud1.urp b/demo/crud1.urp
new file mode 100644
index 0000000..bfc2d14
--- /dev/null
+++ b/demo/crud1.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql crud1.sql
+
+crud
+crud1
diff --git a/demo/crud2.ur b/demo/crud2.ur
new file mode 100644
index 0000000..a89b37b
--- /dev/null
+++ b/demo/crud2.ur
@@ -0,0 +1,35 @@
+table t : {Id : int, Nam : string, Ready : bool}
+  PRIMARY KEY Id
+
+open Crud.Make(struct
+                   val tab = t
+                             
+                   val title = "Are you ready?"
+
+                   val cols = {Nam = Crud.string "Name",
+                               Ready = {Nam = "Ready",
+                                        Show = (fn b => if b then
+                                                            <xml>Ready!</xml>
+                                                        else
+                                                            <xml>Not ready</xml>),
+                                        Widget = (fn [nm :: Name] => <xml>
+                                          <select{nm}>
+                                            <option>Ready</option>
+                                            <option>Not ready</option>
+                                          </select>
+                                        </xml>),
+                                        WidgetPopulated = (fn [nm :: Name] b => <xml>
+                                          <select{nm}>
+                                            <option selected={b}>Ready</option>
+                                            <option selected={not b}>Not ready</option>
+                                          </select>
+                                        </xml>),
+                                        Parse = (fn s =>
+                                                    case s of
+                                                        "Ready" => True
+                                                      | "Not ready" => False
+                                                      | _ => error <xml>Invalid ready/not ready</xml>),
+                                        Inject = _
+                                       }
+                              }
+               end)
diff --git a/demo/crud2.urp b/demo/crud2.urp
new file mode 100644
index 0000000..d552e1a
--- /dev/null
+++ b/demo/crud2.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql crud2.sql
+
+crud
+crud2
diff --git a/demo/crud3.ur b/demo/crud3.ur
new file mode 100644
index 0000000..5be035d
--- /dev/null
+++ b/demo/crud3.ur
@@ -0,0 +1,27 @@
+table t : {Id : int, Text : string}
+  PRIMARY KEY Id
+
+open Crud.Make(struct
+                   val tab = t
+                             
+                   val title = "Crud3"
+
+                   val cols = {Text = {Nam = "Text",
+                                       Show = txt,
+                                       Widget = (fn [nm :: Name] => <xml>
+                                         <subform{nm}>
+                                           <textbox{#A}/>
+                                           <textbox{#B}/>
+                                         </subform>
+                                       </xml>),
+                                       WidgetPopulated = (fn [nm :: Name] s => <xml>
+                                         <subform{nm}>
+                                           <textbox{#A} value={s}/>
+                                           <textbox{#B}/>
+                                         </subform>
+                                       </xml>),
+                                       Parse = (fn p : {A : string, B : string} => p.A ^ p.B),
+                                       Inject = _
+                                      }
+                              }
+               end)
diff --git a/demo/crud3.urp b/demo/crud3.urp
new file mode 100644
index 0000000..cc3be2f
--- /dev/null
+++ b/demo/crud3.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql crud3.sql
+
+crud
+crud3
diff --git a/demo/css.ur b/demo/css.ur
new file mode 100644
index 0000000..0c1d8f7
--- /dev/null
+++ b/demo/css.ur
@@ -0,0 +1,11 @@
+style quote
+
+fun main () = return <xml>
+  <head>
+    <link rel="stylesheet" type="text/css" href="http://adam.chlipala.net/style.css"/>
+  </head>
+
+  <body>
+    <div class={quote}>Here's a quote.</div>
+  </body>
+</xml>
diff --git a/demo/css.urp b/demo/css.urp
new file mode 100644
index 0000000..150808d
--- /dev/null
+++ b/demo/css.urp
@@ -0,0 +1,4 @@
+allow url http://adam.chlipala.net/style.css
+rewrite style Css/quote quote
+
+css
diff --git a/demo/css.urs b/demo/css.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/css.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/form.ur b/demo/form.ur
new file mode 100644
index 0000000..ec466db
--- /dev/null
+++ b/demo/form.ur
@@ -0,0 +1,18 @@
+fun handler r = return <xml><body>
+  <table>
+    <tr> <th>A:</th> <td>{[r.A]}</td> </tr>
+    <tr> <th>B:</th> <td>{[r.B]}</td> </tr>
+    <tr> <th>C:</th> <td>{[r.C]}</td> </tr>
+  </table>
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <table>
+      <tr> <th>A:</th> <td><textbox{#A}/></td> </tr>
+      <tr> <th>B:</th> <td><textbox{#B}/></td> </tr>
+      <tr> <th>C:</th> <td><checkbox{#C}/></td> </tr>
+      <tr> <th/> <td><submit action={handler}/></td> </tr>
+    </table>
+  </form>
+</body></xml>
diff --git a/demo/form.urp b/demo/form.urp
new file mode 100644
index 0000000..335f1dd
--- /dev/null
+++ b/demo/form.urp
@@ -0,0 +1 @@
+form
diff --git a/demo/form.urs b/demo/form.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/form.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/hello.ur b/demo/hello.ur
new file mode 100644
index 0000000..9313460
--- /dev/null
+++ b/demo/hello.ur
@@ -0,0 +1,9 @@
+fun main () = return <xml>
+  <head>
+    <title>Hello world!</title>
+  </head>
+
+  <body>
+    <h1>Hello world!</h1>
+  </body>
+</xml>
diff --git a/demo/hello.urp b/demo/hello.urp
new file mode 100644
index 0000000..ce01362
--- /dev/null
+++ b/demo/hello.urp
@@ -0,0 +1 @@
+hello
diff --git a/demo/hello.urs b/demo/hello.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/hello.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/increment.ur b/demo/increment.ur
new file mode 100644
index 0000000..4ac2b2d
--- /dev/null
+++ b/demo/increment.ur
@@ -0,0 +1,10 @@
+sequence seq
+
+fun increment () = nextval seq
+
+fun main () =
+    src <- source 0;
+    return <xml><body>
+      <dyn signal={n <- signal src; return <xml>{[n]}</xml>}/>
+      <button value="Update" onclick={fn _ => n <- rpc (increment ()); set src n}/>
+    </body></xml>
diff --git a/demo/increment.urp b/demo/increment.urp
new file mode 100644
index 0000000..3a5c107
--- /dev/null
+++ b/demo/increment.urp
@@ -0,0 +1,3 @@
+database dbname=test
+
+increment
diff --git a/demo/increment.urs b/demo/increment.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/increment.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/link.ur b/demo/link.ur
new file mode 100644
index 0000000..f9e3396
--- /dev/null
+++ b/demo/link.ur
@@ -0,0 +1,7 @@
+fun target () = return <xml><body>
+  Welcome!
+</body></xml>
+
+fun main () = return <xml><body>
+  <a link={target ()}>Go there</a>
+</body></xml>
diff --git a/demo/link.urp b/demo/link.urp
new file mode 100644
index 0000000..2b2328d
--- /dev/null
+++ b/demo/link.urp
@@ -0,0 +1 @@
+link
diff --git a/demo/link.urs b/demo/link.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/link.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/list.ur b/demo/list.ur
new file mode 100644
index 0000000..961708e
--- /dev/null
+++ b/demo/list.ur
@@ -0,0 +1,21 @@
+datatype list t = Nil | Cons of t * list t
+
+fun length [t] (ls : list t) =
+    let
+        fun length' (ls : list t) (acc : int) =
+            case ls of
+                Nil => acc
+              | Cons (_, ls') => length' ls' (acc + 1)
+    in
+        length' ls 0
+    end
+
+fun rev [t] (ls : list t) = 
+    let
+        fun rev' (ls : list t) (acc : list t) =
+            case ls of
+                Nil => acc
+              | Cons (x, ls') => rev' ls' (Cons (x, acc))
+    in
+        rev' ls Nil
+    end
diff --git a/demo/list.urs b/demo/list.urs
new file mode 100644
index 0000000..e09f511
--- /dev/null
+++ b/demo/list.urs
@@ -0,0 +1,5 @@
+datatype list t = Nil | Cons of t * list t
+
+val length : t ::: Type -> list t -> int
+
+val rev : t ::: Type -> list t -> list t
diff --git a/demo/listEdit.ur b/demo/listEdit.ur
new file mode 100644
index 0000000..e75f2d0
--- /dev/null
+++ b/demo/listEdit.ur
@@ -0,0 +1,49 @@
+datatype rlist = Nil | Cons of {Data : source string,
+                                NewData : source string,
+                                Tail : source rlist}
+
+fun showString ss =
+    s <- signal ss;
+    return <xml>{[s]}</xml>
+
+fun show rls =
+    v <- signal rls;
+    show' v
+
+and show' rl =
+    case rl of
+        Nil => return <xml/>
+      | Cons {Data = ss, NewData = ss', Tail = rls} => return <xml>
+        <dyn signal={showString ss}/>
+        <button value="Change to:" onclick={fn _ => s <- get ss'; set ss s}/>
+        <ctextbox source={ss'}/><br/>
+        <dyn signal={show rls}/>
+      </xml>
+
+fun main () =
+    head <- source Nil;
+    tailP <- source head;
+    data <- source "";
+
+    let
+        fun add () =
+            data <- get data;
+            data <- source data;
+            ndata <- source "";
+            tail <- get tailP;
+            tail' <- source Nil;
+
+            let
+                val cons = Cons {Data = data, NewData = ndata, Tail = tail'}
+            in
+                set tail cons;
+                set tailP tail'
+            end
+    in
+        return <xml><body>
+          <ctextbox source={data}/> <button value="Add" onclick={fn _ => add ()}/><br/>
+          <br/>
+
+          <dyn signal={show head}/>
+        </body></xml>
+    end
diff --git a/demo/listEdit.urp b/demo/listEdit.urp
new file mode 100644
index 0000000..87bd245
--- /dev/null
+++ b/demo/listEdit.urp
@@ -0,0 +1 @@
+listEdit
diff --git a/demo/listEdit.urs b/demo/listEdit.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/listEdit.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/listFun.ur b/demo/listFun.ur
new file mode 100644
index 0000000..d679c2f
--- /dev/null
+++ b/demo/listFun.ur
@@ -0,0 +1,33 @@
+open List
+
+functor Make(M : sig
+                 type t
+                 val toString : t -> string
+                 val fromString : string -> option t
+             end) = struct
+    fun toXml (ls : list M.t) =
+        case ls of
+            Nil => <xml>[]</xml>
+          | Cons (x, ls') => <xml>{[M.toString x]} :: {toXml ls'}</xml>
+      
+    fun console (ls : list M.t) =
+        let
+            fun cons (r : {X : string}) =
+                case M.fromString r.X of
+                    None => return <xml><body>Invalid string!</body></xml>
+                  | Some v => console (Cons (v, ls))
+        in
+            return <xml><body>
+              Current list: {toXml ls}<br/>
+              Reversed list: {toXml (rev ls)}<br/>
+              Length: {[length ls]}<br/>
+              <br/>
+
+              <form>
+                Add element: <textbox{#X}/> <submit action={cons}/>
+              </form>
+            </body></xml>
+        end
+
+    fun main () = console Nil
+end
diff --git a/demo/listFun.urs b/demo/listFun.urs
new file mode 100644
index 0000000..909bbcf
--- /dev/null
+++ b/demo/listFun.urs
@@ -0,0 +1,7 @@
+functor Make(M : sig
+                 type t
+                 val toString : t -> string
+                 val fromString : string -> option t
+             end) : sig
+    val main : unit -> transaction page
+end
diff --git a/demo/listShop.ur b/demo/listShop.ur
new file mode 100644
index 0000000..be35d50
--- /dev/null
+++ b/demo/listShop.ur
@@ -0,0 +1,20 @@
+structure I = struct
+    type t = int
+    val toString = show
+    val fromString = read
+end
+
+structure S = struct
+    type t = string
+    val toString = show
+    val fromString = read
+end
+
+structure IL = ListFun.Make(I)
+structure SL = ListFun.Make(S)
+
+fun main () = return <xml><body>
+  Pick your poison:<br/>
+  <li> <a link={IL.main ()}>Integers</a></li>
+  <li> <a link={SL.main ()}>Strings</a></li>
+</body></xml>
diff --git a/demo/listShop.urp b/demo/listShop.urp
new file mode 100644
index 0000000..9b4b318
--- /dev/null
+++ b/demo/listShop.urp
@@ -0,0 +1,3 @@
+list
+listFun
+listShop
diff --git a/demo/listShop.urs b/demo/listShop.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/listShop.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/metaform.ur b/demo/metaform.ur
new file mode 100644
index 0000000..c6a6e54
--- /dev/null
+++ b/demo/metaform.ur
@@ -0,0 +1,28 @@
+functor Make (M : sig
+                  con fs :: {Unit}
+                  val fl : folder fs
+                  val names : $(mapU string fs)
+              end) = struct
+
+    fun handler values = return <xml><body>
+      {@mapUX2 [string] [string] [body]
+        (fn [nm :: Name] [rest ::_] [[nm] ~ rest] name value => <xml>
+          <li> {[name]} = {[value]}</li>
+        </xml>)
+        M.fl M.names values}
+    </body></xml>
+
+    fun main () = return <xml><body>
+      <form>
+        {@foldUR [string] [fn cols => xml form [] (mapU string cols)]
+          (fn [nm :: Name] [rest ::_] [[nm] ~ rest] name acc => <xml>
+            <li> {[name]}: <textbox{nm}/></li>
+            {useMore acc}
+          </xml>)
+          <xml/>
+          M.fl M.names}
+        <submit action={handler}/>
+      </form>
+    </body></xml>
+
+end
diff --git a/demo/metaform.urs b/demo/metaform.urs
new file mode 100644
index 0000000..0544e56
--- /dev/null
+++ b/demo/metaform.urs
@@ -0,0 +1,7 @@
+functor Make (M : sig
+                  con fs :: {Unit}
+                  val fl : folder fs
+                  val names : $(mapU string fs)
+              end) : sig
+    val main : unit -> transaction page
+end
diff --git a/demo/metaform1.ur b/demo/metaform1.ur
new file mode 100644
index 0000000..c6a4664
--- /dev/null
+++ b/demo/metaform1.ur
@@ -0,0 +1,3 @@
+open Metaform.Make(struct
+                       val names = {A = "Tic", B = "Tac", C = "Toe"}
+                   end)
diff --git a/demo/metaform1.urp b/demo/metaform1.urp
new file mode 100644
index 0000000..c5558e2
--- /dev/null
+++ b/demo/metaform1.urp
@@ -0,0 +1,2 @@
+metaform
+metaform1
diff --git a/demo/metaform1.urs b/demo/metaform1.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/metaform1.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/metaform2.ur b/demo/metaform2.ur
new file mode 100644
index 0000000..430a42f
--- /dev/null
+++ b/demo/metaform2.ur
@@ -0,0 +1,12 @@
+structure MM = Metaform.Make(struct
+                                 val names = {X = "x", Y = "y"}
+                             end)
+
+fun diversion () = return <xml><body>
+  Welcome to the diversion.
+</body></xml>
+
+fun main () = return <xml><body>
+  <li> <a link={diversion ()}>See something shiny!</a></li>
+  <li> <a link={MM.main ()}>Fill out a form!</a></li>
+</body></xml>
diff --git a/demo/metaform2.urp b/demo/metaform2.urp
new file mode 100644
index 0000000..623a84d
--- /dev/null
+++ b/demo/metaform2.urp
@@ -0,0 +1,2 @@
+metaform
+metaform2
diff --git a/demo/metaform2.urs b/demo/metaform2.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/metaform2.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
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
diff --git a/demo/nested.ur b/demo/nested.ur
new file mode 100644
index 0000000..31c9e1e
--- /dev/null
+++ b/demo/nested.ur
@@ -0,0 +1,62 @@
+fun pageA () = return <xml>
+  <head>
+    <title>A</title>
+  </head>
+  <body>
+    <form>
+      <table>
+        <tr>
+          <td>Forename:</td>
+          <td><textbox{#Forename}/></td>
+        </tr>
+        <tr>
+          <td>Enter a Surname?</td>
+          <td><checkbox{#EnterSurname}/></td>
+        </tr>
+      </table>
+      <submit action={fromA} />
+    </form>
+  </body>
+</xml>
+
+and fromA r =
+    let
+        val forename = r.Forename
+
+        fun pageB () = return <xml>
+          <head>
+            <title>B</title>
+          </head>
+          <body>
+            <form>
+              Surname:
+              <textbox{#Surname}/>
+              <submit action={pageC'} />
+            </form>
+            <a link={pageA ()}>Previous</a>
+          </body>
+        </xml>
+
+        and pageC' r = pageC (Some r.Surname)
+
+        and pageC surname = return <xml>
+          <head>
+            <title>C</title>
+          </head>
+          <body>
+            <p>Hello {[forename]}{case surname of
+                                      None => <xml/>
+                                    | Some s => <xml> {[s]}</xml>}</p>
+            {case surname of
+                 None => <xml><a link={pageA ()}>Previous</a></xml>
+               | Some _ => <xml><a link={pageB ()}>Previous</a></xml>}
+          </body>
+        </xml>
+    in
+        if r.EnterSurname then
+            pageB ()
+        else
+            pageC None
+    end
+
+val main = pageA
diff --git a/demo/nested.urp b/demo/nested.urp
new file mode 100644
index 0000000..79c5395
--- /dev/null
+++ b/demo/nested.urp
@@ -0,0 +1 @@
+nested
diff --git a/demo/nested.urs b/demo/nested.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/nested.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/noisy.ur b/demo/noisy.ur
new file mode 100644
index 0000000..caf5240
--- /dev/null
+++ b/demo/noisy.ur
@@ -0,0 +1,43 @@
+datatype list t = Nil | Cons of t * list t
+
+table t : { Id : int, A : string }
+  PRIMARY KEY Id
+
+fun add id s =
+    dml (INSERT INTO t (Id, A) VALUES ({[id]}, {[s]}))
+
+fun del id =
+    dml (DELETE FROM t WHERE t.Id = {[id]})
+
+fun lookup id =
+    ro <- oneOrNoRows (SELECT t.A FROM t WHERE t.Id = {[id]});
+    case ro of
+        None => return None
+      | Some r => return (Some r.T.A)
+
+fun check ls =
+    case ls of
+        Nil => return ()
+      | Cons (id, ls') =>
+        ao <- rpc (lookup id);
+        alert (case ao of
+                   None => "Nada"
+                 | Some a => a);
+        check ls'
+
+fun main () =
+    idAdd <- source "";
+    aAdd <- source "";
+
+    idDel <- source "";
+
+    return <xml><body>
+      <button value="Check values of 1, 2, and 3" onclick={fn _ => check (Cons (1, Cons (2, Cons (3, Nil))))}/><br/>
+      <br/>
+      <button value="Add" onclick={fn _ => id <- get idAdd; a <- get aAdd; rpc (add (readError id) a)}/>
+      <ctextbox source={idAdd}/>
+      <ctextbox source={aAdd}/><br/>
+      <br/>
+      <button value="Delete" onclick={fn _ => id <- get idDel; rpc (del (readError id))}/>
+      <ctextbox source={idDel}/>
+    </body></xml>
diff --git a/demo/noisy.urp b/demo/noisy.urp
new file mode 100644
index 0000000..ea08bf7
--- /dev/null
+++ b/demo/noisy.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql noisy.sql
+
+noisy
diff --git a/demo/noisy.urs b/demo/noisy.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/noisy.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/outer.ur b/demo/outer.ur
new file mode 100644
index 0000000..ac49f47
--- /dev/null
+++ b/demo/outer.ur
@@ -0,0 +1,35 @@
+table t : { Id : int, B : string }
+  PRIMARY KEY Id
+
+table u : { Id : int, Link : int, C : string, D : option float }
+  PRIMARY KEY Id,
+  CONSTRAINT Link FOREIGN KEY Link REFERENCES t(Id)
+
+fun main () =
+    xml <- queryX (SELECT t.Id, t.B, u.Id, u.C, u.D
+                   FROM t LEFT JOIN u ON t.Id = u.Link)
+                  (fn r => <xml><tr>
+                    <td>{[r.T.Id]}</td>
+                    <td>{[r.T.B]}</td>
+                    <td>{[r.U.Id]}</td>
+                    <td>{[r.U.C]}</td>
+                    <td>{[r.U.D]}</td>
+                  </tr></xml>);
+    return <xml><body>
+      <table>{xml}</table>
+
+      <form>Insert into t: <textbox{#Id} size={5}/> <textbox{#B} size={5}/>
+        <submit action={addT}/></form>
+      <form>
+        Insert into u: <textbox{#Id} size={5}/> <textbox{#Link} size={5}/> <textbox{#C} size={5}/>
+        <textbox{#D} size={5}/> <submit action={addU}/>
+      </form>
+    </body></xml>
+
+and addT r =
+    dml (INSERT INTO t (Id, B) VALUES ({[readError r.Id]}, {[r.B]}));
+    main ()
+
+and addU r =
+    dml (INSERT INTO u (Id, Link, C, D) VALUES ({[readError r.Id]}, {[readError r.Link]}, {[r.C]}, {[readError r.D]}));
+    main ()
diff --git a/demo/outer.urp b/demo/outer.urp
new file mode 100644
index 0000000..994c3e1
--- /dev/null
+++ b/demo/outer.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql outer.sql
+
+outer
diff --git a/demo/outer.urs b/demo/outer.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/outer.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/prose b/demo/prose
new file mode 100644
index 0000000..781eeed
--- /dev/null
+++ b/demo/prose
@@ -0,0 +1,375 @@
+<p><b>Ur/Web</b> is a domain-specific language for programming web applications backed by SQL databases.  It is (strongly) statically typed (like ML and Haskell) and purely functional (like Haskell).  <b>Ur</b> is the base language, and the web-specific features of Ur/Web (mostly) come only in the form of special rules for parsing and optimization.  The Ur core looks a lot like <a href="http://sml.sourceforge.net/">Standard ML</a>, with a few <a href="http://www.haskell.org/">Haskell</a>-isms added, and kinder, gentler versions added of many features from dependently typed languages like the logic behind <a href="http://coq.inria.fr/">Coq</a>.  The type system is much more expressive than in ML and Haskell, such that well-typed web applications cannot "go wrong," not just in handling single HTTP requests, but across their entire lifetimes of interacting with HTTP clients.  Beyond that, Ur is unusual in using ideas from dependent typing to enable very effective metaprogramming, or programming with explicit analysis of type structure.  Many common web application components can be built by Ur/Web functions that operate on types, where it seems impossible to achieve similar code re-use in more established statically typed languages.</p>
+
+<p>The page you are currently reading is a part of the demo included with the Ur/Web sources and supporting files available from <a href="https://github.com/urweb/urweb">GitHub</a>.  The following steps will build a local instance of the demo if you're lucky (and running a Debian-based Linux OS, which actually tend to have Ur/Web packages built in these days).  If you're not lucky, you can consult the beginning of <a href="http://www.impredicative.com/ur/manual.pdf">the manual</a> for more detailed instructions.</p>
+
+<h6>Install System Dependencies</h6>
+
+<p>
+<blockquote><pre>sudo apt-get install build-essential \
+  emacs-goodies-el \
+  libgmp-dev \
+  libssl-dev \
+  libpq-dev \
+  libsqlite3-dev \
+  mlton \
+  sqlite3</blockquote></pre></p>
+
+<h6>Build and Install the Ur/Web Framework</h6>
+
+<p><blockquote><pre>./configure
+make
+sudo make install
+</pre></blockquote></p>
+
+<h6>Compile the Demo the Easy Way</h6>
+
+<p><blockquote><pre>$ urweb -dbms sqlite -db /path_to_db.sqlite -demo /Demo demo
+</blockquote></pre></p>
+
+<p>The <tt>-dbms sqlite</tt> flag indicates that instead of using the default database management system (<a href="https://www.postgresql.org/">PostgreSQL</a>), we wish to use <a href="https://sqlite.org/">SQLite</a> (usually unsuited for production).  The <tt>-db</tt> flag allows us to specify the file-system path to our SQLite database.  The <tt>-demo /Demo</tt> parameter indicates that we want to build a demo application that expects its URIs to begin with <tt>/Demo</tt>.  The final argument <tt>demo</tt> gives the path to a directory housing Ur/Web source files (<tt>.ur</tt>, <tt>.urp</tt>, <tt>.urs</tt>, etc.).
+</p>
+
+<p>
+The following files are created during the compilation process:
+<ul>
+<li><tt>demo/demo.exe</tt>
+<li><tt>demo/out/*</tt>
+<li><tt>demo/demo.sql</tt>
+</ul>
+</p>
+
+<h6>Initialize the Database</h6>
+
+<p>
+When we compiled the demo in the last step, a <tt>demo.sql</tt> file was created for us, which contains all the information required to create a database compatible with the demo web app.  The command below will provision our SQLite database.  To see an example of where a database table is defined in source code, check out <tt>demo/crud1.ur</tt>.  Also of interest is the file <tt>demo.urp</tt>, which contains a <tt>database</tt> directive with the PostgreSQL database that the demo web server will try to connect to if database information isn't provided as command-line arguments when the application is compiled.
+
+<blockquote><pre>$ sqlite3 /path/to/database/file &lt;demo/demo.sql
+</blockquote></pre>
+</p>
+
+<h6>Boot the App</h6>
+
+Executing the binary generated above (<tt>demo/demo.exe</tt>) with no arguments will start a single-threaded server listening on port 8080.  (To answer the usual first question: the <tt>.exe</tt> prefix has nothing to do with Windows and does not mean that you compiled for the wrong OS!)  Pass the flag <tt>-h</tt> to see which options are available on such freshly built binaries.
+</p>
+<p><blockquote><pre>$ demo/demo.exe
+Database connection initialized.
+Listening on port 8080....
+</blockquote></pre>
+Test out <tt>http://localhost:8080/Demo/Demo/main</tt>, which should consist of links to the individual demos after booting the app.</p>
+</p>
+
+<h6>Serve the Static Content with a Reverse Proxy</h6>
+
+<p>The <tt>-demo</tt> version also generates some HTML in a subdirectory <tt>out</tt> of the demo directory (e.g. <tt>index.html</tt>).  It is easy to set Apache up to serve these HTML files and to proxy out to the Ur/Web web server for dynamic page requests.  This configuration works for me, where <tt>DIR</tt> is the location of an Ur/Web source distribution.  (You may also need to enable the proxy module with a command like <tt>a2enmod proxy_http</tt>.)
+
+<blockquote><pre>Alias /demo/ "DIR/demo/out/"
+
+ProxyPass /Demo/ http://localhost:8080/Demo/
+ProxyPassReverse /Demo/ http://localhost:8080/Demo/</pre></blockquote></p>
+
+<h6>Compile Individually</h6>
+
+<p>These project files can also be built separately.  For example, you could run
+
+<blockquote><pre>$ urweb demo/hello
+</pre></blockquote>
+
+to build the "Hello World" demo application.  Doing so will invite Ur/Web to seek out the various <tt>demo/hello.*</tt> files and, from them, build a binary <tt>demo/hello.exe</tt>.  The URL to access the resulting app will be <tt>http://localhost:8080/Hello/main</tt>.
+</p>
+
+<h6>This File</h6>
+<p>One of the files in the demo directory is named <tt>prose</tt>, a file describing the different demo pieces with HTML.  Some lines of <tt>prose</tt> have the form <tt><i>foo</i>.urp</tt>, naming particular project files (with the extension <tt>.urp</tt>) in that directory.  These make up the different pages of the tutorial.</p>
+
+<h6>Finally, the Demos!</h6>
+
+<p>The rest of the demo focuses on introducing Ur/Web programming, one feature at a time.  Follow the links in the lefthand frame to visit the applications, commentary, and syntax-highlighted source code.  (An Emacs mode is behind the syntax highlighting.)  I recommend visiting the applications in the order listed, since that is the order in which new concepts are introduced.</p>
+
+hello.urp
+
+<p>We must, of course, begin with "Hello World."</p>
+
+<p>The project file justs list one filename prefix, <tt>hello</tt>.  This causes both <tt>hello.urs</tt> and <tt>hello.ur</tt> to be pulled into the project.  <tt>.urs</tt> files are like <a href="http://caml.inria.fr/ocaml/">OCaml</a> <tt>.mli</tt> files, and <tt>.ur</tt> files are like OCaml <tt>.ml</tt> files.  That is, <tt>.urs</tt> files provide interfaces, and <tt>.ur</tt> files provide implementations.  <tt>.urs</tt> files may be omitted for <tt>.ur</tt> files, in which case most permissive interfaces are inferred.</p>
+
+<p>Ur/Web features a module system very similar to those found in SML and OCaml.  Like in OCaml, interface files are treated as module system signatures, and they are ascribed to structures built from implementation files.  <tt>hello.urs</tt> tells us that we only export a function named <tt>main</tt>, taking no arguments and running a transaction that results in an HTML page.  <tt>transaction</tt> is a monad in the spirit of the Haskell IO monad, with the intent that every operation performable in <tt>transaction</tt> can be undone.  By design, Ur/Web does not provide a less constrained way of running side-effecting actions.  This particular example application will employ no side effects, but the compiler requires that all pages be generated by transactions.</p>
+
+<p>Looking at <tt>hello.ur</tt>, we see an SML-looking function definition that returns a fragment of XML, written with special syntax.  This fragment is returned to browsers that request the URI <tt>/Demo/Hello/main</tt>.  That is, we take the demo-wide prefix <tt>/Demo</tt> and add a suffix that indicates we want to call the <tt>main</tt> function in the <tt>Hello</tt> module.  This path convention generalizes to arbitrary levels of nested module definitions and functor applications (which we will see later).</p>
+
+link.urp
+
+<p>In <tt>link.ur</tt>, we see how easy it is to link to another page.  The Ur/Web compiler guarantees that all links are valid.  We just write some Ur/Web code inside an "antiquote" in our XML, denoting a transaction that will produce the new page if the link is clicked.</p>
+
+rec.urp
+
+<p>Crafting webs of interlinked pages is easy, using recursion.</p>
+
+counter.urp
+
+<p>It is also easy to pass state around via functions, in the style commonly associated with "continuation-based" web servers.  As is usual for such systems, all state is stored on the client side.  In this case, it is encoded in URLs.</p>
+
+<p>In the implementation of <tt>Counter.counter</tt>, we see the notation <tt>{[...]}</tt>, which uses type classes to inject values of different types (<tt>int</tt> in this case) into XML.  It's probably worth stating explicitly that XML fragments <i>are not strings</i>, so that the type-checker will enforce that our final piece of XML is valid.</p>
+
+form.urp
+
+<p>Here we see a basic form.  The type system tracks which form inputs we include, and it enforces that the form handler function expects a record containing exactly those fields, with exactly the proper types.</p>
+
+nested.urp
+
+<p>Here is an implementation of the tiny challenge problem from <a href="http://www.accursoft.co.uk/web/">this web framework comparison</a>.  Using nested function definitions, it is easy to persist state across clicks.</p>
+
+cookie.urp
+
+<p>Often, it is useful to associate persistent data with particular web clients.  Ur/Web includes an easy facility for using type-safe cookies.  This example shows how to use a form to set a named cookie.</p>
+
+<p>After setting the cookie, try browsing back to this demo from the main index.  The data you entered should still be there.</p>
+
+url.urp
+
+<p>Up to this point, we haven't included a single URL in our source code.  This may be very surprising to programmers used to working with traditional web frameworks!  In Ur/Web, we avoid writing URLs explicitly wherever possible.  To link to an external web page, we rely on an abstract type <tt>url</tt>.  Strings can't be treated implicitly as URLs; rather, they must be "blessed" explicitly.  This helps avoid some classes of code injection attacks.</p>
+
+<p>Further, each Ur/Web application enforces a global condition on which strings are allowed as URLs.  The <tt>.urp</tt> file for this demo shows an example that specifies particular rules about which URLs are allowed.  You can try entering a variety of URLs on the form on the front page.  Only those satisfying the <tt>allow url</tt>/<tt>deny url</tt> conditions should be permitted.</p>
+
+css.urp
+
+<p>Ur/Web supports a structured approach to Cascading Style Sheets, where each style is a first-class value within a module.  This demo shows the importing of an external style sheet with one style.  By default, like other Ur/Web entities, the name of the style would be <tt>Css_quote</tt>.  We use the <tt>rewrite</tt> directive in the <tt>.urp</tt> file to specify an alternate name for a particular canonical module path.  The external style sheet contains a definition of a style with the alternate name that we give.</p>
+
+upload.urp
+
+<p>HTTP file upload is made convenient, via the abstract types <tt>blob</tt> and <tt>file</tt> in the standard library.  A <tt>blob</tt> is a binary sequence, and a <tt>file</tt> combines a <tt>blob</tt> with MIME type information.  An <tt>upload</tt> form input can be used to accept <tt>file</tt>s from the user.</p>
+
+<p>In the <tt>.urp</tt> file for this example, we give a whitelist of MIME types to be accepted.  The application will echo back to the user any file he uploads as one of those types.  You can try submitting other kinds of files to verify that they are rejected.</p>
+
+subforms.urp
+
+<p>In the examples so far, the number of inputs per form has been constant.  Often it is useful to have a varying set of form inputs.  Ur/Web provides the <tt>&lt;subforms&gt;</tt> and <tt>&lt;entry&gt;</tt> tags for grouping a list of forms with the same field names and types into a single, list-valued composite form.  This demo shows those tags in action, in a simple form echoing application that lets the user add and remove inputs.</p>
+
+listShop.urp
+
+<p>This example shows off algebraic datatypes, parametric polymorphism, and functors.</p>
+
+<p>The <tt>List</tt> module defines a list datatype, much in the style of SML, but with type parameters written more in Haskell style.  The types of <tt>List.length</tt> and <tt>List.rev</tt> indicate that they are polymorphic.  Types like <tt>t ::: Type -> ...</tt> indicate polymorphism, with the triple colon denoting that the value of this type parameter should be <i>inferred</i> at uses.  A double colon would mean that the type argument must be provided explicitly at uses.  In contrast to ML and Haskell, all polymorphism must be <i>declared</i> explicitly in Ur, while instantiations may be inferred at uses.</p>
+
+<p>The <tt>ListFun</tt> module defines a functor for building list editing sub-applications.  An argument to the functor <tt>Make</tt> must give the type to be stored in the lists, along with marshaling and unmarshaling functions.  In return, the functor returns an entry point function.</p>
+
+<p>The <tt>ListShop</tt> modules ties everything together by instantiating <tt>ListFun.Make</tt> with structures for integers and strings.  <tt>show</tt> and <tt>read</tt> can be used for marshaling and unmarshaling in both cases because they are type-class-generic.</p>
+
+sql.urp
+
+<p>We see a simple example of accessing a SQL database.  The project file specifies the database to connect to.</p>
+
+<p>A <tt>table</tt> declaration declares a SQL table with rows of a particular record type.  We can use embedded SQL syntax in a way that leads to all of our queries and updates being type-checked.  Indeed, Ur/Web makes strong guarantees that it is impossible to execute invalid SQL queries or make bad assumptions about the types of tables for marshaling and unmarshaling (which happen implicitly).</p>
+
+<p>The <tt>list</tt> function implements an HTML table view of all rows in the SQL table.  The <tt>queryX</tt> function takes two arguments: a SQL query and a function for generating XML fragments from query result rows.  The query is run, and the fragments for the rows are concatenated together.</p>
+
+<p>Other functions demonstrate use of the <tt>dml</tt> function, for building a transaction from a SQL DML command.  It is easy to insert antiquoted Ur code into queries and DML commands, and the type-checker catches mistakes in the types of the expressions that we insert.</p>
+
+<p>
+
+ref.urp
+
+<p>This example shows how to mix the module system with SQL to implement a kind of "abstract data type."  The functor <tt>RefFun.Make</tt> takes in a type belonging to the type class of those types that may be included in SQL.  The functor output includes an abstract type <tt>ref</tt>, along with operations for working with <tt>ref</tt>s via transactions.  In the functor implementation, we see that <tt>ref</tt> is implemented as <tt>int</tt>, treated as primary keys of a SQL table.</p>
+
+<p>The functor creates a new encapsulated SQL sequence and table on each call.  These local relations show up in the automatically generated SQL file that should be run to prepare the database for use, but they are invisible from client code.  We could change the functor to create different SQL relations, without needing to change client code.</p>
+
+<p>Note that, in <tt>ref.ur</tt>, the <tt>inj</tt> components of functor arguments are omitted.  Since these arguments are type class witnesses, the compiler infers them automatically based on the choices of <tt>data</tt>.</p>
+
+tree.urp
+
+<p>Here we see how we can abstract over common patterns of SQL queries.  In particular, since standard SQL does not help much with queries over trees, we write a function for traversing an SQL tree, building an HTML representation, based on a user-provided function for rendering individual rows.</p>
+
+<p>The signature of <tt>TreeFun.Make</tt> tells us that, to instantiate the functor, we must provide</p>
+<ol>
+        <li>A primary key type <tt>key</tt></li>
+        <li>SQL field names <tt>id</tt> (for primary keys) and <tt>parent</tt> (for parent links)</li>
+        <li>A type-level record <tt>cols</tt> of field names besides <tt>id</tt> and <tt>parent</tt></li>
+        <li>"Proofs" that <tt>id</tt> is distinct from <tt>parent</tt> and that neither of <tt>id</tt> and <tt>parent</tt> appears in <tt>cols</tt></li>
+        <li>A witness that <tt>key</tt> belongs to the type class <tt>sql_injectable_prim</tt>, which indicates that both <tt>key</tt> and <tt>option key</tt> are fair game to use with SQL</li>
+        <li>An SQL table <tt>tab</tt>, containing a field <tt>id</tt> of type <tt>key</tt>, a field <tt>parent</tt> of type <tt>option key</tt>, and every field of <tt>cols</tt></li>
+</ol>
+
+constraints.urp
+
+<p>Ur/Web supports attaching SQL table constraints to table definitions.  We've sprinkled a few such constraints throughout our examples so far, without mentioning them.  This example shows a table with all four of the supported kinds of constraints.  An application would generally try to avoid inserting data that violates constraints, but, in this example, we let you insert arbitrary data, so that you can see each of the constraints failing.</p>
+
+<ol>
+        <li>The <tt>PRIMARY KEY</tt> constraint establishes the field of the table that we expect to use as a key in looking up specific rows.  It is an error for two rows to share the same primary key.</li>
+        <li>The <tt>UNIQUE</tt> constraint is like <tt>PRIMARY KEY</tt>, with the difference being that a table may have many <tt>UNIQUE</tt> constraints but no more than one primary key.</li>
+        <li>The <tt>CHECK</tt> constraint declares a boolean assertion that must hold for every row of the table.</li>
+        <li>The <tt>FOREIGN KEY</tt> constraint declares that a row of the table references a particular column of another table, or of the same table, as we see in this example.  It's a static type error to reference a foreign key column that has no <tt>PRIMARY KEY</tt> or <tt>UNIQUE</tt> constraint.</li>
+</ol>
+
+outer.urp
+
+<p>SQL outer joins are no problem, as this demo shows.  Unlike with SQL, here we have static type inference determining for us which columns may become nullable as a result of an outer join, and the compiler will reject programs that make the wrong assumptions about that process.  The details of that nullification don't appear in this example, where the magic of type classes determines both the post-join type of each field and the right pretty-printing and parsing function for each of those types.</p>
+
+view.urp
+
+<p>SQL views are also supported with a special declaration form, analogous to <tt>table</tt>.  A multi-parameter type class <tt>fieldsOf</tt> is used to characterize places where both tables and views are allowed.  For instance, the polymorphic function <tt>list</tt> shown here lists the contents of any table or view containing just a single <tt>int</tt> column named <tt>A</tt>.</p>
+
+cookieSec.urp
+
+<p>Ur/Web guarantees that compiled applications are immune to certain kinds of <a href="http://www.owasp.org/index.php/Top_10_2007-A5">cross site request forgery</a>.  For instance, a "phisher" might send many e-mails linking to a form that he has set up to look like your web site.  The form is connected to your web site, where it might, say, transfer money from your bank account to the phisher's account.  The phisher doesn't know your username, but, if that username is stored in a cookie, it will be sent automatically by your browser.  Ur/Web automatically signs cookie values cryptographically, with the signature included as a POST parameter and not part of a cookie, to prevent such attacks.</p>
+
+<p>This demo shows a simple mock-up of a situation where such an attack is often possible with traditional web frameworks.  You can set an arbitrary username for yourself in a cookie, and you can modify the database in a way that depends on the current cookie value.  Try getting the latter action to succeed without first setting your desired username in the cookie.  This should be roughly as impossible as cracking the particular cryptographic hash function that is used.</p>
+
+sum.urp
+
+<p>Metaprogramming is one of the most important facilities of Ur.  This example shows how to write a function that is able to sum up the fields of records of integers, no matter which set of fields the particular record has.</p>
+
+<p>Ur's support for analysis of types is based around extensible records, or <i>row types</i>.  In the definition of the <tt>sum</tt> function, we see the type parameter <tt>fs</tt> assigned the <i>kind</i> <tt>{Unit}</tt>, which stands for records of types of kind <tt>Unit</tt>.  The <tt>Unit</tt> kind has only one inhabitant, <tt>()</tt>.  The kind <tt>Type</tt> is for "normal" types.</p>
+
+<p>The <tt>sum</tt> function also takes an argument <tt>fl</tt> of type <tt>folder fs</tt>.  Folders represent permutations of the elements of type-level records.  We can use a folder to iterate over a type-level record in the order indicated by the permutation.</p>
+
+<p>The unary <tt>$</tt> operator is used to build a record <tt>Type</tt> from a <tt>{Type}</tt> (that is, the kind of records of types).  The library function <tt>mapU</tt> takes in a type <i>t</i> of kind <t>K</t> and a <tt>{Unit}</tt> <i>r</i>, and it builds a <tt>{K}</tt> as long as <i>r</i>, where every field is assigned value <i>t</i>.</p>
+
+<p>Another library function <tt>foldUR</tt> is defined at the level of expressions, while <tt>mapU</tt> is a type-level function.  <tt>foldUR</tt> takes 7 arguments, some of them types and some values.  Type arguments are distinguished by being written within brackets.  The arguments to <tt>foldUR</tt> respectively tell us:
+
+<ol>
+<li>The type we will assign to each record field</li>
+<li>The type of the final and all intermediate results of the fold, expressed as a function over the portion of the <tt>{Unit}</tt> that has been traversed so far</li>
+<li>A function that updates the accumulator based on the current record field name, the rest of the input record type, the current record field value, and the current accumulator</li>
+<li>The initial accumulator value</li>
+<li>The input record type</li>
+<li>A folder for that type</li>
+<li>The input record value</li>
+</ol>
+
+An unusual part of the third argument is the syntax <tt>[t1 ~ t2]</tt> within a multi-argument <tt>fn</tt>.  This syntax denotes a proof that row types <tt>t1</tt> and <tt>t2</tt> have no field names in common.  The proof is not named, because it is applied automatically as needed.  Indeed, the proof appears unused in this case, though it is actually needed to ensure the validity of some inferred types, as well as to unify with the type of <tt>foldUR</tt>.</p>
+
+<p>The general syntax for constant row types is <tt>[Name1 = t1, ..., NameN = tN]</tt>, and there is a shorthand version <tt>[Name1, ..., NameN]</tt> for records of <tt>Unit</tt>s.</p>
+
+<p>With <tt>sum</tt> defined, it is easy to make some sample calls.  The form of the code for <tt>main</tt> does not make it apparent, but the compiler must "reverse engineer" the appropriate <tt>{Unit}</tt> from the <tt>{Type}</tt> available from the context at each call to <tt>sum</tt>.  The compiler also infers a <tt>folder</tt> for each call, guessing at the desired permutations by examining the orders in which field names are written in the code.</p>
+
+tcSum.urp
+
+<p>It's easy to adapt the last example to use type classes, such that we can sum the fields of records based on any numeric type.</p>
+
+metaform1.urp
+
+<p>We can use metaprogramming with row types to build HTML forms (and their handlers) generically.  The functor <tt>Metaform.Make</tt> takes in a unit row <tt>fs</tt> and a value-level record <tt>names</tt> assigning string names to the fields of <tt>fs</tt>.  The functor implementation builds a form handler with a library function <tt>foldURX2</tt>, which runs over two value-level records in parallel, building an XML fragment.</p>
+
+<p>The form itself is generated using the more primitive <tt>foldUR</tt>.  We see the type <tt>xml form [] (mapU string cols)</tt> as the result of the fold.  This is the type of XML fragments that are suitable for inclusion in forms, require no form fields to be defined on entry, and themselves define form fields whose names and types are given by <tt>mapU string cols</tt>.  The <tt>useMore</tt> function "weakens" the type of an XML fragment, so that it "pretends" to require additional fields as input.  This weakening is necessary to accommodate the general typing rule for concatenating bits of XML.</tt>
+<p>The functor use in <tt>Metaform1</tt> is trivial.  The compiler infers the values of the structure members <tt>fs</tt> and <tt>fl</tt> from the type of the value provided for <tt>names</tt>.</p>
+
+metaform2.urp
+
+<p>This example showcases code reuse by applying the same functor as in the last example.  The <tt>Metaform2</tt> module mixes pages from the functor with some new pages of its own.</p>
+
+crud1.urp
+
+<p>This example pulls together much of what we have seen so far.  It involves a generic "admin interface" builder.  That is, we have the <tt>Crud.Make</tt> functor, which takes in a description of a table and outputs a sub-application for viewing and editing that table.</p>
+
+<p>The signature of <tt>Crud.Make</tt> is based around a type function <tt>colMeta</tt>, which describes which supporting values we need for each column.  This function is declared with the keyword <tt>con</tt>, which stands for "constructor," the general class of "compile-time things" that includes types.  An argument to <tt>colMeta</tt> has kind <tt>(Type * Type)</tt>, which means that it must be a type-level tuple.  The first type is how the column is represented in SQL, and the second is how we represent it in HTML forms.  In order, the components of the resulting record give:
+
+<ol>
+<li>A display name</li>
+<li>A way of pretty-printing values of the column</li>
+<li>A way of generating an HTML form widget to input this column</li>
+<li>A way of generating an HTML form widget with an initial value specified</li>
+<li>A way of parsing values of the column from strings</li>
+<li>A type class witness, showing that the SQL representation can really be included in SQL</li>
+</ol></p>
+
+<p>The function <tt>colsMeta</tt> lifts <tt>colMeta</tt> over type-level records of type pairs.  The <tt>Crud</tt> module also defines reasonable default <tt>colMeta</tt> values for some primitive types.</p>
+
+<p>The functor signature tells us (in order) that an input must contain:
+
+<ol>
+<li>A type pair record <tt>cols</tt></li>
+<li>A proof that <tt>cols</tt> does not contain a field named <tt>Id</tt></li>
+<li>A SQL table <tt>tab</tt> with an <tt>Id</tt> field of type <tt>int</tt> and other fields whose names and types are read off of <tt>cols</tt></li>
+<li>A display title for the admin interface</li>
+<li>A record of meta-data for the columns</li>
+</ol></p>
+
+<p>Looking at <tt>crud1.ur</tt>, we see that a use of the functor is almost trivial.  Only the value components of the argument structure must be provided.  The column row type is inferred, and the disjointness constraint is proved automatically.</p>
+
+<p>We won't go into detail on the implementation of <tt>Crud.Make</tt>.  The types of the functions used there can be found in the signatures of the built-in <tt>Basis</tt> module and the <tt>Top</tt> module from the standard library.  The signature of the first and the signature and implementation of the second can be found in the <tt>lib/ur</tt> directory of the Ur/Web distribution.</p>
+
+crud2.urp
+
+<p>This example shows another application of <tt>Crud.Make</tt>.  We mix one standard column with one customized column.  We write an underscore for the <tt>Inject</tt> field of meta-data, since the type class facility can infer that witness.</p>
+
+crud3.urp
+
+<p>One thing that is unclear from the previous examples is how to provide more complex, multi-input widgets for taking input meant for particular fields.  The signature of <tt>Crud.Make</tt> forces every widget to define exactly one input.  The <tt>&lt;subform&gt;</tt> tag, the simpler cousin of the <tt>&lt;subforms&gt;</tt> tag that we saw earlier, provides a fix for this problem.  Via <tt>&lt;subform&gt;</tt>, an arbitrary form can be turned into a single record-valued input.</p>
+
+<p>We use that possibility here to define a silly widget for a <tt>string</tt> column, which concatenates the values entered into two different textboxes.</p>
+
+alert.urp
+
+<p>Ur/Web makes it easy to write code whose execution should be distributed between the web server and client web browsers.  Server-side code is compiled to efficient native code, and client-side code is compiled to JavaScript.  Ur/Web programmers don't need to worry about these details, because the language and standard library provide a uniform ML-like interface for the whole process.</p>
+
+<p>Here's an example of a button that, when clicked, opens an alert dialog on the client.</p>
+
+react.urp
+
+<p>Most client-side JavaScript programs modify page contents imperatively, but Ur/Web is based on functional-reactive programming instead.  Programs allocate data sources and then describe the page as a pure function of those data sources.  When the sources change, the page changes automatically.</p>
+
+<p>Here's an example where a button modifies a data source that affects some text on the page.  The affected portion of the page is indicated with the pseudo-HTML tag <tt>dyn</tt>, whose <tt>signal</tt> attribute specifies one of these pure functions over mutable sources.  A source containing data of type <tt>t</tt> has type <tt>source t</tt> and is created with the <tt>source</tt> operation within the <tt>transaction</tt> monad.  Functions over sources are represented in the monad <tt>signal</tt>.  Like in Haskell, we overload monad notations, so that the same return and bind operators can be used to write signals and transactions.  The <tt>signal</tt> function coerces a source to a signal.</p>
+
+listEdit.urp
+
+<p>This is a more involved functional-reactive example, involving recursive data structures that contain sources.  We build a list editor similar to the one from the <tt>ListShop</tt> example, but with all editing happening on the client side.</p>
+
+<p>The central data structure is the <tt>rlist</tt>, a list whose individual elements are sources, enabling fine-grained mutation.  Every rlist is either nil or is a cons cell made up of a source for a string data element, another source to serve as a scratchpad for GUI-based edits to the data element, and a final source that stores the remainder of the list.</p>
+
+<p>The main program provides operations to append to a list and to edit the data stored at any cell of the list.  Append is implemented by maintaining a source <tt>head</tt>, which points to the first list element; and a source <tt>tailP</tt>, which points to a <tt>source rlist</tt> where we should place the next appended node.</p>
+
+increment.urp
+
+<p>Here's an example where client-side code needs to run more code on the server.  We maintain a (server-side) SQL sequence.  When the user clicks a button, an AJAX request increments the remote sequence and gets the new value.</p>
+
+noisy.urp
+
+<p>This example shows how easy it is to make the flow of control "ping pong" back and forth between the client and the server.  Clicking a button triggers three queries to the server, with an alert generated after each query.</p>
+
+batch.urp
+
+<p>This example shows more of what is possible with mixed client/server code.  The application is an editor for a simple database table, where additions of new rows can be batched in the client, before a button is clicked to trigger a mass addition.</p>
+
+batchG.urp
+
+<p>We can redo the last example with a generic component, like we did in the <tt>Crud</tt> examples.  The module <tt>BatchFun</tt> is analogous to the <tt>Crud</tt> module.  It contains a functor that builds a batching editor, when given a suitable description of a table.</p>
+
+<p>The signature of the functor is the same as for <tt>Crud</tt>.  We change the definition of <tt>colMeta</tt> to reflect the different kinds of column metadata that we need.  Each column is still described by a pair of types, and the first element of each pair still gives the SQL type for a column.  Now, however, the second type in a pair gives a type of <i>local state</i> to be used in a reactive widget for inputing that column.</p>
+
+<p>The first three fields of a <tt>colMeta</tt> record are the same as for <tt>Crud</tt>.  The rest of the fields are:</p>
+<ol>
+        <li><tt>NewState</tt>, which allocates some new widget local state</li>
+        <li><tt>Widget</tt>, which produces a reactive widget from some state</li>
+        <li><tt>ReadState</tt>, which reads the current value of some state to determine which SQL value it encodes</li>
+</ol>
+
+<p><tt>BatchFun.Make</tt> handles the plumbing of allocating the local state, using it to create widgets, and reading the state values when the user clicks "Batch it."</p>
+
+<p><tt>batchG.ur</tt> contains an example instantiation, which is just as easy to write as in the <tt>Crud1</tt> example.</p>
+
+threads.urp
+
+<p>Ur/Web makes it easy to write multi-threaded client-side code.  This example demonstrates two threads writing to a page at once.</p>
+
+<p>First, we define a useful component for sections of pages that can have lines of text added to them dynamically.  This is the <tt>Buffer</tt> module.  It contains an abstract type of writable regions, along with functions to create a region, retrieve a signal representing its HTML rendering, and add a new line to it.</p>
+
+<p>The entry point to the main module <tt>Threads</tt> begins by creating a buffer.  The function <tt>loop</tt> implements writing to that buffer periodically, incrementing a counter each time.  The arguments to <tt>loop</tt> specify a prefix for the messages and the number of milliseconds to wait between writes.</p>
+
+<p>We specify some client-side code to run on page load using the <tt>onload</tt> attribute of <tt>&lt;body&gt;</tt>.  The <tt>onload</tt> code in this example spawns two separate threads running the <tt>loop</tt> code with different prefixes, update intervals, and starting counters.</p>
+
+<p>Old hands at concurrent programming may be worried at the lack of synchronization in this program.  Ur/Web uses <i>cooperative multi-threading</i>, not the more common <i>preemptive</i> multi-threading.  Only one thread runs at a time, and only particular function calls can trigger context switches.  In this example, <tt>sleep</tt> is the only such function that appears.</p>
+
+roundTrip.urp
+
+<p>So far, we've seen examples of client-side code triggering the execution of server-side code.  Such remote calls only happen in response to client-side events.  It is often useful to allow a client to trigger events on other clients, and Ur/Web facilitates this with a simple asynchronous message-passing facility.  The current example introduces the basics of message-passing with a trivial use case, and the next example shows a more realistic case where several clients can communicate.</p>
+
+<p>We are going to provide a silly service where a client can send messages to the server, which the server then echoes back to the client.  The SQL table <tt>channels</tt> stores a mapping from client IDs to message channels.  The abstract type <tt>client</tt> holds unique client IDs, which Ur/Web generates automatically as needed.  A <tt>channel <i>T</i></tt> is a channel to which messages of type <tt><i>T</i></tt> can be sent.  Every channel belongs to a single client; anyone can send to a channel, but only the channel's owner can read the messages.  Every client is associated with a particular open page on a particular web browser somewhere.  Since web browsing sessions are ephemeral, clients and their channels are garbage-collected automatically as the web server loses contact with browsers.  When a client is garbage-collected, any database row mentioning it or one of its channels is deleted.  It's also possible to include <tt>option client</tt>s (and likewise for channels) in databases, in which case such columns are merely nulled out when they refer to dead clients.</p>
+
+<p>The <tt>main</tt> function begins by retrieving the current client ID, allocating a new channel, and associating that channel with the current client in the database.  Next, we allocate a buffer and return the page, which in its <tt>onload</tt> attribute starts two loops running in parallel.  In contrast to in the last example, here we only use <tt>spawn</tt> with the call to the first loop, since every client-side event handler is implicitly started in a new thread.</tt>
+
+<p>The first loop, <tt>receiver</tt>, repeatedly reads messages from the channel and writes them to the buffer.  The second loop, <tt>sender</tt>, periodically sends messages to the channel.  Client code can't send messages directly.  Instead, we must use server-side functions to do the sending.  Clients aren't trusted to pass channels to the server, so our server-side function <tt>writeBack</tt> instead keys off of the client ID, looking up the corresponding channel in the database.</p>
+
+chat.urp
+
+<p>This example provides a simple anonymous online chatting system, with multiple named channels.</p>
+
+<p>First, we build another useful component.  Recall that each channel has an owning client, who has the exclusive ability to read messages sent to it.  On top of that functionality, we can build a kind of broadcast channel that accepts multiple subscribers.  The <tt>Broadcast</tt> module contains a functor with such an implementation.  We instantiate the functor with the type of data we want to send over the channel.  The functor output gives us an abstract type of "topics," which are subscribable IDs.  When a client subscribes to a topic, it is handed a channel that it can use to read new messages on that topic.  We also have an operation to count the number of subscribers to a topic.  This number shouldn't be treated as too precise, since some clients that have surfed away from the application may still be considered subscribed until a timeout period elapses.</p>
+
+<p>The main <tt>Chat</tt> application includes some standard management of a table of named channels.  All of the interesting client-server work is done with the <tt>recv</tt> function and with the functions provided by <tt>Broadcast</tt>.</p>
diff --git a/demo/react.ur b/demo/react.ur
new file mode 100644
index 0000000..35ee924
--- /dev/null
+++ b/demo/react.ur
@@ -0,0 +1,6 @@
+fun main () =
+  s <- source "You didn't click it yet.";
+  return <xml><body>
+    <button value="Click me!" onclick={fn _ => set s "Now you clicked it."}/><br/>
+    <dyn signal={v <- signal s; return <xml>{[v]}</xml>}/>
+  </body></xml>
diff --git a/demo/react.urp b/demo/react.urp
new file mode 100644
index 0000000..f7757f4
--- /dev/null
+++ b/demo/react.urp
@@ -0,0 +1 @@
+react
diff --git a/demo/react.urs b/demo/react.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/react.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/rec.ur b/demo/rec.ur
new file mode 100644
index 0000000..a808446
--- /dev/null
+++ b/demo/rec.ur
@@ -0,0 +1,7 @@
+fun main () = return <xml><body>
+  <a link={other ()}>Go to the other one!</a>
+</body></xml>
+
+and other () = return <xml><body>
+  <a link={main ()}>Return to <tt>main</tt>!</a>
+</body></xml>
diff --git a/demo/rec.urp b/demo/rec.urp
new file mode 100644
index 0000000..6e27e71
--- /dev/null
+++ b/demo/rec.urp
@@ -0,0 +1 @@
+rec
diff --git a/demo/rec.urs b/demo/rec.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/rec.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/ref.ur b/demo/ref.ur
new file mode 100644
index 0000000..b21d40a
--- /dev/null
+++ b/demo/ref.ur
@@ -0,0 +1,30 @@
+structure IR = RefFun.Make(struct
+                               type data = int
+                           end)
+
+structure SR = RefFun.Make(struct
+                               type data = string
+                           end)
+
+fun mutate () =
+    ir <- IR.new 3;
+    ir' <- IR.new 7;
+    sr <- SR.new "hi";
+
+    IR.write ir' 10;
+
+    iv <- IR.read ir;
+    iv' <- IR.read ir';
+    sv <- SR.read sr;
+
+    IR.delete ir;
+    IR.delete ir';
+    SR.delete sr;
+
+    return <xml><body>
+      {[iv]}, {[iv']}, {[sv]}
+    </body></xml>
+
+fun main () = return <xml><body>
+  <form><submit action={mutate} value="Do some pointless stuff"/></form>
+</body></xml>
diff --git a/demo/ref.urp b/demo/ref.urp
new file mode 100644
index 0000000..a6bb1de
--- /dev/null
+++ b/demo/ref.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql ref.sql
+
+refFun
+ref
diff --git a/demo/ref.urs b/demo/ref.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/ref.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/refFun.ur b/demo/refFun.ur
new file mode 100644
index 0000000..114d4ef
--- /dev/null
+++ b/demo/refFun.ur
@@ -0,0 +1,29 @@
+functor Make(M : sig
+                 type data
+                 val inj : sql_injectable data
+             end) = struct
+
+    type ref = int
+
+    sequence s
+    table t : { Id : int, Data : M.data }
+      PRIMARY KEY Id
+
+    fun new d =
+        id <- nextval s;
+        dml (INSERT INTO t (Id, Data) VALUES ({[id]}, {[d]}));
+        return id
+
+    fun read r =
+        o <- oneOrNoRows (SELECT t.Data FROM t WHERE t.Id = {[r]});
+        case o of
+            None => error <xml>You already deleted that ref!</xml>
+          | Some r => return r.T.Data
+
+    fun write r d =
+        dml (UPDATE t SET Data = {[d]} WHERE Id = {[r]})
+
+    fun delete r =
+        dml (DELETE FROM t WHERE Id = {[r]})
+
+end
diff --git a/demo/refFun.urs b/demo/refFun.urs
new file mode 100644
index 0000000..bcecc8d
--- /dev/null
+++ b/demo/refFun.urs
@@ -0,0 +1,10 @@
+functor Make(M : sig
+                 type data
+                 val inj : sql_injectable data
+             end) : sig
+    type ref
+    val new : M.data -> transaction ref
+    val read : ref -> transaction M.data
+    val write : ref -> M.data -> transaction unit
+    val delete : ref -> transaction unit
+end
diff --git a/demo/roundTrip.ur b/demo/roundTrip.ur
new file mode 100644
index 0000000..aa7017a
--- /dev/null
+++ b/demo/roundTrip.ur
@@ -0,0 +1,34 @@
+table channels : { Client : client, Channel : channel (string * int * float) }
+  PRIMARY KEY Client
+
+fun writeBack v =
+    me <- self;
+    r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]});
+    send r.Channels.Channel v
+
+fun action () =
+    me <- self;
+    ch <- channel;
+    dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]}));
+    
+    buf <- Buffer.create;
+
+    let
+        fun receiver () =
+            v <- recv ch;
+            Buffer.write buf ("(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
+            receiver ()
+
+        fun sender s n f =
+            sleep 2000;
+            rpc (writeBack (s, n, f));
+            sender (s ^ "!") (n + 1) (f + 1.23)
+    in
+        return <xml><body onload={spawn (receiver ()); sender "" 0 0.0}>
+          <dyn signal={Buffer.render buf}/>
+        </body></xml>
+    end
+
+fun main () = return <xml><body>
+  <form><submit value="Begin demo" action={action}/></form>
+</body></xml>
diff --git a/demo/roundTrip.urp b/demo/roundTrip.urp
new file mode 100644
index 0000000..37de381
--- /dev/null
+++ b/demo/roundTrip.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql roundTrip.sql
+
+buffer
+roundTrip
diff --git a/demo/roundTrip.urs b/demo/roundTrip.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/roundTrip.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/sql.ur b/demo/sql.ur
new file mode 100644
index 0000000..adfc590
--- /dev/null
+++ b/demo/sql.ur
@@ -0,0 +1,53 @@
+table t : { A : int, B : float, C : string, D : bool }
+  PRIMARY KEY A
+
+fun list () =
+    rows <- queryX (SELECT * FROM t)
+            (fn row => <xml><tr>
+              <td>{[row.T.A]}</td> <td>{[row.T.B]}</td> <td>{[row.T.C]}</td> <td>{[row.T.D]}</td>
+              <td><form><submit action={delete row.T.A} value="Delete"/></form></td>
+            </tr></xml>);
+    return <xml>
+      <table border=1>
+        <tr> <th>A</th> <th>B</th> <th>C</th> <th>D</th> </tr>
+        {rows}
+      </table>
+
+      <br/><hr/><br/>
+
+      <form>
+        <table>
+          <tr> <th>A:</th> <td><textbox{#A}/></td> </tr>
+          <tr> <th>B:</th> <td><textbox{#B}/></td> </tr>
+          <tr> <th>C:</th> <td><textbox{#C}/></td> </tr>
+          <tr> <th>D:</th> <td><checkbox{#D}/></td> </tr>
+          <tr> <th/> <td><submit action={add} value="Add Row"/></td> </tr>
+        </table>
+      </form>
+    </xml>
+
+and add r =
+    dml (INSERT INTO t (A, B, C, D)
+         VALUES ({[readError r.A]}, {[readError r.B]}, {[r.C]}, {[r.D]}));
+    xml <- list ();
+    return <xml><body>
+      <p>Row added.</p>
+
+      {xml}
+    </body></xml>
+
+and delete a () =
+    dml (DELETE FROM t
+         WHERE t.A = {[a]});
+    xml <- list ();
+    return <xml><body>
+      <p>Row deleted.</p>
+
+      {xml}
+    </body></xml>
+
+fun main () =
+    xml <- list ();
+    return <xml><body>
+      {xml}
+    </body></xml>
diff --git a/demo/sql.urp b/demo/sql.urp
new file mode 100644
index 0000000..7894da9
--- /dev/null
+++ b/demo/sql.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql sql.sql
+
+sql
diff --git a/demo/sql.urs b/demo/sql.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/sql.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/subforms.ur b/demo/subforms.ur
new file mode 100644
index 0000000..62e3cc8
--- /dev/null
+++ b/demo/subforms.ur
@@ -0,0 +1,43 @@
+fun sub r =
+    let
+        fun sub' ls =
+            case ls of
+                [] => <xml/>
+              | r :: ls => <xml>
+                <li>{[r.Num]} = {[r.Text]}</li>
+                {sub' ls}
+              </xml>
+    in
+        return <xml><body>
+          {sub' r.Lines}
+        </body></xml>
+    end
+
+fun subfrms n =
+    if n <= 0 then
+        <xml/>
+    else
+        <xml>
+          <entry>
+            <hidden{#Num} value={show n}/>
+            <li>{[n]}: <textbox{#Text}/></li>
+          </entry>
+          {subfrms (n - 1)}
+        </xml>
+
+fun form n = return <xml><body>
+  <form>
+    <subforms{#Lines}>
+      {subfrms n}
+    </subforms>
+    <submit action={sub}/>
+  </form>
+
+  <a link={form (n + 1)}>One more blank</a><br/>
+  {if n > 0 then
+       <xml><a link={form (n - 1)}>One fewer blank</a></xml>
+   else
+       <xml/>}
+</body></xml>
+
+fun main () = form 1
diff --git a/demo/subforms.urp b/demo/subforms.urp
new file mode 100644
index 0000000..e70e4ef
--- /dev/null
+++ b/demo/subforms.urp
@@ -0,0 +1 @@
+subforms
diff --git a/demo/subforms.urs b/demo/subforms.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/subforms.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/sum.ur b/demo/sum.ur
new file mode 100644
index 0000000..c8d4288
--- /dev/null
+++ b/demo/sum.ur
@@ -0,0 +1,10 @@
+fun sum [fs ::: {Unit}] (fl : folder fs) (x : $(mapU int fs)) =
+    @foldUR [int] [fn _ => int]
+     (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
+     0 fl x
+
+fun main () = return <xml><body>
+  {[sum {}]}<br/>
+  {[sum {A = 0, B = 1}]}<br/>
+  {[sum {C = 2, D = 3, E = 4}]}
+</body></xml>
diff --git a/demo/sum.urp b/demo/sum.urp
new file mode 100644
index 0000000..9229287
--- /dev/null
+++ b/demo/sum.urp
@@ -0,0 +1 @@
+sum
diff --git a/demo/sum.urs b/demo/sum.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/sum.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/tcSum.ur b/demo/tcSum.ur
new file mode 100644
index 0000000..0026d50
--- /dev/null
+++ b/demo/tcSum.ur
@@ -0,0 +1,9 @@
+fun sum [t] (_ : num t) [fs ::: {Unit}] (fl : folder fs) (x : $(mapU t fs)) =
+    @foldUR [t] [fn _ => t]
+     (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
+     zero fl x
+
+fun main () = return <xml><body>
+  {[sum {A = 0, B = 1}]}<br/>
+  {[sum {C = 2.1, D = 3.2, E = 4.3}]}
+</body></xml>
diff --git a/demo/tcSum.urp b/demo/tcSum.urp
new file mode 100644
index 0000000..42f743a
--- /dev/null
+++ b/demo/tcSum.urp
@@ -0,0 +1 @@
+tcSum
diff --git a/demo/tcSum.urs b/demo/tcSum.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/tcSum.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/threads.ur b/demo/threads.ur
new file mode 100644
index 0000000..ac6d8ce
--- /dev/null
+++ b/demo/threads.ur
@@ -0,0 +1,17 @@
+fun main () =
+    buf <- Buffer.create;
+    let
+        fun loop prefix delay =
+            let
+                fun loop' n =
+                    Buffer.write buf (prefix ^ ": Message #" ^ show n);
+                    sleep delay;
+                    loop' (n + 1)
+            in
+                loop'
+            end
+    in
+        return <xml><body onload={spawn (loop "A" 5000 0); spawn (loop "B" 3000 100)}>
+          <dyn signal={Buffer.render buf}/>
+        </body></xml>
+    end
diff --git a/demo/threads.urp b/demo/threads.urp
new file mode 100644
index 0000000..84fbe4f
--- /dev/null
+++ b/demo/threads.urp
@@ -0,0 +1,2 @@
+buffer
+threads
diff --git a/demo/threads.urs b/demo/threads.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/threads.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/tree.ur b/demo/tree.ur
new file mode 100644
index 0000000..6cb5051
--- /dev/null
+++ b/demo/tree.ur
@@ -0,0 +1,37 @@
+sequence s
+table t : { Id : int, Parent : option int, Nam : string }
+  PRIMARY KEY Id,
+  CONSTRAINT F FOREIGN KEY Parent REFERENCES t (Id) ON DELETE CASCADE
+
+open TreeFun.Make(struct
+                      con id = #Id
+                      con parent = #Parent
+                      val tab = t
+                  end)
+
+fun row r = <xml>
+  #{[r.Id]}: {[r.Nam]} <form><submit action={del r.Id} value="Delete"/></form>
+
+  <form>
+    Add child: <textbox{#Nam}/> <submit action={add (Some r.Id)}/>
+  </form>
+</xml>
+
+and main () =
+    xml <- tree row None;
+    return <xml><body>
+      {xml}
+
+      <form>
+        Add a top-level node: <textbox{#Nam}/> <submit action={add None}/>
+      </form>
+    </body></xml>
+
+and add parent r =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Parent, Nam) VALUES ({[id]}, {[parent]}, {[r.Nam]}));
+    main ()
+
+and del id () =
+    dml (DELETE FROM t WHERE Id = {[id]});
+    main ()
diff --git a/demo/tree.urp b/demo/tree.urp
new file mode 100644
index 0000000..0ded420
--- /dev/null
+++ b/demo/tree.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql tree.sql
+
+treeFun
+tree
diff --git a/demo/tree.urs b/demo/tree.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/tree.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/treeFun.ur b/demo/treeFun.ur
new file mode 100644
index 0000000..2d4ef73
--- /dev/null
+++ b/demo/treeFun.ur
@@ -0,0 +1,34 @@
+functor Make(M : sig
+                 type key
+                 con id :: Name
+                 con parent :: Name
+                 con cols :: {Type}
+                 constraint [id] ~ [parent]
+                 constraint [id, parent] ~ cols
+
+                 val key_inj : sql_injectable_prim key
+
+                 table tab : ([id = key, parent = option key] ++ cols)
+             end) = struct
+
+    open M
+
+    fun tree (f : $([id = key, parent = option key] ++ cols) -> xbody)
+             (root : option M.key) =
+        let
+            fun recurse (root : option key) =
+                queryX' (SELECT * FROM tab WHERE {eqNullable' (SQL tab.{parent}) root})
+                        (fn r =>
+                            children <- recurse (Some r.Tab.id);
+                            return <xml>
+                              <li> {f r.Tab}</li>
+                              
+                              <ul>
+                                {children}
+                              </ul>
+                            </xml>)
+        in
+            recurse root
+        end
+
+end
diff --git a/demo/treeFun.urs b/demo/treeFun.urs
new file mode 100644
index 0000000..323c2e5
--- /dev/null
+++ b/demo/treeFun.urs
@@ -0,0 +1,21 @@
+functor Make(M : sig
+                 type key
+                 con id :: Name
+                 con parent :: Name
+                 con cols :: {Type}
+                 constraint [id] ~ [parent]
+                 constraint [id, parent] ~ cols
+
+                 val key_inj : sql_injectable_prim key
+
+                 table tab : ([id = key, parent = option key] ++ cols)
+             end) : sig
+
+    con id = M.id
+    con parent = M.parent
+
+    val tree : ($([id = M.key, parent = option M.key] ++ M.cols) -> xbody)
+               -> option M.key
+               -> transaction xbody
+
+end
diff --git a/demo/upload.ur b/demo/upload.ur
new file mode 100644
index 0000000..505a1ae
--- /dev/null
+++ b/demo/upload.ur
@@ -0,0 +1,11 @@
+fun echo r =
+  if blobSize (fileData r.File) > 100000 then
+      return <xml>Whoa!  That one's too big.</xml>
+  else
+      returnBlob (fileData r.File) (blessMime (fileMimeType r.File))
+
+fun main () = return <xml><body>
+  <h1>The Amazing File Echoer!</h1>
+
+  <form>Upload a file: <upload{#File}/> <submit action={echo}/></form>
+</body></xml>
diff --git a/demo/upload.urp b/demo/upload.urp
new file mode 100644
index 0000000..60519aa
--- /dev/null
+++ b/demo/upload.urp
@@ -0,0 +1,5 @@
+allow mime text/plain
+allow mime image/png
+allow mime image/gif
+
+upload
diff --git a/demo/upload.urs b/demo/upload.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/upload.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/url.ur b/demo/url.ur
new file mode 100644
index 0000000..48d1bdc
--- /dev/null
+++ b/demo/url.ur
@@ -0,0 +1,13 @@
+fun yourChoice r = return <xml><body>
+  {case checkUrl r.Url of
+       None => <xml>You aren't allowed to link to there.</xml>
+     | Some url => <xml><a href={url}>Enjoy!</a></xml>}
+</body></xml>
+
+fun main () = return <xml><body>
+  <a href="http://en.wikipedia.org/wiki/Type_inference">Learn something</a><br/>
+  <br/>
+  <form>
+    URL of your choice: <textbox{#Url}/> <submit action={yourChoice}/>
+  </form>
+</body></xml>
diff --git a/demo/url.urp b/demo/url.urp
new file mode 100644
index 0000000..945e11d
--- /dev/null
+++ b/demo/url.urp
@@ -0,0 +1,4 @@
+deny url http://en.wikipedia.org/wiki/PHP
+allow url http://en.wikipedia.org/wiki/*
+
+url
diff --git a/demo/url.urs b/demo/url.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/url.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/demo/view.ur b/demo/view.ur
new file mode 100644
index 0000000..0dcb42f
--- /dev/null
+++ b/demo/view.ur
@@ -0,0 +1,25 @@
+table t : { A : int }
+view v = SELECT t.A AS A FROM t WHERE t.A > 7
+
+fun list [u] (_ : fieldsOf u [A = int]) (title : string) (x : u) : transaction xbody =
+    xml <- queryX (SELECT * FROM x)
+           (fn r : {X : {A : int}} => <xml><li>{[r.X.A]}</li></xml>);
+    return <xml>
+      <h2>{[title]}</h2>
+      <ul>{xml}</ul>
+    </xml>
+
+fun main () =
+    listT <- list "T" t;
+    listV <- list "V" v;
+    return <xml><body>
+      {listT}
+      {listV}
+      <br/>
+
+      <form>Insert: <textbox{#A}/> <submit action={ins}/></form>
+    </body></xml>
+
+and ins r =
+    dml (INSERT INTO t (A) VALUES ({[readError r.A]}));
+    main ()
diff --git a/demo/view.urp b/demo/view.urp
new file mode 100644
index 0000000..0677e8b
--- /dev/null
+++ b/demo/view.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql view.sql
+
+view
diff --git a/demo/view.urs b/demo/view.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/demo/view.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/doc/LICENSE b/doc/LICENSE
new file mode 100644
index 0000000..af0d848
--- /dev/null
+++ b/doc/LICENSE
@@ -0,0 +1,27 @@
+The code in the tutorials files (intro.ur and tlc.ur), excluding comments, is additionally released under the following license (same as for Ur/Web itself):
+
+Copyright (c) 2008-2011, Adam Chlipala
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+- The names of contributors may not be used to endorse or promote products
+  derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/doc/Makefile b/doc/Makefile
new file mode 100644
index 0000000..777c5bf
--- /dev/null
+++ b/doc/Makefile
@@ -0,0 +1,23 @@
+PAPERS=manual
+
+FIGURES=
+
+all: $(PAPERS:%=%.dvi) $(PAPERS:%=%.ps) $(PAPERS:%=%.pdf) 
+
+%.dvi: %.tex $(FIGURES:%=%.eps)
+	latex $<
+	latex $<
+
+%.ps: %.dvi
+	dvips $< -o $@
+
+%.pdf: %.dvi $(FIGURES:%=%.pdf)
+	pdflatex $(<:%.dvi=%)
+
+%.pdf: %.eps
+	epstopdf $<
+
+clean:
+	rm -f *.aux *.bbl *.blg *.dvi *.log *.pdf *.ps
+
+.PHONY: all clean
diff --git a/doc/manual.tex b/doc/manual.tex
new file mode 100644
index 0000000..eaf7aab
--- /dev/null
+++ b/doc/manual.tex
@@ -0,0 +1,2702 @@
+\documentclass{article}
+\usepackage{fullpage,amsmath,amssymb,proof,url}
+\usepackage[T1]{fontenc}
+\usepackage{ae,aecompl}
+\newcommand{\cd}[1]{\texttt{#1}}
+\newcommand{\mt}[1]{\mathsf{#1}}
+
+\newcommand{\rc}{+ \hspace{-.075in} + \;}
+\newcommand{\rcut}{\; \texttt{-{}-} \;}
+\newcommand{\rcutM}{\; \texttt{-{}-{}-} \;}
+
+\usepackage{hyperref}
+
+\begin{document}
+
+\title{The Ur/Web Manual}
+\author{Adam Chlipala}
+
+\maketitle
+
+\tableofcontents
+
+
+\section{Introduction}
+
+\emph{Ur} is a programming language designed to introduce richer type system features into functional programming in the tradition of ML and Haskell.  Ur is functional, pure, statically typed, and strict.  Ur supports a powerful kind of \emph{metaprogramming} based on \emph{type-level computation with type-level records}.
+
+\emph{Ur/Web} is Ur plus a special standard library and associated rules for parsing and optimization.  Ur/Web supports construction of dynamic web applications backed by SQL databases.  The signature of the standard library is such that well-typed Ur/Web programs ``don't go wrong'' in a very broad sense.  Not only do they not crash during particular page generations, but they also may not:
+
+\begin{itemize}
+\item Suffer from any kinds of code-injection attacks
+\item Return invalid HTML
+\item Contain dead intra-application links
+\item Have mismatches between HTML forms and the fields expected by their handlers
+\item Include client-side code that makes incorrect assumptions about the ``AJAX''-style services that the remote web server provides
+\item Attempt invalid SQL queries
+\item Use improper marshaling or unmarshaling in communication with SQL databases or between browsers and web servers
+\end{itemize}
+
+This type safety is just the foundation of the Ur/Web methodology.  It is also possible to use metaprogramming to build significant application pieces by analysis of type structure.  For instance, the demo includes an ML-style functor for building an admin interface for an arbitrary SQL table.  The type system guarantees that the admin interface sub-application that comes out will always be free of the above-listed bugs, no matter which well-typed table description is given as input.
+
+The Ur/Web compiler also produces very efficient object code that does not use garbage collection.  These compiled programs will often be even more efficient than what most programmers would bother to write in C.  The compiler also generates JavaScript versions of client-side code, with no need to write those parts of applications in a different language.
+
+\medskip
+
+The official web site for Ur is:
+\begin{center}
+  \url{http://www.impredicative.com/ur/}
+\end{center}
+
+
+\section{Installation}
+
+If you are lucky, then the following standard command sequence will suffice for installation, in a directory to which you have unpacked the latest distribution tarball.
+
+\begin{verbatim}
+./configure
+make
+sudo make install
+\end{verbatim}
+
+Some other packages must be installed for the above to work.  At a minimum, you need a standard UNIX shell, with standard UNIX tools like sed and GCC (or an alternate C compiler) in your execution path; MLton, the whole-program optimizing compiler for Standard ML; and the development files for the OpenSSL C library.  As of this writing, in the ``testing'' version of Debian Linux, this command will install the more uncommon of these dependencies:
+\begin{verbatim}
+apt-get install mlton libssl-dev
+\end{verbatim}
+
+Note that, like the Ur/Web compiler, MLton is a whole-program optimizing compiler, so it frequently requires much more memory than old-fashioned compilers do.  Expect building Ur/Web with MLton to require not much less than a gigabyte of RAM.  If a \texttt{mlton} invocation ends suspiciously, the most likely explanation is that it has exhausted available memory.
+
+To build programs that access SQL databases, you also need one of these client libraries for supported backends.
+\begin{verbatim}
+apt-get install libpq-dev libmysqlclient-dev libsqlite3-dev
+\end{verbatim}
+
+It is also possible to access the modules of the Ur/Web compiler interactively, within Standard ML of New Jersey.  To install the prerequisites in Debian testing:
+\begin{verbatim}
+apt-get install smlnj libsmlnj-smlnj ml-yacc ml-lpt
+\end{verbatim}
+
+To begin an interactive session with the Ur compiler modules, run \texttt{make smlnj}, and then, from within an \texttt{sml} session, run \texttt{CM.make "src/urweb.cm";}.  The \texttt{Compiler} module is the main entry point, and you can find its signature in \texttt{src/compiler.sig}.
+
+To run an SQL-backed application with a backend besides SQLite, you will probably want to install one of these servers.
+
+\begin{verbatim}
+apt-get install postgresql mysql-server
+\end{verbatim}
+
+To use the Emacs mode, you must have a modern Emacs installed.  We assume that you already know how to do this, if you're in the business of looking for an Emacs mode.  The demo generation facility of the compiler will also call out to Emacs to syntax-highlight code, and that process depends on the \texttt{htmlize} module, which can be installed in Debian testing via:
+
+\begin{verbatim}
+apt-get install emacs-goodies-el
+\end{verbatim}
+
+If you don't want to install the Emacs mode, run \texttt{./configure} with the argument \texttt{--without-emacs}.
+
+Even with the right packages installed, configuration and building might fail to work.  After you run \texttt{./configure}, you will see the values of some named environment variables printed.  You may need to adjust these values to get proper installation for your system.  To change a value, store your preferred alternative in the corresponding UNIX environment variable, before running \texttt{./configure}.  For instance, here is how to change the list of extra arguments that the Ur/Web compiler will pass to the C compiler and linker on every invocation.  Some older GCC versions need this setting to mask a bug in function inlining.
+
+\begin{verbatim}
+CCARGS=-fno-inline ./configure
+\end{verbatim}
+
+Since the author is still getting a handle on the GNU Autotools that provide the build system, you may need to do some further work to get started, especially in environments with significant differences from Linux (where most testing is done).  The variables \texttt{PGHEADER}, \texttt{MSHEADER}, and \texttt{SQHEADER} may be used to set the proper C header files to include for the development libraries of PostgreSQL, MySQL, and SQLite, respectively.  To get libpq to link, one OS X user reported setting \texttt{CCARGS="-I/opt/local/include -L/opt/local/lib/postgresql84"}, after creating a symbolic link with \texttt{ln -s /opt/local/include/postgresql84 /opt/local/include/postgresql}.
+
+The Emacs mode can be set to autoload by adding the following to your \texttt{.emacs} file.
+
+\begin{verbatim}
+(add-to-list 'load-path "/usr/local/share/emacs/site-lisp/urweb-mode")
+(load "urweb-mode-startup")
+\end{verbatim}
+
+Change the path in the first line if you chose a different Emacs installation path during configuration.
+
+
+\section{Command-Line Compiler}
+
+\subsection{\label{cl}Project Files}
+
+The basic inputs to the \texttt{urweb} compiler are project files, which have the extension \texttt{.urp}.  Here is a sample \texttt{.urp} file.
+
+\begin{verbatim}
+database dbname=test
+sql crud1.sql
+
+crud
+crud1
+\end{verbatim}
+
+The \texttt{database} line gives the database information string to pass to libpq.  In this case, the string only says to connect to a local database named \texttt{test}.
+
+The \texttt{sql} line asks for an SQL source file to be generated, giving the commands to run to create the tables and sequences that this application expects to find.  After building this \texttt{.urp} file, the following commands could be used to initialize the database, assuming that the current UNIX user exists as a Postgres user with database creation privileges:
+
+\begin{verbatim}
+createdb test
+psql -f crud1.sql test
+\end{verbatim}
+
+A blank line separates the named directives from a list of modules to include in the project.  Any line may contain a shell-script-style comment, where any suffix of a line starting at a hash character \texttt{\#} is ignored.
+
+For each entry \texttt{M} in the module list, the file \texttt{M.urs} is included in the project if it exists, and the file \texttt{M.ur} must exist and is always included.
+
+Here is the complete list of directive forms.  ``FFI'' stands for ``foreign function interface,'' Ur's facility for interaction between Ur programs and C and JavaScript libraries.
+\begin{itemize}
+\item \texttt{[allow|deny] [url|mime|requestHeader|responseHeader|env|meta] PATTERN} registers a rule governing which URLs, MIME types, HTTP request headers, HTTP response headers, environment variable names, or HTML \texttt{<meta>} names are allowed to appear explicitly in this application.  The first such rule to match a name determines the verdict.  If \texttt{PATTERN} ends in \texttt{*}, it is interpreted as a prefix rule.  Otherwise, a string must match it exactly.
+\item \texttt{alwaysInline PATH} requests that every call to the referenced function be inlined.  Section \ref{structure} explains how functions are assigned path strings.
+\item \texttt{benignEffectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  Every effectful FFI function must be registered, or the optimizer may make invalid transformations.  This version of the \texttt{effectful} directive registers that this function only has side effects that remain local to a single page generation.
+\item \texttt{clientOnly Module.ident} registers an FFI function or transaction that may only be run in client browsers.
+\item \texttt{clientToServer Module.ident} adds FFI type \texttt{Module.ident} to the list of types that are OK to marshal from clients to servers.  Values like XML trees and SQL queries are hard to marshal without introducing expensive validity checks, so it's easier to ensure that the server never trusts clients to send such values.  The file \texttt{include/urweb/urweb\_cpp.h} shows examples of the C support functions that are required of any type that may be marshalled.  These include \texttt{attrify}, \texttt{urlify}, and \texttt{unurlify} functions.
+\item \texttt{coreInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function.  (This is one of two options for one of two intermediate languages within the compiler.)
+\item \texttt{database DBSTRING} sets the string to pass to libpq to open a database connection.
+\item \texttt{debug} saves some intermediate C files, which is mostly useful to help in debugging the compiler itself.
+\item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  This is the default behavior for \texttt{transaction}-based types.
+\item \texttt{exe FILENAME} sets the filename to which to write the output executable.  The default for file \texttt{P.urp} is \texttt{P.exe}.
+\item \texttt{file URI FILENAME} asks for the application executable to respond to requests for \texttt{URI} by serving a snapshot of the contents of \texttt{FILENAME} as of compile time.  That is, the file contents are baked into the executable.  System file \texttt{/etc/mime.types} is consulted (again, at compile time) to figure out the right MIME type to suggest in the HTTP response.
+\item \texttt{ffi FILENAME} reads the file \texttt{FILENAME.urs} to determine the interface to a new FFI module.  The name of the module is calculated from \texttt{FILENAME} in the same way as for normal source files.  See the files \texttt{include/urweb/urweb\_cpp.h} and \texttt{src/c/urweb.c} for examples of C headers and implementations for FFI modules.  In general, every type or value \texttt{Module.ident} becomes \texttt{uw\_Module\_ident} in C.
+\item \texttt{html5} asks to generate HTML5 code, which primarily affects the first few lines of the output documents, like the \texttt{DOCTYPE}.  This option is on by default.
+\item \texttt{include FILENAME} adds \texttt{FILENAME} to the list of files to be \texttt{\#include}d in C sources.  This is most useful for interfacing with new FFI modules.
+\item \texttt{jsFile FILENAME} asks to serve the contents of a file as JavaScript.  All such content is concatenated into a single file, included via a \texttt{<script>} tag on every page that needs client-side scripting.
+\item \texttt{jsFunc Module.ident=name} gives the JavaScript name of an FFI value.
+\item \texttt{jsModule Module} helps make \texttt{jsFunc} directives less verbose, by setting a module name to prefix in front of \texttt{name} arguments (so running e.g. \texttt{jsFunc MyFfi.foo=bar} actually sets up \texttt{Mod.bar} as the JavaScript name for that function, if \texttt{jsModule Mod} was run beforehand).
+\item \texttt{library FILENAME} parses \texttt{FILENAME.urp} and merges its contents with the rest of the current file's contents.  If \texttt{FILENAME.urp} doesn't exist, the compiler also tries \texttt{FILENAME/lib.urp}.
+\item \texttt{limit class num} sets a resource usage limit for generated applications.  The limit \texttt{class} will be set to the non-negative integer \texttt{num}.  The classes are:
+  \begin{itemize}
+  \item \texttt{cleanup}: maximum number of cleanup operations (e.g., entries recording the need to deallocate certain temporary objects) that may be active at once per request
+  \item \texttt{clients}: maximum number of simultaneous connections to one application by web clients waiting for new asynchronous messages sent with \texttt{Basis.send}
+  \item \texttt{database}: maximum size of a database file (currently only used by SQLite, which interprets the parameter as a number of pages, where page size is itself a quantity configurable in SQLite)
+  \item \texttt{deltas}: maximum number of messages sendable in a single request handler with \texttt{Basis.send}
+  \item \texttt{globals}: maximum number of global variables that FFI libraries may set in a single request context
+  \item \texttt{headers}: maximum size (in bytes) of per-request buffer used to hold HTTP headers for generated pages
+  \item \texttt{heap}: maximum size (in bytes) of per-request heap for dynamically allocated data
+  \item \texttt{inputs}: maximum number of top-level form fields per request
+  \item \texttt{messages}: maximum size (in bytes) of per-request buffer used to hold a single outgoing message sent with \texttt{Basis.send}
+  \item \texttt{page}: maximum size (in bytes) of per-request buffer used to hold HTML content of generated pages
+  \item \texttt{script}: maximum size (in bytes) of per-request buffer used to hold JavaScript content of generated pages
+  \item \texttt{subinputs}: maximum number of form fields per request, excluding top-level fields
+  \item \texttt{time}: maximum running time of a single page request, in units of approximately 0.1 seconds
+  \item \texttt{transactionals}: maximum number of custom transactional actions (e.g., sending an e-mail) that may be run in a single page generation
+  \end{itemize}
+\item \texttt{link FILENAME} adds \texttt{FILENAME} to the list of files to be passed to the linker at the end of compilation.  This is most useful for importing extra libraries needed by new FFI modules.
+\item \texttt{linker CMD} sets \texttt{CMD} as the command line prefix to use for linking C object files.  The command line will be completed with a space-separated list of \texttt{.o} and \texttt{.a} files, \texttt{-L} and \texttt{-l} flags, and finally with a \texttt{-o} flag to set the location where the executable should be written.
+\item \texttt{minHeap NUMBYTES} sets the initial size for thread-local heaps used in handling requests.  These heaps grow automatically as needed (up to any maximum set with \texttt{limit}), but each regrow requires restarting the request handling process.
+\item \texttt{monoInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function.  (This is one of two options for one of two intermediate languages within the compiler.)
+\item \texttt{neverInline PATH} requests that no call to the referenced function be inlined.  Section \ref{structure} explains how functions are assigned path strings.
+\item \texttt{noMangleSql} avoids adding a \texttt{uw\_} prefix in front of each identifier in SQL.  With this experimental feature, the burden is on the programmer to avoid naming tables or columns after SQL keywords!
+\item \texttt{noXsrfProtection URIPREFIX} turns off automatic cross-site request forgery protection for the page handler identified by the given URI prefix.  This will avoid checking cryptographic signatures on cookies, which is generally a reasonable idea for some pages, such as login pages that are going to discard all old cookie values, anyway.
+\item \texttt{onError Module.var} changes the handling of fatal application errors.  Instead of displaying a default, ugly error 500 page, the error page will be generated by calling function \texttt{Module.var} on a piece of XML representing the error message.  The error handler should have type $\mt{xbody} \to \mt{transaction} \; \mt{page}$.  Note that the error handler \emph{cannot} be in the application's main module, since that would register it as explicitly callable via URLs.
+\item \texttt{path NAME=VALUE} creates a mapping from \texttt{NAME} to \texttt{VALUE}.  This mapping may be used at the beginnings of filesystem paths given to various other configuration directives.  A path like \texttt{\$NAME/rest} is expanded to \texttt{VALUE/rest}.  There is an initial mapping from the empty name (for paths like \texttt{\$/list}) to the directory where the Ur/Web standard library is installed.  If you accept the default \texttt{configure} options, this directory is \texttt{/usr/local/lib/urweb/ur}.
+\item \texttt{prefix PREFIX} sets the prefix included before every URI within the generated application.  The default is \texttt{/}.
+\item \texttt{profile} generates an executable that may be used with gprof.
+\item \texttt{rewrite KIND FROM TO} gives a rule for rewriting canonical module paths.  For instance, the canonical path of a page may be \texttt{Mod1.Mod2.mypage}, while you would rather the page were accessed via a URL containing only \texttt{page}.  The directive \texttt{rewrite url Mod1/Mod2/mypage page} would accomplish that.  The possible values of \texttt{KIND} determine which kinds of objects are affected.  The kind \texttt{all} matches any object, and \texttt{url} matches page URLs.  The kinds \texttt{table}, \texttt{sequence}, and \texttt{view} match those sorts of SQL entities, and \texttt{relation} matches any of those three.  \texttt{cookie} matches HTTP cookies, and \texttt{style} matches CSS class names.  If \texttt{FROM} ends in \texttt{/*}, it is interpreted as a prefix matching rule, and rewriting occurs by replacing only the appropriate prefix of a path with \texttt{TO}.  The \texttt{TO} field may be left empty to express the idea of deleting a prefix.  For instance, \texttt{rewrite url Main/*} will strip all \texttt{Main/} prefixes from URLs.  While the actual external names of relations and styles have parts separated by underscores instead of slashes, all rewrite rules must be written in terms of slashes.  An optional suffix of \cd{[-]} for a \cd{rewrite} directive asks to additionally replace all \cd{\_} characters with \cd{-} characters, which can be handy for, e.g., interfacing with an off-the-shelf CSS library that prefers hyphens over underscores.
+\item \texttt{safeGet URI} asks to allow the page handler assigned this canonical URI prefix to cause persistent side effects, even if accessed via an HTTP \cd{GET} request.
+\item \texttt{script URL} adds \texttt{URL} to the list of extra JavaScript files to be included at the beginning of any page that uses JavaScript.  This is most useful for importing JavaScript versions of functions found in new FFI modules.
+\item \texttt{serverOnly Module.ident} registers an FFI function or transaction that may only be run on the server.
+\item \texttt{sigfile PATH} sets a path where your application should look for a key to use in cryptographic signing.  This is used to prevent cross-site request forgery attacks for any form handler that both reads a cookie and creates side effects.  If the referenced file doesn't exist, an application will create it and read its saved data on future invocations.  You can also initialize the file manually with any contents at least 16 bytes long; the first 16 bytes will be treated as the key.
+\item \texttt{sql FILENAME} sets where to write an SQL file with the commands to create the expected database schema.  The default is not to create such a file.
+\item \texttt{timeFormat FMT} accepts a time format string, as processed by the POSIX C function \texttt{strftime()}.  This controls the default rendering of $\mt{time}$ values, via the $\mt{show}$ instance for $\mt{time}$.
+\item \texttt{timeout N} sets to \texttt{N} seconds the amount of time that the generated server will wait after the last contact from a client before determining that that client has exited the application.  Clients that remain active will take the timeout setting into account in determining how often to ping the server, so it only makes sense to set a high timeout to cope with browser and network delays and failures.  Higher timeouts can lead to more unnecessary client information taking up memory on the server.  The timeout goes unused by any page that doesn't involve the \texttt{recv} function, since the server only needs to store per-client information for clients that receive asynchronous messages.
+\item \texttt{xhtml} asks to generate XHTML code, which primarily affects the first few lines of the output documents, like the \texttt{DOCTYPE}.
+\end{itemize}
+
+
+\subsection{Building an Application}
+
+To compile project \texttt{P.urp}, simply run
+\begin{verbatim}
+urweb P
+\end{verbatim}
+The output executable is a standalone web server.  Run it with the command-line argument \texttt{-h} to see which options it takes.  If the project file lists a database, the web server will attempt to connect to that database on startup.  See Section \ref{structure} for an explanation of the URI mapping convention, which determines how each page of your application may be accessed via URLs.
+
+To time how long the different compiler phases run, without generating an executable, run
+\begin{verbatim}
+urweb -timing P
+\end{verbatim}
+
+To stop the compilation process after type-checking, run
+\begin{verbatim}
+urweb -tc P
+\end{verbatim}
+It is often worthwhile to run \cd{urweb} in this mode, because later phases of compilation can take significantly longer than type-checking alone, and the type checker catches many errors that would traditionally be found through debugging a running application.
+
+A related option is \cd{-dumpTypes}, which, as long as parsing succeeds, outputs to stdout a summary of the kinds of all identifiers declared with \cd{con} and the types of all identifiers declared with \cd{val} or \cd{val rec}.  This information is dumped even if there are errors during type inference.  Compiler error messages go to stderr, not stdout, so it is easy to distinguish the two kinds of output programmatically.  A refined version of this option is \cd{-dumpTypesOnError}, which only has an effect when there are compilation errors.
+
+It may be useful to combine another option \cd{-unifyMore} with \cd{-dumpTypes}.  Ur/Web type inference proceeds in a series of stages, where the first is standard Hindley-Milner type inference as in ML, and the later phases add more complex aspects.  By default, an error detected in one phase cuts off the execution of later phases.  However, the later phases might still determine more values of unification variables.  These value choices might be ``misguided,'' since earlier phases have not come up with reasonable types at a coarser detail level; but the unification decisions may still be useful for debugging and program understanding.  So, if a run with \cd{-dumpTypes} leaves unification variables undetermined in positions where you would like to see best-effort guesses instead, consider \cd{-unifyMore}.  Note that \cd{-unifyMore} has no effect when type inference succeeds fully, but it may lead to many more error messages when inference fails.
+
+To output information relevant to CSS stylesheets (and not finish regular compilation), run
+\begin{verbatim}
+urweb -css P
+\end{verbatim}
+The first output line is a list of categories of CSS properties that would be worth setting on the document body.  The remaining lines are space-separated pairs of CSS class names and categories of properties that would be worth setting for that class.  The category codes are divided into two varieties.  Codes that reveal properties of a tag or its (recursive) children are \cd{B} for block-level elements, \cd{C} for table captions, \cd{D} for table cells, \cd{L} for lists, and \cd{T} for tables.  Codes that reveal properties of the precise tag that uses a class are \cd{b} for block-level elements, \cd{t} for tables, \cd{d} for table cells, \cd{-} for table rows, \cd{H} for the possibility to set a height, \cd{N} for non-replaced inline-level elements, \cd{R} for replaced inline elements, and \cd{W} for the possibility to set a width.
+
+Ur/Web type inference can take a significant amount of time, so it can be helpful to cache type-inferred versions of source files.  This mode can be activated by running
+\begin{verbatim}
+urweb daemon start
+\end{verbatim}
+Further \cd{urweb} invocations in the same working directory will send requests to a background daemon process that reuses type inference results whenever possible, tracking source file dependencies and modification times.  To stop the background daemon, run
+\begin{verbatim}
+urweb daemon stop
+\end{verbatim}
+Communication happens via a UNIX domain socket in file \cd{.urweb\_daemon} in the working directory.
+
+\medskip
+
+Some other command-line parameters are accepted:
+\begin{itemize}
+\item \texttt{-boot}: Run Ur/Web from a build tree (and not from a system install).  This is useful if you're testing the compiler and don't want to install it.  It forces generation of statically linked executables.
+
+\item \texttt{-ccompiler <PROGRAM>}: Select an alternative C compiler to call with command lines in compiling Ur/Web applications.  (It's possible to set the default compiler as part of the \texttt{configure} process, but it may sometimes be useful to override the default.)
+
+\item \texttt{-db <DBSTRING>}: Set database connection information, using the format expected by Postgres's \texttt{PQconnectdb()}, which is \texttt{name1=value1 ... nameN=valueN}.  The same format is also parsed and used to discover connection parameters for MySQL and SQLite.  The only significant settings for MySQL are \texttt{host}, \texttt{hostaddr}, \texttt{port}, \texttt{dbname}, \texttt{user}, and \texttt{password}.  The only significant setting for SQLite is \texttt{dbname}, which is interpreted as the filesystem path to the database.  Additionally, when using SQLite, a database string may be just a file path.
+
+\item \texttt{-dbms [postgres|mysql|sqlite]}: Sets the database backend to use.
+  \begin{itemize}
+  \item \texttt{postgres}: This is PostgreSQL, the default.  Among the supported engines, Postgres best matches the design philosophy behind Ur, with a focus on consistent views of data, even in the face of much concurrency.  Different database engines have different quirks of SQL syntax.  Ur/Web tends to use Postgres idioms where there are choices to be made, though the compiler translates SQL as needed to support other backends.
+
+    A command sequence like this can initialize a Postgres database, using a file \texttt{app.sql} generated by the compiler:
+    \begin{verbatim}
+createdb app
+psql -f app.sql app
+    \end{verbatim}
+
+  \item \texttt{mysql}: This is MySQL, another popular relational database engine that uses persistent server processes.  Ur/Web needs transactions to function properly.  Many installations of MySQL use non-transactional storage engines by default.  Ur/Web generates table definitions that try to use MySQL's InnoDB engine, which supports transactions.  You can edit the first line of a generated \texttt{.sql} file to change this behavior, but it really is true that Ur/Web applications will exhibit bizarre behavior if you choose an engine that ignores transaction commands.
+
+    A command sequence like this can initialize a MySQL database:
+    \begin{verbatim}
+echo "CREATE DATABASE app" | mysql
+mysql -D app <app.sql
+    \end{verbatim}
+
+  \item \texttt{sqlite}: This is SQLite, a simple filesystem-based transactional database engine.  With this backend, Ur/Web applications can run without any additional server processes.  The other engines are generally preferred for large-workload performance and full admin feature sets, while SQLite is popular for its low resource footprint and ease of set-up.
+
+    A command like this can initialize an SQLite database:
+    \begin{verbatim}
+sqlite3 path/to/database/file <app.sql
+    \end{verbatim}
+  \end{itemize}
+
+\item \texttt{-dumpSource}: When compilation fails, output to stderr the complete source code of the last intermediate program before the compilation phase that signaled the error.  (Warning: these outputs can be very long and aren't especially optimized for readability!)
+
+\item \texttt{-explainEmbed}: Trigger more verbose error messages about inability to embed server-side values in client-side code.
+
+\item \texttt{-js FILENAME}: Ur/Web applications with client-side code link in generated JavaScript files, which, by default, are assigned random-looking names.  Use this directive to override the filename chosen for the JavaScript code.  Be forewarned that the default method uses a name based on hashing the code itself, which is done for a good reason: browsers are very eager to cache JavaScript code, and application changes may fail to propagate quickly to browsers if this filename stays the same between versions.  In such cases, it isn't just that the user sees an old version of your application.  Instead, the application runs with a mix of old and new files, leading to arbitrary bugs that Ur/Web prevents, when used properly.
+
+\item \texttt{-limit class num}: Equivalent to the \texttt{limit} directive from \texttt{.urp} files
+
+\item \texttt{-moduleOf FILENAME}: Prints the Ur/Web module name corresponding to source file \texttt{FILENAME}, exiting immediately afterward.
+
+\item \texttt{-output FILENAME}: Set where the application executable is written.
+
+\item \texttt{-path NAME VALUE}: Set the value of path variable \texttt{\$NAME} to \texttt{VALUE}, for use in \texttt{.urp} files.
+
+\item \texttt{-prefix PREFIX}: Equivalent to the \texttt{prefix} directive from \texttt{.urp} files
+
+\item \texttt{-print-ccompiler}: Print the C compiler being used.
+
+\item \texttt{-print-cinclude}: Print the name of the directory where C/C++ header files are installed.
+
+\item \texttt{-protocol [http|cgi|fastcgi|static]}: Set the protocol that the generated application speaks.
+  \begin{itemize}
+  \item \texttt{http}: This is the default.  It is for building standalone web servers that can be accessed by web browsers directly.
+
+  \item \texttt{cgi}: This is the classic protocol that web servers use to generate dynamic content by spawning new processes.  While Ur/Web programs may in general use message-passing with the \texttt{send} and \texttt{recv} functions, that functionality is not yet supported in CGI, since CGI needs a fresh process for each request, and message-passing needs to use persistent sockets to deliver messages.
+
+    Since Ur/Web treats paths in an unusual way, a configuration line like this one can be used to configure an application that was built with URL prefix \texttt{/Hello}:
+    \begin{verbatim}
+ScriptAlias /Hello /path/to/hello.exe
+    \end{verbatim}
+
+    A different method can be used for, e.g., a shared host, where you can only configure Apache via \texttt{.htaccess} files.  Drop the generated executable into your web space and mark it as CGI somehow.  For instance, if the script ends in \texttt{.exe}, you might put this in \texttt{.htaccess} in the directory containing the script:
+    \begin{verbatim}
+Options +ExecCGI
+AddHandler cgi-script .exe
+    \end{verbatim}
+
+    Additionally, make sure that Ur/Web knows the proper URI prefix for your script.  For instance, if the script is accessed via \texttt{http://somewhere/dir/script.exe}, then include this line in your \texttt{.urp} file:
+    \begin{verbatim}
+prefix /dir/script.exe/
+    \end{verbatim}
+
+    To access the \texttt{foo} function in the \texttt{Bar} module, you would then hit \texttt{http://somewhere/dir/script.exe/Bar/foo}.
+
+    If your application contains form handlers that read cookies before causing side effects, then you will need to use the \texttt{sigfile} \texttt{.urp} directive, too.
+
+  \item \texttt{fastcgi}: This is a newer protocol inspired by CGI, wherein web servers can start and reuse persistent external processes to generate dynamic content.  Ur/Web doesn't implement the whole protocol, but Ur/Web's support has been tested to work with the \texttt{mod\_fastcgi}s of Apache and lighttpd.
+
+    To configure a FastCGI program with Apache, one could combine the above \texttt{ScriptAlias} line with a line like this:
+    \begin{verbatim}
+FastCgiServer /path/to/hello.exe -idle-timeout 99999
+    \end{verbatim}
+    The idle timeout is only important for applications that use message-passing.  Client connections may go long periods without receiving messages, and Apache tries to be helpful and garbage collect them in such cases.  To prevent that behavior, we specify how long a connection must be idle to be collected.
+
+    Also see the discussion of the \cd{prefix} directive for CGI above; similar configuration is likely to be necessary for FastCGI.  An Ur/Web application won't generally run correctly if it doesn't have a unique URI prefix assigned to it and configured with \cd{prefix}.
+
+    Here is some lighttpd configuration for the same application.
+    \begin{verbatim}
+fastcgi.server = (
+  "/Hello/" =>
+  (( "bin-path" => "/path/to/hello.exe",
+  "socket" => "/tmp/hello",
+  "check-local" => "disable",
+  "docroot" => "/",
+  "max-procs" => "1"
+  ))
+)
+    \end{verbatim}
+    The least obvious requirement is setting \texttt{max-procs} to 1, so that lighttpd doesn't try to multiplex requests across multiple external processes.  This is required for message-passing applications, where a single database of client connections is maintained within a multi-threaded server process.  Multiple processes may, however, be used safely with applications that don't use message-passing.
+
+    A FastCGI process reads the environment variable \texttt{URWEB\_NUM\_THREADS} to determine how many threads to spawn for handling client requests.  The default is 1.
+
+  \item \texttt{static}: This protocol may be used to generate static web pages from Ur/Web code.  The output executable expects a single command-line argument, giving the URI of a page to generate.  For instance, this argument might be \cd{/main}, in which case a static HTTP response for that page will be written to stdout.
+  \end{itemize}
+
+\item \texttt{-root Name PATH}: Trigger an alternate module convention for all source files found in directory \texttt{PATH} or any of its subdirectories.  Any file \texttt{PATH/foo.ur} defines a module \texttt{Name.Foo} instead of the usual \texttt{Foo}.  Any file \texttt{PATH/subdir/foo.ur} defines a module \texttt{Name.Subdir.Foo}, and so on for arbitrary nesting of subdirectories.
+
+\item \texttt{-sigfile PATH}: Same as the \texttt{sigfile} directive in \texttt{.urp} files
+
+\item \texttt{-sql FILENAME}: Set where a database set-up SQL script is written.
+
+\item \texttt{-static}: Link the runtime system statically.  The default is to link against dynamic libraries.
+
+\item \texttt{-stop PHASE}: Stop compilation after the named phase, printing the intermediate program to stderr.  This flag is mainly useful for debugging the Ur/Web compiler itself.
+\end{itemize}
+
+There is an additional convenience method for invoking \texttt{urweb}.  If the main argument is \texttt{FOO}, and \texttt{FOO.ur} exists but \texttt{FOO.urp} doesn't, then the invocation is interpreted as if called on a \texttt{.urp} file containing \texttt{FOO} as its only main entry, with an additional \texttt{rewrite all FOO/*} directive.
+
+There are also two experimental compiler extensions enabled with flags \texttt{-iflow} and \texttt{-sqlcache}.  They are intentionally not documented further here, to indicate just how very experimental they are!
+
+\subsection{Tutorial Formatting}
+
+The Ur/Web compiler also supports rendering of nice HTML tutorials from Ur source files, when invoked like \cd{urweb -tutorial DIR}.  The directory \cd{DIR} is examined for files whose names end in \cd{.ur}.  Every such file is translated into a \cd{.html} version.
+
+These input files follow normal Ur syntax, with a few exceptions:
+\begin{itemize}
+\item The first line must be a comment like \cd{(* TITLE *)}, where \cd{TITLE} is a string of your choice that will be used as the title of the output page.
+\item While most code in the output HTML will be formatted as a monospaced code listing, text in regular Ur comments is formatted as normal English text.
+\item A comment like \cd{(* * HEADING *)} introduces a section heading, with text \cd{HEADING} of your choice.
+\item To include both a rendering of an Ur expression and a pretty-printed version of its value, bracket the expression with \cd{(* begin eval *)} and \cd{(* end *)}.  The result of expression evaluation is pretty-printed with \cd{show}, so the expression type must belong to that type class.
+\item To include code that should not be shown in the tutorial (e.g., to add a \cd{show} instance to use with \cd{eval}), bracket the code with \cd{(* begin hide *)} and \cd{(* end *)}.
+\end{itemize}
+
+A word of warning: as for demo generation, tutorial generation calls Emacs to syntax-highlight Ur code.
+
+\subsection{Run-Time Options}
+
+Compiled applications consult a few environment variables to modify their behavior:
+
+\begin{itemize}
+  \item \cd{URWEB\_NUM\_THREADS}: alternative to the \cd{-t} command-line argument (currently used only by FastCGI)
+  \item \cd{URWEB\_STACK\_SIZE}: size of per-thread stacks, in bytes
+  \item \cd{URWEB\_PQ\_CON}: when using PostgreSQL, overrides the compiled-in connection string
+\end{itemize}
+
+\subsection{A Word of Warning on Heuristic Compilation}
+
+For server-side code, Ur/Web follows an unusual compilation model, where not all type-correct programs can be compiled successfully, especially when using functions as data not known until runtime.  See Section \ref{phases} for more detail.
+
+
+\section{Ur Syntax}
+
+In this section, we describe the syntax of Ur, deferring to a later section discussion of most of the syntax specific to SQL and XML.  The sole exceptions are the declaration forms for relations, cookies, and styles.
+
+\subsection{Lexical Conventions}
+
+We give the Ur language definition in \LaTeX $\;$ math mode, since that is prettier than monospaced ASCII.  The corresponding ASCII syntax can be read off directly.  Here is the key for mapping math symbols to ASCII character sequences.
+
+\begin{center}
+  \begin{tabular}{rl}
+    \textbf{\LaTeX} & \textbf{ASCII} \\
+    $\to$ & \cd{->} \\
+    $\longrightarrow$ & \cd{-{}->} \\
+    $\times$ & \cd{*} \\
+    $\lambda$ & \cd{fn} \\
+    $\Rightarrow$ & \cd{=>} \\
+    $\Longrightarrow$ & \cd{==>} \\
+    $\neq$ & \cd{<>} \\
+    $\leq$ & \cd{<=} \\
+    $\geq$ & \cd{>=} \\
+    \\
+    $x$ & Normal textual identifier, not beginning with an uppercase letter \\
+    $X$ & Normal textual identifier, beginning with an uppercase letter \\
+  \end{tabular}
+\end{center}
+
+We often write syntax like $e^*$ to indicate zero or more copies of $e$, $e^+$ to indicate one or more copies, and $e,^*$ and $e,^+$ to indicate multiple copies separated by commas.  Another separator may be used in place of a comma.  The $e$ term may be surrounded by parentheses to indicate grouping; those parentheses should not be included in the actual ASCII.
+
+We write $\ell$ for literals of the primitive types, for the most part following C conventions.  There are $\mt{int}$, $\mt{float}$, $\mt{char}$, and $\mt{string}$ literals.  Character literals follow the SML convention instead of the C convention, written like \texttt{\#"a"} instead of \texttt{'a'}.
+
+This version of the manual doesn't include operator precedences; see \texttt{src/urweb.grm} for that.
+
+As in the ML language family, the syntax \texttt{(* ... *)} is used for (nestable) comments.  Within XML literals, Ur/Web also supports the usual \texttt{<!-- ... -->} XML comments.
+
+\subsection{\label{core}Core Syntax}
+
+\emph{Kinds} classify types and other compile-time-only entities.  Each kind in the grammar is listed with a description of the sort of data it classifies.
+$$\begin{array}{rrcll}
+  \textrm{Kinds} & \kappa &::=& \mt{Type} & \textrm{proper types} \\
+  &&& \mt{Unit} & \textrm{the trivial constructor} \\
+  &&& \mt{Name} & \textrm{field names} \\
+  &&& \kappa \to \kappa & \textrm{type-level functions} \\
+  &&& \{\kappa\} & \textrm{type-level records} \\
+  &&& (\kappa\times^+) & \textrm{type-level tuples} \\
+  &&& X & \textrm{variable} \\
+  &&& X \longrightarrow \kappa & \textrm{kind-polymorphic type-level function} \\
+  &&& \_\_ & \textrm{wildcard} \\
+  &&& (\kappa) & \textrm{explicit precedence} \\
+\end{array}$$
+
+Ur supports several different notions of functions that take types as arguments.  These arguments can be either implicit, causing them to be inferred at use sites; or explicit, forcing them to be specified manually at use sites.  There is a common explicitness annotation convention applied at the definitions of and in the types of such functions.
+$$\begin{array}{rrcll}
+  \textrm{Explicitness} & ? &::=& :: & \textrm{explicit} \\
+  &&& ::: & \textrm{implicit}
+\end{array}$$
+
+\emph{Constructors} are the main class of compile-time-only data.  They include proper types and are classified by kinds.
+$$\begin{array}{rrcll}
+  \textrm{Constructors} & c, \tau &::=& (c) :: \kappa & \textrm{kind annotation} \\
+  &&& \hat{x} & \textrm{constructor variable} \\
+  \\
+  &&& \tau \to \tau & \textrm{function type} \\
+  &&& x \; ? \; \kappa \to \tau & \textrm{polymorphic function type} \\
+  &&& X \longrightarrow \tau & \textrm{kind-polymorphic function type} \\
+  &&& \$ c & \textrm{record type} \\
+  \\
+  &&& c \; c & \textrm{type-level function application} \\
+  &&& \lambda x \; :: \; \kappa \Rightarrow c & \textrm{type-level function abstraction} \\
+  \\
+  &&& X \Longrightarrow c & \textrm{type-level kind-polymorphic function abstraction} \\
+  &&& c [\kappa] & \textrm{type-level kind-polymorphic function application} \\
+  \\
+  &&& () & \textrm{type-level unit} \\
+  &&& \#X & \textrm{field name} \\
+  \\
+  &&& [(c = c)^*] & \textrm{known-length type-level record} \\
+  &&& c \rc c & \textrm{type-level record concatenation} \\
+  &&& \mt{map} & \textrm{type-level record map} \\
+  \\
+  &&& (c,^+) & \textrm{type-level tuple} \\
+  &&& c.n & \textrm{type-level tuple projection ($n \in \mathbb N^+$)} \\
+  \\
+  &&& [c \sim c] \Rightarrow \tau & \textrm{guarded type} \\
+  \\
+  &&& \_ :: \kappa & \textrm{wildcard} \\
+  &&& (c) & \textrm{explicit precedence} \\
+  \\
+  \textrm{Qualified uncapitalized variables} & \hat{x} &::=& x & \textrm{not from a module} \\
+  &&& M.x & \textrm{projection from a module} \\
+\end{array}$$
+
+We include both abstraction and application for kind polymorphism, but applications are only inferred internally; they may not be written explicitly in source programs.  Also, in the ``known-length type-level record'' form, in $c_1 = c_2$ terms, the parser currently only allows $c_1$ to be of the forms $X$ (as a shorthand for $\#X$) or $x$, or a natural number to stand for the corresponding field name (e.g., for tuples).
+
+Modules of the module system are described by \emph{signatures}.
+$$\begin{array}{rrcll}
+  \textrm{Signatures} & S &::=& \mt{sig} \; s^* \; \mt{end} & \textrm{constant} \\
+  &&& X & \textrm{variable} \\
+  &&& \mt{functor}(X : S) : S & \textrm{functor} \\
+  &&& S \; \mt{where} \; \mt{con} \; x = c & \textrm{concretizing an abstract constructor} \\
+  &&& M.X & \textrm{projection from a module} \\
+  \\
+  \textrm{Signature items} & s &::=& \mt{con} \; x :: \kappa & \textrm{abstract constructor} \\
+  &&& \mt{con} \; x :: \kappa = c & \textrm{concrete constructor} \\
+  &&& \mt{datatype} \; x \; x^* = dc\mid^+ & \textrm{algebraic datatype definition} \\
+  &&& \mt{datatype} \; x = \mt{datatype} \; M.x & \textrm{algebraic datatype import} \\
+  &&& \mt{val} \; x : \tau & \textrm{value} \\
+  &&& \mt{structure} \; X : S & \textrm{sub-module} \\
+  &&& \mt{signature} \; X = S & \textrm{sub-signature} \\
+  &&& \mt{include} \; S & \textrm{signature inclusion} \\
+  &&& \mt{constraint} \; c \sim c & \textrm{record disjointness constraint} \\
+  &&& \mt{class} \; x :: \kappa & \textrm{abstract constructor class} \\
+  &&& \mt{class} \; x :: \kappa = c & \textrm{concrete constructor class} \\
+  \\
+  \textrm{Datatype constructors} & dc &::=& X & \textrm{nullary constructor} \\
+  &&& X \; \mt{of} \; \tau & \textrm{unary constructor} \\
+\end{array}$$
+
+\emph{Patterns} are used to describe structural conditions on expressions, such that expressions may be tested against patterns, generating assignments to pattern variables if successful.
+$$\begin{array}{rrcll}
+  \textrm{Patterns} & p &::=& \_ & \textrm{wildcard} \\
+  &&& x & \textrm{variable} \\
+  &&& \ell & \textrm{constant} \\
+  &&& \hat{X} & \textrm{nullary constructor} \\
+  &&& \hat{X} \; p & \textrm{unary constructor} \\
+  &&& \{(X = p,)^*\} & \textrm{rigid record pattern} \\
+  &&& \{(X = p,)^+, \ldots\} & \textrm{flexible record pattern} \\
+  &&& p : \tau & \textrm{type annotation} \\
+  &&& (p) & \textrm{explicit precedence} \\
+  \\
+  \textrm{Qualified capitalized variables} & \hat{X} &::=& X & \textrm{not from a module} \\
+  &&& M.X & \textrm{projection from a module} \\
+\end{array}$$
+
+\emph{Expressions} are the main run-time entities, corresponding to both ``expressions'' and ``statements'' in mainstream imperative languages.
+$$\begin{array}{rrcll}
+  \textrm{Expressions} & e &::=& e : \tau & \textrm{type annotation} \\
+  &&& \hat{x} & \textrm{variable} \\
+  &&& \hat{X} & \textrm{datatype constructor} \\
+  &&& \ell & \textrm{constant} \\
+  \\
+  &&& e \; e & \textrm{function application} \\
+  &&& \lambda x : \tau \Rightarrow e & \textrm{function abstraction} \\
+  &&& e [c] & \textrm{polymorphic function application} \\
+  &&& \lambda [x \; ? \; \kappa] \Rightarrow e & \textrm{polymorphic function abstraction} \\
+  &&& e [\kappa] & \textrm{kind-polymorphic function application} \\
+  &&& X \Longrightarrow e & \textrm{kind-polymorphic function abstraction} \\
+  \\
+  &&& \{(c = e,)^*\} & \textrm{known-length record} \\
+  &&& e.c & \textrm{record field projection} \\
+  &&& e \rc e & \textrm{record concatenation} \\
+  &&& e \rcut c & \textrm{removal of a single record field} \\
+  &&& e \rcutM c & \textrm{removal of multiple record fields} \\
+  \\
+  &&& \mt{let} \; ed^* \; \mt{in} \; e \; \mt{end} & \textrm{local definitions} \\
+  \\
+  &&& \mt{case} \; e \; \mt{of} \; (p \Rightarrow e|)^+ & \textrm{pattern matching} \\
+  \\
+  &&& \lambda [c \sim c] \Rightarrow e & \textrm{guarded expression abstraction} \\
+  &&& e \; ! & \textrm{guarded expression application} \\
+  \\
+  &&& \_ & \textrm{wildcard} \\
+  &&& (e) & \textrm{explicit precedence} \\
+  \\
+  \textrm{Local declarations} & ed &::=& \cd{val} \; p = e & \textrm{non-recursive value} \\
+  &&& \cd{val} \; \cd{rec} \; (x : \tau = e \; \cd{and})^+ & \textrm{mutually recursive values} \\
+\end{array}$$
+
+As with constructors, we include both abstraction and application for kind polymorphism, but applications are only inferred internally.
+
+\emph{Declarations} primarily bring new symbols into context.
+$$\begin{array}{rrcll}
+  \textrm{Declarations} & d &::=& \mt{con} \; x :: \kappa = c & \textrm{constructor synonym} \\
+  &&& \mt{datatype} \; x \; x^* = dc\mid^+ & \textrm{algebraic datatype definition} \\
+  &&& \mt{datatype} \; x = \mt{datatype} \; M.x & \textrm{algebraic datatype import} \\
+  &&& \mt{val} \; p = e & \textrm{value} \\
+  &&& \mt{val} \; \cd{rec} \; (x : \tau = e \; \mt{and})^+ & \textrm{mutually recursive values} \\
+  &&& \mt{structure} \; X : S = M & \textrm{module definition} \\
+  &&& \mt{signature} \; X = S & \textrm{signature definition} \\
+  &&& \mt{open} \; M & \textrm{module inclusion} \\
+  &&& \mt{constraint} \; c \sim c & \textrm{record disjointness constraint} \\
+  &&& \mt{open} \; \mt{constraints} \; M & \textrm{inclusion of just the constraints from a module} \\
+  &&& \mt{table} \; x : c & \textrm{SQL table} \\
+  &&& \mt{view} \; x = e & \textrm{SQL view} \\
+  &&& \mt{sequence} \; x & \textrm{SQL sequence} \\
+  &&& \mt{cookie} \; x : \tau & \textrm{HTTP cookie} \\
+  &&& \mt{style} \; x : \tau & \textrm{CSS class} \\
+  &&& \mt{task} \; e = e & \textrm{recurring task} \\
+  \\
+  \textrm{Modules} & M &::=& \mt{struct} \; d^* \; \mt{end} & \textrm{constant} \\
+  &&& X & \textrm{variable} \\
+  &&& M.X & \textrm{projection} \\
+  &&& M(M) & \textrm{functor application} \\
+  &&& \mt{functor}(X : S) : S = M & \textrm{functor abstraction} \\
+\end{array}$$
+
+There are two kinds of Ur files.  A file named $M\texttt{.ur}$ is an \emph{implementation file}, and it should contain a sequence of declarations $d^*$.  A file named $M\texttt{.urs}$ is an \emph{interface file}; it must always have a matching $M\texttt{.ur}$ and should contain a sequence of signature items $s^*$.  When both files are present, the overall effect is the same as a monolithic declaration $\mt{structure} \; M : \mt{sig} \; s^* \; \mt{end} = \mt{struct} \; d^* \; \mt{end}$.  When no interface file is included, the overall effect is similar, with a signature for module $M$ being inferred rather than just checked against an interface.
+
+We omit some extra possibilities in $\mt{table}$ syntax, deferring them to Section \ref{tables}.  The concrete syntax of $\mt{view}$ declarations is also more complex than shown in the table above, with details deferred to Section \ref{tables}.
+
+\subsection{Shorthands}
+
+There are a variety of derived syntactic forms that elaborate into the core syntax from the last subsection.  We will present the additional forms roughly following the order in which we presented the constructs that they elaborate into.
+
+In many contexts where record fields are expected, like in a projection $e.c$, a constant field may be written as simply $X$, rather than $\#X$.
+
+A record type may be written $\{(c = c,)^*\}$, which elaborates to $\$[(c = c,)^*]$.
+
+The notation $[c_1, \ldots, c_n]$ is shorthand for $[c_1 = (), \ldots, c_n = ()]$.
+
+A tuple type $\tau_1 \times \ldots \times \tau_n$ expands to a record type $\{1 : \tau_1, \ldots, n : \tau_n\}$, with natural numbers as field names.  A tuple expression $(e_1, \ldots, e_n)$ expands to a record expression $\{1 = e_1, \ldots, n = e_n\}$.  A tuple pattern $(p_1, \ldots, p_n)$ expands to a rigid record pattern $\{1 = p_1, \ldots, n = p_n\}$.  Positive natural numbers may be used in most places where field names would be allowed.
+
+The syntax $()$ expands to $\{\}$ as a pattern or expression.
+
+In general, several adjacent $\lambda$ forms may be combined into one, and kind and type annotations may be omitted, in which case they are implicitly included as wildcards.  More formally, for constructor-level abstractions, we can define a new non-terminal $b ::= x \mid (x :: \kappa) \mid X$ and allow composite abstractions of the form $\lambda b^+ \Rightarrow c$, elaborating into the obvious sequence of one core $\lambda$ per element of $b^+$.
+
+Further, the signature item or declaration syntax $\mt{con} \; x \; b^+ = c$ is shorthand for wrapping of the appropriate $\lambda$s around the righthand side $c$.  The $b$ elements may not include $X$, and there may also be an optional $:: \kappa$ before the $=$.
+
+In some contexts, the parser isn't happy with token sequences like $x :: \_$, to indicate a constructor variable of wildcard kind.  In such cases, write the second two tokens as $::\hspace{-.05in}\_$, with no intervening spaces.  Analogous syntax $:::\hspace{-.05in}\_$ is available for implicit constructor arguments.
+
+For any signature item or declaration that defines some entity to be equal to $A$ with classification annotation $B$ (e.g., $\mt{val} \; x : B = A$), $B$ and the preceding colon (or similar punctuation) may be omitted, in which case it is filled in as a wildcard.
+
+A signature item or declaration $\mt{type} \; x$ or $\mt{type} \; x = \tau$ is elaborated into $\mt{con} \; x :: \mt{Type}$ or $\mt{con} \; x :: \mt{Type} = \tau$, respectively.
+
+A signature item or declaration $\mt{class} \; x = \lambda y \Rightarrow c$ may be abbreviated $\mt{class} \; x \; y = c$.
+
+Handling of implicit and explicit constructor arguments may be tweaked with some prefixes to variable references.  An expression $@x$ is a version of $x$ where all type class instance and disjointness arguments have been made explicit.  (For the purposes of this paragraph, the type family $\mt{Top.folder}$ is a type class, though it isn't marked as one by the usual means; and any record type is considered to be a type class instance type when every field's type is a type class instance type.)  An expression $@@x$ achieves the same effect, additionally making explicit all implicit constructor arguments.  The default is that implicit arguments are inserted automatically after any reference to a variable, or after any application of a variable to one or more arguments.  For such an expression, implicit wildcard arguments are added for the longest prefix of the expression's type consisting only of implicit polymorphism, type class instances, and disjointness obligations.  The same syntax works for variables projected out of modules and for capitalized variables (datatype constructors).
+
+At the expression level, an analogue is available of the composite $\lambda$ form for constructors.  We define the language of binders as $b ::= p \mid [x] \mid [x \; ? \; \kappa] \mid X \mid [c \sim c]$.  A lone variable $[x]$ stands for an implicit constructor variable of unspecified kind.  The standard value-level function binder is recovered as the type-annotated pattern form $x : \tau$.  It is a compile-time error to include a pattern $p$ that does not match every value of the appropriate type.
+
+A local $\mt{val}$ declaration may bind a pattern instead of just a plain variable.  As for function arguments, only irrefutable patterns are legal.
+
+The keyword $\mt{fun}$ is a shorthand for $\mt{val} \; \mt{rec}$ that allows arguments to be specified before the equal sign in the definition of each mutually recursive function, as in SML.  Each curried argument must follow the grammar of the $b$ non-terminal introduced two paragraphs ago.  A $\mt{fun}$ declaration is elaborated into a version that adds additional $\lambda$s to the fronts of the righthand sides, as appropriate.
+
+A signature item $\mt{functor} \; X_1 \; (X_2 : S_1) : S_2$ is elaborated into $\mt{structure} \; X_1 : \mt{functor}(X_2 : S_1) : S_2$.  A declaration $\mt{functor} \; X_1 \; (X_2 : S_1) : S_2 = M$ is elaborated into $\mt{structure} \; X_1 : \mt{functor}(X_2 : S_1) : S_2 = \mt{functor}(X_2 : S_1) : S_2 = M$.
+
+An $\mt{open} \; \mt{constraints}$ declaration is implicitly inserted for the argument of every functor at the beginning of the functor body.  For every declaration of the form $\mt{structure} \; X : S = \mt{struct} \ldots \mt{end}$, an $\mt{open} \; \mt{constraints} \; X$ declaration is implicitly inserted immediately afterward.
+
+A declaration $\mt{table} \; x : \{(c = c,)^*\}$ is elaborated into $\mt{table} \; x : [(c = c,)^*]$.
+
+The syntax $\mt{where} \; \mt{type}$ is an alternate form of $\mt{where} \; \mt{con}$.
+
+The syntax $\mt{if} \; e \; \mt{then} \; e_1 \; \mt{else} \; e_2$ expands to $\mt{case} \; e \; \mt{of} \; \mt{Basis}.\mt{True} \Rightarrow e_1 \mid \mt{Basis}.\mt{False} \Rightarrow e_2$.
+
+There are infix operator syntaxes for a number of functions defined in the $\mt{Basis}$ module.  There is $=$ for $\mt{eq}$, $\neq$ for $\mt{neq}$, $-$ for $\mt{neg}$ (as a prefix operator) and $\mt{minus}$, $+$ for $\mt{plus}$, $\times$ for $\mt{times}$, $/$ for $\mt{div}$, $\%$ for $\mt{mod}$, $<$ for $\mt{lt}$, $\leq$ for $\mt{le}$, $>$ for $\mt{gt}$, and $\geq$ for $\mt{ge}$.
+
+A signature item $\mt{table} \; x : c$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{sql\_table} \; c \; []$.  $\mt{view} \; x : c$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{sql\_view} \; c$, $\mt{sequence} \; x$ is short for $\mt{val} \; x : \mt{Basis}.\mt{sql\_sequence}$.  $\mt{cookie} \; x : \tau$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{http\_cookie} \; \tau$, and $\mt{style} \; x$ is shorthand for $\mt{val} \; x : \mt{Basis}.\mt{css\_class}$.
+
+It is possible to write a $\mt{let}$ expression with its constituents in reverse order, along the lines of Haskell's \cd{where}.  An expression $\mt{let} \; e \; \mt{where} \; ed^* \; \mt{end}$ desugars to $\mt{let} \; ed^* \; \mt{in} \; e \; \mt{end}$.
+
+Ur/Web also includes a few more infix operators: $f \; \texttt{<|} \; x$ desugars to $f \; x$, $x \; \texttt{|>} \; f$ to $f \; x$, $f \; \texttt{<{}<{}<} \; g$ to $\mt{Top}.\mt{compose} \; f \; g$, and $g \; \texttt{>{}>{}>} \; f$ to $\mt{Top}.\mt{compose} \; f \; g$.  (The latter two are doing function composition in the usual way.)  Furthermore, any identifier may be changed into an infix operator by placing it between backticks, e.g. a silly way to do addition is $x \; \texttt{`}\mt{plus}\texttt{`} \; y$ instead of $x + y$.
+
+Hexadecimal integer literals are supported like \texttt{0xDEADBEEF}.  Only capital letters are allowed.
+
+
+\section{Static Semantics}
+
+In this section, we give a declarative presentation of Ur's typing rules and related judgments.  Inference is the subject of the next section; here, we assume that an oracle has filled in all wildcards with concrete values.
+
+The notations used here are the standard ones of programming language semantics.  They are probably the most effective way to convey this information.  At the same time, most Ur/Web users can probably get by \emph{without} knowing the contents of this section!  If you're interested in diving into the details of Ur typing but are unfamiliar with ``inference rule notation,'' I recommend the following book:
+\begin{quote}
+  Benjamin C. Pierce, \emph{Types and Programming Languages}, MIT Press, 2002.
+\end{quote}
+
+Since there is significant mutual recursion among the judgments, we introduce them all before beginning to give rules.  We use the same variety of contexts throughout this section, implicitly introducing new sorts of context entries as needed.
+\begin{itemize}
+\item $\Gamma \vdash \kappa$ expresses kind well-formedness.
+\item $\Gamma \vdash c :: \kappa$ assigns a kind to a constructor in a context.
+\item $\Gamma \vdash c \sim c$ proves the disjointness of two record constructors; that is, that they share no field names.  We overload the judgment to apply to pairs of field names as well.
+\item $\Gamma \vdash c \hookrightarrow C$ proves that record constructor $c$ decomposes into set $C$ of field names and record constructors.
+\item $\Gamma \vdash c \equiv c$ proves the computational equivalence of two constructors.  This is often called a \emph{definitional equality} in the world of type theory.
+\item $\Gamma \vdash e : \tau$ is a standard typing judgment.
+\item $\Gamma \vdash p \leadsto \Gamma; \tau$ combines typing of patterns with calculation of which new variables they bind.
+\item $\Gamma \vdash d \leadsto \Gamma$ expresses how a declaration modifies a context.  We overload this judgment to apply to sequences of declarations, as well as to signature items and sequences of signature items.
+\item $\Gamma \vdash S \equiv S$ is the signature equivalence judgment.
+\item $\Gamma \vdash S \leq S$ is the signature compatibility judgment.  We write $\Gamma \vdash S$ as shorthand for $\Gamma \vdash S \leq S$.
+\item $\Gamma \vdash M : S$ is the module signature checking judgment.
+\item $\mt{proj}(M, \overline{s}, V)$ is a partial function for projecting a signature item from $\overline{s}$, given the module $M$ that we project from.  $V$ may be $\mt{con} \; x$, $\mt{datatype} \; x$, $\mt{val} \; x$, $\mt{signature} \; X$, or $\mt{structure} \; X$.  The parameter $M$ is needed because the projected signature item may refer to other items from $\overline{s}$.
+\item $\mt{selfify}(M, \overline{s})$ adds information to signature items $\overline{s}$ to reflect the fact that we are concerned with the particular module $M$.  This function is overloaded to work over individual signature items as well.
+\end{itemize}
+
+
+\subsection{Kind Well-Formedness}
+
+$$\infer{\Gamma \vdash \mt{Type}}{}
+\quad \infer{\Gamma \vdash \mt{Unit}}{}
+\quad \infer{\Gamma \vdash \mt{Name}}{}
+\quad \infer{\Gamma \vdash \kappa_1 \to \kappa_2}{
+  \Gamma \vdash \kappa_1
+  & \Gamma \vdash \kappa_2
+}
+\quad \infer{\Gamma \vdash \{\kappa\}}{
+  \Gamma \vdash \kappa
+}
+\quad \infer{\Gamma \vdash (\kappa_1 \times \ldots \times \kappa_n)}{
+  \forall i: \Gamma \vdash \kappa_i
+}$$
+
+$$\infer{\Gamma \vdash X}{
+  X \in \Gamma
+}
+\quad \infer{\Gamma \vdash X \longrightarrow \kappa}{
+  \Gamma, X \vdash \kappa
+}$$
+
+\subsection{Kinding}
+
+We write $[X \mapsto \kappa_1]\kappa_2$ for capture-avoiding substitution of $\kappa_1$ for $X$ in $\kappa_2$.
+
+$$\infer{\Gamma \vdash (c) :: \kappa :: \kappa}{
+  \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash x :: \kappa}{
+  x :: \kappa \in \Gamma
+}
+\quad \infer{\Gamma \vdash x :: \kappa}{
+  x :: \kappa = c \in \Gamma
+}$$
+
+$$\infer{\Gamma \vdash M.x :: \kappa}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{con} \; x) = \kappa
+}
+\quad \infer{\Gamma \vdash M.x :: \kappa}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{con} \; x) = (\kappa, c)
+}$$
+
+$$\infer{\Gamma \vdash \tau_1 \to \tau_2 :: \mt{Type}}{
+  \Gamma \vdash \tau_1 :: \mt{Type}
+  & \Gamma \vdash \tau_2 :: \mt{Type}
+}
+\quad \infer{\Gamma \vdash x \; ? \: \kappa \to \tau :: \mt{Type}}{
+  \Gamma, x :: \kappa \vdash \tau :: \mt{Type}
+}
+\quad \infer{\Gamma \vdash X \longrightarrow \tau :: \mt{Type}}{
+  \Gamma, X \vdash \tau :: \mt{Type}
+}
+\quad \infer{\Gamma \vdash \$c :: \mt{Type}}{
+  \Gamma \vdash c :: \{\mt{Type}\}
+}$$
+
+$$\infer{\Gamma \vdash c_1 \; c_2 :: \kappa_2}{
+  \Gamma \vdash c_1 :: \kappa_1 \to \kappa_2
+  & \Gamma \vdash c_2 :: \kappa_1
+}
+\quad \infer{\Gamma \vdash \lambda x \; :: \; \kappa_1 \Rightarrow c :: \kappa_1 \to \kappa_2}{
+  \Gamma, x :: \kappa_1 \vdash c :: \kappa_2
+}$$
+
+$$\infer{\Gamma \vdash c[\kappa'] :: [X \mapsto \kappa']\kappa}{
+  \Gamma \vdash c :: X \to \kappa
+  & \Gamma \vdash \kappa'
+}
+\quad \infer{\Gamma \vdash X \Longrightarrow c :: X \to \kappa}{
+  \Gamma, X \vdash c :: \kappa
+}$$
+
+$$\infer{\Gamma \vdash () :: \mt{Unit}}{}
+\quad \infer{\Gamma \vdash \#X :: \mt{Name}}{}$$
+
+$$\infer{\Gamma \vdash [\overline{c_i = c'_i}] :: \{\kappa\}}{
+  \forall i: \Gamma \vdash c_i : \mt{Name}
+  & \Gamma \vdash c'_i :: \kappa
+  & \forall i \neq j: \Gamma \vdash c_i \sim c_j
+}
+\quad \infer{\Gamma \vdash c_1 \rc c_2 :: \{\kappa\}}{
+  \Gamma \vdash c_1 :: \{\kappa\}
+  & \Gamma \vdash c_2 :: \{\kappa\}
+  & \Gamma \vdash c_1 \sim c_2
+}$$
+
+$$\infer{\Gamma \vdash \mt{map} :: (\kappa_1 \to \kappa_2) \to \{\kappa_1\} \to \{\kappa_2\}}{}$$
+
+$$\infer{\Gamma \vdash (\overline c) :: (\kappa_1 \times \ldots \times \kappa_n)}{
+  \forall i: \Gamma \vdash c_i :: \kappa_i
+}
+\quad \infer{\Gamma \vdash c.i :: \kappa_i}{
+  \Gamma \vdash c :: (\kappa_1 \times \ldots \times \kappa_n)
+}$$
+
+$$\infer{\Gamma \vdash \lambda [c_1 \sim c_2] \Rightarrow \tau :: \mt{Type}}{
+  \Gamma \vdash c_1 :: \{\kappa\}
+  & \Gamma \vdash c_2 :: \{\kappa'\}
+  & \Gamma, c_1 \sim c_2 \vdash \tau :: \mt{Type}
+}$$
+
+\subsection{Record Disjointness}
+
+$$\infer{\Gamma \vdash c_1 \sim c_2}{
+  \Gamma \vdash c_1 \hookrightarrow C_1
+  & \Gamma \vdash c_2 \hookrightarrow C_2
+  & \forall c'_1 \in C_1, c'_2 \in C_2: \Gamma \vdash c'_1 \sim c'_2
+}
+\quad \infer{\Gamma \vdash X \sim X'}{
+  X \neq X'
+}$$
+
+$$\infer{\Gamma \vdash c_1 \sim c_2}{
+  c'_1 \sim c'_2 \in \Gamma
+  & \Gamma \vdash c'_1 \hookrightarrow C_1
+  & \Gamma \vdash c'_2 \hookrightarrow C_2
+  & c_1 \in C_1
+  & c_2 \in C_2
+}$$
+
+$$\infer{\Gamma \vdash c \hookrightarrow \{c\}}{}
+\quad \infer{\Gamma \vdash [\overline{c = c'}] \hookrightarrow \{\overline{c}\}}{}
+\quad \infer{\Gamma \vdash c_1 \rc c_2 \hookrightarrow C_1 \cup C_2}{
+  \Gamma \vdash c_1 \hookrightarrow C_1
+  & \Gamma \vdash c_2 \hookrightarrow C_2
+}
+\quad \infer{\Gamma \vdash c \hookrightarrow C}{
+  \Gamma \vdash c \equiv c'
+  & \Gamma \vdash c' \hookrightarrow C
+}
+\quad \infer{\Gamma \vdash \mt{map} \; f \; c \hookrightarrow C}{
+  \Gamma \vdash c \hookrightarrow C
+}$$
+
+\subsection{\label{definitional}Definitional Equality}
+
+We use $\mathcal C$ to stand for a one-hole context that, when filled, yields a constructor.  The notation $\mathcal C[c]$ plugs $c$ into $\mathcal C$.  We omit the standard definition of one-hole contexts.  We write $[x \mapsto c_1]c_2$ for capture-avoiding substitution of $c_1$ for $x$ in $c_2$, with analogous notation for substituting a kind in a constructor.
+
+$$\infer{\Gamma \vdash c \equiv c}{}
+\quad \infer{\Gamma \vdash c_1 \equiv c_2}{
+  \Gamma \vdash c_2 \equiv c_1
+}
+\quad \infer{\Gamma \vdash c_1 \equiv c_3}{
+  \Gamma \vdash c_1 \equiv c_2
+  & \Gamma \vdash c_2 \equiv c_3
+}
+\quad \infer{\Gamma \vdash \mathcal C[c_1] \equiv \mathcal C[c_2]}{
+  \Gamma \vdash c_1 \equiv c_2
+}$$
+
+$$\infer{\Gamma \vdash x \equiv c}{
+  x :: \kappa = c \in \Gamma
+}
+\quad \infer{\Gamma \vdash M.x \equiv c}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{con} \; x) = (\kappa, c)
+}
+\quad \infer{\Gamma \vdash (\overline c).i \equiv c_i}{}$$
+
+$$\infer{\Gamma \vdash (\lambda x :: \kappa \Rightarrow c) \; c' \equiv [x \mapsto c'] c}{}
+\quad \infer{\Gamma \vdash (X \Longrightarrow c) [\kappa] \equiv [X \mapsto \kappa] c}{}$$
+
+$$\infer{\Gamma \vdash c_1 \rc c_2 \equiv c_2 \rc c_1}{}
+\quad \infer{\Gamma \vdash c_1 \rc (c_2 \rc c_3) \equiv (c_1 \rc c_2) \rc c_3}{}$$
+
+$$\infer{\Gamma \vdash [] \rc c \equiv c}{}
+\quad \infer{\Gamma \vdash [\overline{c_1 = c'_1}] \rc [\overline{c_2 = c'_2}] \equiv [\overline{c_1 = c'_1}, \overline{c_2 = c'_2}]}{}$$
+
+$$\infer{\Gamma \vdash \mt{map} \; f \; [] \equiv []}{}
+\quad \infer{\Gamma \vdash \mt{map} \; f \; ([c_1 = c_2] \rc c) \equiv [c_1 = f \; c_2] \rc \mt{map} \; f \; c}{}$$
+
+$$\infer{\Gamma \vdash \mt{map} \; (\lambda x \Rightarrow x) \; c \equiv c}{}
+\quad \infer{\Gamma \vdash \mt{map} \; f \; (\mt{map} \; f' \; c)
+  \equiv \mt{map} \; (\lambda x \Rightarrow f \; (f' \; x)) \; c}{}$$
+
+$$\infer{\Gamma \vdash \mt{map} \; f \; (c_1 \rc c_2) \equiv \mt{map} \; f \; c_1 \rc \mt{map} \; f \; c_2}{}$$
+
+\subsection{Expression Typing}
+
+We assume the existence of a function $T$ assigning types to literal constants.  It maps integer constants to $\mt{Basis}.\mt{int}$, float constants to $\mt{Basis}.\mt{float}$, character constants to $\mt{Basis}.\mt{char}$, and string constants to $\mt{Basis}.\mt{string}$.
+
+We also refer to a function $\mathcal I$, such that $\mathcal I(\tau)$ ``uses an oracle'' to instantiate all constructor function arguments at the beginning of $\tau$ that are marked implicit; i.e., replace $x_1 ::: \kappa_1 \to \ldots \to x_n ::: \kappa_n \to \tau$ with $[x_1 \mapsto c_1]\ldots[x_n \mapsto c_n]\tau$, where the $c_i$s are inferred and $\tau$ does not start like $x ::: \kappa \to \tau'$.
+
+$$\infer{\Gamma \vdash e : \tau : \tau}{
+  \Gamma \vdash e : \tau
+}
+\quad \infer{\Gamma \vdash e : \tau}{
+  \Gamma \vdash e : \tau'
+  & \Gamma \vdash \tau' \equiv \tau
+}
+\quad \infer{\Gamma \vdash \ell : T(\ell)}{}$$
+
+$$\infer{\Gamma \vdash x : \mathcal I(\tau)}{
+  x : \tau \in \Gamma
+}
+\quad \infer{\Gamma \vdash M.x : \mathcal I(\tau)}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{val} \; x) = \tau
+}
+\quad \infer{\Gamma \vdash X : \mathcal I(\tau)}{
+  X : \tau \in \Gamma
+}
+\quad \infer{\Gamma \vdash M.X : \mathcal I(\tau)}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{val} \; X) = \tau
+}$$
+
+$$\infer{\Gamma \vdash e_1 \; e_2 : \tau_2}{
+  \Gamma \vdash e_1 : \tau_1 \to \tau_2
+  & \Gamma \vdash e_2 : \tau_1
+}
+\quad \infer{\Gamma \vdash \lambda x : \tau_1 \Rightarrow e : \tau_1 \to \tau_2}{
+  \Gamma, x : \tau_1 \vdash e : \tau_2
+}$$
+
+$$\infer{\Gamma \vdash e [c] : [x \mapsto c]\tau}{
+  \Gamma \vdash e : x :: \kappa \to \tau
+  & \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash \lambda [x \; ? \; \kappa] \Rightarrow e : x \; ? \; \kappa \to \tau}{
+  \Gamma, x :: \kappa \vdash e : \tau
+}$$
+
+$$\infer{\Gamma \vdash e [\kappa] : [X \mapsto \kappa]\tau}{
+  \Gamma \vdash e : X \longrightarrow \tau
+  & \Gamma \vdash \kappa
+}
+\quad \infer{\Gamma \vdash X \Longrightarrow e : X \longrightarrow \tau}{
+  \Gamma, X \vdash e : \tau
+}$$
+
+$$\infer{\Gamma \vdash \{\overline{c = e}\} : \{\overline{c : \tau}\}}{
+  \forall i: \Gamma \vdash c_i :: \mt{Name}
+  & \Gamma \vdash e_i : \tau_i
+  & \forall i \neq j: \Gamma \vdash c_i \sim c_j
+}
+\quad \infer{\Gamma \vdash e.c : \tau}{
+  \Gamma \vdash e : \$([c = \tau] \rc c')
+}
+\quad \infer{\Gamma \vdash e_1 \rc e_2 : \$(c_1 \rc c_2)}{
+  \Gamma \vdash e_1 : \$c_1
+  & \Gamma \vdash e_2 : \$c_2
+  & \Gamma \vdash c_1 \sim c_2
+}$$
+
+$$\infer{\Gamma \vdash e \rcut c : \$c'}{
+  \Gamma \vdash e : \$([c = \tau] \rc c')
+}
+\quad \infer{\Gamma \vdash e \rcutM c : \$c'}{
+  \Gamma \vdash e : \$(c \rc c')
+}$$
+
+$$\infer{\Gamma \vdash \mt{let} \; \overline{ed} \; \mt{in} \; e \; \mt{end} : \tau}{
+  \Gamma \vdash \overline{ed} \leadsto \Gamma'
+  & \Gamma' \vdash e : \tau
+}
+\quad \infer{\Gamma \vdash \mt{case} \; e \; \mt{of} \; \overline{p \Rightarrow e} : \tau}{
+  \forall i: \Gamma \vdash p_i \leadsto \Gamma_i, \tau'
+  & \Gamma_i \vdash e_i : \tau
+}$$
+
+$$\infer{\Gamma \vdash \lambda [c_1 \sim c_2] \Rightarrow e : \lambda [c_1 \sim c_2] \Rightarrow \tau}{
+  \Gamma \vdash c_1 :: \{\kappa\}
+  & \Gamma \vdash c_2 :: \{\kappa'\}
+  & \Gamma, c_1 \sim c_2 \vdash e : \tau
+}
+\quad \infer{\Gamma \vdash e \; ! : \tau}{
+  \Gamma \vdash e : [c_1 \sim c_2] \Rightarrow \tau
+  & \Gamma \vdash c_1 \sim c_2
+}$$
+
+\subsection{Pattern Typing}
+
+$$\infer{\Gamma \vdash \_ \leadsto \Gamma; \tau}{}
+\quad \infer{\Gamma \vdash x \leadsto \Gamma, x : \tau; \tau}{}
+\quad \infer{\Gamma \vdash \ell \leadsto \Gamma; T(\ell)}{}$$
+
+$$\infer{\Gamma \vdash X \leadsto \Gamma; \overline{[x_i \mapsto \tau'_i]}\tau}{
+  X : \overline{x ::: \mt{Type}} \to \tau \in \Gamma
+  & \textrm{$\tau$ not a function type}
+}
+\quad \infer{\Gamma \vdash X \; p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau}{
+  X : \overline{x ::: \mt{Type}} \to \tau'' \to \tau \in \Gamma
+  & \Gamma \vdash p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau''
+}$$
+
+$$\infer{\Gamma \vdash M.X \leadsto \Gamma; \overline{[x_i \mapsto \tau'_i]}\tau}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{val} \; X) = \overline{x ::: \mt{Type}} \to \tau
+  & \textrm{$\tau$ not a function type}
+}$$
+
+$$\infer{\Gamma \vdash M.X \; p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{val} \; X) = \overline{x ::: \mt{Type}} \to \tau'' \to \tau
+  & \Gamma \vdash p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau''
+}$$
+
+$$\infer{\Gamma \vdash \{\overline{X = p}\} \leadsto \Gamma_n; \{\overline{X = \tau}\}}{
+  \Gamma_0 = \Gamma
+  & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
+}
+\quad \infer{\Gamma \vdash \{\overline{X = p}, \ldots\} \leadsto \Gamma_n; \$([\overline{X = \tau}] \rc c)}{
+  \Gamma_0 = \Gamma
+  & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
+}$$
+
+$$\infer{\Gamma \vdash p : \tau \leadsto \Gamma'; \tau}{
+  \Gamma \vdash p \leadsto \Gamma'; \tau'
+  & \Gamma \vdash \tau' \equiv \tau
+}$$
+
+\subsection{Declaration Typing}
+
+We use an auxiliary judgment $\overline{y}; x; \Gamma \vdash \overline{dc} \leadsto \Gamma'$, expressing the enrichment of $\Gamma$ with the types of the datatype constructors $\overline{dc}$, when they are known to belong to datatype $x$ with type parameters $\overline{y}$.
+
+We presuppose the existence of a function $\mathcal O$, where $\mathcal O(M, \overline{s})$ implements the $\mt{open}$ declaration by producing a context with the appropriate entry for each available component of module $M$ with signature items $\overline{s}$.  Where possible, $\mathcal O$ uses ``transparent'' entries (e.g., an abstract type $M.x$ is mapped to $x :: \mt{Type} = M.x$), so that the relationship with $M$ is maintained.  A related function $\mathcal O_c$ builds a context containing the disjointness constraints found in $\overline s$.
+We write $\kappa_1^n \to \kappa$ as a shorthand, where $\kappa_1^0 \to \kappa = \kappa$ and $\kappa_1^{n+1} \to \kappa_2 = \kappa_1 \to (\kappa_1^n \to \kappa_2)$.  We write $\mt{len}(\overline{y})$ for the length of vector $\overline{y}$ of variables.
+
+$$\infer{\Gamma \vdash \cdot \leadsto \Gamma}{}
+\quad \infer{\Gamma \vdash d, \overline{d} \leadsto \Gamma''}{
+  \Gamma \vdash d \leadsto \Gamma'
+  & \Gamma' \vdash \overline{d} \leadsto \Gamma''
+}$$
+
+$$\infer{\Gamma \vdash \mt{con} \; x :: \kappa = c \leadsto \Gamma, x :: \kappa = c}{
+  \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash \mt{datatype} \; x \; \overline{y} = \overline{dc} \leadsto \Gamma'}{
+  \overline{y}; x; \Gamma, x :: \mt{Type}^{\mt{len}(\overline y)} \to \mt{Type} \vdash \overline{dc} \leadsto \Gamma'
+}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x = \mt{datatype} \; M.z \leadsto \Gamma'}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{datatype} \; z) = (\overline{y}, \overline{dc})
+  & \overline{y}; x; \Gamma, x :: \mt{Type}^{\mt{len}(\overline y)} \to \mt{Type} = M.z \vdash \overline{dc} \leadsto \Gamma'
+}$$
+
+$$\infer{\Gamma \vdash \mt{val} \; x : \tau = e \leadsto \Gamma, x : \tau}{
+  \Gamma \vdash e : \tau
+}$$
+
+$$\infer{\Gamma \vdash \mt{val} \; \mt{rec} \; \overline{x : \tau = e} \leadsto \Gamma, \overline{x : \tau}}{
+  \forall i: \Gamma, \overline{x : \tau} \vdash e_i : \tau_i
+  & \textrm{$e_i$ starts with an expression $\lambda$, optionally preceded by constructor and disjointness $\lambda$s}
+}$$
+
+$$\infer{\Gamma \vdash \mt{structure} \; X : S = M \leadsto \Gamma, X : S}{
+  \Gamma \vdash M : S
+  & \textrm{ $M$ not a constant or application}
+}
+\quad \infer{\Gamma \vdash \mt{structure} \; X : S = M \leadsto \Gamma, X : \mt{selfify}(X, \overline{s})}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash \mt{signature} \; X = S \leadsto \Gamma, X = S}{
+  \Gamma \vdash S
+}$$
+
+$$\infer{\Gamma \vdash \mt{open} \; M \leadsto \Gamma, \mathcal O(M, \overline{s})}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash \mt{constraint} \; c_1 \sim c_2 \leadsto \Gamma}{
+  \Gamma \vdash c_1 :: \{\kappa\}
+  & \Gamma \vdash c_2 :: \{\kappa\}
+  & \Gamma \vdash c_1 \sim c_2
+}
+\quad \infer{\Gamma \vdash \mt{open} \; \mt{constraints} \; M \leadsto \Gamma, \mathcal O_c(M, \overline{s})}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash \mt{table} \; x : c \leadsto \Gamma, x : \mt{Basis}.\mt{sql\_table} \; c \; []}{
+  \Gamma \vdash c :: \{\mt{Type}\}
+}
+\quad \infer{\Gamma \vdash \mt{view} \; x = e \leadsto \Gamma, x : \mt{Basis}.\mt{sql\_view} \; c}{
+  \Gamma \vdash e :: \mt{Basis}.\mt{sql\_query} \; [] \; [] \; (\mt{map} \; (\lambda \_ \Rightarrow []) \; c') \; c
+}$$
+
+$$\infer{\Gamma \vdash \mt{sequence} \; x \leadsto \Gamma, x : \mt{Basis}.\mt{sql\_sequence}}{}$$
+
+$$\infer{\Gamma \vdash \mt{cookie} \; x : \tau \leadsto \Gamma, x : \mt{Basis}.\mt{http\_cookie} \; \tau}{
+  \Gamma \vdash \tau :: \mt{Type}
+}
+\quad \infer{\Gamma \vdash \mt{style} \; x \leadsto \Gamma, x : \mt{Basis}.\mt{css\_class}}{}$$
+
+$$\infer{\Gamma \vdash \mt{task} \; e_1 = e_2 \leadsto \Gamma}{
+  \Gamma \vdash e_1 :: \mt{Basis}.\mt{task\_kind} \; \tau
+  & \Gamma \vdash e_2 :: \tau \to \mt{Basis}.\mt{transaction} \; \{\}
+}$$
+
+$$\infer{\overline{y}; x; \Gamma \vdash \cdot \leadsto \Gamma}{}
+\quad \infer{\overline{y}; x; \Gamma \vdash X \mid \overline{dc} \leadsto \Gamma', X : \overline{y ::: \mt{Type}} \to x \; \overline{y}}{
+  \overline{y}; x; \Gamma \vdash \overline{dc} \leadsto \Gamma'
+}
+\quad \infer{\overline{y}; x; \Gamma \vdash X \; \mt{of} \; \tau \mid \overline{dc} \leadsto \Gamma', X : \overline{y ::: \mt{Type}} \to \tau \to x \; \overline{y}}{
+  \overline{y}; x; \Gamma \vdash \overline{dc} \leadsto \Gamma'
+}$$
+
+\subsection{Signature Item Typing}
+
+We appeal to a signature item analogue of the $\mathcal O$ function from the last subsection.
+
+This is the first judgment where we deal with constructor classes, for the $\mt{class}$ forms.  We will omit their special handling in this formal specification.  Section \ref{typeclasses} gives an informal description of how constructor classes influence type inference.
+
+$$\infer{\Gamma \vdash \cdot \leadsto \Gamma}{}
+\quad \infer{\Gamma \vdash s, \overline{s} \leadsto \Gamma''}{
+  \Gamma \vdash s \leadsto \Gamma'
+  & \Gamma' \vdash \overline{s} \leadsto \Gamma''
+}$$
+
+$$\infer{\Gamma \vdash \mt{con} \; x :: \kappa \leadsto \Gamma, x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{con} \; x :: \kappa = c \leadsto \Gamma, x :: \kappa = c}{
+  \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash \mt{datatype} \; x \; \overline{y} = \overline{dc} \leadsto \Gamma'}{
+  \overline{y}; x; \Gamma, x :: \mt{Type}^{\mt{len}(\overline y)} \to \mt{Type} \vdash \overline{dc} \leadsto \Gamma'
+}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x = \mt{datatype} \; M.z \leadsto \Gamma'}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{datatype} \; z) = (\overline{y}, \overline{dc})
+  & \overline{y}; x; \Gamma, x :: \mt{Type}^{\mt{len}(\overline y)} \to \mt{Type} = M.z \vdash \overline{dc} \leadsto \Gamma'
+}$$
+
+$$\infer{\Gamma \vdash \mt{val} \; x : \tau \leadsto \Gamma, x : \tau}{
+  \Gamma \vdash \tau :: \mt{Type}
+}$$
+
+$$\infer{\Gamma \vdash \mt{structure} \; X : S \leadsto \Gamma, X : S}{
+  \Gamma \vdash S
+}
+\quad \infer{\Gamma \vdash \mt{signature} \; X = S \leadsto \Gamma, X = S}{
+  \Gamma \vdash S
+}$$
+
+$$\infer{\Gamma \vdash \mt{include} \; S \leadsto \Gamma, \mathcal O(\overline{s})}{
+  \Gamma \vdash S
+  & \Gamma \vdash S \equiv \mt{sig} \; \overline{s} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash \mt{constraint} \; c_1 \sim c_2 \leadsto \Gamma, c_1 \sim c_2}{
+  \Gamma \vdash c_1 :: \{\kappa\}
+  & \Gamma \vdash c_2 :: \{\kappa\}
+}$$
+
+$$\infer{\Gamma \vdash \mt{class} \; x :: \kappa = c \leadsto \Gamma, x :: \kappa = c}{
+  \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash \mt{class} \; x :: \kappa \leadsto \Gamma, x :: \kappa}{}$$
+
+\subsection{Signature Compatibility}
+
+To simplify the judgments in this section, we assume that all signatures are alpha-varied as necessary to avoid including multiple bindings for the same identifier.  This is in addition to the usual alpha-variation of locally bound variables.
+
+We rely on a judgment $\Gamma \vdash \overline{s} \leq s'$, which expresses the occurrence in signature items $\overline{s}$ of an item compatible with $s'$.  We also use a judgment $\Gamma \vdash \overline{dc} \leq \overline{dc}$, which expresses compatibility of datatype definitions.
+
+$$\infer{\Gamma \vdash S \equiv S}{}
+\quad \infer{\Gamma \vdash S_1 \equiv S_2}{
+  \Gamma \vdash S_2 \equiv S_1
+}
+\quad \infer{\Gamma \vdash X \equiv S}{
+  X = S \in \Gamma
+}
+\quad \infer{\Gamma \vdash M.X \equiv S}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{signature} \; X) = S
+}$$
+
+$$\infer{\Gamma \vdash S \; \mt{where} \; \mt{con} \; x = c \equiv \mt{sig} \; \overline{s^1} \; \mt{con} \; x :: \kappa = c \; \overline{s_2} \; \mt{end}}{
+  \Gamma \vdash S \equiv \mt{sig} \; \overline{s^1} \; \mt{con} \; x :: \kappa \; \overline{s_2} \; \mt{end}
+  & \Gamma \vdash c :: \kappa
+}
+\quad \infer{\Gamma \vdash \mt{sig} \; \overline{s^1} \; \mt{include} \; S \; \overline{s^2} \; \mt{end} \equiv \mt{sig} \; \overline{s^1} \; \overline{s} \; \overline{s^2} \; \mt{end}}{
+  \Gamma \vdash S \equiv \mt{sig} \; \overline{s} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash S_1 \leq S_2}{
+  \Gamma \vdash S_1 \equiv S_2
+}
+\quad \infer{\Gamma \vdash \mt{sig} \; \overline{s} \; \mt{end} \leq \mt{sig} \; \mt{end}}{}
+\quad \infer{\Gamma \vdash \mt{sig} \; \overline{s} \; \mt{end} \leq \mt{sig} \; s' \; \overline{s'} \; \mt{end}}{
+  \Gamma \vdash \overline{s} \leq s'
+  & \Gamma \vdash s' \leadsto \Gamma'
+  & \Gamma' \vdash \mt{sig} \; \overline{s} \; \mt{end} \leq \mt{sig} \; \overline{s'} \; \mt{end}
+}$$
+
+$$\infer{\Gamma \vdash s \; \overline{s} \leq s'}{
+  \Gamma \vdash s \leq s'
+}
+\quad \infer{\Gamma \vdash s \; \overline{s} \leq s'}{
+  \Gamma \vdash s \leadsto \Gamma'
+  & \Gamma' \vdash \overline{s} \leq s'
+}$$
+
+$$\infer{\Gamma \vdash \mt{functor} (X : S_1) : S_2 \leq \mt{functor} (X : S'_1) : S'_2}{
+  \Gamma \vdash S'_1 \leq S_1
+  & \Gamma, X : S'_1 \vdash S_2 \leq S'_2
+}$$
+
+$$\infer{\Gamma \vdash \mt{con} \; x :: \kappa \leq \mt{con} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{con} \; x :: \kappa = c \leq \mt{con} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{datatype} \; x \; \overline{y} = \overline{dc} \leq \mt{con} \; x :: \mt{Type}^{\mt{len}(\overline y)} \to \mt{Type}}{}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x = \mt{datatype} \; M.z \leq \mt{con} \; x :: \mt{Type}^{\mt{len}(y)} \to \mt{Type}}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{datatype} \; z) = (\overline{y}, \overline{dc})
+}$$
+
+$$\infer{\Gamma \vdash \mt{class} \; x :: \kappa \leq \mt{con} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{class} \; x :: \kappa = c \leq \mt{con} \; x :: \kappa}{}$$
+
+$$\infer{\Gamma \vdash \mt{con} \; x :: \kappa = c_1 \leq \mt{con} \; x :: \mt{\kappa} = c_2}{
+  \Gamma \vdash c_1 \equiv c_2
+}
+\quad \infer{\Gamma \vdash \mt{class} \; x :: \kappa = c_1 \leq \mt{con} \; x :: \kappa = c_2}{
+  \Gamma \vdash c_1 \equiv c_2
+}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x \; \overline{y} = \overline{dc} \leq \mt{datatype} \; x \; \overline{y} = \overline{dc'}}{
+  \Gamma, \overline{y :: \mt{Type}} \vdash \overline{dc} \leq \overline{dc'}
+}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x = \mt{datatype} \; M.z \leq \mt{datatype} \; x \; \overline{y} = \overline{dc'}}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{datatype} \; z) = (\overline{y}, \overline{dc})
+  & \Gamma, \overline{y :: \mt{Type}} \vdash \overline{dc} \leq \overline{dc'}
+}$$
+
+$$\infer{\Gamma \vdash \cdot \leq \cdot}{}
+\quad \infer{\Gamma \vdash X; \overline{dc} \leq X; \overline{dc'}}{
+  \Gamma \vdash \overline{dc} \leq \overline{dc'}
+}
+\quad \infer{\Gamma \vdash X \; \mt{of} \; \tau_1; \overline{dc} \leq X \; \mt{of} \; \tau_2; \overline{dc'}}{
+  \Gamma \vdash \tau_1 \equiv \tau_2
+  & \Gamma \vdash \overline{dc} \leq \overline{dc'}
+}$$
+
+$$\infer{\Gamma \vdash \mt{datatype} \; x = \mt{datatype} \; M.z \leq \mt{datatype} \; x = \mt{datatype} \; M'.z'}{
+  \Gamma \vdash M.z \equiv M'.z'
+}$$
+
+$$\infer{\Gamma \vdash \mt{val} \; x : \tau_1 \leq \mt{val} \; x : \tau_2}{
+  \Gamma \vdash \tau_1 \equiv \tau_2
+}
+\quad \infer{\Gamma \vdash \mt{structure} \; X : S_1 \leq \mt{structure} \; X : S_2}{
+  \Gamma \vdash S_1 \leq S_2
+}
+\quad \infer{\Gamma \vdash \mt{signature} \; X = S_1 \leq \mt{signature} \; X = S_2}{
+  \Gamma \vdash S_1 \leq S_2
+  & \Gamma \vdash S_2 \leq S_1
+}$$
+
+$$\infer{\Gamma \vdash \mt{constraint} \; c_1 \sim c_2 \leq \mt{constraint} \; c'_1 \sim c'_2}{
+  \Gamma \vdash c_1 \equiv c'_1
+  & \Gamma \vdash c_2 \equiv c'_2
+}$$
+
+$$\infer{\Gamma \vdash \mt{class} \; x :: \kappa \leq \mt{class} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{class} \; x :: \kappa = c \leq \mt{class} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{class} \; x :: \kappa = c_1 \leq \mt{class} \; x :: \kappa = c_2}{
+  \Gamma \vdash c_1 \equiv c_2
+}$$
+
+$$\infer{\Gamma \vdash \mt{con} \; x :: \kappa \leq \mt{class} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{con} \; x :: \kappa = c \leq \mt{class} \; x :: \kappa}{}
+\quad \infer{\Gamma \vdash \mt{con} \; x :: \kappa = c_1 \leq \mt{class} \; x :: \kappa = c_2}{
+  \Gamma \vdash c_1 \equiv c_2
+}$$
+
+\subsection{Module Typing}
+
+We use a helper function $\mt{sigOf}$, which converts declarations and sequences of declarations into their principal signature items and sequences of signature items, respectively.
+
+$$\infer{\Gamma \vdash M : S}{
+  \Gamma \vdash M : S'
+  & \Gamma \vdash S' \leq S
+}
+\quad \infer{\Gamma \vdash \mt{struct} \; \overline{d} \; \mt{end} : \mt{sig} \; \mt{sigOf}(\overline{d}) \; \mt{end}}{
+  \Gamma \vdash \overline{d} \leadsto \Gamma'
+}
+\quad \infer{\Gamma \vdash X : S}{
+  X : S \in \Gamma
+}$$
+
+$$\infer{\Gamma \vdash M.X : S}{
+  \Gamma \vdash M : \mt{sig} \; \overline{s} \; \mt{end}
+  & \mt{proj}(M, \overline{s}, \mt{structure} \; X) = S
+}$$
+
+$$\infer{\Gamma \vdash M_1(M_2) : [X \mapsto M_2]S_2}{
+  \Gamma \vdash M_1 : \mt{functor}(X : S_1) : S_2
+  & \Gamma \vdash M_2 : S_1
+}
+\quad \infer{\Gamma \vdash \mt{functor} (X : S_1) : S_2 = M : \mt{functor} (X : S_1) : S_2}{
+  \Gamma \vdash S_1
+  & \Gamma, X : S_1 \vdash S_2
+  & \Gamma, X : S_1 \vdash M : S_2
+}$$
+
+\begin{eqnarray*}
+  \mt{sigOf}(\cdot) &=& \cdot \\
+  \mt{sigOf}(s \; \overline{s'}) &=& \mt{sigOf}(s) \; \mt{sigOf}(\overline{s'}) \\
+  \\
+  \mt{sigOf}(\mt{con} \; x :: \kappa = c) &=& \mt{con} \; x :: \kappa = c \\
+  \mt{sigOf}(\mt{datatype} \; x \; \overline{y} = \overline{dc}) &=& \mt{datatype} \; x \; \overline{y} = \overline{dc} \\
+  \mt{sigOf}(\mt{datatype} \; x = \mt{datatype} \; M.z) &=& \mt{datatype} \; x = \mt{datatype} \; M.z \\
+  \mt{sigOf}(\mt{val} \; x : \tau = e) &=& \mt{val} \; x : \tau \\
+  \mt{sigOf}(\mt{val} \; \mt{rec} \; \overline{x : \tau = e}) &=& \overline{\mt{val} \; x : \tau} \\
+  \mt{sigOf}(\mt{structure} \; X : S = M) &=& \mt{structure} \; X : S \\
+  \mt{sigOf}(\mt{signature} \; X = S) &=& \mt{signature} \; X = S \\
+  \mt{sigOf}(\mt{open} \; M) &=& \mt{include} \; S \textrm{ (where $\Gamma \vdash M : S$)} \\
+  \mt{sigOf}(\mt{constraint} \; c_1 \sim c_2) &=& \mt{constraint} \; c_1 \sim c_2 \\
+  \mt{sigOf}(\mt{open} \; \mt{constraints} \; M) &=& \cdot \\
+  \mt{sigOf}(\mt{table} \; x : c) &=& \mt{table} \; x : c \\
+  \mt{sigOf}(\mt{view} \; x = e) &=& \mt{view} \; x : c \textrm{ (where $\Gamma \vdash e : \mt{Basis}.\mt{sql\_query} \; [] \; [] \; (\mt{map} \; (\lambda \_ \Rightarrow []) \; c') \; c$)} \\
+  \mt{sigOf}(\mt{sequence} \; x) &=& \mt{sequence} \; x \\
+  \mt{sigOf}(\mt{cookie} \; x : \tau) &=& \mt{cookie} \; x : \tau \\
+  \mt{sigOf}(\mt{style} \; x) &=& \mt{style} \; x
+\end{eqnarray*}
+\begin{eqnarray*}
+  \mt{selfify}(M, \cdot) &=& \cdot \\
+  \mt{selfify}(M, s \; \overline{s'}) &=& \mt{selfify}(M, s) \; \mt{selfify}(M, \overline{s'}) \\
+  \\
+  \mt{selfify}(M, \mt{con} \; x :: \kappa) &=& \mt{con} \; x :: \kappa = M.x \\
+  \mt{selfify}(M, \mt{con} \; x :: \kappa = c) &=& \mt{con} \; x :: \kappa = c \\
+  \mt{selfify}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc}) &=& \mt{datatype} \; x \; \overline{y} = \mt{datatype} \; M.x \\
+  \mt{selfify}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z) &=& \mt{datatype} \; x = \mt{datatype} \; M'.z \\
+  \mt{selfify}(M, \mt{val} \; x : \tau) &=& \mt{val} \; x : \tau \\
+  \mt{selfify}(M, \mt{structure} \; X : S) &=& \mt{structure} \; X : \mt{selfify}(M.X, \overline{s}) \textrm{ (where $\Gamma \vdash S \equiv \mt{sig} \; \overline{s} \; \mt{end}$)} \\
+  \mt{selfify}(M, \mt{signature} \; X = S) &=& \mt{signature} \; X = S \\
+  \mt{selfify}(M, \mt{include} \; S) &=& \mt{include} \; S \\
+  \mt{selfify}(M, \mt{constraint} \; c_1 \sim c_2) &=& \mt{constraint} \; c_1 \sim c_2 \\
+  \mt{selfify}(M, \mt{class} \; x :: \kappa) &=& \mt{class} \; x :: \kappa = M.x \\
+  \mt{selfify}(M, \mt{class} \; x :: \kappa = c) &=& \mt{class} \; x :: \kappa = c \\
+\end{eqnarray*}
+
+\subsection{Module Projection}
+
+\begin{eqnarray*}
+  \mt{proj}(M, \mt{con} \; x :: \kappa \; \overline{s}, \mt{con} \; x) &=& \kappa \\
+  \mt{proj}(M, \mt{con} \; x :: \kappa = c \; \overline{s}, \mt{con} \; x) &=& (\kappa, c) \\
+  \mt{proj}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc} \; \overline{s}, \mt{con} \; x) &=& \mt{Type}^{\mt{len}(\overline{y})} \to \mt{Type} \\
+  \mt{proj}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z \; \overline{s}, \mt{con} \; x) &=& (\mt{Type}^{\mt{len}(\overline{y})} \to \mt{Type}, M'.z) \textrm{ (where $\Gamma \vdash M' : \mt{sig} \; \overline{s'} \; \mt{end}$} \\
+  && \textrm{and $\mt{proj}(M', \overline{s'}, \mt{datatype} \; z) = (\overline{y}, \overline{dc})$)} \\
+  \mt{proj}(M, \mt{class} \; x :: \kappa \; \overline{s}, \mt{con} \; x) &=& \kappa \to \mt{Type} \\
+  \mt{proj}(M, \mt{class} \; x :: \kappa = c \; \overline{s}, \mt{con} \; x) &=& (\kappa \to \mt{Type}, c) \\
+  \\
+  \mt{proj}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc} \; \overline{s}, \mt{datatype} \; x) &=& (\overline{y}, \overline{dc}) \\
+  \mt{proj}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z \; \overline{s}, \mt{con} \; x) &=& \mt{proj}(M', \overline{s'}, \mt{datatype} \; z) \textrm{ (where $\Gamma \vdash M' : \mt{sig} \; \overline{s'} \; \mt{end}$)} \\
+  \\
+  \mt{proj}(M, \mt{val} \; x : \tau \; \overline{s}, \mt{val} \; x) &=& \tau \\
+  \mt{proj}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc} \; \overline{s}, \mt{val} \; X) &=& \overline{y ::: \mt{Type}} \to M.x \; \overline y \textrm{ (where $X \in \overline{dc}$)} \\
+  \mt{proj}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc} \; \overline{s}, \mt{val} \; X) &=& \overline{y ::: \mt{Type}} \to \tau \to M.x \; \overline y \textrm{ (where $X \; \mt{of} \; \tau \in \overline{dc}$)} \\
+  \mt{proj}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z, \mt{val} \; X) &=& \overline{y ::: \mt{Type}} \to M.x \; \overline y \textrm{ (where $\Gamma \vdash M' : \mt{sig} \; \overline{s'} \; \mt{end}$} \\
+  && \textrm{and $\mt{proj}(M', \overline{s'}, \mt{datatype} \; z = (\overline{y}, \overline{dc})$ and $X \in \overline{dc}$)} \\
+  \mt{proj}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z, \mt{val} \; X) &=& \overline{y ::: \mt{Type}} \to \tau \to M.x \; \overline y \textrm{ (where $\Gamma \vdash M' : \mt{sig} \; \overline{s'} \; \mt{end}$} \\
+  && \textrm{and $\mt{proj}(M', \overline{s'}, \mt{datatype} \; z = (\overline{y}, \overline{dc})$ and $X \; \mt{of} \; \tau \in \overline{dc}$)} \\
+  \\
+  \mt{proj}(M, \mt{structure} \; X : S \; \overline{s}, \mt{structure} \; X) &=& S \\
+  \\
+  \mt{proj}(M, \mt{signature} \; X = S \; \overline{s}, \mt{signature} \; X) &=& S \\
+  \\
+  \mt{proj}(M, \mt{con} \; x :: \kappa \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{con} \; x :: \kappa = c \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{datatype} \; x \; \overline{y} = \overline{dc} \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{datatype} \; x = \mt{datatype} \; M'.z \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{val} \; x : \tau \; \overline{s}, V) &=& \mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{structure} \; X : S \; \overline{s}, V) &=& [X \mapsto M.X]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{signature} \; X = S \; \overline{s}, V) &=& [X \mapsto M.X]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{include} \; S \; \overline{s}, V) &=& \mt{proj}(M, \overline{s'} \; \overline{s}, V) \textrm{ (where $\Gamma \vdash S \equiv \mt{sig} \; \overline{s'} \; \mt{end}$)} \\
+  \mt{proj}(M, \mt{constraint} \; c_1 \sim c_2 \; \overline{s}, V) &=& \mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{class} \; x :: \kappa \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+  \mt{proj}(M, \mt{class} \; x :: \kappa = c \; \overline{s}, V) &=& [x \mapsto M.x]\mt{proj}(M, \overline{s}, V) \\
+\end{eqnarray*}
+
+
+\section{Type Inference}
+
+The Ur/Web compiler uses \emph{heuristic type inference}, with no claims of completeness with respect to the declarative specification of the last section.  The rules in use seem to work well in practice.  This section summarizes those rules, to help Ur programmers predict what will work and what won't.
+
+\subsection{Basic Unification}
+
+Type-checkers for languages based on the Hindley-Milner type discipline, like ML and Haskell, take advantage of \emph{principal typing} properties, making complete type inference relatively straightforward.  Inference algorithms are traditionally implemented using type unification variables, at various points asserting equalities between types, in the process discovering the values of type variables.  The Ur/Web compiler uses the same basic strategy, but the complexity of the type system rules out easy completeness.
+
+Type-checking can require evaluating recursive functional programs, thanks to the type-level $\mt{map}$ operator.  When a unification variable appears in such a type, the next step of computation can be undetermined.  The value of that variable might be determined later, but this would be ``too late'' for the unification problems generated at the first occurrence.  This is the essential source of incompleteness.
+
+Nonetheless, the unification engine tends to do reasonably well.  Unlike in ML, polymorphism is never inferred in definitions; it must be indicated explicitly by writing out constructor-level parameters.  By writing these and other annotations, the programmer can generally get the type inference engine to do most of the type reconstruction work.
+
+\subsection{Unifying Record Types}
+
+The type inference engine tries to take advantage of the algebraic rules governing type-level records, as shown in Section \ref{definitional}.  When two constructors of record kind are unified, they are reduced to normal forms, with like terms crossed off from each normal form until, hopefully, nothing remains.  This cannot be complete, with the inclusion of unification variables.  The type-checker can help you understand what goes wrong when the process fails, as it outputs the unmatched remainders of the two normal forms.
+
+\subsection{\label{typeclasses}Constructor Classes}
+
+Ur includes a constructor class facility inspired by Haskell's.  The current version is experimental, with very general Prolog-like facilities that can lead to compile-time non-termination.
+
+Constructor classes are integrated with the module system.  A constructor class of kind $\kappa$ is just a constructor of kind $\kappa$.  By marking such a constructor $c$ as a constructor class, the programmer instructs the type inference engine to, in each scope, record all values of types $c \; c_1 \; \ldots \; c_n$ as \emph{instances}.  Any function argument whose type is of such a form is treated as implicit, to be determined by examining the current instance database.  Any suitably kinded constructor within a module may be exposed as a constructor class from outside the module, simply by using a $\mt{class}$ signature item instead of a $\mt{con}$ signature item in the module's signature.
+
+The ``dictionary encoding'' often used in Haskell implementations is made explicit in Ur.  Constructor class instances are just properly typed values, and they can also be considered as ``proofs'' of membership in the class.  In some cases, it is useful to pass these proofs around explicitly.  An underscore written where a proof is expected will also be inferred, if possible, from the current instance database.
+
+Just as for constructors, constructors classes may be exported from modules, and they may be exported as concrete or abstract.  Concrete constructor classes have their ``real'' definitions exposed, so that client code may add new instances freely.  Automatic inference of concrete class instances will not generally work, so abstract classes are almost always the right choice.  They are useful as ``predicates'' that can be used to enforce invariants, as we will see in some definitions of SQL syntax in the Ur/Web standard library.  Free extension of a concrete class is easily supported by exporting a constructor function from a module, since the class implementation will be concrete within the module.
+
+\subsection{Reverse-Engineering Record Types}
+
+It's useful to write Ur functions and functors that take record constructors as inputs, but these constructors can grow quite long, even though their values are often implied by other arguments.  The compiler uses a simple heuristic to infer the values of unification variables that are mapped over, yielding known results.  If the result is empty, we're done; if it's not empty, we replace a single unification variable with a new constructor formed from three new unification variables, as in $[\alpha = \beta] \rc \gamma$.  This process can often be repeated to determine a unification variable fully.
+
+\subsection{Implicit Arguments in Functor Applications}
+
+Constructor, constraint, and constructor class witness members of structures may be omitted, when those structures are used in contexts where their assigned signatures imply how to fill in those missing members.  This feature combines well with reverse-engineering to allow for uses of complicated meta-programming functors with little more code than would be necessary to invoke an untyped, ad-hoc code generator.
+
+
+\section{The Ur Standard Library}
+
+The built-in parts of the Ur/Web standard library are described by the signature in \texttt{lib/basis.urs} in the distribution.  A module $\mt{Basis}$ ascribing to that signature is available in the initial environment, and every program is implicitly prefixed by $\mt{open} \; \mt{Basis}$.
+
+Additionally, other common functions that are definable within Ur are included in \texttt{lib/top.urs} and \texttt{lib/top.ur}.  This $\mt{Top}$ module is also opened implicitly.
+
+The idea behind Ur is to serve as the ideal host for embedded domain-specific languages.  For now, however, the ``generic'' functionality is intermixed with Ur/Web-specific functionality, including in these two library modules.  We hope that these generic library components have types that speak for themselves.  The next section introduces the Ur/Web-specific elements.  Here, we only give the type declarations from the beginning of $\mt{Basis}$.
+$$\begin{array}{l}
+  \mt{type} \; \mt{int} \\
+  \mt{type} \; \mt{float} \\
+  \mt{type} \; \mt{char} \\
+  \mt{type} \; \mt{string} \\
+  \mt{type} \; \mt{time} \\
+  \mt{type} \; \mt{blob} \\
+  \\
+  \mt{type} \; \mt{unit} = \{\} \\
+  \\
+  \mt{datatype} \; \mt{bool} = \mt{False} \mid \mt{True} \\
+  \\
+  \mt{datatype} \; \mt{option} \; \mt{t} = \mt{None} \mid \mt{Some} \; \mt{of} \; \mt{t} \\
+  \\
+  \mt{datatype} \; \mt{list} \; \mt{t} = \mt{Nil} \mid \mt{Cons} \; \mt{of} \; \mt{t} \times \mt{list} \; \mt{t}
+\end{array}$$
+
+The only unusual element of this list is the $\mt{blob}$ type, which stands for binary sequences.  Simple blobs can be created from strings via $\mt{Basis.textBlob}$.  Blobs will also be generated from HTTP file uploads.
+
+Ur also supports \emph{polymorphic variants}, a dual to extensible records that has been popularized by OCaml.  A type $\mt{variant} \; r$ represents an $n$-ary sum type, with one constructor for each field of record $r$.  Each constructor $c$ takes an argument of type $r.c$; the type $\{\}$ can be used to ``simulate'' a nullary constructor.  The \cd{make} function builds a variant value, while \cd{match} implements pattern-matching, with match cases represented as records of functions.
+$$\begin{array}{l}
+  \mt{con} \; \mt{variant} :: \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{make} : \mt{nm} :: \mt{Name} \to \mt{t} ::: \mt{Type} \to \mt{ts} ::: \{\mt{Type}\} \to [[\mt{nm}] \sim \mt{ts}] \Rightarrow \mt{t} \to \mt{variant} \; ([\mt{nm} = \mt{t}] \rc \mt{ts}) \\
+  \mt{val} \; \mt{match} : \mt{ts} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \to \mt{variant} \; \mt{ts} \to \$(\mt{map} \; (\lambda \mt{t'} \Rightarrow \mt{t'} \to \mt{t}) \; \mt{ts}) \to \mt{t}
+\end{array}$$
+
+Another important generic Ur element comes at the beginning of \texttt{top.urs}.
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{folder} :: \mt{K} \longrightarrow \{\mt{K}\} \to \mt{Type} \\
+  \\
+  \mt{val} \; \mt{fold} : \mt{K} \longrightarrow \mt{tf} :: (\{\mt{K}\} \to \mt{Type}) \\
+  \hspace{.1in} \to (\mt{nm} :: \mt{Name} \to \mt{v} :: \mt{K} \to \mt{r} :: \{\mt{K}\} \to [[\mt{nm}] \sim \mt{r}] \Rightarrow \\
+  \hspace{.2in} \mt{tf} \; \mt{r} \to \mt{tf} \; ([\mt{nm} = \mt{v}] \rc \mt{r})) \\
+  \hspace{.1in} \to \mt{tf} \; [] \\
+  \hspace{.1in} \to \mt{r} ::: \{\mt{K}\} \to \mt{folder} \; \mt{r} \to \mt{tf} \; \mt{r}
+\end{array}$$
+
+For a type-level record $\mt{r}$, a $\mt{folder} \; \mt{r}$ encodes a permutation of $\mt{r}$'s elements.  The $\mt{fold}$ function can be called on a $\mt{folder}$ to iterate over the elements of $\mt{r}$ in that order.  $\mt{fold}$ is parameterized on a type-level function to be used to calculate the type of each intermediate result of folding.  After processing a subset $\mt{r'}$ of $\mt{r}$'s entries, the type of the accumulator should be $\mt{tf} \; \mt{r'}$.  The next two expression arguments to $\mt{fold}$ are the usual step function and initial accumulator, familiar from fold functions over lists.  The final two arguments are the record to fold over and a $\mt{folder}$ for it.
+
+The Ur compiler treats $\mt{folder}$ like a constructor class, using built-in rules to infer $\mt{folder}$s for records with known structure.  The order in which field names are mentioned in source code is used as a hint about the permutation that the programmer would like.
+
+
+\section{The Ur/Web Standard Library}
+
+Some operations are only allowed in server-side code or only in client-side code.  The type system does not enforce such restrictions, but the compiler enforces them in the process of whole-program compilation.  In the discussion below, we note when a set of operations has a location restriction.
+
+\subsection{Monads}
+
+The Ur Basis defines the monad constructor class from Haskell.
+
+$$\begin{array}{l}
+  \mt{class} \; \mt{monad} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{return} : \mt{m} ::: (\mt{Type} \to \mt{Type}) \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{monad} \; \mt{m} \\
+  \hspace{.1in} \to \mt{t} \to \mt{m} \; \mt{t} \\
+  \mt{val} \; \mt{bind} : \mt{m} ::: (\mt{Type} \to \mt{Type}) \to \mt{t1} ::: \mt{Type} \to \mt{t2} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{monad} \; \mt{m} \\
+  \hspace{.1in} \to \mt{m} \; \mt{t1} \to (\mt{t1} \to \mt{m} \; \mt{t2}) \\
+  \hspace{.1in} \to \mt{m} \; \mt{t2} \\
+  \mt{val} \; \mt{mkMonad} : \mt{m} ::: (\mt{Type} \to \mt{Type}) \\
+  \hspace{.1in} \to \{\mt{Return} : \mt{t} ::: \mt{Type} \to \mt{t} \to \mt{m} \; \mt{t}, \\
+  \hspace{.3in} \mt{Bind} : \mt{t1} ::: \mt{Type} \to \mt{t2} ::: \mt{Type} \to \mt{m} \; \mt{t1} \to (\mt{t1} \to \mt{m} \; \mt{t2}) \to \mt{m} \; \mt{t2}\} \\
+  \hspace{.1in} \to \mt{monad} \; \mt{m}
+\end{array}$$
+
+The Ur/Web compiler provides syntactic sugar for monads, similar to Haskell's \cd{do} notation.  An expression $x \leftarrow e_1; e_2$ is desugared to $\mt{bind} \; e_1 \; (\lambda x \Rightarrow e_2)$, and an expression $e_1; e_2$ is desugared to $\mt{bind} \; e_1 \; (\lambda () \Rightarrow e_2)$.  Note a difference from Haskell: as the $e_1; e_2$ case desugaring involves a function with $()$ as its formal argument, the type of $e_1$ must be of the form $m \; \{\}$, rather than some arbitrary $m \; t$.
+
+The syntactic sugar also allows $p \leftarrow e_1; e_2$ for $p$ a pattern.  The pattern should be guaranteed to match any value of the corresponding type, or there will be a compile-time error.
+
+\subsection{Transactions}
+
+Ur is a pure language; we use Haskell's trick to support controlled side effects.  The standard library defines a monad $\mt{transaction}$, meant to stand for actions that may be undone cleanly.  By design, no other kinds of actions are supported.
+$$\begin{array}{l}
+  \mt{con} \; \mt{transaction} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{transaction\_monad} : \mt{monad} \; \mt{transaction}
+\end{array}$$
+
+For debugging purposes, a transactional function is provided for outputting a string on the server process' \texttt{stderr}.
+$$\begin{array}{l}
+  \mt{val} \; \mt{debug} : \mt{string} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+\subsection{HTTP}
+
+There are transactions for reading an HTTP header by name and for getting and setting strongly typed cookies.  Cookies may only be created by the $\mt{cookie}$ declaration form, ensuring that they be named consistently based on module structure.  For now, cookie operations are server-side only.
+$$\begin{array}{l}
+  \mt{con} \; \mt{http\_cookie} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{getCookie} : \mt{t} ::: \mt{Type} \to \mt{http\_cookie} \; \mt{t} \to \mt{transaction} \; (\mt{option} \; \mt{t}) \\
+  \mt{val} \; \mt{setCookie} : \mt{t} ::: \mt{Type} \to \mt{http\_cookie} \; \mt{t} \to \{\mt{Value} : \mt{t}, \mt{Expires} : \mt{option} \; \mt{time}, \mt{Secure} : \mt{bool}\} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{clearCookie} : \mt{t} ::: \mt{Type} \to \mt{http\_cookie} \; \mt{t} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+There are also an abstract $\mt{url}$ type and functions for converting to it, based on the policy defined by \texttt{[allow|deny] url} directives in the project file.
+$$\begin{array}{l}
+  \mt{type} \; \mt{url} \\
+  \mt{val} \; \mt{bless} : \mt{string} \to \mt{url} \\
+  \mt{val} \; \mt{checkUrl} : \mt{string} \to \mt{option} \; \mt{url}
+\end{array}$$
+$\mt{bless}$ raises a runtime error if the string passed to it fails the URL policy.
+
+It is possible to grab the current page's URL or to build a URL for an arbitrary transaction that would also be an acceptable value of a \texttt{link} attribute of the \texttt{a} tag.  These are server-side operations.
+$$\begin{array}{l}
+  \mt{val} \; \mt{currentUrl} : \mt{transaction} \; \mt{url} \\
+  \mt{val} \; \mt{url} : \mt{transaction} \; \mt{page} \to \mt{url}
+\end{array}$$
+
+Page generation may be interrupted at any time with a request to redirect to a particular URL instead.
+$$\begin{array}{l}
+  \mt{val} \; \mt{redirect} : \mt{t} ::: \mt{Type} \to \mt{url} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+It's possible for pages to return files of arbitrary MIME types.  A file can be input from the user using this data type, along with the $\mt{upload}$ form tag.  These functions and those described in the following paragraph are server-side.
+$$\begin{array}{l}
+  \mt{type} \; \mt{file} \\
+  \mt{val} \; \mt{fileName} : \mt{file} \to \mt{option} \; \mt{string} \\
+  \mt{val} \; \mt{fileMimeType} : \mt{file} \to \mt{string} \\
+  \mt{val} \; \mt{fileData} : \mt{file} \to \mt{blob}
+\end{array}$$
+
+It is also possible to get HTTP request headers and environment variables, and set HTTP response headers, using abstract types similar to the one for URLs.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{requestHeader} \\
+  \mt{val} \; \mt{blessRequestHeader} : \mt{string} \to \mt{requestHeader} \\
+  \mt{val} \; \mt{checkRequestHeader} : \mt{string} \to \mt{option} \; \mt{requestHeader} \\
+  \mt{val} \; \mt{getHeader} : \mt{requestHeader} \to \mt{transaction} \; (\mt{option} \; \mt{string}) \\
+  \\
+  \mt{type} \; \mt{envVar} \\
+  \mt{val} \; \mt{blessEnvVar} : \mt{string} \to \mt{envVar} \\
+  \mt{val} \; \mt{checkEnvVar} : \mt{string} \to \mt{option} \; \mt{envVar} \\
+  \mt{val} \; \mt{getenv} : \mt{envVar} \to \mt{transaction} \; (\mt{option} \; \mt{string}) \\
+  \\
+  \mt{type} \; \mt{responseHeader} \\
+  \mt{val} \; \mt{blessResponseHeader} : \mt{string} \to \mt{responseHeader} \\
+  \mt{val} \; \mt{checkResponseHeader} : \mt{string} \to \mt{option} \; \mt{responseHeader} \\
+  \mt{val} \; \mt{setHeader} : \mt{responseHeader} \to \mt{string} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+A blob can be extracted from a file and returned as the page result.  There are bless and check functions for MIME types analogous to those for URLs.
+$$\begin{array}{l}
+  \mt{type} \; \mt{mimeType} \\
+  \mt{val} \; \mt{blessMime} : \mt{string} \to \mt{mimeType} \\
+  \mt{val} \; \mt{checkMime} : \mt{string} \to \mt{option} \; \mt{mimeType} \\
+  \mt{val} \; \mt{returnBlob} : \mt{t} ::: \mt{Type} \to \mt{blob} \to \mt{mimeType} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+
+\subsection{SQL}
+
+Everything about SQL database access is restricted to server-side code.
+
+The fundamental unit of interest in the embedding of SQL is tables, described by a type family and creatable only via the $\mt{table}$ declaration form.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_table} :: \{\mt{Type}\} \to \{\{\mt{Unit}\}\} \to \mt{Type}
+\end{array}$$
+The first argument to this constructor gives the names and types of a table's columns, and the second argument gives the set of valid keys.  Keys are the only subsets of the columns that may be referenced as foreign keys.  Each key has a name.
+
+We also have the simpler type family of SQL views, which have no keys.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_view} :: \{\mt{Type}\} \to \mt{Type}
+\end{array}$$
+
+A multi-parameter type class is used to allow tables and views to be used interchangeably, with a way of extracting the set of columns from each.
+$$\begin{array}{l}
+  \mt{class} \; \mt{fieldsOf} :: \mt{Type} \to \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{fieldsOf\_table} : \mt{fs} ::: \{\mt{Type}\} \to \mt{keys} ::: \{\{\mt{Unit}\}\} \to \mt{fieldsOf} \; (\mt{sql\_table} \; \mt{fs} \; \mt{keys}) \; \mt{fs} \\
+  \mt{val} \; \mt{fieldsOf\_view} : \mt{fs} ::: \{\mt{Type}\} \to \mt{fieldsOf} \; (\mt{sql\_view} \; \mt{fs}) \; \mt{fs}
+\end{array}$$
+
+\subsubsection{Table Constraints}
+
+Tables may be declared with constraints, such that database modifications that violate the constraints are blocked.  A table may have at most one \texttt{PRIMARY KEY} constraint, which gives the subset of columns that will most often be used to look up individual rows in the table.
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{primary\_key} :: \{\mt{Type}\} \to \{\{\mt{Unit}\}\} \to \mt{Type} \\
+  \mt{val} \; \mt{no\_primary\_key} : \mt{fs} ::: \{\mt{Type}\} \to \mt{primary\_key} \; \mt{fs} \; [] \\
+  \mt{val} \; \mt{primary\_key} : \mt{rest} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \to \mt{key1} :: \mt{Name} \to \mt{keys} :: \{\mt{Type}\} \\
+  \hspace{.1in} \to [[\mt{key1}] \sim \mt{keys}] \Rightarrow [[\mt{key1} = \mt{t}] \rc \mt{keys} \sim \mt{rest}] \\
+  \hspace{.1in} \Rightarrow \$([\mt{key1} = \mt{sql\_injectable\_prim} \; \mt{t}] \rc \mt{map} \; \mt{sql\_injectable\_prim} \; \mt{keys}) \\
+  \hspace{.1in} \to \mt{primary\_key} \; ([\mt{key1} = \mt{t}] \rc \mt{keys} \rc \mt{rest}) \; [\mt{Pkey} = [\mt{key1}] \rc \mt{map} \; (\lambda \_ \Rightarrow ()) \; \mt{keys}]
+\end{array}$$
+The type class $\mt{sql\_injectable\_prim}$ characterizes which types are allowed in SQL and are not $\mt{option}$ types.  In SQL, a \texttt{PRIMARY KEY} constraint enforces after-the-fact that a column may not contain \texttt{NULL}s, but Ur/Web forces that information to be included in table types from the beginning.  Thus, the only effect of this kind of constraint in Ur/Web is to enforce uniqueness of the given key within the table.
+
+A type family stands for sets of named constraints of the remaining varieties.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_constraints} :: \{\mt{Type}\} \to \{\{\mt{Unit}\}\} \to \mt{Type}
+\end{array}$$
+The first argument gives the column types of the table being constrained, and the second argument maps constraint names to the keys that they define.  Constraints that don't define keys are mapped to ``empty keys.''
+
+There is a type family of individual, unnamed constraints.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_constraint} :: \{\mt{Type}\} \to \{\mt{Unit}\} \to \mt{Type}
+\end{array}$$
+The first argument is the same as above, and the second argument gives the key columns for just this constraint.
+
+We have operations for assembling constraints into constraint sets.
+$$\begin{array}{l}
+  \mt{val} \; \mt{no\_constraint} : \mt{fs} ::: \{\mt{Type}\} \to \mt{sql\_constraints} \; \mt{fs} \; [] \\
+  \mt{val} \; \mt{one\_constraint} : \mt{fs} ::: \{\mt{Type}\} \to \mt{unique} ::: \{\mt{Unit}\} \to \mt{name} :: \mt{Name} \\
+  \hspace{.1in} \to \mt{sql\_constraint} \; \mt{fs} \; \mt{unique} \to \mt{sql\_constraints} \; \mt{fs} \; [\mt{name} = \mt{unique}] \\
+  \mt{val} \; \mt{join\_constraints} : \mt{fs} ::: \{\mt{Type}\} \to \mt{uniques1} ::: \{\{\mt{Unit}\}\} \to \mt{uniques2} ::: \{\{\mt{Unit}\}\} \to [\mt{uniques1} \sim \mt{uniques2}] \\
+  \hspace{.1in} \Rightarrow \mt{sql\_constraints} \; \mt{fs} \; \mt{uniques1} \to \mt{sql\_constraints} \; \mt{fs} \; \mt{uniques2} \to \mt{sql\_constraints} \; \mt{fs} \; (\mt{uniques1} \rc \mt{uniques2})
+\end{array}$$
+
+A \texttt{UNIQUE} constraint forces a set of columns to be a key, which means that no combination of column values may occur more than once in the table.  The $\mt{unique1}$ and $\mt{unique}$ arguments are separated out only to ensure that empty \texttt{UNIQUE} constraints are rejected.
+$$\begin{array}{l}
+  \mt{val} \; \mt{unique} : \mt{rest} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \to \mt{unique1} :: \mt{Name} \to \mt{unique} :: \{\mt{Type}\} \\
+  \hspace{.1in} \to [[\mt{unique1}] \sim \mt{unique}] \Rightarrow [[\mt{unique1} = \mt{t}] \rc \mt{unique} \sim \mt{rest}] \\
+  \hspace{.1in} \Rightarrow \mt{sql\_constraint} \; ([\mt{unique1} = \mt{t}] \rc \mt{unique} \rc \mt{rest}) \; ([\mt{unique1}] \rc \mt{map} \; (\lambda \_ \Rightarrow ()) \; \mt{unique})
+\end{array}$$
+
+A \texttt{FOREIGN KEY} constraint connects a set of local columns to a local or remote key, enforcing that the local columns always reference an existent row of the foreign key's table.  A local column of type $\mt{t}$ may be linked to a foreign column of type $\mt{option} \; \mt{t}$, and vice versa.  We formalize that notion with a type class.
+$$\begin{array}{l}
+  \mt{class} \; \mt{linkable} :: \mt{Type} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{linkable\_same} : \mt{t} ::: \mt{Type} \to \mt{linkable} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{linkable\_from\_nullable} : \mt{t} ::: \mt{Type} \to \mt{linkable} \; (\mt{option} \; \mt{t}) \; \mt{t} \\
+  \mt{val} \; \mt{linkable\_to\_nullable} : \mt{t} ::: \mt{Type} \to \mt{linkable} \; \mt{t} \; (\mt{option} \; \mt{t})
+\end{array}$$
+
+The $\mt{matching}$ type family uses $\mt{linkable}$ to define when two keys match up type-wise.
+$$\begin{array}{l}
+  \mt{con} \; \mt{matching} :: \{\mt{Type}\} \to \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{mat\_nil} : \mt{matching} \; [] \; [] \\
+  \mt{val} \; \mt{mat\_cons} : \mt{t1} ::: \mt{Type} \to \mt{rest1} ::: \{\mt{Type}\} \to \mt{t2} ::: \mt{Type} \to \mt{rest2} ::: \{\mt{Type}\} \to \mt{nm1} :: \mt{Name} \to \mt{nm2} :: \mt{Name} \\
+  \hspace{.1in} \to [[\mt{nm1}] \sim \mt{rest1}] \Rightarrow [[\mt{nm2}] \sim \mt{rest2}] \Rightarrow \mt{linkable} \; \mt{t1} \; \mt{t2} \to \mt{matching} \; \mt{rest1} \; \mt{rest2} \\
+  \hspace{.1in} \to \mt{matching} \; ([\mt{nm1} = \mt{t1}] \rc \mt{rest1}) \; ([\mt{nm2} = \mt{t2}] \rc \mt{rest2})
+\end{array}$$
+
+SQL provides a number of different propagation modes for \texttt{FOREIGN KEY} constraints, governing what happens when a row containing a still-referenced foreign key value is deleted or modified to have a different key value.  The argument of a propagation mode's type gives the local key type.
+$$\begin{array}{l}
+  \mt{con} \; \mt{propagation\_mode} :: \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{restrict} : \mt{fs} ::: \{\mt{Type}\} \to \mt{propagation\_mode} \; \mt{fs} \\
+  \mt{val} \; \mt{cascade} : \mt{fs} ::: \{\mt{Type}\} \to \mt{propagation\_mode} \; \mt{fs} \\
+  \mt{val} \; \mt{no\_action} : \mt{fs} ::: \{\mt{Type}\} \to \mt{propagation\_mode} \; \mt{fs} \\
+  \mt{val} \; \mt{set\_null} : \mt{fs} ::: \{\mt{Type}\} \to \mt{propagation\_mode} \; (\mt{map} \; \mt{option} \; \mt{fs})
+\end{array}$$
+
+Finally, we put these ingredient together to define the \texttt{FOREIGN KEY} constraint function.
+$$\begin{array}{l}
+  \mt{val} \; \mt{foreign\_key} : \mt{mine1} ::: \mt{Name} \to \mt{t} ::: \mt{Type} \to \mt{mine} ::: \{\mt{Type}\} \to \mt{munused} ::: \{\mt{Type}\} \to \mt{foreign} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{funused} ::: \{\mt{Type}\} \to \mt{nm} ::: \mt{Name} \to \mt{uniques} ::: \{\{\mt{Unit}\}\} \\
+  \hspace{.1in} \to [[\mt{mine1}] \sim \mt{mine}] \Rightarrow [[\mt{mine1} = \mt{t}] \rc \mt{mine} \sim \mt{munused}] \Rightarrow [\mt{foreign} \sim \mt{funused}] \Rightarrow [[\mt{nm}] \sim \mt{uniques}] \\
+  \hspace{.1in} \Rightarrow \mt{matching} \; ([\mt{mine1} = \mt{t}] \rc \mt{mine}) \; \mt{foreign} \\
+  \hspace{.1in} \to \mt{sql\_table} \; (\mt{foreign} \rc \mt{funused}) \; ([\mt{nm} = \mt{map} \; (\lambda \_ \Rightarrow ()) \; \mt{foreign}] \rc \mt{uniques}) \\
+  \hspace{.1in} \to \{\mt{OnDelete} : \mt{propagation\_mode} \; ([\mt{mine1} = \mt{t}] \rc \mt{mine}), \\
+  \hspace{.2in} \mt{OnUpdate} : \mt{propagation\_mode} \; ([\mt{mine1} = \mt{t}] \rc \mt{mine})\} \\
+  \hspace{.1in} \to \mt{sql\_constraint} \; ([\mt{mine1} = \mt{t}] \rc \mt{mine} \rc \mt{munused}) \; []
+\end{array}$$
+
+The last kind of constraint is a \texttt{CHECK} constraint, which attaches a boolean invariant over a row's contents.  It is defined using the $\mt{sql\_exp}$ type family, which we discuss in more detail below.
+$$\begin{array}{l}
+  \mt{val} \; \mt{check} : \mt{fs} ::: \{\mt{Type}\} \to \mt{sql\_exp} \; [] \; [] \; \mt{fs} \; \mt{bool} \to \mt{sql\_constraint} \; \mt{fs} \; []
+\end{array}$$
+
+Section \ref{tables} shows the expanded syntax of the $\mt{table}$ declaration and signature item that includes constraints.  There is no other way to use constraints with SQL in Ur/Web.
+
+
+\subsubsection{Queries}
+
+A final query is constructed via the $\mt{sql\_query}$ function.  Constructor arguments respectively specify the unrestricted free table variables (which will only be available in subqueries), the free table variables that may only be mentioned within arguments to aggregate functions, table fields we select (as records mapping tables to the subsets of their fields that we choose), and the (always named) extra expressions that we select.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_query} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_query} : \mt{free} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{afree} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{tables} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedFields} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedExps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to [\mt{free} \sim \mt{tables}] \\
+  \hspace{.1in} \Rightarrow \{\mt{Rows} : \mt{sql\_query1} \; \mt{free} \; \mt{afree} \; \mt{tables} \; \mt{selectedFields} \; \mt{selectedExps}, \\
+  \hspace{.2in} \mt{OrderBy} : \mt{sql\_order\_by} \; (\mt{free} \rc \mt{tables}) \; \mt{selectedExps}, \\
+  \hspace{.2in} \mt{Limit} : \mt{sql\_limit}, \\
+  \hspace{.2in} \mt{Offset} : \mt{sql\_offset}\} \\
+  \hspace{.1in} \to \mt{sql\_query} \; \mt{free} \; \mt{afree} \; \mt{selectedFields} \; \mt{selectedExps}
+\end{array}$$
+
+Queries are used by folding over their results inside transactions.
+$$\begin{array}{l}
+  \mt{val} \; \mt{query} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to [\mt{tables} \sim \mt{exps}] \Rightarrow \mt{state} ::: \mt{Type} \to \mt{sql\_query} \; [] \; [] \; \mt{tables} \; \mt{exps} \\
+  \hspace{.1in} \to (\$(\mt{exps} \rc \mt{map} \; (\lambda \mt{fields} :: \{\mt{Type}\} \Rightarrow \$\mt{fields}) \; \mt{tables}) \\
+  \hspace{.2in} \to \mt{state} \to \mt{transaction} \; \mt{state}) \\
+  \hspace{.1in} \to \mt{state} \to \mt{transaction} \; \mt{state}
+\end{array}$$
+
+Most of the complexity of the query encoding is in the type $\mt{sql\_query1}$, which includes simple queries and derived queries based on relational operators.  Constructor arguments respectively specify the unrestricted free table veriables, the aggregate-only free table variables, the tables we select from, the subset of fields that we keep from each table for the result rows, and the extra expressions that we select.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_query1} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \\
+  \\
+  \mt{type} \; \mt{sql\_relop} \\
+  \mt{val} \; \mt{sql\_union} : \mt{sql\_relop} \\
+  \mt{val} \; \mt{sql\_intersect} : \mt{sql\_relop} \\
+  \mt{val} \; \mt{sql\_except} : \mt{sql\_relop} \\
+  \mt{val} \; \mt{sql\_relop} : \mt{free} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{afree} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{tables1} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{tables2} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedFields} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedExps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{sql\_relop} \\
+  \hspace{.1in} \to \mt{bool} \; (* \; \mt{ALL} \; *) \\
+  \hspace{.1in} \to \mt{sql\_query1} \; \mt{free} \; \mt{afree} \; \mt{tables1} \; \mt{selectedFields} \; \mt{selectedExps} \\
+  \hspace{.1in} \to \mt{sql\_query1} \; \mt{free} \; \mt{afree} \; \mt{tables2} \; \mt{selectedFields} \; \mt{selectedExps} \\
+  \hspace{.1in} \to \mt{sql\_query1} \; \mt{free} \; \mt{afree} \; \mt{selectedFields} \; \mt{selectedFields} \; \mt{selectedExps}
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_query1} : \mt{free} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{afree} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{tables} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{grouped} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedFields} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{selectedExps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{empties} :: \{\mt{Unit}\} \\
+  \hspace{.1in} \to [\mt{free} \sim \mt{tables}] \\
+  \hspace{.1in} \Rightarrow [\mt{free} \sim \mt{grouped}] \\
+  \hspace{.1in} \Rightarrow [\mt{afree} \sim \mt{tables}] \\
+  \hspace{.1in} \Rightarrow [\mt{empties} \sim \mt{selectedFields}] \\
+  \hspace{.1in} \Rightarrow \{\mt{Distinct} : \mt{bool}, \\
+  \hspace{.2in} \mt{From} : \mt{sql\_from\_items} \; \mt{free} \; \mt{tables}, \\
+  \hspace{.2in} \mt{Where} : \mt{sql\_exp} \; (\mt{free} \rc \mt{tables}) \; \mt{afree} \; [] \; \mt{bool}, \\
+  \hspace{.2in} \mt{GroupBy} : \mt{sql\_subset} \; \mt{tables} \; \mt{grouped}, \\
+  \hspace{.2in} \mt{Having} : \mt{sql\_exp} \; (\mt{free} \rc \mt{grouped}) \; (\mt{afree} \rc \mt{tables}) \; [] \; \mt{bool}, \\
+  \hspace{.2in} \mt{SelectFields} : \mt{sql\_subset} \; \mt{grouped} \; (\mt{map} \; (\lambda \_ \Rightarrow []) \; \mt{empties} \rc \mt{selectedFields}), \\
+  \hspace{.2in} \mt {SelectExps} : \$(\mt{map} \; (\mt{sql\_expw} \; (\mt{free} \rc \mt{grouped}) \; (\mt{afree} \rc \mt{tables}) \; []) \; \mt{selectedExps}) \} \\
+  \hspace{.1in} \to \mt{sql\_query1} \; \mt{free} \; \mt{afree} \; \mt{tables} \; \mt{selectedFields} \; \mt{selectedExps}
+\end{array}$$
+
+To encode projection of subsets of fields in $\mt{SELECT}$ clauses, and to encode $\mt{GROUP} \; \mt{BY}$ clauses, we rely on a type family $\mt{sql\_subset}$, capturing what it means for one record of table fields to be a subset of another.  The main constructor $\mt{sql\_subset}$ ``proves subset facts'' by requiring a split of a record into kept and dropped parts.  The extra constructor $\mt{sql\_subset\_all}$ is a convenience for keeping all fields of a record.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_subset} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_subset} : \mt{keep\_drop} :: \{(\{\mt{Type}\} \times \{\mt{Type}\})\} \\
+  \hspace{.1in} \to \mt{sql\_subset} \\
+  \hspace{.2in} (\mt{map} \; (\lambda \mt{fields} :: (\{\mt{Type}\} \times \{\mt{Type}\}) \Rightarrow \mt{fields}.1 \rc \mt{fields}.2)\; \mt{keep\_drop}) \\
+  \hspace{.2in} (\mt{map} \; (\lambda \mt{fields} :: (\{\mt{Type}\} \times \{\mt{Type}\}) \Rightarrow \mt{fields}.1) \; \mt{keep\_drop}) \\
+\mt{val} \; \mt{sql\_subset\_all} : \mt{tables} :: \{\{\mt{Type}\}\} \to \mt{sql\_subset} \; \mt{tables} \; \mt{tables}
+\end{array}$$
+
+SQL expressions are used in several places, including $\mt{SELECT}$, $\mt{WHERE}$, $\mt{HAVING}$, and $\mt{ORDER} \; \mt{BY}$ clauses.  They reify a fragment of the standard SQL expression language, while making it possible to inject ``native'' Ur values in some places.  The arguments to the $\mt{sql\_exp}$ type family respectively give the unrestricted-availability table fields, the table fields that may only be used in arguments to aggregate functions, the available selected expressions, and the type of the expression.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_exp} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type}
+\end{array}$$
+
+Any field in scope may be converted to an expression.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_field} : \mt{otherTabs} ::: \{\{\mt{Type}\}\} \to \mt{otherFields} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{fieldType} ::: \mt{Type} \to \mt{agg} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{tab} :: \mt{Name} \to \mt{field} :: \mt{Name} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; ([\mt{tab} = [\mt{field} = \mt{fieldType}] \rc \mt{otherFields}] \rc \mt{otherTabs}) \; \mt{agg} \; \mt{exps} \; \mt{fieldType}
+\end{array}$$
+
+There is an analogous function for referencing named expressions.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_exp} : \mt{tabs} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{t} ::: \mt{Type} \to \mt{rest} ::: \{\mt{Type}\} \to \mt{nm} :: \mt{Name} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tabs} \; \mt{agg} \; ([\mt{nm} = \mt{t}] \rc \mt{rest}) \; \mt{t}
+\end{array}$$
+
+Ur values of appropriate types may be injected into SQL expressions.
+$$\begin{array}{l}
+  \mt{class} \; \mt{sql\_injectable\_prim} \\
+  \mt{val} \; \mt{sql\_bool} : \mt{sql\_injectable\_prim} \; \mt{bool} \\
+  \mt{val} \; \mt{sql\_int} : \mt{sql\_injectable\_prim} \; \mt{int} \\
+  \mt{val} \; \mt{sql\_float} : \mt{sql\_injectable\_prim} \; \mt{float} \\
+  \mt{val} \; \mt{sql\_string} : \mt{sql\_injectable\_prim} \; \mt{string} \\
+  \mt{val} \; \mt{sql\_time} : \mt{sql\_injectable\_prim} \; \mt{time} \\
+  \mt{val} \; \mt{sql\_blob} : \mt{sql\_injectable\_prim} \; \mt{blob} \\
+  \mt{val} \; \mt{sql\_channel} : \mt{t} ::: \mt{Type} \to \mt{sql\_injectable\_prim} \; (\mt{channel} \; \mt{t}) \\
+  \mt{val} \; \mt{sql\_client} : \mt{sql\_injectable\_prim} \; \mt{client} \\
+  \\
+  \mt{class} \; \mt{sql\_injectable} \\
+  \mt{val} \; \mt{sql\_prim} : \mt{t} ::: \mt{Type} \to \mt{sql\_injectable\_prim} \; \mt{t} \to \mt{sql\_injectable} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_option\_prim} : \mt{t} ::: \mt{Type} \to \mt{sql\_injectable\_prim} \; \mt{t} \to \mt{sql\_injectable} \; (\mt{option} \; \mt{t}) \\
+  \\
+  \mt{val} \; \mt{sql\_inject} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \to \mt{sql\_injectable} \; \mt{t} \\
+  \hspace{.1in} \to \mt{t} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t}
+\end{array}$$
+
+Additionally, most function-free types may be injected safely, via the $\mt{serialized}$ type family.
+$$\begin{array}{l}
+  \mt{con} \; \mt{serialized} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{serialize} : \mt{t} ::: \mt{Type} \to \mt{t} \to \mt{serialized} \; \mt{t} \\
+  \mt{val} \; \mt{deserialize} : \mt{t} ::: \mt{Type} \to \mt{serialized} \; \mt{t} \to \mt{t} \\
+  \mt{val} \; \mt{sql\_serialized} : \mt{t} ::: \mt{Type} \to \mt{sql\_injectable\_prim} \; (\mt{serialized} \; \mt{t})
+\end{array}$$
+
+We have the SQL nullness test, which is necessary because of the strange SQL semantics of equality in the presence of null values.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_is\_null} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; (\mt{option} \; \mt{t}) \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{bool}
+\end{array}$$
+
+As another way of dealing with null values, there is also a restricted form of the standard \cd{COALESCE} function.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_coalesce} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; (\mt{option} \; \mt{t}) \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t}
+\end{array}$$
+
+We have generic nullary, unary, and binary operators.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_nfunc} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_current\_timestamp} : \mt{sql\_nfunc} \; \mt{time} \\
+  \mt{val} \; \mt{sql\_nfunc} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_nfunc} \; \mt{t} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\\end{array}$$
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_unary} :: \mt{Type} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_not} : \mt{sql\_unary} \; \mt{bool} \; \mt{bool} \\
+  \mt{val} \; \mt{sql\_unary} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{arg} ::: \mt{Type} \to \mt{res} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_unary} \; \mt{arg} \; \mt{res} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{arg} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{res} \\
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_binary} :: \mt{Type} \to \mt{Type} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_and} : \mt{sql\_binary} \; \mt{bool} \; \mt{bool} \; \mt{bool} \\
+  \mt{val} \; \mt{sql\_or} : \mt{sql\_binary} \; \mt{bool} \; \mt{bool} \; \mt{bool} \\
+  \mt{val} \; \mt{sql\_binary} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{arg_1} ::: \mt{Type} \to \mt{arg_2} ::: \mt{Type} \to \mt{res} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_binary} \; \mt{arg_1} \; \mt{arg_2} \; \mt{res} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{arg_1} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{arg_2} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{res}
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{class} \; \mt{sql\_arith} \\
+  \mt{val} \; \mt{sql\_int\_arith} : \mt{sql\_arith} \; \mt{int} \\
+  \mt{val} \; \mt{sql\_float\_arith} : \mt{sql\_arith} \; \mt{float} \\
+  \mt{val} \; \mt{sql\_neg} : \mt{t} ::: \mt{Type} \to \mt{sql\_arith} \; \mt{t} \to \mt{sql\_unary} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_plus} : \mt{t} ::: \mt{Type} \to \mt{sql\_arith} \; \mt{t} \to \mt{sql\_binary} \; \mt{t} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_minus} : \mt{t} ::: \mt{Type} \to \mt{sql\_arith} \; \mt{t} \to \mt{sql\_binary} \; \mt{t} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_times} : \mt{t} ::: \mt{Type} \to \mt{sql\_arith} \; \mt{t} \to \mt{sql\_binary} \; \mt{t} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_div} : \mt{t} ::: \mt{Type} \to \mt{sql\_arith} \; \mt{t} \to \mt{sql\_binary} \; \mt{t} \; \mt{t} \; \mt{t} \\
+  \mt{val} \; \mt{sql\_mod} : \mt{sql\_binary} \; \mt{int} \; \mt{int} \; \mt{int}
+\end{array}$$
+
+Finally, we have aggregate functions.  The $\mt{COUNT(\ast)}$ syntax is handled specially, since it takes no real argument.  The other aggregate functions are placed into a general type family, using constructor classes to restrict usage to properly typed arguments.  The key aspect of the $\mt{sql\_aggregate}$ function's type is the shift of aggregate-function-only fields into unrestricted fields.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_count} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{int}
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_aggregate} :: \mt{Type} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_aggregate} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{dom} ::: \mt{Type} \to \mt{ran} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_aggregate} \; \mt{dom} \; \mt{ran} \to \mt{sql\_exp} \; \mt{agg} \; \mt{agg} \; \mt{exps} \; \mt{dom} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{ran}
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{sql\_count\_col} : \mt{t} ::: \mt{Type} \to \mt{sql\_aggregate} \; (\mt{option} \; \mt{t}) \; \mt{int}
+\end{array}$$
+
+Most aggregate functions are typed using a two-parameter constructor class $\mt{nullify}$ which maps $\mt{option}$ types to themselves and adds $\mt{option}$ to others.  That is, this constructor class represents the process of making an SQL type ``nullable.''
+ 
+$$\begin{array}{l}
+  \mt{class} \; \mt{sql\_summable} \\
+  \mt{val} \; \mt{sql\_summable\_int} : \mt{sql\_summable} \; \mt{int} \\
+  \mt{val} \; \mt{sql\_summable\_float} : \mt{sql\_summable} \; \mt{float} \\
+  \mt{val} \; \mt{sql\_avg} : \mt{t} ::: \mt{Type} \to \mt{sql\_summable} \; \mt{t} \to \mt{sql\_aggregate} \; \mt{t} \; (\mt{option} \; \mt{float}) \\
+  \mt{val} \; \mt{sql\_sum} : \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \to \mt{sql\_summable} \; \mt{t} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_aggregate} \; \mt{t} \; \mt{nt}
+\end{array}$$
+
+$$\begin{array}{l}
+  \mt{class} \; \mt{sql\_maxable} \\
+  \mt{val} \; \mt{sql\_maxable\_int} : \mt{sql\_maxable} \; \mt{int} \\
+  \mt{val} \; \mt{sql\_maxable\_float} : \mt{sql\_maxable} \; \mt{float} \\
+  \mt{val} \; \mt{sql\_maxable\_string} : \mt{sql\_maxable} \; \mt{string} \\
+  \mt{val} \; \mt{sql\_maxable\_time} : \mt{sql\_maxable} \; \mt{time} \\
+  \mt{val} \; \mt{sql\_max} : \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \to \mt{sql\_maxable} \; \mt{t} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_aggregate} \; \mt{t} \; \mt{nt} \\
+  \mt{val} \; \mt{sql\_min} : \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \to \mt{sql\_maxable} \; \mt{t} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_aggregate} \; \mt{t} \; \mt{nt}
+\end{array}$$
+
+Any SQL query that returns single columns may be turned into a subquery expression.
+
+$$\begin{array}{l}
+\mt{val} \; \mt{sql\_subquery} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{nm} ::: \mt{Name} \to \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \\
+\hspace{.1in} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_query} \; \mt{tables} \; \mt{agg} \; [] \; [\mt{nm} = \mt{t}] \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt}
+\end{array}$$
+
+There is also an \cd{IF..THEN..ELSE..} construct that is compiled into standard SQL \cd{CASE} expressions.
+$$\begin{array}{l}
+\mt{val} \; \mt{sql\_if\_then\_else} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+\hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{bool} \\
+\hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+\hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+\hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t}
+\end{array}$$
+
+\texttt{FROM} clauses are specified using a type family, whose arguments are the free table variables and the table variables bound by this clause.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_from\_items} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_from\_table} : \mt{free} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to \mt{t} ::: \mt{Type} \to \mt{fs} ::: \{\mt{Type}\} \to \mt{fieldsOf} \; \mt{t} \; \mt{fs} \to \mt{name} :: \mt{Name} \to \mt{t} \to \mt{sql\_from\_items} \; \mt{free} \; [\mt{name} = \mt{fs}] \\
+  \mt{val} \; \mt{sql\_from\_query} : \mt{free} ::: \{\{\mt{Type}\}\} \to \mt{fs} ::: \{\mt{Type}\} \to \mt{name} :: \mt{Name} \to \mt{sql\_query} \; \mt{free} \; [] \; \mt{fs} \to \mt{sql\_from\_items} \; \mt{free} \; [\mt{name} = \mt{fs}] \\
+  \mt{val} \; \mt{sql\_from\_comma} : \mt{free} ::: \mt{tabs1} ::: \{\{\mt{Type}\}\} \to \mt{tabs2} ::: \{\{\mt{Type}\}\} \to [\mt{tabs1} \sim \mt{tabs2}] \\
+  \hspace{.1in} \Rightarrow \mt{sql\_from\_items} \; \mt{free} \; \mt{tabs1} \to \mt{sql\_from\_items} \; \mt{free} \; \mt{tabs2} \\
+  \hspace{.1in} \to \mt{sql\_from\_items} \; \mt{free} \; (\mt{tabs1} \rc \mt{tabs2}) \\
+  \mt{val} \; \mt{sql\_inner\_join} : \mt{free} ::: \{\{\mt{Type}\}\} \to \mt{tabs1} ::: \{\{\mt{Type}\}\} \to \mt{tabs2} ::: \{\{\mt{Type}\}\} \\
+  \hspace{.1in} \to [\mt{free} \sim \mt{tabs1}] \Rightarrow [\mt{free} \sim \mt{tabs2}] \Rightarrow [\mt{tabs1} \sim \mt{tabs2}] \\
+  \hspace{.1in} \Rightarrow \mt{sql\_from\_items} \; \mt{free} \; \mt{tabs1} \to \mt{sql\_from\_items} \; \mt{free} \; \mt{tabs2} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; (\mt{free} \rc \mt{tabs1} \rc \mt{tabs2}) \; [] \; [] \; \mt{bool} \\
+  \hspace{.1in} \to \mt{sql\_from\_items} \; \mt{free} \; (\mt{tabs1} \rc \mt{tabs2})
+\end{array}$$
+
+Besides these basic cases, outer joins are supported, which requires a type class for turning non-$\mt{option}$ columns into $\mt{option}$ columns.
+$$\begin{array}{l}
+  \mt{class} \; \mt{nullify} :: \mt{Type} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{nullify\_option} : \mt{t} ::: \mt{Type} \to \mt{nullify} \; (\mt{option} \; \mt{t}) \; (\mt{option} \; \mt{t}) \\
+  \mt{val} \; \mt{nullify\_prim} : \mt{t} ::: \mt{Type} \to \mt{sql\_injectable\_prim} \; \mt{t} \to \mt{nullify} \; \mt{t} \; (\mt{option} \; \mt{t})
+\end{array}$$
+
+Left, right, and full outer joins can now be expressed using functions that accept records of $\mt{nullify}$ instances.  Here, we give only the type for a left join as an example.
+
+$$\begin{array}{l}
+ \mt{val} \; \mt{sql\_left\_join} : \mt{free} ::: \{\{\mt{Type}\}\} \to \mt{tabs1} ::: \{\{\mt{Type}\}\} \to \mt{tabs2} ::: \{\{(\mt{Type} \times \mt{Type})\}\} \\
+  \hspace{.1in} \to [\mt{free} \sim \mt{tabs1}] \Rightarrow [\mt{free} \sim \mt{tabs2}] \Rightarrow [\mt{tabs1} \sim \mt{tabs2}] \\
+ \hspace{.1in} \Rightarrow \$(\mt{map} \; (\lambda \mt{r} \Rightarrow \$(\mt{map} \; (\lambda \mt{p} :: (\mt{Type} \times \mt{Type}) \Rightarrow \mt{nullify} \; \mt{p}.1 \; \mt{p}.2) \; \mt{r})) \; \mt{tabs2}) \\
+ \hspace{.1in} \to \mt{sql\_from\_items} \; \mt{free} \; \mt{tabs1} \to \mt{sql\_from\_items} \; \mt{free} \; (\mt{map} \; (\mt{map} \; (\lambda \mt{p} :: (\mt{Type} \times \mt{Type}) \Rightarrow \mt{p}.1)) \; \mt{tabs2}) \\
+ \hspace{.1in} \to \mt{sql\_exp} \; (\mt{free} \rc \mt{tabs1} \rc \mt{map} \; (\mt{map} \; (\lambda \mt{p} :: (\mt{Type} \times \mt{Type}) \Rightarrow \mt{p}.1)) \; \mt{tabs2}) \; [] \; [] \; \mt{bool} \\
+ \hspace{.1in} \to \mt{sql\_from\_items} \; \mt{free} \; (\mt{tabs1} \rc \mt{map} \; (\mt{map} \; (\lambda \mt{p} :: (\mt{Type} \times \mt{Type}) \Rightarrow \mt{p}.2)) \; \mt{tabs2})
+\end{array}$$
+
+We wrap up the definition of query syntax with the types used in representing $\mt{ORDER} \; \mt{BY}$, $\mt{LIMIT}$, and $\mt{OFFSET}$ clauses.
+$$\begin{array}{l}
+  \mt{type} \; \mt{sql\_direction} \\
+  \mt{val} \; \mt{sql\_asc} : \mt{sql\_direction} \\
+  \mt{val} \; \mt{sql\_desc} : \mt{sql\_direction} \\
+  \\
+  \mt{con} \; \mt{sql\_order\_by} :: \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_order\_by\_Nil} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{exps} :: \{\mt{Type}\} \to \mt{sql\_order\_by} \; \mt{tables} \; \mt{exps} \\
+  \mt{val} \; \mt{sql\_order\_by\_Cons} : \mt{tf} ::: (\{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type}) \\
+  \hspace{.1in} \to \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_window} \; \mt{tf} \to \mt{tf} \; \mt{tables} \; [] \; \mt{exps} \; \mt{t} \to \mt{sql\_direction} \to \mt{sql\_order\_by} \; \mt{tables} \; \mt{exps} \to \mt{sql\_order\_by} \; \mt{tables} \; \mt{exps} \\
+  \mt{val} \; \mt{sql\_order\_by\_random} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{sql\_order\_by} \; \mt{tables} \; \mt{exps} \\
+  \\
+  \mt{type} \; \mt{sql\_limit} \\
+  \mt{val} \; \mt{sql\_no\_limit} : \mt{sql\_limit} \\
+  \mt{val} \; \mt{sql\_limit} : \mt{int} \to \mt{sql\_limit} \\
+  \\
+  \mt{type} \; \mt{sql\_offset} \\
+  \mt{val} \; \mt{sql\_no\_offset} : \mt{sql\_offset} \\
+  \mt{val} \; \mt{sql\_offset} : \mt{int} \to \mt{sql\_offset}
+\end{array}$$
+
+When using Postgres, \cd{SELECT} and \cd{ORDER BY} are allowed to contain top-level uses of \emph{window functions}.  A separate type family \cd{sql\_expw} is provided for such cases, with some type class convenience for overloading between normal and window expressions.
+$$\begin{array}{l}
+  \mt{con} \; \mt{sql\_expw} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type} \\
+  \\
+  \mt{class} \; \mt{sql\_window} :: (\{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type}) \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_window\_normal} : \mt{sql\_window} \; \mt{sql\_exp} \\
+  \mt{val} \; \mt{sql\_window\_fancy} : \mt{sql\_window} \; \mt{sql\_expw} \\
+  \mt{val} \; \mt{sql\_window} : \mt{tf} ::: (\{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type}) \\
+  \hspace{.1in} \to \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_window} \; \mt{tf} \\
+  \hspace{.1in} \to \mt{tf} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \hspace{.1in} \to \mt{sql\_expw} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \\
+  \mt{con} \; \mt{sql\_partition} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_no\_partition} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{sql\_partition} \; \mt{tables} \; \mt{agg} \; \mt{exps} \\
+  \mt{val} \; \mt{sql\_partition} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \hspace{.1in} \to \mt{sql\_partition} \; \mt{tables} \; \mt{agg} \; \mt{exps} \\
+  \\
+  \mt{con} \; \mt{sql\_window\_function} :: \{\{\mt{Type}\}\} \to \{\{\mt{Type}\}\} \to \{\mt{Type}\} \to \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{sql\_window\_function} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{t} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_window\_function} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \hspace{.1in} \to \mt{sql\_partition} \; \mt{tables} \; \mt{agg} \; \mt{exps} \\
+  \hspace{.1in} \to \mt{sql\_order\_by} \; \mt{tables} \; \mt{exps} \\
+  \hspace{.1in} \to \mt{sql\_expw} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \\
+  \mt{val} \; \mt{sql\_window\_aggregate} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \\
+  \hspace{.1in} \to \mt{sql\_aggregate} \; \mt{t} \; \mt{nt} \\
+  \hspace{.1in} \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{t} \\
+  \hspace{.1in} \to \mt{sql\_window\_function} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt} \\
+  \mt{val} \; \mt{sql\_window\_count} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{sql\_window\_function} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{int} \\
+  \mt{val} \; \mt{sql\_rank} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to \mt{sql\_window\_function} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{int}
+\end{array}$$
+
+
+\subsubsection{DML}
+
+The Ur/Web library also includes an embedding of a fragment of SQL's DML, the Data Manipulation Language, for modifying database tables.  Any piece of DML may be executed in a transaction.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{dml} \\
+  \mt{val} \; \mt{dml} : \mt{dml} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+The function $\mt{Basis.dml}$ will trigger a fatal application error if the command fails, for instance, because a data integrity constraint is violated.  An alternate function returns an error message as a string instead.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{tryDml} : \mt{dml} \to \mt{transaction} \; (\mt{option} \; \mt{string})
+\end{array}$$
+
+Properly typed records may be used to form $\mt{INSERT}$ commands.
+$$\begin{array}{l}
+  \mt{val} \; \mt{insert} : \mt{fields} ::: \{\mt{Type}\} \to \mt{sql\_table} \; \mt{fields} \\
+  \hspace{.1in} \to \$(\mt{map} \; (\mt{sql\_exp} \; [] \; [] \; []) \; \mt{fields}) \to \mt{dml}
+\end{array}$$
+
+An $\mt{UPDATE}$ command is formed from a choice of which table fields to leave alone and which to change, along with an expression to use to compute the new value of each changed field and a $\mt{WHERE}$ clause.  Note that, in the table environment applied to expressions, the table being updated is hardcoded at the name $\mt{T}$.  The parsing extension for $\mt{UPDATE}$ will elaborate all table-free field references to use constant table name $\mt{T}$.
+$$\begin{array}{l}
+  \mt{val} \; \mt{update} : \mt{unchanged} ::: \{\mt{Type}\} \to \mt{changed} :: \{\mt{Type}\} \to [\mt{changed} \sim \mt{unchanged}] \\
+  \hspace{.1in} \Rightarrow \$(\mt{map} \; (\mt{sql\_exp} \; [\mt{T} = \mt{changed} \rc \mt{unchanged}] \; [] \; []) \; \mt{changed}) \\
+  \hspace{.1in} \to \mt{sql\_table} \; (\mt{changed} \rc \mt{unchanged}) \to \mt{sql\_exp} \; [\mt{T} = \mt{changed} \rc \mt{unchanged}] \; [] \; [] \; \mt{bool} \to \mt{dml}
+\end{array}$$
+
+A $\mt{DELETE}$ command is formed from a table and a $\mt{WHERE}$ clause.  The above use of $\mt{T}$ is repeated.
+$$\begin{array}{l}
+  \mt{val} \; \mt{delete} : \mt{fields} ::: \{\mt{Type}\} \to \mt{sql\_table} \; \mt{fields} \to \mt{sql\_exp} \; [\mt{T} = \mt{fields}] \; [] \; [] \; \mt{bool} \to \mt{dml}
+\end{array}$$
+
+\subsubsection{Sequences}
+
+SQL sequences are counters with concurrency control, often used to assign unique IDs.  Ur/Web supports them via a simple interface.  The only way to create a sequence is with the $\mt{sequence}$ declaration form.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{sql\_sequence} \\
+  \mt{val} \; \mt{nextval} : \mt{sql\_sequence} \to \mt{transaction} \; \mt{int} \\
+  \mt{val} \; \mt{setval} : \mt{sql\_sequence} \to \mt{int} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+
+\subsection{\label{xml}XML}
+
+Ur/Web's library contains an encoding of XML syntax and semantic constraints.  We make no effort to follow the standards governing XML schemas.  Rather, XML fragments are viewed more as values of ML datatypes, and we only track which tags are allowed inside which other tags.  The Ur/Web standard library encodes a very loose version of XHTML, where it is very easy to produce documents which are invalid XHTML, but which still display properly in all major browsers.  The main purposes of the invariants that are enforced are first, to provide some documentation about the places where it would make sense to insert XML fragments; and second, to rule out code injection attacks and other abstraction violations related to HTML syntax.
+
+The basic XML type family has arguments respectively indicating the \emph{context} of a fragment, the fields that the fragment expects to be bound on entry (and their types), and the fields that the fragment will bind (and their types).  Contexts are a record-based ``poor man's subtyping'' encoding, with each possible set of valid tags corresponding to a different context record.  For instance, the context for the \texttt{<td>} tag is $[\mt{Dyn}, \mt{MakeForm}, \mt{Tr}]$, to indicate nesting inside a \texttt{<tr>} tag with the ability to nest \texttt{<form>} and \texttt{<dyn>} tags (see below).  Contexts are maintained in a somewhat ad-hoc way; the only definitive reference for their meanings is the types of the tag values in \texttt{basis.urs}.  The arguments dealing with field binding are only relevant to HTML forms.
+$$\begin{array}{l}
+  \mt{con} \; \mt{xml} :: \{\mt{Unit}\} \to \{\mt{Type}\} \to \{\mt{Type}\} \to \mt{Type}
+\end{array}$$
+
+We also have a type family of XML tags, indexed respectively by the record of optional attributes accepted by the tag, the context in which the tag may be placed, the context required of children of the tag, which form fields the tag uses, and which fields the tag defines.
+$$\begin{array}{l}
+  \mt{con} \; \mt{tag} :: \{\mt{Type}\} \to \{\mt{Unit}\} \to \{\mt{Unit}\} \to \{\mt{Type}\} \to \{\mt{Type}\} \to \mt{Type}
+\end{array}$$
+
+Literal text may be injected into XML as ``CDATA.''
+$$\begin{array}{l}
+  \mt{val} \; \mt{cdata} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use} ::: \{\mt{Type}\} \to \mt{string} \to \mt{xml} \; \mt{ctx} \; \mt{use} \; []
+\end{array}$$
+
+There is also a function to insert the literal value of a character.  Since Ur/Web uses the UTF-8 text encoding, the $\mt{cdata}$ function is only sufficient to encode characters with ASCII codes below 128.  Higher codes have alternate meanings in UTF-8 than in usual ASCII, so this alternate function should be used with them.
+$$\begin{array}{l}
+  \mt{val} \; \mt{cdataChar} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use} ::: \{\mt{Type}\} \to \mt{char} \to \mt{xml} \; \mt{ctx} \; \mt{use} \; []
+\end{array}$$
+
+There is a function for producing an XML tree with a particular tag at its root.
+$$\begin{array}{l}
+  \mt{val} \; \mt{tag} : \mt{attrsGiven} ::: \{\mt{Type}\} \to \mt{attrsAbsent} ::: \{\mt{Type}\} \to \mt{ctxOuter} ::: \{\mt{Unit}\} \to \mt{ctxInner} ::: \{\mt{Unit}\} \\
+  \hspace{.1in} \to \mt{useOuter} ::: \{\mt{Type}\} \to \mt{useInner} ::: \{\mt{Type}\} \to \mt{bindOuter} ::: \{\mt{Type}\} \to \mt{bindInner} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to [\mt{attrsGiven} \sim \mt{attrsAbsent}] \Rightarrow [\mt{useOuter} \sim \mt{useInner}] \Rightarrow [\mt{bindOuter} \sim \mt{bindInner}] \\
+  \hspace{.1in} \Rightarrow \mt{css\_class} \\
+  \hspace{.1in} \to \mt{option} \; (\mt{signal} \; \mt{css\_class}) \\
+  \hspace{.1in} \to \mt{css\_style} \\
+  \hspace{.1in} \to \mt{option} \; (\mt{signal} \; \mt{css\_style}) \\
+  \hspace{.1in} \to \$\mt{attrsGiven} \\
+  \hspace{.1in} \to \mt{tag} \; (\mt{attrsGiven} \rc \mt{attrsAbsent}) \; \mt{ctxOuter} \; \mt{ctxInner} \; \mt{useOuter} \; \mt{bindOuter} \\
+  \hspace{.1in} \to \mt{xml} \; \mt{ctxInner} \; \mt{useInner} \; \mt{bindInner} \to \mt{xml} \; \mt{ctxOuter} \; (\mt{useOuter} \rc \mt{useInner}) \; (\mt{bindOuter} \rc \mt{bindInner})
+\end{array}$$
+Note that any tag may be assigned a CSS class, or left without a class by passing $\mt{Basis.null}$ as the first value-level argument.  This is the sole way of making use of the values produced by $\mt{style}$ declarations.  The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag.  Stylesheets to assign properties to the classes can be linked via URL's with \texttt{link} tags.  Ur/Web makes it easy to calculate upper bounds on usage of CSS classes through program analysis, with the \cd{-css} command-line flag.
+
+Also note that two different arguments are available for setting CSS classes: the first, associated with the \texttt{class} pseudo-attribute syntactic sugar, fixes the class of a tag for the duration of the tag's life; while the second, associated with the \texttt{dynClass} pseudo-attribute, allows the class to vary over the tag's life.  See Section \ref{signals} for an introduction to the $\mt{signal}$ type family.
+
+The third and fourth value-level arguments makes it possible to generate HTML \cd{style} attributes, either with fixed content (\cd{style} attribute) or dynamic content (\cd{dynStyle} pseudo-attribute).
+
+Two XML fragments may be concatenated.
+$$\begin{array}{l}
+  \mt{val} \; \mt{join} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use_1} ::: \{\mt{Type}\} \to \mt{bind_1} ::: \{\mt{Type}\} \to \mt{bind_2} ::: \{\mt{Type}\} \\
+  \hspace{.1in} \to [\mt{use_1} \sim \mt{bind_1}] \Rightarrow [\mt{bind_1} \sim \mt{bind_2}] \\
+  \hspace{.1in} \Rightarrow \mt{xml} \; \mt{ctx} \; \mt{use_1} \; \mt{bind_1} \to \mt{xml} \; \mt{ctx} \; (\mt{use_1} \rc \mt{bind_1}) \; \mt{bind_2} \to \mt{xml} \; \mt{ctx} \; \mt{use_1} \; (\mt{bind_1} \rc \mt{bind_2})
+\end{array}$$
+
+Finally, any XML fragment may be updated to ``claim'' to use more form fields than it does.
+$$\begin{array}{l}
+  \mt{val} \; \mt{useMore} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use_1} ::: \{\mt{Type}\} \to \mt{use_2} ::: \{\mt{Type}\} \to \mt{bind} ::: \{\mt{Type}\} \to [\mt{use_1} \sim \mt{use_2}] \\
+  \hspace{.1in} \Rightarrow \mt{xml} \; \mt{ctx} \; \mt{use_1} \; \mt{bind} \to \mt{xml} \; \mt{ctx} \; (\mt{use_1} \rc \mt{use_2}) \; \mt{bind}
+\end{array}$$
+
+We will not list here the different HTML tags and related functions from the standard library.  They should be easy enough to understand from the code in \texttt{basis.urs}.  The set of tags in the library is not yet claimed to be complete for HTML standards.  Also note that there is currently no way for the programmer to add his own tags, without using the foreign function interface (Section \ref{ffi}).
+
+Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind.  See \texttt{basis.urs} for details.  The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar, and the same mechanism is reused to support \texttt{aria-*} attributes.
+
+One last useful function is for aborting any page generation, returning some XML as an error message.  This function takes the place of some uses of a general exception mechanism.
+$$\begin{array}{l}
+  \mt{val} \; \mt{error} : \mt{t} ::: \mt{Type} \to \mt{xbody} \to \mt{t}
+\end{array}$$
+
+There is limited support for the HTML \texttt{<meta>} tag, with the following type used to control which names are allowed.
+$$\begin{array}{l}
+  \mt{type} \; \mt{meta} \\
+  \mt{val} \; \mt{blessMeta} : \mt{string} \to \mt{meta} \\
+  \mt{val} \; \mt{checkMeta} : \mt{string} \to \mt{option} \; \mt{meta}
+\end{array}$$
+Configure the policy for meta names with the \texttt{allow} and \texttt{deny} \texttt{.urp} directives.
+
+
+\subsection{Client-Side Programming}
+
+Ur/Web supports running code on web browsers, via automatic compilation to JavaScript.
+
+The concurrency model is \emph{cooperative multithreading}.  Like with, say, POSIX threads, which uses the \emph{preemptive multithreading} model, there may be multiple threads of control active at a time.  However, unlike with preemptive multithreading, the currently running thread gets to run interrupted until a well-defined \emph{context-switch} point.  Specifically, four functions defined below are the context-switch points.  They are $\mt{sleep}$, $\mt{rpc}$, $\mt{tryRpc}$, and $\mt{recv}$.  (We explain their purposes as we come to them below.)  Additional functions added via the foreign function interface might also have context-switching behavior.  In any case, it is guaranteed that a running thread ``owns the processor'' until it calls a context-switching function, at which time we may switch to running a different thread instead.
+
+This concurrency paradigm has many nice properties.  For instance, there is almost never any need for locking or other synchronization between threads.
+
+Readers used to the standard JavaScript model may recognize this style as the natural one that we obtain by imposing a thread-based perspective on top of the usual JavaScript callback-based API.  Indeed, every context-switching Ur/Web function is implemented with an underlying JavaScript call that asks for some callback to be triggered when an event happens.
+
+\subsubsection{The Basics}
+
+All of the functions in this subsection are client-side only.
+
+Clients can open alert and confirm dialog boxes, in the usual annoying JavaScript way.
+$$\begin{array}{l}
+  \mt{val} \; \mt{alert} : \mt{string} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{confirm} : \mt{string} \to \mt{transaction} \; \mt{bool}
+\end{array}$$
+
+Any transaction may be run in a new thread with the $\mt{spawn}$ function.
+$$\begin{array}{l}
+  \mt{val} \; \mt{spawn} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+The current thread can be paused for at least a specified number of milliseconds.
+$$\begin{array}{l}
+  \mt{val} \; \mt{sleep} : \mt{int} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+A few functions are available to registers callbacks for particular error events.  Respectively, they are triggered on calls to $\mt{error}$, uncaught JavaScript exceptions, failure of remote procedure calls, the severance of the connection serving asynchronous messages, or the occurrence of some other error with that connection.  If no handlers are registered for a kind of error, then a JavaScript \cd{alert()} is used to announce its occurrence.  When one of these functions is called multiple times within a single page, all registered handlers are run when appropriate events occur, with handlers run in the reverse of their registration order.
+$$\begin{array}{l}
+  \mt{val} \; \mt{onError} : (\mt{xbody} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{onFail} : (\mt{string} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{onConnectFail} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{onDisconnect} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{onServerError} : (\mt{string} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+There are also functions to register standard document-level event handlers.
+
+$$\begin{array}{l}
+ \mt{val} \; \mt{onClick} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onDblclick} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onKeydown} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onKeypress} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onKeyup} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onMousedown} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\
+ \mt{val} \; \mt{onMouseup} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+Versions of standard JavaScript functions are provided that event handlers may call to mask default handling or prevent bubbling of events up to parent DOM nodes, respectively.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{preventDefault} : \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{stopPropagation} : \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+Finally, here is an HTML tag to leave a marker in the \cd{<head>} of a document asking for some side-effecting code to be run.  This pattern is \emph{much} less common in Ur/Web applications than in normal HTML/JavaScript applications; see Section \ref{signals} for the more idiomatic, functional way of manipulating the visible page.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{script} : \mt{unit} \to \mt{tag} \; [\mt{Code} = \mt{transaction} \; \mt{unit}] \; \mt{head} \; [] \; [] \; []
+\end{array}$$
+
+Note that the Ur/Web version of \cd{<script>} is used like \cd{<script code=\{...\}/>}, rather than \cd{<script>...</script>}.
+
+\subsubsection{Node IDs}
+
+There is an abstract type of node IDs that may be assigned to \cd{id} attributes of most HTML tags.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{id} \\
+  \mt{val} \; \mt{fresh} : \mt{transaction} \; \mt{id}
+\end{array}$$
+
+The \cd{fresh} function is allowed on both server and client, but there is no other way to create IDs, which includes lack of a way to force an ID to match a particular string.  The main semantic importance of IDs within Ur/Web is in uses of the HTML \cd{<label>} tag.  IDs play a much more central role in mainstream JavaScript programming, but Ur/Web uses a very different model to enable changes to particular nodes of a page tree, as the next manual subsection explains.  IDs may still be useful in interfacing with JavaScript code (for instance, through Ur/Web's FFI).
+
+One further use of IDs is as handles for requesting that \emph{focus} be given to specific tags.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{giveFocus} : \mt{id} \to \mt{transaction} \; \mt{unit}
+\end{array}$$
+
+\subsubsection{\label{signals}Functional-Reactive Page Generation}
+
+Most approaches to ``AJAX''-style coding involve imperative manipulation of the DOM tree representing an HTML document's structure.  Ur/Web follows the \emph{functional-reactive} approach instead.  Programs may allocate mutable \emph{sources} of arbitrary types, and an HTML page is effectively a pure function over the latest values of the sources.  The page is not mutated directly, but rather it changes automatically as the sources are mutated.
+
+More operationally, you can think of a source as a mutable cell with facilities for subscription to change notifications.  That level of detail is hidden behind a monadic facility to be described below.  First, there are three primitive operations for working with sources just as if they were ML \cd{ref} cells, corresponding to ML's \cd{ref}, \cd{:=}, and \cd{!} operations.
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{source} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{source} : \mt{t} ::: \mt{Type} \to \mt{t} \to \mt{transaction} \; (\mt{source} \; \mt{t}) \\
+  \mt{val} \; \mt{set} : \mt{t} ::: \mt{Type} \to \mt{source} \; \mt{t} \to \mt{t} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{get} : \mt{t} ::: \mt{Type} \to \mt{source} \; \mt{t} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+Only source creation and setting are supported server-side, as a convenience to help in setting up a page, where you may wish to allocate many sources that will be referenced through the page.  All server-side storage of values inside sources uses string serializations of values, while client-side storage uses normal JavaScript values.
+
+Pure functions over arbitrary numbers of sources are represented in a monad of \emph{signals}, which may only be used in client-side code.  This is presented to the programmer in the form of a monad $\mt{signal}$, each of whose values represents (conceptually) some pure function over all sources that may be allocated in the course of program execution.  A monad operation $\mt{signal}$ denotes the identity function over a particular source.  By using $\mt{signal}$ on a source, you implicitly subscribe to change notifications for that source.  That is, your signal will automatically be recomputed as that source changes.  The usual monad operators make it possible to build up complex signals that depend on multiple sources; automatic updating upon source-value changes still happens automatically.  There is also an operator for computing a signal's current value within a transaction.
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{signal} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{signal\_monad} : \mt{monad} \; \mt{signal} \\
+  \mt{val} \; \mt{signal} : \mt{t} ::: \mt{Type} \to \mt{source} \; \mt{t} \to \mt{signal} \; \mt{t} \\
+  \mt{val} \; \mt{current} : \mt{t} ::: \mt{Type} \to \mt{signal} \; \mt{t} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+A reactive portion of an HTML page is injected with a $\mt{dyn}$ tag, which has a signal-valued attribute $\mt{Signal}$.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{dyn} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use} ::: \{\mt{Type}\} \to \mt{bind} ::: \{\mt{Type}\} \to [\mt{ctx} \sim [\mt{Dyn}]] \Rightarrow \mt{unit} \\
+  \hspace{.1in} \to \mt{tag} \; [\mt{Signal} = \mt{signal} \; (\mt{xml} \; ([\mt{Dyn}] \rc \mt{ctx}) \; \mt{use} \; \mt{bind})] \; ([\mt{Dyn}] \rc \mt{ctx}) \; [] \; \mt{use} \; \mt{bind}
+\end{array}$$
+
+The semantics of \cd{<dyn>} tags is somewhat subtle.  When the signal associated with such a tag changes value, the associated subtree of the HTML page is recreated.  Some properties of the subtree, such as attributes and client-side widget values, are specified explicitly in the signal value, so these may be counted on to remain the same after recreation.  Other properties, like focus and cursor position within textboxes, are \emph{not} specified by signal values, and these properties will be \emph{reset} upon subtree regeneration.  Furthermore, user interaction with widgets may not work properly during regeneration.  For instance, clicking a button while it is being regenerated may not trigger its \cd{onclick} event code.
+
+Currently, the only way to avoid undesired resets is to avoid regeneration of containing subtrees.  There are two main strategies for achieving that goal.  First, when changes to a subtree can be confined to CSS classes of tags, the \texttt{dynClass} pseudo-attribute may be used instead (see Section \ref{xml}), as it does not regenerate subtrees.  Second, a single \cd{<dyn>} tag may be broken into multiple tags, in a way that makes finer-grained dependency structure explicit.  This latter strategy can avoid ``spurious'' regenerations that are not actually required to achieve the intended semantics.
+
+Transactions can be run on the client by including them in attributes like the $\mt{Onclick}$ attribute of $\mt{button}$, and GUI widgets like $\mt{ctextbox}$ have $\mt{Source}$ attributes that can be used to connect them to sources, so that their values can be read by code running because of, e.g., an $\mt{Onclick}$ event.  It is also possible to create an ``active'' HTML fragment that runs a $\mt{transaction}$ to determine its content, possibly allocating some sources in the process:
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{active} : \mt{unit} \to \mt{tag} \; [\mt{Code} = \mt{transaction} \; \mt{xbody}] \; \mt{body} \; [] \; [] \; []
+\end{array}$$
+
+\subsubsection{Remote Procedure Calls}
+
+Any function call may be made a client-to-server ``remote procedure call'' if the function being called needs no features that are only available to client code.  To make a function call an RPC, pass that function call as the argument to $\mt{Basis.rpc}$:
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{rpc} : \mt{t} ::: \mt{Type} \to \mt{transaction} \; \mt{t} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+There is an alternate form that uses $\mt{None}$ to indicate that an error occurred during RPC processing, rather than raising an exception to abort this branch of control flow.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{tryRpc} : \mt{t} ::: \mt{Type} \to \mt{transaction} \; \mt{t} \to \mt{transaction} \; (\mt{option} \; \mt{t})
+\end{array}$$
+
+\subsubsection{Asynchronous Message-Passing}
+
+To support asynchronous, ``server push'' delivery of messages to clients, any client that might need to receive an asynchronous message is assigned a unique ID.  These IDs may be retrieved both on the client and on the server, during execution of code related to a client.
+
+$$\begin{array}{l}
+  \mt{type} \; \mt{client} \\
+  \mt{val} \; \mt{self} : \mt{transaction} \; \mt{client}
+\end{array}$$
+
+\emph{Channels} are the means of message-passing.  Each channel is created in the context of a client and belongs to that client; no other client may receive the channel's messages.  Note that here \emph{client} has a technical Ur/Web meaning so that it describes only \emph{single page views}, so a user following a traditional link within an application will remove the ability for \emph{any} code to receive messages on the channels associated with the previous client.  Each channel type includes the type of values that may be sent over the channel.  Sending and receiving are asynchronous, in the sense that a client need not be ready to receive a message right away.  Rather, sent messages may queue up, waiting to be processed.
+
+$$\begin{array}{l}
+  \mt{con} \; \mt{channel} :: \mt{Type} \to \mt{Type} \\
+  \mt{val} \; \mt{channel} : \mt{t} ::: \mt{Type} \to \mt{transaction} \; (\mt{channel} \; \mt{t}) \\
+  \mt{val} \; \mt{send} : \mt{t} ::: \mt{Type} \to \mt{channel} \; \mt{t} \to \mt{t} \to \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{recv} : \mt{t} ::: \mt{Type} \to \mt{channel} \; \mt{t} \to \mt{transaction} \; \mt{t}
+\end{array}$$
+
+The $\mt{channel}$ and $\mt{send}$ operations may only be executed on the server, and $\mt{recv}$ may only be executed on a client.  Neither clients nor channels may be passed as arguments from clients to server-side functions, so persistent channels can only be maintained by storing them in the database and looking them up using the current client ID or some application-specific value as a key.
+
+Clients and channels live only as long as the web browser page views that they are associated with.  When a user surfs away, his client and its channels will be garbage-collected, after that user is not heard from for the timeout period.  Garbage collection deletes any database row that contains a client or channel directly.  Any reference to one of these types inside an $\mt{option}$ is set to $\mt{None}$ instead.  Both kinds of handling have the flavor of weak pointers, and that is a useful way to think about clients and channels in the database.
+
+\emph{Note}: Currently, there are known concurrency issues with multi-threaded applications that employ message-passing on top of database engines that don't support true serializable transactions.  Postgres (versions 9.1 and up) is the only supported engine that does this properly.
+
+
+\section{Ur/Web Syntax Extensions}
+
+Ur/Web features some syntactic shorthands for building values using the functions from the last section.  This section sketches the grammar of those extensions.  We write spans of syntax inside brackets to indicate that they are optional.
+
+\subsection{SQL}
+
+\subsubsection{\label{tables}Table Declarations}
+
+$\mt{table}$ declarations may include constraints, via these grammar rules.
+$$\begin{array}{rrcll}
+  \textrm{Declarations} & d &::=& \mt{table} \; x : c \; [pk[,]] \; cts \mid \mt{view} \; x = V \\
+  \textrm{Primary key constraints} & pk &::=& \mt{PRIMARY} \; \mt{KEY} \; K \\
+  \textrm{Keys} & K &::=& f \mid (f, (f,)^+) \mid \{\{e\}\} \\
+  \textrm{Constraint sets} & cts &::=& \mt{CONSTRAINT} f \; ct \mid cts, cts \mid \{\{e\}\} \\
+  \textrm{Constraints} & ct &::=& \mt{UNIQUE} \; K \mid \mt{CHECK} \; E \\
+  &&& \mid \mt{FOREIGN} \; \mt{KEY} \; K \; \mt{REFERENCES} \; F \; (K) \; [\mt{ON} \; \mt{DELETE} \; pr] \; [\mt{ON} \; \mt{UPDATE} \; pr] \\
+  \textrm{Foreign tables} & F &::=& x \mid \{\{e\}\} \\
+  \textrm{Propagation modes} & pr &::=& \mt{NO} \; \mt{ACTION} \mid \mt{RESTRICT} \mid \mt{CASCADE} \mid \mt{SET} \; \mt{NULL} \\
+  \textrm{View expressions} & V &::=& Q \mid \{e\}
+\end{array}$$
+
+A signature item $\mt{table} \; \mt{x} : \mt{c}$ is actually elaborated into two signature items: $\mt{con} \; \mt{x\_hidden\_constraints} :: \{\{\mt{Unit}\}\}$ and $\mt{val} \; \mt{x} : \mt{sql\_table} \; \mt{c} \; \mt{x\_hidden\_constraints}$.  This is appropriate for common cases where client code doesn't care which keys a table has.  It's also possible to include constraints after a $\mt{table}$ signature item, with the same syntax as for $\mt{table}$ declarations.  This may look like dependent typing, but it's just a convenience.  The constraints are type-checked to determine a constructor $u$ to include in $\mt{val} \; \mt{x} : \mt{sql\_table} \; \mt{c} \; (u \rc \mt{x\_hidden\_constraints})$, and then the expressions are thrown away.  Nonetheless, it can be useful for documentation purposes to include table constraint details in signatures.  Note that the automatic generation of $\mt{x\_hidden\_constraints}$ leads to a kind of free subtyping with respect to which constraints are defined.
+
+
+\subsubsection{Queries}
+
+Queries $Q$ are added to the rules for expressions $e$.
+
+$$\begin{array}{rrcll}
+  \textrm{Queries} & Q &::=& (q \; [\mt{ORDER} \; \mt{BY} \; O] \; [\mt{LIMIT} \; N] \; [\mt{OFFSET} \; N]) \\
+  \textrm{Pre-queries} & q &::=& \mt{SELECT} \; [\mt{DISTINCT}] \; P \; \mt{FROM} \; F,^+ \; [\mt{WHERE} \; E] \; [\mt{GROUP} \; \mt{BY} \; p,^+] \; [\mt{HAVING} \; E] \\
+  &&& \mid q \; R \; q \mid \{\{\{e\}\}\} \\
+  \textrm{Relational operators} & R &::=& \mt{UNION} \mid \mt{INTERSECT} \mid \mt{EXCEPT} \\
+  \textrm{$\mt{ORDER \; BY}$ items} & O &::=& \mt{RANDOM} [()] \mid \hat{E} \; [o] \mid \hat{E} \; [o], O \mid \{\{\{e\}\}\}
+\end{array}$$
+
+$$\begin{array}{rrcll}
+  \textrm{Projections} & P &::=& \ast & \textrm{all columns} \\
+  &&& p,^+ & \textrm{particular columns} \\
+  \textrm{Pre-projections} & p &::=& t.f & \textrm{one column from a table} \\
+  &&& t.\{\{c\}\} & \textrm{a record of columns from a table (of kind $\{\mt{Type}\}$)} \\
+  &&& t.* & \textrm{all columns from a table} \\
+  &&& \hat{E} \; [\mt{AS} \; f] & \textrm{expression column} \\
+  \textrm{Table names} & t &::=& x & \textrm{constant table name (automatically capitalized)} \\
+  &&& X & \textrm{constant table name} \\
+  &&& \{\{c\}\} & \textrm{computed table name (of kind $\mt{Name}$)} \\
+  \textrm{Column names} & f &::=& X & \textrm{constant column name} \\
+  &&& \{c\} & \textrm{computed column name (of kind $\mt{Name}$)} \\
+  \textrm{Tables} & T &::=& x & \textrm{table variable, named locally by its own capitalization} \\
+  &&& x \; \mt{AS} \; X & \textrm{table variable, with local name} \\
+  &&& x \; \mt{AS} \; \{c\} & \textrm{table variable, with computed local name} \\
+  &&& \{\{e\}\} \; \mt{AS} \; X & \textrm{computed table expression, with local name} \\
+  &&& \{\{e\}\} \; \mt{AS} \; \{c\} & \textrm{computed table expression, with computed local name} \\
+  \textrm{$\mt{FROM}$ items} & F &::=& T \mid \{\{e\}\} \mid F \; J \; \mt{JOIN} \; F \; \mt{ON} \; E \\
+  &&& \mid F \; \mt{CROSS} \; \mt{JOIN} \ F \\
+  &&& \mid (Q) \; \mt{AS} \; X \mid (Q) \; \mt{AS} \; \{c\} \\
+  &&& \mid (\{\{e\}\}) \; \mt{AS} \; t \\
+  \textrm{Joins} & J &::=& [\mt{INNER}] \\
+  &&& \mid [\mt{LEFT} \mid \mt{RIGHT} \mid \mt{FULL}] \; [\mt{OUTER}] \\
+  \textrm{SQL expressions} & E &::=& t.f & \textrm{column references} \\
+  &&& X & \textrm{named expression references} \\
+  &&& \{[e]\} & \textrm{injected native Ur expressions} \\
+  &&& \{e\} & \textrm{computed expressions, probably using $\mt{sql\_exp}$ directly} \\
+  &&& \mt{TRUE} \mid \mt{FALSE} & \textrm{boolean constants} \\
+  &&& \ell & \textrm{primitive type literals} \\
+  &&& \mt{NULL} & \textrm{null value (injection of $\mt{None}$)} \\
+  &&& E \; \mt{IS} \; \mt{NULL} & \textrm{nullness test} \\
+  &&& \mt{COALESCE}(E, E) & \textrm{take first non-null value} \\
+  &&& n & \textrm{nullary operators} \\
+  &&& u \; E & \textrm{unary operators} \\
+  &&& E \; b \; E & \textrm{binary operators} \\
+  &&& \mt{COUNT}(\ast) & \textrm{count number of rows} \\
+  &&& a(E) & \textrm{other aggregate function} \\
+  &&& \mt{IF} \; E \; \mt{THEN} \; E \; \mt{ELSE} \; E & \textrm{conditional} \\
+  &&& (Q) & \textrm{subquery (must return a single expression column)} \\
+  &&& (E) & \textrm{explicit precedence} \\
+  \textrm{Nullary operators} & n &::=& \mt{CURRENT\_TIMESTAMP} \\
+  \textrm{Unary operators} & u &::=& \mt{NOT} \\
+  \textrm{Binary operators} & b &::=& \mt{AND} \mid \mt{OR} \mid = \mid \neq \mid < \mid \leq \mid > \mid \geq \mid \mt{LIKE} \\
+  \textrm{Aggregate functions} & a &::=& \mt{COUNT} \mid \mt{AVG} \mid \mt{SUM} \mid \mt{MIN} \mid \mt{MAX} \\
+  \textrm{Directions} & o &::=& \mt{ASC} \mid \mt{DESC} \mid \{e\} \\
+  \textrm{SQL integer} & N &::=& n \mid \{e\} \\
+  \textrm{Windowable expressions} & \hat{E} &::=& E \\
+  &&& w \; [\mt{OVER} \; ( & \textrm{(Postgres only)} \\
+  &&& \hspace{.1in} [\mt{PARTITION} \; \mt{BY} \; E] \\
+  &&& \hspace{.1in} [\mt{ORDER} \; \mt{BY} \; O])] \\
+  \textrm{Window function} & w &::=& \mt{RANK}() \\
+  &&& \mt{COUNT}(*) \\
+  &&& a(E)
+\end{array}$$
+
+Additionally, an SQL expression may be inserted into normal Ur code with the syntax $(\mt{SQL} \; E)$ or $(\mt{WHERE} \; E)$.  Similar shorthands exist for other nonterminals, with the prefix $\mt{FROM}$ for $\mt{FROM}$ items and $\mt{SELECT1}$ for pre-queries.
+
+Unnamed expression columns in $\mt{SELECT}$ clauses are assigned consecutive natural numbers, starting with 1.  Any expression in a $p$ position that is enclosed in parentheses is treated as an expression column, rather than a column pulled directly out of a table, even if it is only a field projection.  (This distinction affects the record type used to describe query results.)
+
+\subsubsection{DML}
+
+DML commands $D$ are added to the rules for expressions $e$.
+
+$$\begin{array}{rrcll}
+  \textrm{Commands} & D &::=& (\mt{INSERT} \; \mt{INTO} \; T^E \; (f,^+) \; \mt{VALUES} \; (E,^+)) \\
+  &&& (\mt{UPDATE} \; T^E \; \mt{SET} \; (f = E,)^+ \; \mt{WHERE} \; E) \\
+  &&& (\mt{DELETE} \; \mt{FROM} \; T^E \; \mt{WHERE} \; E) \\
+  \textrm{Table expressions} & T^E &::=& x \mid \{\{e\}\}
+\end{array}$$
+
+Inside $\mt{UPDATE}$ and $\mt{DELETE}$ commands, lone variables $X$ are interpreted as references to columns of the implicit table $\mt{T}$, rather than to named expressions.
+
+\subsection{XML}
+
+XML fragments $L$ are added to the rules for expressions $e$.
+
+$$\begin{array}{rrcll}
+  \textrm{XML fragments} & L &::=& \texttt{<xml/>} \mid \texttt{<xml>}l^*\texttt{</xml>} \\
+  \textrm{XML pieces} & l &::=& \textrm{text} & \textrm{cdata} \\
+  &&& \texttt{<}g\texttt{/>} & \textrm{tag with no children} \\
+  &&& \texttt{<}g\texttt{>}l^*\texttt{</}x\texttt{>} & \textrm{tag with children} \\
+  &&& \{e\} & \textrm{computed XML fragment} \\
+  &&& \{[e]\} & \textrm{injection of an Ur expression, via the $\mt{Top}.\mt{txt}$ function} \\
+  \textrm{Tag} & g &::=& h \; (x [= v])^* \\
+  \textrm{Tag head} & h &::=& x & \textrm{tag name} \\
+  &&& h\{c\} & \textrm{constructor parameter} \\
+  \textrm{Attribute value} & v &::=& \ell & \textrm{literal value} \\
+  &&& \{e\} & \textrm{computed value} \\
+\end{array}$$
+
+When the optional $= v$ is omitted in an XML attribute, the attribute is assigned value $\mt{True}$ in Ur/Web, and it is rendered to HTML merely as including the attribute name without a value.  If such a Boolean attribute is manually set to value $\mt{False}$, then it is omitted altogether in generating HTML.
+
+Further, there is a special convenience and compatibility form for setting CSS classes of tags.  If a \cd{class} attribute has a value that is a string literal, the literal is parsed in the usual HTML way and replaced with calls to appropriate Ur/Web combinators.  Any dashes in the text are replaced with underscores to determine Ur identifiers.  The same desugaring can be accessed in a normal expression context by calling the pseudo-function \cd{CLASS} on a string literal.
+
+Similar support is provided for \cd{style} attributes.  Normal CSS syntax may be used in string literals that are \cd{style} attribute values, and the desugaring may be accessed elsewhere with the pseudo-function \cd{STYLE}.
+
+\section{\label{structure}The Structure of Web Applications}
+
+A web application is built from a series of modules, with one module, the last one appearing in the \texttt{.urp} file, designated as the main module.  The signature of the main module determines the URL entry points to the application.  Such an entry point should have type $\mt{t1} \to \ldots \to \mt{tn} \to \mt{transaction} \; \mt{page}$, for any integer $n \geq 0$, where $\mt{page}$ is a type synonym for top-level HTML pages, defined in $\mt{Basis}$.  If such a function is at the top level of main module $M$, with $n = 0$, it will be accessible at URI \texttt{/M/f}, and so on for more deeply nested functions, as described in Section \ref{tag} below.  See Section \ref{cl} for information on the \texttt{prefix} and \texttt{rewrite url} directives, which can be used to rewrite the default URIs of different entry point functions.  The final URL of a function is its default module-based URI, with \texttt{rewrite url} rules applied, and with the \texttt{prefix} prepended.  Arguments to an entry-point function are deserialized from the part of the URI following \texttt{f}.
+
+Elements of modules beside the main module, including page handlers, will only be included in the final application if they are transitive dependencies of the handlers in the main module.
+
+Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects.  To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$.  When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$).  This kind of handler should not be used with forms that exist solely within Ur/Web apps; for these, use Ur/Web's built-in support, as described below.  It may still be useful to use $\mt{Basis.postBody}$ with form requests submitted by code outside an Ur/Web app.  For such cases, the function $\mt{Top.postFields} : \mt{postBody} \to \mt{list} \; (\mt{string} \times \mt{string})$ may be useful, breaking a \texttt{POST} body of type \texttt{application/x-www-form-urlencoded} into its name-value pairs.
+
+Any normal page handler may also include arguments of type $\mt{option \; Basis.queryString}$, which will be handled specially.  Rather than being deserialized from the current URI, such an argument is passed the whole query string that the handler received.  The string may be analyzed by calling $\mt{Basis.show}$ on it.  A handler of this kind may be passed as an argument to $\mt{Basis.effectfulUrl}$ to generate a URL to a page that may be used as a ``callback'' by an external service, such that the handler is allowed to cause side effects.
+
+When the standalone web server receives a request for a known page, it calls the function for that page, ``running'' the resulting transaction to produce the page to return to the client.  Pages link to other pages with the \texttt{link} attribute of the \texttt{a} HTML tag.  A link has type $\mt{transaction} \; \mt{page}$, and the semantics of a link are that this transaction should be run to compute the result page, when the link is followed.  Link targets are assigned URL names in the same way as top-level entry points.
+
+HTML forms are handled in a similar way.  The $\mt{action}$ attribute of a $\mt{submit}$ form tag takes a value of type $\$\mt{use} \to \mt{transaction} \; \mt{page}$, where $\mt{use}$ is a kind-$\{\mt{Type}\}$ record of the form fields used by this action handler.  Action handlers are assigned URL patterns in the same way as above.
+
+For both links and actions, direct arguments and local variables mentioned implicitly via closures are automatically included in serialized form in URLs, in the order in which they appear in the source code.  Such serialized values may only be drawn from a limited set of types, and programs will fail to compile when the (implicit or explicit) arguments of page handler functions involve disallowed types.  (Keep in mind that every free variable of a function is an implicit argument if it was not defined at the top level of a module.)  For instance:
+\begin{itemize}
+  \item Functions are disallowed, since there is no obvious way to serialize them safely.
+  \item XML fragments are disallowed, since it is unclear how to check client-provided XML to be sure it doesn't break the HTML invariants of the application (for instance, by mutating the DOM in the conventional way, interfering with Ur/Web's functional-reactive regime).
+  \item Blobs (``files'') are disallowed, since they can easily have very large serializations that could not fit within most web servers' URL size limits.  (And you probably don't want to be serializing, e.g., image files in URLs, anyway.)
+\end{itemize}
+
+Ur/Web programs generally mix server- and client-side code in a fairly transparent way.  The one important restriction is that mixed client-server code must encapsulate all server-side pieces within named functions.  This is because execution of such pieces will be implemented by explicit calls to the remote web server, and it is useful to get the programmer's help in designing the interface to be used.  For example, this makes it easier to allow a client running an old version of an application to continue interacting with a server that has been upgraded to a new version, if the programmer took care to keep the interfaces of all of the old remote calls the same.  The functions implementing these services are assigned names in the same way as normal web entry points, by using module structure.
+
+\medskip
+
+The HTTP standard suggests that GET requests only be used in ways that generate no side effects.  Side effecting operations should use POST requests instead.  The Ur/Web compiler enforces this rule strictly, via a simple conservative program analysis.  Any page that may have a side effect must be accessed through a form, all of which use POST requests, or via a direct call to a page handler with some argument of type $\mt{Basis.postBody}$.  A page is judged to have a side effect if its code depends syntactically on any of the side-effecting, server-side FFI functions.  Links, forms, and most client-side event handlers are not followed during this syntactic traversal, but \texttt{<body onload=\{...\}>} handlers \emph{are} examined, since they run right away and could just as well be considered parts of main page handlers.
+
+Ur/Web includes a kind of automatic protection against cross site request forgery attacks.  Whenever any page execution can have side effects and can also read at least one cookie value, all cookie values must be signed cryptographically, to ensure that the user has come to the current page by submitting a form on a real page generated by the proper server.  Signing and signature checking are inserted automatically by the compiler.  This prevents attacks like phishing schemes where users are directed to counterfeit pages with forms that submit to your application, where a user's cookies might be submitted without his knowledge, causing some undesired side effect.
+
+\subsection{Tasks}
+
+In many web applications, it's useful to run code at points other than requests from browsers.  Ur/Web's \emph{task} mechanism facilitates this.  A type family of \emph{task kinds} is in the standard library:
+
+$$\begin{array}{l}
+\mt{con} \; \mt{task\_kind} :: \mt{Type} \to \mt{Type} \\
+\mt{val} \; \mt{initialize} : \mt{task\_kind} \; \mt{unit} \\
+\mt{val} \; \mt{clientLeaves} : \mt{task\_kind} \; \mt{client} \\
+\mt{val} \; \mt{periodic} : \mt{int} \to \mt{task\_kind} \; \mt{unit}
+\end{array}$$
+
+A task kind names a particular extension point of generated applications, where the type parameter of a task kind describes which extra input data is available at that extension point.  Add task code with the special declaration form $\mt{task} \; e_1 = e_2$, where $e_1$ is a task kind with data $\tau$, and $e_2$ is a function from $\tau$ to $\mt{transaction} \; \mt{unit}$.
+
+The currently supported task kinds are:
+\begin{itemize}
+\item $\mt{initialize}$: Code that is run when the application starts up.
+\item $\mt{clientLeaves}$: Code that is run for each client that the runtime system decides has surfed away.  When a request that generates a new client handle is aborted, that handle will still eventually be passed to $\mt{clientLeaves}$ task code, even though the corresponding browser was never informed of the client handle's existence.  In other words, in general, $\mt{clientLeaves}$ handlers will be called more times than there are actual clients.
+\item $\mt{periodic} \; n$: Code that is run when the application starts up and then every $n$ seconds thereafter.
+\end{itemize}
+
+
+\section{\label{ffi}The Foreign Function Interface}
+
+It is possible to call your own C and JavaScript code from Ur/Web applications, via the foreign function interface (FFI).  The starting point for a new binding is a \texttt{.urs} signature file that presents your external library as a single Ur/Web module (with no nested modules).  Compilation conventions map the types and values that you use into C and/or JavaScript types and values.
+
+It is most convenient to encapsulate an FFI binding with a new \texttt{.urp} file, which applications can include with the \texttt{library} directive in their own \texttt{.urp} files.  A number of directives are likely to show up in the library's project file.
+
+\begin{itemize}
+\item \texttt{clientOnly Module.ident} registers a value as being allowed only in client-side code.
+\item \texttt{clientToServer Module.ident} declares a type as OK to marshal between clients and servers.  By default, abstract FFI types are not allowed to be marshalled, since your library might be maintaining invariants that the simple serialization code doesn't check.
+\item \texttt{effectful Module.ident} registers a function that can have side effects.  This is the default for \texttt{transaction}-based types, and, actually, this directive is mostly present for legacy compatibility reasons, since it used to be required explicitly for each \texttt{transaction}al function.
+\item \texttt{ffi FILE.urs} names the file giving your library's signature.  You can include multiple such files in a single \texttt{.urp} file, and each file \texttt{mod.urp} defines an FFI module \texttt{Mod}.
+\item \texttt{include FILE} requests inclusion of a C header file.
+\item \texttt{jsFile FILE} requests inclusion of a JavaScript source file.
+\item \texttt{jsFunc Module.ident=name} gives a mapping from an Ur name for a value to a JavaScript name.
+\item \texttt{link FILE} requests that \texttt{FILE} be linked into applications.  It should be a C object or library archive file, and you are responsible for generating it with your own build process.
+\item \texttt{script URL} requests inclusion of a JavaScript source file within application HTML.
+\item \texttt{serverOnly Module.ident} registers a value as being allowed only in server-side code.
+\end{itemize}
+
+\subsection{Writing C FFI Code}
+
+C source files connecting to the Ur/Web FFI should include \texttt{urweb.h}, and C++ source files should include \texttt{urweb\_cpp.h}.
+
+A server-side FFI type or value \texttt{Module.ident} must have a corresponding type or value definition \texttt{uw\_Module\_ident} in C code.  With the current Ur/Web version, it's not generally possible to work with Ur records or complex datatypes in C code, but most other kinds of types are fair game.
+
+\begin{itemize}
+  \item Primitive types defined in \texttt{Basis} are themselves using the standard FFI interface, so you may refer to them like \texttt{uw\_Basis\_t}.  See \texttt{include/urweb/types.h} for their definitions.
+  \item Enumeration datatypes, which have only constructors that take no arguments, should be defined using C \texttt{enum}s.  The type is named as for any other type identifier, and each constructor \texttt{c} gets an enumeration constant named \texttt{uw\_Module\_c}.
+  \item A datatype \texttt{dt} (such as \texttt{Basis.option}) that has one non-value-carrying constructor \texttt{NC} and one value-carrying constructor \texttt{C} gets special treatment.  Where \texttt{T} is the type of \texttt{C}'s argument, and where we represent \texttt{T} as \texttt{t} in C, we represent \texttt{NC} with \texttt{NULL}.  The representation of \texttt{C} depends on whether we're sure that we don't need to use \texttt{NULL} to represent \texttt{t} values; this condition holds only for strings and complex datatypes.  For such types, \texttt{C v} is represented with the C encoding of \texttt{v}, such that the translation of \texttt{dt} is \texttt{t}.  For other types, \texttt{C v} is represented with a pointer to the C encoding of v, such that the translation of \texttt{dt} is \texttt{t*}.
+  \item Ur/Web involves many types of program syntax, such as for HTML and SQL code.  All of these types are implemented with normal C strings, and you may take advantage of that encoding to manipulate code as strings in C FFI code.  Be mindful that, in writing such code, it is your responsibility to maintain the appropriate code invariants, or you may reintroduce the code injection vulnerabilities that Ur/Web rules out.  The most convenient way to extend Ur/Web with functions that, e.g., use natively unsupported HTML tags is to generate the HTML code with the FFI.
+\end{itemize}
+
+The C FFI version of a Ur function with type \texttt{T1 -> ... -> TN -> R} or \texttt{T1 -> ... -> TN -> transaction R} has a C prototype like \texttt{R uw\_Module\_ident(uw\_context, T1, ..., TN)}.  Only functions with types of the second form may have side effects.  \texttt{uw\_context} is the type of state that persists across handling a client request.  Many functions that operate on contexts are prototyped in \texttt{include/urweb/urweb\_cpp.h}.  Most should only be used internally by the compiler.  A few are useful in general FFI implementation:
+\begin{itemize}
+  \item \begin{verbatim}
+void uw_error(uw_context, failure_kind, const char *fmt, ...);
+  \end{verbatim}
+  Abort the current request processing, giving a \texttt{printf}-style format string and arguments for generating an error message.  The \texttt{failure\_kind} argument can be \texttt{FATAL}, to abort the whole execution; \texttt{BOUNDED\_RETRY}, to try processing the request again from the beginning, but failing if this happens too many times; or \texttt{UNLIMITED\_RETRY}, to repeat processing, with no cap on how many times this can recur.
+
+  All pointers to the context-local heap (see description below of \texttt{uw\_malloc()}) become invalid at the start and end of any execution of a main entry point function of an application.  For example, if the request handler is restarted because of a \texttt{uw\_error()} call with \texttt{BOUNDED\_RETRY} or for any other reason, it is unsafe to access any local heap pointers that may have been stashed somewhere beforehand.
+
+  \item \begin{verbatim}
+void uw_set_error_message(uw_context, const char *fmt, ...);
+  \end{verbatim}
+  This simpler form of \texttt{uw\_error()} saves an error message without immediately aborting execution.
+
+  \item \begin{verbatim}
+void uw_push_cleanup(uw_context, void (*func)(void *), void *arg);
+void uw_pop_cleanup(uw_context);
+  \end{verbatim}
+  Manipulate a stack of actions that should be taken if any kind of error condition arises.  Calling the ``pop'' function both removes an action from the stack and executes it.  It is a bug to let a page request handler finish successfully with unpopped cleanup actions.
+
+  Pending cleanup actions aren't intended to have any complex relationship amongst themselves, so, upon request handler abort, pending actions are executed in first-in-first-out order.
+
+  \item \begin{verbatim}
+void *uw_malloc(uw_context, size_t);
+  \end{verbatim}
+  A version of \texttt{malloc()} that allocates memory inside a context's heap, which is managed with region allocation.  Thus, there is no \texttt{uw\_free()}, but you need to be careful not to keep ad-hoc C pointers to this area of memory.  In general, \texttt{uw\_malloc()}ed memory should only be used in ways compatible with the computation model of pure Ur.  This means it is fine to allocate and return a value that could just as well have been built with core Ur code.  In contrast, it is almost never safe to store \texttt{uw\_malloc()}ed pointers in global variables, including when the storage happens implicitly by registering a callback that would take the pointer as an argument.
+
+  For performance and correctness reasons, it is usually preferable to use \texttt{uw\_malloc()} instead of \texttt{malloc()}.  The former manipulates a local heap that can be kept allocated across page requests, while the latter uses global data structures that may face contention during concurrent execution.  However, we emphasize again that \texttt{uw\_malloc()} should never be used to implement some logic that couldn't be implemented trivially by a constant-valued expression in Ur.
+
+  \item \begin{verbatim}
+typedef void (*uw_callback)(void *);
+typedef void (*uw_callback_with_retry)(void *, int will_retry);
+int uw_register_transactional(uw_context, void *data, uw_callback commit,
+                              uw_callback rollback, uw_callback_with_retry free);
+  \end{verbatim}
+  All side effects in Ur/Web programs need to be compatible with transactions, such that any set of actions can be undone at any time.  Thus, you should not perform actions with non-local side effects directly; instead, register handlers to be called when the current transaction is committed or rolled back.  The arguments here give an arbitary piece of data to be passed to callbacks, a function to call on commit, a function to call on rollback, and a function to call afterward in either case to clean up any allocated resources.  A rollback handler may be called after the associated commit handler has already been called, if some later part of the commit process fails.  A free handler is told whether the runtime system expects to retry the current page request after rollback finishes.  The return value of \texttt{uw\_register\_transactional()} is 0 on success and nonzero on failure (where failure currently only happens when exceeding configured limits on number of transactionals).
+
+  Any of the callbacks may be \texttt{NULL}.  To accommodate some stubbornly non-transactional real-world actions like sending an e-mail message, Ur/Web treats \texttt{NULL} \texttt{rollback} callbacks specially.  When a transaction commits, all \texttt{commit} actions that have non-\texttt{NULL} rollback actions are tried before any \texttt{commit} actions that have \texttt{NULL} rollback actions.  Furthermore, an SQL \texttt{COMMIT} is also attempted in between the two phases, so the nicely transactional actions have a chance to influence whether data are committed to the database, while \texttt{NULL}-rollback actions only get run in the first place after committing data.  The reason for all this is that it is \emph{expected} that concurrency interactions will cause database commits to fail in benign ways that call for transaction restart.  A truly non-undoable action should only be run after we are sure the database transaction will commit.
+
+  When a request handler ends with multiple pending transactional actions, their handlers are run in a first-in-last-out stack-like order, wherever the order would otherwise be ambiguous.
+
+  It is not safe for any of these handlers to access a context-local heap through a pointer returned previously by \texttt{uw\_malloc()}, nor should any new calls to that function be made.  Think of the context-local heap as meant for use by the Ur/Web code itself, while transactional handlers execute after the Ur/Web code has finished.
+
+  A handler may signal an error by calling \texttt{uw\_set\_error\_message()}, but it is not safe to call \texttt{uw\_error()} from a handler.  Signaling an error in a commit handler will cause the runtime system to switch to aborting the transaction, immediately after the current commit handler returns.
+
+  \item \begin{verbatim}
+void *uw_get_global(uw_context, char *name);
+void uw_set_global(uw_context, char *name, void *data, uw_callback free);
+  \end{verbatim}
+  Different FFI-based extensions may want to associate their own pieces of data with contexts.  The global interface provides a way of doing that, where each extension must come up with its own unique key.  The \texttt{free} argument to \texttt{uw\_set\_global()} explains how to deallocate the saved data.  It is never safe to store \texttt{uw\_malloc()}ed pointers in global variable slots.
+
+\end{itemize}
+
+\subsection{Writing JavaScript FFI Code}
+
+JavaScript is dynamically typed, so Ur/Web type definitions imply no JavaScript code.  The JavaScript identifier for each FFI function is set with the \texttt{jsFunc} directive.  Each identifier can be defined in any JavaScript file that you ask to include with the \texttt{script} directive, and one easy way to get code included is with the \texttt{jsFile} directive.
+
+In contrast to C FFI code, JavaScript FFI functions take no extra context argument.  Their argument lists are as you would expect from their Ur types.  Only functions whose ranges take the form \texttt{transaction T} should have side effects; the JavaScript ``return type'' of such a function is \texttt{T}.  Here are the conventions for representing Ur values in JavaScript.
+
+\begin{itemize}
+\item Integers, floats, strings, characters, and booleans are represented in the usual JavaScript way.
+\item Ur functions are represented in an unspecified way.  This means that you should not rely on any details of function representation.  Named FFI functions are represented as JavaScript functions with as many arguments as their Ur types specify.  To call a non-FFI function \texttt{f} on argument \texttt{x}, run \texttt{execF(f, x)}.  A normal JavaScript function may also be used in a position where the Ur/Web runtime system expects an Ur/Web function.
+\item An Ur record is represented with a JavaScript record, where Ur field name \texttt{N} translates to JavaScript field name \texttt{\_N}.  An exception to this rule is that the empty record is encoded as \texttt{null}.
+\item \texttt{option}-like types receive special handling similar to their handling in C.  The ``\texttt{None}'' constructor is \texttt{null}, and a use of the ``\texttt{Some}'' constructor on a value \texttt{v} is either \texttt{v}, if the underlying type doesn't need to use \texttt{null}; or \texttt{\{v:v\}} otherwise.
+\item Any other datatypes represent a non-value-carrying constructor \texttt{C} as \texttt{"C"} and an application of a constructor \texttt{C} to value \texttt{v} as \texttt{\{n:"C", v:v\}}.  This rule only applies to datatypes defined in FFI module signatures; the compiler is free to optimize the representations of other, non-\texttt{option}-like datatypes in arbitrary ways.
+\item As in the C FFI, all abstract types of program syntax are implemented with strings in JavaScript.
+\item A value of Ur type \texttt{transaction t} is represented in the same way as for \texttt{unit -> t}.  (Note that FFI functions skip this extra level of function encoding, which only applies to functions defined in Ur/Web.)
+\end{itemize}
+
+It is possible to write JavaScript FFI code that interacts with the functional-reactive structure of a document.  Here is a quick summary of some of the simpler functions to use; descriptions of fancier stuff may be added later on request (and such stuff should be considered ``undocumented features'' until then).
+
+\begin{itemize}
+\item Sources should be treated as an abstract type, manipulated via:
+  \begin{itemize}
+  \item \cd{sc(v)}, to create a source initialized to \cd{v}
+  \item \cd{sg(s)}, to retrieve the current value of source \cd{s}
+  \item \cd{sv(s, v)}, to set source \cd{s} to value \cd{v}
+  \end{itemize}
+
+\item Signals should be treated as an abstract type, manipulated via:
+  \begin{itemize}
+  \item \cd{sr(v)} and \cd{sb(s, f)}, the ``return'' and ``bind'' monad operators, respectively
+  \item \cd{ss(s)}, to produce the signal corresponding to source \cd{s}
+  \item \cd{scur(s)}, to get the current value of signal \cd{s}
+  \end{itemize}
+
+\item The behavior of the \cd{<dyn>} pseudo-tag may be mimicked by following the right convention in a piece of HTML source code with a type like $\mt{xbody}$.  Such a piece of source code may be encoded with a JavaScript string.  To insert a dynamic section, include a \cd{<script>} tag whose content is just a call \cd{dyn(pnode, s)}.  The argument \cd{pnode} specifies what the relevant enclosing parent tag is.  Use value \cd{"tr"} when the immediate parent is \cd{<tr>}, use \cd{"table"} when the immediate parent is \cd{<table>}, and use \cd{"span"} otherwise.  The argument \cd{s} is a string-valued signal giving the HTML code to be inserted at this point.  As with the usual \cd{<dyn>} tag, that HTML subtree is automatically updated as the value of \cd{s} changes.
+
+\item There is only one supported method of taking HTML values generated in Ur/Web code and adding them to the DOM in FFI JavaScript code: call \cd{setInnerHTML(node, html)} to add HTML content \cd{html} within DOM node \cd{node}.  Merely running \cd{node.innerHTML = html} is not guaranteed to get the job done, though programmers familiar with JavaScript will probably find it useful to think of \cd{setInnerHTML} as having this effect.  The unusual idiom is required because Ur/Web uses a nonstandard representation of HTML, to support infinite nesting of code that may generate code that may generate code that....  The \cd{node} value must already be in the DOM tree at the point when \cd{setInnerHTML} is called, because some plumbing must be set up to interact sensibly with \cd{<dyn>} tags. 
+
+\item It is possible to use the more standard ``IDs and mutation'' style of JavaScript coding, though that style is unidiomatic for Ur/Web and should be avoided wherever possible.  Recall the abstract type $\mt{id}$ and its constructor $\mt{fresh}$, which can be used to generate new unique IDs in Ur/Web code.  Values of this type are represented as strings in JavaScript, and a function \cd{fresh()} is available to generate new unique IDs.  Application-specific ID generation schemes may cause bad interactions with Ur/Web code that also generates IDs, so the recommended approach is to produce IDs only via calls to \cd{fresh()}.  FFI code shouldn't depend on the ID generation scheme (on either server side or client side), but it is safe to include these IDs in tag attributes (in either server-side or client-side code) and manipulate the associated DOM nodes in the standard way (in client-side code).  Be forewarned that this kind of imperative DOM manipulation may confuse the Ur/Web runtime system and interfere with proper behavior of tags like \cd{<dyn>}!
+\end{itemize}
+
+\subsection{Introducing New HTML Tags}
+
+FFI modules may introduce new tags as values with $\mt{Basis.tag}$ types.  See \texttt{basis.urs} for examples of how tags are declared.  The identifier of a tag value is used as its rendering in HTML.  The Ur/Web syntax sugar for XML literals desugars each use of a tag into a reference to an identifier with the same name.  There is no need to provide implementations (i.e., in C or JavaScript code) for such identifiers.
+
+The onus is on the coder of a new tag's interface to think about consequences for code injection attacks, messing with the DOM in ways that may break Ur/Web reactive programming, etc.
+
+\subsection{The Less Safe FFI}
+
+An alternative interface is provided for declaring FFI functions inline within normal Ur/Web modules.  This facility must be opted into with the \texttt{lessSafeFfi} \texttt{.urp} directive, since it breaks a crucial property, allowing code in a \texttt{.ur} file to break basic invariants of the Ur/Web type system.  Without this option, one only needs to audit \texttt{.urp} files to be sure an application obeys the type-system rules.  The alternative interface may be more convenient for such purposes as declaring an FFI function typed in terms of some type local to a module.
+
+When the less safe mode is enabled, declarations like this one are accepted, at the top level of a \texttt{.ur} file:
+\begin{verbatim}
+  ffi foo : int -> int
+\end{verbatim}
+
+Now \texttt{foo} is available as a normal function.  If called in server-side code, and if the above declaration appeared in \texttt{bar.ur}, the C function will be linked as \texttt{uw\_Bar\_foo()}.  It is also possible to declare an FFI function to be implemented in JavaScript, using a general facility for including modifiers in an FFI declaration.  The modifiers appear before the colon, separated by spaces.  Here are the available ones, which have the same semantics as corresponding \texttt{.urp} directives.
+\begin{itemize}
+\item \texttt{effectful}
+\item \texttt{benignEffectful}
+\item \texttt{clientOnly}
+\item \texttt{serverOnly}
+\item \texttt{jsFunc "putJsFuncNameHere"}
+\end{itemize}
+
+When no \texttt{jsFunc} directive is present, the function is assumed to map to a JavaScript function of the same name, if used in a client-side context.
+
+
+\section{\label{phases}Compiler Phases}
+
+The Ur/Web compiler is unconventional in that it relies on a kind of \emph{heuristic compilation}.  Not all valid programs will compile successfully.  Informally, programs fail to compile when they are ``too higher order.''  Compiler phases do their best to eliminate different kinds of higher order-ness, but some programs just won't compile.  This is a trade-off for producing very efficient executables.  Compiled Ur/Web programs use native C representations and require no garbage collection.  Also, this warning only applies to server-side code, as client-side code runs in a normal JavaScript environment with garbage collection.
+
+In this section, we step through the main phases of compilation, noting what consequences each phase has for effective programming.
+
+\subsection{Parse}
+
+The compiler reads a \texttt{.urp} file, figures out which \texttt{.urs} and \texttt{.ur} files it references, and combines them all into what is conceptually a single sequence of declarations in the core language of Section \ref{core}.
+
+\subsection{Elaborate}
+
+This is where type inference takes place, translating programs into an explicit form with no more wildcards.  This phase is the most likely source of compiler error messages.
+
+Those crawling through the compiler source will also want to be aware of another compiler phase, Explify, that occurs immediately afterward.  This phase just translates from an AST language that includes unification variables to a very similar language that doesn't; all variables should have been determined by the end of Elaborate, anyway.  The new AST language also drops some features that are used only for static checking and that have no influence on runtime behavior, like disjointness constraints.
+
+\subsection{Unnest}
+
+Named local function definitions are moved to the top level, to avoid the need to generate closures.
+
+\subsection{Corify}
+
+Module system features are compiled away, through inlining of functor definitions at application sites.  Afterward, most abstraction boundaries are broken, facilitating optimization.
+
+\subsection{Especialize}
+
+Functions are specialized to particular argument patterns.  This is an important trick for avoiding the need to maintain any closures at runtime.  Currently, specialization only happens for prefixes of a function's full list of parameters, so you may need to take care to put arguments of function types before other arguments.  The optimizer will not be effective enough if you use arguments that mix functions and values that must be calculated at run-time.  For instance, a tuple of a function and an integer counter would not lead to successful code generation; these should be split into separate arguments via currying.
+
+\subsection{Untangle}
+
+Remove unnecessary mutual recursion, splitting recursive groups into strongly connected components.
+
+\subsection{Shake}
+
+Remove all definitions not needed to run the page handlers that are visible in the signature of the last module listed in the \texttt{.urp} file.
+
+\subsection{Rpcify}
+
+Pieces of code are determined to be client-side, server-side, neither, or both, by figuring out which standard library functions might be needed to execute them.  Calls to server-side functions (e.g., $\mt{query}$) within mixed client-server code are identified and replaced with explicit remote calls.  Some mixed functions may be converted to continuation-passing style to facilitate this transformation.
+
+\subsection{Untangle, Shake}
+
+Repeat these simplifications.
+
+\subsection{\label{tag}Tag}
+
+Assign a URL name to each link and form action.  It is important that these links and actions are written as applications of named functions, because such names are used to generate URL patterns.  A URL pattern has a name built from the full module path of the named function, followed by the function name, with all pieces separated by slashes.  The path of a functor application is based on the name given to the result, rather than the path of the functor itself.
+
+\subsection{Reduce}
+
+Apply definitional equality rules to simplify the program as much as possible.  This effectively includes inlining of every non-recursive definition.
+
+\subsection{Unpoly}
+
+This phase specializes polymorphic functions to the specific arguments passed to them in the program.  If the program contains real polymorphic recursion, Unpoly will be insufficient to avoid later error messages about too much polymorphism.
+
+\subsection{Specialize}
+
+Replace uses of parameterized datatypes with versions specialized to specific parameters.  As for Unpoly, this phase will not be effective enough in the presence of polymorphic recursion or other fancy uses of impredicative polymorphism.
+
+\subsection{Shake}
+
+Here the compiler repeats the earlier Shake phase.
+
+\subsection{Monoize}
+
+Programs are translated to a new intermediate language without polymorphism or non-$\mt{Type}$ constructors.  Error messages may pop up here if earlier phases failed to remove such features.
+
+This is the stage at which concrete names are generated for cookies, tables, and sequences.  They are named following the same convention as for links and actions, based on module path information saved from earlier stages.  Table and sequence names separate path elements with underscores instead of slashes, and they are prefixed by \texttt{uw\_}.
+
+\subsection{MonoOpt}
+
+Simple algebraic laws are applied to simplify the program, focusing especially on efficient imperative generation of HTML pages.
+
+\subsection{MonoUntangle}
+
+Unnecessary mutual recursion is broken up again.
+
+\subsection{MonoReduce}
+
+Equivalents of the definitional equality rules are applied to simplify programs, with inlining again playing a major role.
+
+\subsection{MonoShake, MonoOpt}
+
+Unneeded declarations are removed, and basic optimizations are repeated.
+
+\subsection{Fuse}
+
+The compiler tries to simplify calls to recursive functions whose results are immediately written as page output.  The write action is pushed inside the function definitions to avoid allocation of intermediate results.
+
+\subsection{MonoUntangle, MonoShake}
+
+Fuse often creates more opportunities to remove spurious mutual recursion.
+
+\subsection{Pathcheck}
+
+The compiler checks that no link or action name has been used more than once.
+
+\subsection{Cjrize}
+
+The program is translated to what is more or less a subset of C.  If any use of functions as data remains at this point, the compiler will complain.
+
+\subsection{C Compilation and Linking}
+
+The output of the last phase is pretty-printed as C source code and passed to the C compiler.
+
+
+\end{document}
diff --git a/include/urweb/queue.h b/include/urweb/queue.h
new file mode 100644
index 0000000..8297dd0
--- /dev/null
+++ b/include/urweb/queue.h
@@ -0,0 +1,7 @@
+#ifndef QUEUE_H
+#define QUEUE_H
+
+int uw_dequeue();
+void uw_enqueue(int);
+
+#endif
diff --git a/include/urweb/request.h b/include/urweb/request.h
new file mode 100644
index 0000000..a15df10
--- /dev/null
+++ b/include/urweb/request.h
@@ -0,0 +1,37 @@
+#ifndef REQUEST_H
+#define REQUEST_H
+
+#include <sys/types.h>
+#include <pthread.h>
+
+#include "types.h"
+
+typedef struct uw_rc *uw_request_context;
+
+void uw_request_init(uw_app *app, uw_loggers* ls);
+void uw_sign(const char *in, char *out);
+
+uw_request_context uw_new_request_context(void);
+void uw_free_request_context(uw_request_context);
+
+request_result uw_request(uw_request_context rc, uw_context ctx,
+                          char *method, char *path, char *query_string,
+                          char *body, size_t body_len,
+                          void (*on_success)(uw_context), void (*on_failure)(uw_context),
+                          void *logger_data, uw_logger log_error, uw_logger log_debug,
+                          int sock,
+                          int (*send)(int sockfd, const void *buf, ssize_t len),
+                          int (*close)(int fd));
+
+uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls);
+
+typedef struct {
+  uw_app *app;
+  uw_loggers *loggers;
+} pruner_data;
+
+void *client_pruner(void *data);
+
+int pthread_create_big(pthread_t *outThread, void *foo, void *threadFunc, void *arg);
+
+#endif
diff --git a/include/urweb/types.h b/include/urweb/types.h
new file mode 100644
index 0000000..b11a8df
--- /dev/null
+++ b/include/urweb/types.h
@@ -0,0 +1,9 @@
+#ifndef URWEB_TYPES_H
+#define URWEB_TYPES_H
+
+#include "types_cpp.h"
+
+typedef struct uw_context *uw_context;
+typedef struct input *uw_input;
+
+#endif
diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h
new file mode 100644
index 0000000..2fa473a
--- /dev/null
+++ b/include/urweb/types_cpp.h
@@ -0,0 +1,152 @@
+#ifndef URWEB_TYPES_CPP_H
+#define URWEB_TYPES_CPP_H
+
+#include <time.h>
+#include <unistd.h>
+#include <stdint.h>
+
+typedef long long uw_Basis_int;
+typedef double uw_Basis_float;
+typedef char* uw_Basis_string;
+typedef char uw_Basis_char;
+typedef struct {
+  time_t seconds;
+  unsigned microseconds;
+} uw_Basis_time;
+typedef struct {
+  size_t size;
+  char *data;
+} uw_Basis_blob;
+
+typedef int uw_unit;
+typedef uw_unit uw_Basis_unit;
+
+typedef enum uw_Basis_bool { uw_Basis_False, uw_Basis_True } uw_Basis_bool;
+
+typedef uw_Basis_string uw_Basis_xhtml;
+typedef uw_Basis_string uw_Basis_page;
+typedef uw_Basis_string uw_Basis_xbody;
+typedef uw_Basis_string uw_Basis_css_class;
+
+typedef unsigned uw_Basis_client;
+typedef struct {
+  unsigned cli, chn;
+} uw_Basis_channel;
+
+typedef struct {
+  int context;
+  unsigned long long source;
+} uw_Basis_source;
+
+typedef struct uw_Basis_file {
+  uw_Basis_string name, type;
+  uw_Basis_blob data;
+} uw_Basis_file;
+
+typedef struct uw_Basis_postBody {
+  uw_Basis_string type, data;
+  size_t len;
+} uw_Basis_postBody;
+
+typedef uw_Basis_string uw_Basis_queryString;
+
+typedef struct {
+  uw_Basis_string name, value, remaining;
+} uw_Basis_postField;
+
+typedef enum { SUCCESS, FATAL, BOUNDED_RETRY, UNLIMITED_RETRY, RETURN_INDIRECTLY } failure_kind;
+
+typedef enum { SERVED, KEEP_OPEN, FAILED } request_result;
+
+#define INTS_MAX 50
+#define FLOATS_MAX 100
+#define TIMES_MAX 100
+
+typedef void (*uw_callback)(void *);
+typedef void (*uw_callback_with_retry)(void *, int will_retry);
+typedef void (*uw_logger)(void*, const char *fmt, ...);
+
+struct uw_context;
+
+typedef struct {
+  void (*callback)(struct uw_context *);
+  unsigned int period;
+} uw_periodic;
+
+typedef struct {
+  int inputs_len, timeout;
+  char *url_prefix;
+
+  void (*client_init)();
+  void (*initializer)(struct uw_context *);
+  void (*expunger)(struct uw_context *, uw_Basis_client);
+
+  void (*db_init)(struct uw_context *);
+  int (*db_begin)(struct uw_context *, int could_write);
+  int (*db_commit)(struct uw_context *);
+  int (*db_rollback)(struct uw_context *);
+  void (*db_close)(struct uw_context *);
+
+  void (*handle)(struct uw_context *, char *);
+
+  int (*input_num)(const char*);
+  uw_Basis_string (*cookie_sig)(struct uw_context *);
+  int (*check_url)(const char *);
+  int (*check_mime)(const char *);
+  int (*check_requestHeader)(const char *);
+  int (*check_responseHeader)(const char *);
+  int (*check_envVar)(const char *);
+  int (*check_meta)(const char *);
+
+  void (*on_error)(struct uw_context *, char *);
+
+  uw_periodic *periodics; // 0-terminated array
+
+  uw_Basis_string time_format;
+
+  int is_html5;
+} uw_app;
+
+typedef struct {
+  /* uw_app *app; */
+  void *logger_data;
+  uw_logger log_error, log_debug;
+} uw_loggers;
+
+#define ERROR_BUF_LEN 10240
+
+typedef struct {
+  size_t max;
+  char *start, *front, *back;
+} uw_buffer;
+
+// Caching
+
+#include <pthread.h>
+#include "uthash.h"
+
+typedef struct uw_Sqlcache_Value {
+  char *result;
+  char *output;
+  char *scriptOutput;
+  unsigned long timeValid;
+} uw_Sqlcache_Value;
+
+typedef struct uw_Sqlcache_Entry {
+  char *key;
+  uw_Sqlcache_Value *value;
+  unsigned long timeInvalid;
+  UT_hash_handle hh;
+} uw_Sqlcache_Entry;
+
+typedef struct uw_Sqlcache_Cache {
+  pthread_rwlock_t lockOut;
+  pthread_rwlock_t lockIn;
+  uw_Sqlcache_Entry *table;
+  unsigned long timeInvalid;
+  unsigned long timeNow;
+  size_t numKeys;
+  UT_hash_handle hh;
+} uw_Sqlcache_Cache;
+
+#endif
diff --git a/include/urweb/urweb.h b/include/urweb/urweb.h
new file mode 100644
index 0000000..589d03f
--- /dev/null
+++ b/include/urweb/urweb.h
@@ -0,0 +1,7 @@
+#ifndef URWEB_H
+#define URWEB_H
+
+#include "types.h"
+#include "urweb_cpp.h"
+
+#endif
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
new file mode 100644
index 0000000..0d5f5e0
--- /dev/null
+++ b/include/urweb/urweb_cpp.h
@@ -0,0 +1,435 @@
+#ifndef URWEB_CPP_H
+#define URWEB_CPP_H
+
+#include <sys/types.h>
+
+#include "types_cpp.h"
+
+int uw_really_send(int sock, const void *buf, ssize_t len);
+int uw_really_write(int fd, const void *buf, size_t len);
+
+extern uw_unit uw_unit_v;
+
+void uw_global_init(void);
+void uw_app_init(uw_app*);
+
+void uw_client_connect(unsigned id, int pass, int sock,
+                       int (*send)(int sockfd, const void *buf, ssize_t len),
+                       int (*close)(int fd),
+                       void *logger_data, uw_logger log_error);
+void uw_prune_clients(struct uw_context *);
+failure_kind uw_initialize(struct uw_context *);
+
+struct uw_context * uw_init(int id, uw_loggers *lg);
+void uw_close(struct uw_context *);
+int uw_set_app(struct uw_context *, uw_app*);
+uw_app *uw_get_app(struct uw_context *);
+void uw_set_db(struct uw_context *, void*);
+void *uw_get_db(struct uw_context *);
+void uw_free(struct uw_context *);
+void uw_reset(struct uw_context *);
+void uw_reset_keep_request(struct uw_context *);
+void uw_reset_keep_error_message(struct uw_context *);
+char *uw_get_url_prefix(struct uw_context *);
+
+failure_kind uw_begin_init(struct uw_context *);
+void uw_set_on_success(char *);
+void uw_set_headers(struct uw_context *, char *(*get_header)(void *, const char *), void *get_header_data);
+void uw_set_env(struct uw_context *, char *(*get_env)(void *, const char *), void *get_env_data);
+uw_loggers* uw_get_loggers(struct uw_context *ctx);
+uw_loggers* uw_get_loggers(struct uw_context *ctx);
+failure_kind uw_begin(struct uw_context *, char *path);
+void uw_ensure_transaction(struct uw_context *);
+void uw_try_reconnecting_and_restarting(struct uw_context *);
+failure_kind uw_begin_onError(struct uw_context *, char *msg);
+void uw_login(struct uw_context *);
+int uw_commit(struct uw_context *);
+// ^-- returns nonzero if the transaction should be restarted
+int uw_rollback(struct uw_context *, int will_retry);
+
+__attribute__((noreturn)) void uw_error(struct uw_context *, failure_kind, const char *fmt, ...);
+char *uw_error_message(struct uw_context *);
+void uw_set_error_message(struct uw_context *, const char *fmt, ...);
+uw_Basis_string uw_dup_and_clear_error_message(struct uw_context *);
+int uw_has_error(struct uw_context *);
+void uw_push_cleanup(struct uw_context *, void (*func)(void *), void *arg);
+void uw_pop_cleanup(struct uw_context *);
+
+void *uw_malloc(struct uw_context *, size_t);
+void uw_begin_region(struct uw_context *);
+void uw_end_region(struct uw_context *);
+void uw_memstats(struct uw_context *);
+
+int uw_send(struct uw_context *, int sock);
+int uw_print(struct uw_context *, int fd);
+int uw_output(struct uw_context * ctx, int (*output)(void *data, const char *buf, size_t len), void *data);
+int uw_pagelen(struct uw_context *);
+
+int uw_set_input(struct uw_context *, const char *name, char *value);
+int uw_set_file_input(struct uw_context *, char *name, uw_Basis_file);
+
+char *uw_get_input(struct uw_context *, int name);
+char *uw_get_optional_input(struct uw_context *, int name);
+uw_Basis_file uw_get_file_input(struct uw_context *, int name);
+void uw_enter_subform(struct uw_context *, int name);
+void uw_leave_subform(struct uw_context *);
+int uw_enter_subforms(struct uw_context *, int name);
+int uw_next_entry(struct uw_context *);
+
+void uw_write(struct uw_context *, const char*);
+
+// For caching.
+void uw_recordingStart(struct uw_context *);
+char *uw_recordingRead(struct uw_context *);
+char *uw_recordingReadScript(struct uw_context *);
+
+uw_Basis_source uw_Basis_new_client_source(struct uw_context *, uw_Basis_string);
+uw_unit uw_Basis_set_client_source(struct uw_context *, uw_Basis_source, uw_Basis_string);
+
+void uw_set_script_header(struct uw_context *, const char*);
+char *uw_Basis_get_settings(struct uw_context *, uw_unit);
+char *uw_get_real_script(struct uw_context *);
+
+uw_Basis_string uw_Basis_maybe_onload(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_maybe_onunload(struct uw_context *, uw_Basis_string);
+
+void uw_set_needs_push(struct uw_context *, int);
+void uw_set_needs_sig(struct uw_context *, int);
+void uw_set_could_write_db(struct uw_context *, int);
+void uw_set_at_most_one_query(struct uw_context *, int);
+
+char *uw_Basis_htmlifyInt(struct uw_context *, uw_Basis_int);
+char *uw_Basis_htmlifyFloat(struct uw_context *, uw_Basis_float);
+char *uw_Basis_htmlifyString(struct uw_context *, uw_Basis_string);
+char *uw_Basis_htmlifyBool(struct uw_context *, uw_Basis_bool);
+char *uw_Basis_htmlifyTime(struct uw_context *, uw_Basis_time);
+char *uw_Basis_htmlifySpecialChar(struct uw_context *, unsigned char);
+char *uw_Basis_htmlifySource(struct uw_context *, uw_Basis_source);
+
+uw_unit uw_Basis_htmlifyInt_w(struct uw_context *, uw_Basis_int);
+uw_unit uw_Basis_htmlifyFloat_w(struct uw_context *, uw_Basis_float);
+uw_unit uw_Basis_htmlifyString_w(struct uw_context *, uw_Basis_string);
+uw_unit uw_Basis_htmlifyBool_w(struct uw_context *, uw_Basis_bool);
+uw_unit uw_Basis_htmlifyTime_w(struct uw_context *, uw_Basis_time);
+uw_unit uw_Basis_htmlifySpecialChar_w(struct uw_context *, unsigned char);
+uw_unit uw_Basis_htmlifySource_w(struct uw_context *, uw_Basis_source);
+
+char *uw_Basis_attrifyInt(struct uw_context *, uw_Basis_int);
+char *uw_Basis_attrifyFloat(struct uw_context *, uw_Basis_float);
+char *uw_Basis_attrifyString(struct uw_context *, uw_Basis_string);
+char *uw_Basis_attrifyChar(struct uw_context *, uw_Basis_char);
+char *uw_Basis_attrifyTime(struct uw_context *, uw_Basis_time);
+char *uw_Basis_attrifyChannel(struct uw_context *, uw_Basis_channel);
+char *uw_Basis_attrifyClient(struct uw_context *, uw_Basis_client);
+char *uw_Basis_attrifyCss_class(struct uw_context *, uw_Basis_css_class);
+
+uw_unit uw_Basis_attrifyInt_w(struct uw_context *, uw_Basis_int);
+uw_unit uw_Basis_attrifyFloat_w(struct uw_context *, uw_Basis_float);
+uw_unit uw_Basis_attrifyString_w(struct uw_context *, uw_Basis_string);
+uw_unit uw_Basis_attrifyChar_w(struct uw_context *, uw_Basis_char);
+
+char *uw_Basis_urlifyInt(struct uw_context *, uw_Basis_int);
+char *uw_Basis_urlifyFloat(struct uw_context *, uw_Basis_float);
+char *uw_Basis_urlifyString(struct uw_context *, uw_Basis_string);
+char *uw_Basis_urlifyBool(struct uw_context *, uw_Basis_bool);
+char *uw_Basis_urlifyTime(struct uw_context *, uw_Basis_time);
+char *uw_Basis_urlifyChannel(struct uw_context *, uw_Basis_channel);
+char *uw_Basis_urlifySource(struct uw_context *, uw_Basis_source);
+
+uw_unit uw_Basis_urlifyInt_w(struct uw_context *, uw_Basis_int);
+uw_unit uw_Basis_urlifyFloat_w(struct uw_context *, uw_Basis_float);
+uw_unit uw_Basis_urlifyString_w(struct uw_context *, uw_Basis_string);
+uw_unit uw_Basis_urlifyBool_w(struct uw_context *, uw_Basis_bool);
+uw_unit uw_Basis_urlifyTime_w(struct uw_context *, uw_Basis_time);
+uw_unit uw_Basis_urlifyChannel_w(struct uw_context *, uw_Basis_channel);
+uw_unit uw_Basis_urlifySource_w(struct uw_context *, uw_Basis_source);
+
+uw_Basis_unit uw_Basis_unurlifyUnit(struct uw_context * ctx, char **s);
+uw_Basis_int uw_Basis_unurlifyInt(struct uw_context *, char **);
+uw_Basis_float uw_Basis_unurlifyFloat(struct uw_context *, char **);
+uw_Basis_string uw_Basis_unurlifyString(struct uw_context *, char **);
+uw_Basis_string uw_Basis_unurlifyString_fromClient(struct uw_context *, char **);
+uw_Basis_bool uw_Basis_unurlifyBool(struct uw_context *, char **);
+uw_Basis_time uw_Basis_unurlifyTime(struct uw_context *, char **);
+
+uw_Basis_int uw_Basis_strlen(struct uw_context *, const char *);
+uw_Basis_bool uw_Basis_strlenGe(struct uw_context *, uw_Basis_string, uw_Basis_int);
+uw_Basis_char uw_Basis_strsub(struct uw_context *, const char *, uw_Basis_int);
+uw_Basis_string uw_Basis_strsuffix(struct uw_context *, const char *, uw_Basis_int);
+uw_Basis_string uw_Basis_strcat(struct uw_context *, const char *, const char *);
+uw_Basis_string uw_Basis_mstrcat(struct uw_context * ctx, ...);
+uw_Basis_int *uw_Basis_strindex(struct uw_context *, const char *, uw_Basis_char);
+uw_Basis_int *uw_Basis_strsindex(struct uw_context *, const char *, const char *needle);
+uw_Basis_string uw_Basis_strchr(struct uw_context *, const char *, uw_Basis_char);
+uw_Basis_int uw_Basis_strcspn(struct uw_context *, const char *, const char *);
+uw_Basis_string uw_Basis_substring(struct uw_context *, const char *, uw_Basis_int, uw_Basis_int);
+uw_Basis_string uw_Basis_str1(struct uw_context *, uw_Basis_char);
+
+uw_Basis_string uw_strdup(struct uw_context *, const char *);
+uw_Basis_string uw_maybe_strdup(struct uw_context *, const char *);
+char *uw_memdup(struct uw_context *, const char *, size_t);
+
+uw_Basis_string uw_Basis_sqlifyInt(struct uw_context *, uw_Basis_int);
+uw_Basis_string uw_Basis_sqlifyFloat(struct uw_context *, uw_Basis_float);
+uw_Basis_string uw_Basis_sqlifyString(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_sqlifyChar(struct uw_context *, uw_Basis_char);
+uw_Basis_string uw_Basis_sqlifyBool(struct uw_context *, uw_Basis_bool);
+uw_Basis_string uw_Basis_sqlifyTime(struct uw_context *, uw_Basis_time);
+uw_Basis_string uw_Basis_sqlifyBlob(struct uw_context *, uw_Basis_blob);
+uw_Basis_string uw_Basis_sqlifyChannel(struct uw_context *, uw_Basis_channel);
+uw_Basis_string uw_Basis_sqlifyClient(struct uw_context *, uw_Basis_client);
+
+uw_Basis_string uw_Basis_sqlifyIntN(struct uw_context *, uw_Basis_int*);
+uw_Basis_string uw_Basis_sqlifyFloatN(struct uw_context *, uw_Basis_float*);
+uw_Basis_string uw_Basis_sqlifyStringN(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_sqlifyBoolN(struct uw_context *, uw_Basis_bool*);
+uw_Basis_string uw_Basis_sqlifyTimeN(struct uw_context *, uw_Basis_time*);
+
+char *uw_Basis_ensqlBool(uw_Basis_bool);
+char *uw_Basis_ensqlTime(struct uw_context * ctx, uw_Basis_time);
+
+char *uw_Basis_jsifyString(struct uw_context *, uw_Basis_string);
+char *uw_Basis_jsifyChar(struct uw_context *, uw_Basis_char);
+char *uw_Basis_jsifyChannel(struct uw_context *, uw_Basis_channel);
+char *uw_Basis_jsifyTime(struct uw_context *, uw_Basis_time);
+
+uw_Basis_string uw_Basis_intToString(struct uw_context *, uw_Basis_int);
+uw_Basis_string uw_Basis_floatToString(struct uw_context *, uw_Basis_float);
+uw_Basis_string uw_Basis_charToString(struct uw_context *, uw_Basis_char);
+uw_Basis_string uw_Basis_boolToString(struct uw_context *, uw_Basis_bool);
+uw_Basis_string uw_Basis_timeToString(struct uw_context *, uw_Basis_time);
+
+uw_Basis_int *uw_Basis_stringToInt(struct uw_context *, uw_Basis_string);
+uw_Basis_float *uw_Basis_stringToFloat(struct uw_context *, uw_Basis_string);
+uw_Basis_char *uw_Basis_stringToChar(struct uw_context *, uw_Basis_string);
+uw_Basis_bool *uw_Basis_stringToBool(struct uw_context *, uw_Basis_string);
+uw_Basis_time *uw_Basis_stringToTime(struct uw_context *, const char *);
+
+uw_Basis_int uw_Basis_stringToInt_error(struct uw_context *, uw_Basis_string);
+uw_Basis_float uw_Basis_stringToFloat_error(struct uw_context *, uw_Basis_string);
+uw_Basis_char uw_Basis_stringToChar_error(struct uw_context *, uw_Basis_string);
+uw_Basis_bool uw_Basis_stringToBool_error(struct uw_context *, uw_Basis_string);
+uw_Basis_time uw_Basis_stringToTime_error(struct uw_context *, const char *);
+uw_Basis_blob uw_Basis_stringToBlob_error(struct uw_context *, uw_Basis_string, size_t);
+uw_Basis_channel uw_Basis_stringToChannel_error(struct uw_context *, uw_Basis_string);
+uw_Basis_client uw_Basis_stringToClient_error(struct uw_context *, uw_Basis_string);
+
+uw_Basis_time uw_Basis_unsqlTime(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_requestHeader(struct uw_context *, uw_Basis_string);
+
+void uw_write_header(struct uw_context *, uw_Basis_string);
+void uw_clear_headers(struct uw_context *);
+int uw_has_contentLength(struct uw_context *);
+void uw_Basis_clear_page(struct uw_context *);
+
+void uw_write_script(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_get_cookie(struct uw_context *, uw_Basis_string c);
+uw_unit uw_Basis_set_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure);
+uw_unit uw_Basis_clear_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c);
+
+uw_Basis_channel uw_Basis_new_channel(struct uw_context *, uw_unit);
+uw_unit uw_Basis_send(struct uw_context *, uw_Basis_channel, uw_Basis_string);
+
+uw_Basis_client uw_Basis_self(struct uw_context *);
+
+uw_Basis_string uw_Basis_bless(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessMime(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessRequestHeader(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessResponseHeader(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessEnvVar(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_blessMeta(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_checkUrl(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkMime(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkRequestHeader(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkResponseHeader(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkEnvVar(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_checkMeta(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_getHeader(struct uw_context *, uw_Basis_string name);
+uw_unit uw_Basis_setHeader(struct uw_context *, uw_Basis_string name, uw_Basis_string value);
+uw_Basis_string uw_Basis_getenv(struct uw_context *, uw_Basis_string name);
+
+uw_Basis_string uw_unnull(uw_Basis_string);
+uw_Basis_string uw_Basis_makeSigString(struct uw_context *, uw_Basis_string);
+int uw_streq(uw_Basis_string, uw_Basis_string);
+uw_Basis_string uw_Basis_sigString(struct uw_context *, uw_unit);
+
+uw_Basis_string uw_Basis_fileName(struct uw_context *, uw_Basis_file);
+uw_Basis_string uw_Basis_fileMimeType(struct uw_context *, uw_Basis_file);
+uw_Basis_blob uw_Basis_fileData(struct uw_context *, uw_Basis_file);
+uw_Basis_int uw_Basis_blobSize(struct uw_context *, uw_Basis_blob);
+uw_Basis_blob uw_Basis_textBlob(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_postType(struct uw_context *, uw_Basis_postBody);
+uw_Basis_string uw_Basis_postData(struct uw_context *, uw_Basis_postBody);
+void uw_noPostBody(struct uw_context *);
+void uw_postBody(struct uw_context *, uw_Basis_postBody);
+int uw_hasPostBody(struct uw_context *);
+uw_Basis_postBody uw_getPostBody(struct uw_context *);
+
+void uw_mayReturnIndirectly(struct uw_context *);
+__attribute__((noreturn)) void uw_return_blob(struct uw_context *, uw_Basis_blob, uw_Basis_string mimeType);
+__attribute__((noreturn)) void uw_return_blob_from_page(struct uw_context *, uw_Basis_string mimeType);
+__attribute__((noreturn)) void uw_redirect(struct uw_context *, uw_Basis_string url);
+void uw_replace_page(struct uw_context *, const char *data, size_t size);
+
+uw_Basis_time uw_Basis_now(struct uw_context *);
+uw_Basis_time uw_Basis_addSeconds(struct uw_context *, uw_Basis_time, uw_Basis_int);
+uw_Basis_int uw_Basis_diffInSeconds(struct uw_context *, uw_Basis_time, uw_Basis_time);
+uw_Basis_int uw_Basis_toSeconds(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_diffInMilliseconds(struct uw_context *, uw_Basis_time, uw_Basis_time);
+uw_Basis_int uw_Basis_toMilliseconds(struct uw_context *, uw_Basis_time);
+uw_Basis_time uw_Basis_fromMilliseconds(struct uw_context *, uw_Basis_int);
+uw_Basis_time uw_Basis_fromDatetime(struct uw_context *, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int);
+uw_Basis_int uw_Basis_datetimeYear(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeMonth(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeDay(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeHour(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeMinute(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeSecond(struct uw_context *, uw_Basis_time);
+uw_Basis_int uw_Basis_datetimeDayOfWeek(struct uw_context *, uw_Basis_time);
+extern const uw_Basis_time uw_Basis_minTime;
+
+int uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free);
+
+void uw_check_heap(struct uw_context *, size_t extra);
+char *uw_heap_front(struct uw_context *);
+void uw_set_heap_front(struct uw_context *, char*);
+
+uw_Basis_string uw_Basis_unAs(struct uw_context *, uw_Basis_string);
+
+extern char *uw_sqlfmtInt;
+extern char *uw_sqlfmtFloat;
+extern int uw_Estrings, uw_sql_type_annotations;
+extern char *uw_sqlsuffixString;
+extern char *uw_sqlsuffixChar;
+extern char *uw_sqlsuffixBlob;
+extern char *uw_sqlfmtUint4;
+
+void *uw_get_global(struct uw_context *, char *name);
+void uw_set_global(struct uw_context *, char *name, void *data, uw_callback free);
+
+uw_Basis_bool uw_Basis_isalnum(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isalpha(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isblank(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_iscntrl(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isdigit(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isgraph(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_islower(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isprint(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_ispunct(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isspace(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isupper(struct uw_context *, uw_Basis_char);
+uw_Basis_bool uw_Basis_isxdigit(struct uw_context *, uw_Basis_char);
+uw_Basis_char uw_Basis_tolower(struct uw_context *, uw_Basis_char);
+uw_Basis_char uw_Basis_toupper(struct uw_context *, uw_Basis_char);
+
+uw_Basis_int uw_Basis_ord(struct uw_context *, uw_Basis_char);
+uw_Basis_char uw_Basis_chr(struct uw_context *, uw_Basis_int);
+
+uw_Basis_string uw_Basis_currentUrl(struct uw_context *);
+void uw_set_currentUrl(struct uw_context *, char *);
+
+extern size_t uw_messages_max, uw_clients_max, uw_headers_max, uw_page_max, uw_heap_max, uw_script_max;
+extern size_t uw_inputs_max, uw_cleanup_max, uw_subinputs_max, uw_deltas_max, uw_transactionals_max, uw_globals_max;
+
+extern size_t uw_database_max;
+
+extern int uw_time;
+
+void uw_set_deadline(struct uw_context *, int);
+void uw_check_deadline(struct uw_context *);
+
+uw_Basis_unit uw_Basis_debug(struct uw_context *, uw_Basis_string);
+uw_Basis_int uw_Basis_naughtyDebug(struct uw_context *, uw_Basis_string);
+
+void uw_set_client_data(struct uw_context *, void *);
+
+uw_Basis_int uw_Basis_rand(struct uw_context *);
+
+extern int uw_time_max, uw_supports_direct_status, uw_min_heap;
+
+failure_kind uw_runCallback(struct uw_context *, void (*callback)(struct uw_context *));
+
+uw_Basis_string uw_Basis_timef(struct uw_context *, const char *fmt, uw_Basis_time);
+uw_Basis_time uw_Basis_stringToTimef(struct uw_context *, const char *fmt, uw_Basis_string);
+uw_Basis_time uw_Basis_stringToTimef_error(struct uw_context *, const char *fmt, uw_Basis_string);
+
+uw_Basis_string uw_Basis_crypt(struct uw_context *, uw_Basis_string key, uw_Basis_string salt);
+
+uw_Basis_bool uw_Basis_eq_time(struct uw_context *, uw_Basis_time, uw_Basis_time);
+uw_Basis_bool uw_Basis_lt_time(struct uw_context *, uw_Basis_time, uw_Basis_time);
+uw_Basis_bool uw_Basis_le_time(struct uw_context *, uw_Basis_time, uw_Basis_time);
+
+void uw_buffer_init(size_t max, uw_buffer *, size_t initial);
+void uw_buffer_free(uw_buffer *);
+void uw_buffer_reset(uw_buffer *);
+int uw_buffer_check(uw_buffer *, size_t extra);
+size_t uw_buffer_used(uw_buffer *);
+size_t uw_buffer_avail(uw_buffer *);
+int uw_buffer_append(uw_buffer *, const char *, size_t);
+
+void uw_setQueryString(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_queryString(struct uw_context *);
+
+uw_Basis_time *uw_Basis_readUtc(struct uw_context *, uw_Basis_string);
+
+void uw_isPost(struct uw_context *);
+uw_Basis_bool uw_Basis_currentUrlHasPost(struct uw_context *);
+uw_Basis_bool uw_Basis_currentUrlHasQueryString(struct uw_context *);
+
+uw_Basis_string uw_Basis_fresh(struct uw_context *);
+
+uw_Basis_float uw_Basis_floatFromInt(struct uw_context *, uw_Basis_int);
+uw_Basis_int uw_Basis_ceil(struct uw_context *, uw_Basis_float);
+uw_Basis_int uw_Basis_trunc(struct uw_context *, uw_Basis_float);
+uw_Basis_int uw_Basis_round(struct uw_context *, uw_Basis_float);
+uw_Basis_int uw_Basis_floor(struct uw_context *, uw_Basis_float);
+
+uw_Basis_float uw_Basis_pow(struct uw_context *, uw_Basis_float, uw_Basis_float);
+uw_Basis_float uw_Basis_sqrt(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_sin(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_cos(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_log(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_exp(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_asin(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_acos(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_atan(struct uw_context *, uw_Basis_float);
+uw_Basis_float uw_Basis_atan2(struct uw_context *, uw_Basis_float, uw_Basis_float);
+uw_Basis_float uw_Basis_abs(struct uw_context *, uw_Basis_float);
+
+uw_Basis_string uw_Basis_atom(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_css_url(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_property(struct uw_context *, uw_Basis_string);
+
+void uw_begin_initializing(struct uw_context *);
+void uw_end_initializing(struct uw_context *);
+
+uw_Basis_string uw_Basis_fieldName(struct uw_context *, uw_Basis_postField);
+uw_Basis_string uw_Basis_fieldValue(struct uw_context *, uw_Basis_postField);
+uw_Basis_string uw_Basis_remainingFields(struct uw_context *, uw_Basis_postField);
+uw_Basis_postField *uw_Basis_firstFormField(struct uw_context *, uw_Basis_string);
+
+uw_Basis_string uw_Basis_blessData(struct uw_context *, uw_Basis_string);
+
+extern const char uw_begin_xhtml[], uw_begin_html5[];
+
+int uw_remoteSock(struct uw_context *);
+void uw_set_remoteSock(struct uw_context *, int sock);
+
+void uw_Basis_writec(struct uw_context *, char);
+
+// Sqlcache.
+
+void *uw_Sqlcache_rlock(struct uw_context *, uw_Sqlcache_Cache *);
+void *uw_Sqlcache_wlock(struct uw_context *, uw_Sqlcache_Cache *);
+uw_Sqlcache_Value *uw_Sqlcache_check(struct uw_context *, uw_Sqlcache_Cache *, char **);
+void *uw_Sqlcache_store(struct uw_context *, uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *);
+void *uw_Sqlcache_flush(struct uw_context *, uw_Sqlcache_Cache *, char **);
+
+int strcmp_nullsafe(const char *, const char *);
+
+#endif
diff --git a/include/urweb/uthash.h b/include/urweb/uthash.h
new file mode 100644
index 0000000..367d295
--- /dev/null
+++ b/include/urweb/uthash.h
@@ -0,0 +1,963 @@
+/*
+Copyright (c) 2003-2014, Troy D. Hanson     http://troydhanson.github.com/uthash/
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*/
+
+#ifndef UTHASH_H
+#define UTHASH_H
+
+#include <string.h>   /* memcmp,strlen */
+#include <stddef.h>   /* ptrdiff_t */
+#include <stdlib.h>   /* exit() */
+
+/* These macros use decltype or the earlier __typeof GNU extension.
+   As decltype is only available in newer compilers (VS2010 or gcc 4.3+
+   when compiling c++ source) this code uses whatever method is needed
+   or, for VS2008 where neither is available, uses casting workarounds. */
+#if defined(_MSC_VER)   /* MS compiler */
+#if _MSC_VER >= 1600 && defined(__cplusplus)  /* VS2010 or newer in C++ mode */
+#define DECLTYPE(x) (decltype(x))
+#else                   /* VS2008 or older (or VS2010 in C mode) */
+#define NO_DECLTYPE
+#define DECLTYPE(x)
+#endif
+#elif defined(__BORLANDC__) || defined(__LCC__) || defined(__WATCOMC__)
+#define NO_DECLTYPE
+#define DECLTYPE(x)
+#else                   /* GNU, Sun and other compilers */
+#define DECLTYPE(x) (__typeof(x))
+#endif
+
+#ifdef NO_DECLTYPE
+#define DECLTYPE_ASSIGN(dst,src)                                                 \
+do {                                                                             \
+  char **_da_dst = (char**)(&(dst));                                             \
+  *_da_dst = (char*)(src);                                                       \
+} while(0)
+#else
+#define DECLTYPE_ASSIGN(dst,src)                                                 \
+do {                                                                             \
+  (dst) = DECLTYPE(dst)(src);                                                    \
+} while(0)
+#endif
+
+/* a number of the hash function use uint32_t which isn't defined on Pre VS2010 */
+#if defined (_WIN32)
+#if defined(_MSC_VER) && _MSC_VER >= 1600
+#include <stdint.h>
+#elif defined(__WATCOMC__)
+#include <stdint.h>
+#else
+typedef unsigned int uint32_t;
+typedef unsigned char uint8_t;
+#endif
+#else
+#include <stdint.h>
+#endif
+
+#define UTHASH_VERSION 1.9.9
+
+#ifndef uthash_fatal
+#define uthash_fatal(msg) exit(-1)        /* fatal error (out of memory,etc) */
+#endif
+#ifndef uthash_malloc
+#define uthash_malloc(sz) malloc(sz)      /* malloc fcn                      */
+#endif
+#ifndef uthash_free
+#define uthash_free(ptr,sz) free(ptr)     /* free fcn                        */
+#endif
+
+#ifndef uthash_noexpand_fyi
+#define uthash_noexpand_fyi(tbl)          /* can be defined to log noexpand  */
+#endif
+#ifndef uthash_expand_fyi
+#define uthash_expand_fyi(tbl)            /* can be defined to log expands   */
+#endif
+
+/* initial number of buckets */
+#define HASH_INITIAL_NUM_BUCKETS 32U     /* initial number of buckets        */
+#define HASH_INITIAL_NUM_BUCKETS_LOG2 5U /* lg2 of initial number of buckets */
+#define HASH_BKT_CAPACITY_THRESH 10U     /* expand when bucket count reaches */
+
+/* calculate the element whose hash handle address is hhe */
+#define ELMT_FROM_HH(tbl,hhp) ((void*)(((char*)(hhp)) - ((tbl)->hho)))
+
+#define HASH_FIND(hh,head,keyptr,keylen,out)                                     \
+do {                                                                             \
+  out=NULL;                                                                      \
+  if (head != NULL) {                                                            \
+     unsigned _hf_bkt,_hf_hashv;                                                 \
+     HASH_FCN(keyptr,keylen, (head)->hh.tbl->num_buckets, _hf_hashv, _hf_bkt);   \
+     if (HASH_BLOOM_TEST((head)->hh.tbl, _hf_hashv) != 0) {                      \
+       HASH_FIND_IN_BKT((head)->hh.tbl, hh, (head)->hh.tbl->buckets[ _hf_bkt ],  \
+                        keyptr,keylen,out);                                      \
+     }                                                                           \
+  }                                                                              \
+} while (0)
+
+#ifdef HASH_BLOOM
+#define HASH_BLOOM_BITLEN (1UL << HASH_BLOOM)
+#define HASH_BLOOM_BYTELEN (HASH_BLOOM_BITLEN/8UL) + (((HASH_BLOOM_BITLEN%8UL)!=0UL) ? 1UL : 0UL)
+#define HASH_BLOOM_MAKE(tbl)                                                     \
+do {                                                                             \
+  (tbl)->bloom_nbits = HASH_BLOOM;                                               \
+  (tbl)->bloom_bv = (uint8_t*)uthash_malloc(HASH_BLOOM_BYTELEN);                 \
+  if (!((tbl)->bloom_bv))  { uthash_fatal( "out of memory"); }                   \
+  memset((tbl)->bloom_bv, 0, HASH_BLOOM_BYTELEN);                                \
+  (tbl)->bloom_sig = HASH_BLOOM_SIGNATURE;                                       \
+} while (0)
+
+#define HASH_BLOOM_FREE(tbl)                                                     \
+do {                                                                             \
+  uthash_free((tbl)->bloom_bv, HASH_BLOOM_BYTELEN);                              \
+} while (0)
+
+#define HASH_BLOOM_BITSET(bv,idx) (bv[(idx)/8U] |= (1U << ((idx)%8U)))
+#define HASH_BLOOM_BITTEST(bv,idx) (bv[(idx)/8U] & (1U << ((idx)%8U)))
+
+#define HASH_BLOOM_ADD(tbl,hashv)                                                \
+  HASH_BLOOM_BITSET((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1U)))
+
+#define HASH_BLOOM_TEST(tbl,hashv)                                               \
+  HASH_BLOOM_BITTEST((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1U)))
+
+#else
+#define HASH_BLOOM_MAKE(tbl)
+#define HASH_BLOOM_FREE(tbl)
+#define HASH_BLOOM_ADD(tbl,hashv)
+#define HASH_BLOOM_TEST(tbl,hashv) (1)
+#define HASH_BLOOM_BYTELEN 0U
+#endif
+
+#define HASH_MAKE_TABLE(hh,head)                                                 \
+do {                                                                             \
+  (head)->hh.tbl = (UT_hash_table*)uthash_malloc(                                \
+                  sizeof(UT_hash_table));                                        \
+  if (!((head)->hh.tbl))  { uthash_fatal( "out of memory"); }                    \
+  memset((head)->hh.tbl, 0, sizeof(UT_hash_table));                              \
+  (head)->hh.tbl->tail = &((head)->hh);                                          \
+  (head)->hh.tbl->num_buckets = HASH_INITIAL_NUM_BUCKETS;                        \
+  (head)->hh.tbl->log2_num_buckets = HASH_INITIAL_NUM_BUCKETS_LOG2;              \
+  (head)->hh.tbl->hho = (char*)(&(head)->hh) - (char*)(head);                    \
+  (head)->hh.tbl->buckets = (UT_hash_bucket*)uthash_malloc(                      \
+          HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket));               \
+  if (! (head)->hh.tbl->buckets) { uthash_fatal( "out of memory"); }             \
+  memset((head)->hh.tbl->buckets, 0,                                             \
+          HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket));               \
+  HASH_BLOOM_MAKE((head)->hh.tbl);                                               \
+  (head)->hh.tbl->signature = HASH_SIGNATURE;                                    \
+} while(0)
+
+#define HASH_ADD(hh,head,fieldname,keylen_in,add)                                \
+        HASH_ADD_KEYPTR(hh,head,&((add)->fieldname),keylen_in,add)
+
+#define HASH_REPLACE(hh,head,fieldname,keylen_in,add,replaced)                   \
+do {                                                                             \
+  replaced=NULL;                                                                 \
+  HASH_FIND(hh,head,&((add)->fieldname),keylen_in,replaced);                     \
+  if (replaced!=NULL) {                                                          \
+     HASH_DELETE(hh,head,replaced);                                              \
+  }                                                                              \
+  HASH_ADD(hh,head,fieldname,keylen_in,add);                                     \
+} while(0)
+
+#define HASH_ADD_KEYPTR(hh,head,keyptr,keylen_in,add)                            \
+do {                                                                             \
+ unsigned _ha_bkt;                                                               \
+ (add)->hh.next = NULL;                                                          \
+ (add)->hh.key = (char*)(keyptr);                                                \
+ (add)->hh.keylen = (unsigned)(keylen_in);                                       \
+ if (!(head)) {                                                                  \
+    head = (add);                                                                \
+    (head)->hh.prev = NULL;                                                      \
+    HASH_MAKE_TABLE(hh,head);                                                    \
+ } else {                                                                        \
+    (head)->hh.tbl->tail->next = (add);                                          \
+    (add)->hh.prev = ELMT_FROM_HH((head)->hh.tbl, (head)->hh.tbl->tail);         \
+    (head)->hh.tbl->tail = &((add)->hh);                                         \
+ }                                                                               \
+ (head)->hh.tbl->num_items++;                                                    \
+ (add)->hh.tbl = (head)->hh.tbl;                                                 \
+ HASH_FCN(keyptr,keylen_in, (head)->hh.tbl->num_buckets,                         \
+         (add)->hh.hashv, _ha_bkt);                                              \
+ HASH_ADD_TO_BKT((head)->hh.tbl->buckets[_ha_bkt],&(add)->hh);                   \
+ HASH_BLOOM_ADD((head)->hh.tbl,(add)->hh.hashv);                                 \
+ HASH_EMIT_KEY(hh,head,keyptr,keylen_in);                                        \
+ HASH_FSCK(hh,head);                                                             \
+} while(0)
+
+#define HASH_TO_BKT( hashv, num_bkts, bkt )                                      \
+do {                                                                             \
+  bkt = ((hashv) & ((num_bkts) - 1U));                                           \
+} while(0)
+
+/* delete "delptr" from the hash table.
+ * "the usual" patch-up process for the app-order doubly-linked-list.
+ * The use of _hd_hh_del below deserves special explanation.
+ * These used to be expressed using (delptr) but that led to a bug
+ * if someone used the same symbol for the head and deletee, like
+ *  HASH_DELETE(hh,users,users);
+ * We want that to work, but by changing the head (users) below
+ * we were forfeiting our ability to further refer to the deletee (users)
+ * in the patch-up process. Solution: use scratch space to
+ * copy the deletee pointer, then the latter references are via that
+ * scratch pointer rather than through the repointed (users) symbol.
+ */
+#define HASH_DELETE(hh,head,delptr)                                              \
+do {                                                                             \
+    struct UT_hash_handle *_hd_hh_del;                                           \
+    if ( ((delptr)->hh.prev == NULL) && ((delptr)->hh.next == NULL) )  {         \
+        uthash_free((head)->hh.tbl->buckets,                                     \
+                    (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \
+        HASH_BLOOM_FREE((head)->hh.tbl);                                         \
+        uthash_free((head)->hh.tbl, sizeof(UT_hash_table));                      \
+        head = NULL;                                                             \
+    } else {                                                                     \
+        unsigned _hd_bkt;                                                        \
+        _hd_hh_del = &((delptr)->hh);                                            \
+        if ((delptr) == ELMT_FROM_HH((head)->hh.tbl,(head)->hh.tbl->tail)) {     \
+            (head)->hh.tbl->tail =                                               \
+                (UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) +               \
+                (head)->hh.tbl->hho);                                            \
+        }                                                                        \
+        if ((delptr)->hh.prev != NULL) {                                         \
+            ((UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) +                  \
+                    (head)->hh.tbl->hho))->next = (delptr)->hh.next;             \
+        } else {                                                                 \
+            DECLTYPE_ASSIGN(head,(delptr)->hh.next);                             \
+        }                                                                        \
+        if (_hd_hh_del->next != NULL) {                                          \
+            ((UT_hash_handle*)((ptrdiff_t)_hd_hh_del->next +                     \
+                    (head)->hh.tbl->hho))->prev =                                \
+                    _hd_hh_del->prev;                                            \
+        }                                                                        \
+        HASH_TO_BKT( _hd_hh_del->hashv, (head)->hh.tbl->num_buckets, _hd_bkt);   \
+        HASH_DEL_IN_BKT(hh,(head)->hh.tbl->buckets[_hd_bkt], _hd_hh_del);        \
+        (head)->hh.tbl->num_items--;                                             \
+    }                                                                            \
+    HASH_FSCK(hh,head);                                                          \
+} while (0)
+
+
+/* convenience forms of HASH_FIND/HASH_ADD/HASH_DEL */
+#define HASH_FIND_STR(head,findstr,out)                                          \
+    HASH_FIND(hh,head,findstr,(unsigned)strlen(findstr),out)
+#define HASH_ADD_STR(head,strfield,add)                                          \
+    HASH_ADD(hh,head,strfield[0],(unsigned int)strlen(add->strfield),add)
+#define HASH_REPLACE_STR(head,strfield,add,replaced)                             \
+    HASH_REPLACE(hh,head,strfield[0],(unsigned)strlen(add->strfield),add,replaced)
+#define HASH_FIND_INT(head,findint,out)                                          \
+    HASH_FIND(hh,head,findint,sizeof(int),out)
+#define HASH_ADD_INT(head,intfield,add)                                          \
+    HASH_ADD(hh,head,intfield,sizeof(int),add)
+#define HASH_REPLACE_INT(head,intfield,add,replaced)                             \
+    HASH_REPLACE(hh,head,intfield,sizeof(int),add,replaced)
+#define HASH_FIND_PTR(head,findptr,out)                                          \
+    HASH_FIND(hh,head,findptr,sizeof(void *),out)
+#define HASH_ADD_PTR(head,ptrfield,add)                                          \
+    HASH_ADD(hh,head,ptrfield,sizeof(void *),add)
+#define HASH_REPLACE_PTR(head,ptrfield,add,replaced)                             \
+    HASH_REPLACE(hh,head,ptrfield,sizeof(void *),add,replaced)
+#define HASH_DEL(head,delptr)                                                    \
+    HASH_DELETE(hh,head,delptr)
+
+/* HASH_FSCK checks hash integrity on every add/delete when HASH_DEBUG is defined.
+ * This is for uthash developer only; it compiles away if HASH_DEBUG isn't defined.
+ */
+#ifdef HASH_DEBUG
+#define HASH_OOPS(...) do { fprintf(stderr,__VA_ARGS__); exit(-1); } while (0)
+#define HASH_FSCK(hh,head)                                                       \
+do {                                                                             \
+    struct UT_hash_handle *_thh;                                                 \
+    if (head) {                                                                  \
+        unsigned _bkt_i;                                                         \
+        unsigned _count;                                                         \
+        char *_prev;                                                             \
+        _count = 0;                                                              \
+        for( _bkt_i = 0; _bkt_i < (head)->hh.tbl->num_buckets; _bkt_i++) {       \
+            unsigned _bkt_count = 0;                                             \
+            _thh = (head)->hh.tbl->buckets[_bkt_i].hh_head;                      \
+            _prev = NULL;                                                        \
+            while (_thh) {                                                       \
+               if (_prev != (char*)(_thh->hh_prev)) {                            \
+                   HASH_OOPS("invalid hh_prev %p, actual %p\n",                  \
+                    _thh->hh_prev, _prev );                                      \
+               }                                                                 \
+               _bkt_count++;                                                     \
+               _prev = (char*)(_thh);                                            \
+               _thh = _thh->hh_next;                                             \
+            }                                                                    \
+            _count += _bkt_count;                                                \
+            if ((head)->hh.tbl->buckets[_bkt_i].count !=  _bkt_count) {          \
+               HASH_OOPS("invalid bucket count %u, actual %u\n",                 \
+                (head)->hh.tbl->buckets[_bkt_i].count, _bkt_count);              \
+            }                                                                    \
+        }                                                                        \
+        if (_count != (head)->hh.tbl->num_items) {                               \
+            HASH_OOPS("invalid hh item count %u, actual %u\n",                   \
+                (head)->hh.tbl->num_items, _count );                             \
+        }                                                                        \
+        /* traverse hh in app order; check next/prev integrity, count */         \
+        _count = 0;                                                              \
+        _prev = NULL;                                                            \
+        _thh =  &(head)->hh;                                                     \
+        while (_thh) {                                                           \
+           _count++;                                                             \
+           if (_prev !=(char*)(_thh->prev)) {                                    \
+              HASH_OOPS("invalid prev %p, actual %p\n",                          \
+                    _thh->prev, _prev );                                         \
+           }                                                                     \
+           _prev = (char*)ELMT_FROM_HH((head)->hh.tbl, _thh);                    \
+           _thh = ( _thh->next ?  (UT_hash_handle*)((char*)(_thh->next) +        \
+                                  (head)->hh.tbl->hho) : NULL );                 \
+        }                                                                        \
+        if (_count != (head)->hh.tbl->num_items) {                               \
+            HASH_OOPS("invalid app item count %u, actual %u\n",                  \
+                (head)->hh.tbl->num_items, _count );                             \
+        }                                                                        \
+    }                                                                            \
+} while (0)
+#else
+#define HASH_FSCK(hh,head)
+#endif
+
+/* When compiled with -DHASH_EMIT_KEYS, length-prefixed keys are emitted to
+ * the descriptor to which this macro is defined for tuning the hash function.
+ * The app can #include <unistd.h> to get the prototype for write(2). */
+#ifdef HASH_EMIT_KEYS
+#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen)                                   \
+do {                                                                             \
+    unsigned _klen = fieldlen;                                                   \
+    write(HASH_EMIT_KEYS, &_klen, sizeof(_klen));                                \
+    write(HASH_EMIT_KEYS, keyptr, (unsigned long)fieldlen);                      \
+} while (0)
+#else
+#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen)
+#endif
+
+/* default to Jenkin's hash unless overridden e.g. DHASH_FUNCTION=HASH_SAX */
+#ifdef HASH_FUNCTION
+#define HASH_FCN HASH_FUNCTION
+#else
+#define HASH_FCN HASH_JEN
+#endif
+
+/* The Bernstein hash function, used in Perl prior to v5.6. Note (x<<5+x)=x*33. */
+#define HASH_BER(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned _hb_keylen=(unsigned)keylen;                                          \
+  const unsigned char *_hb_key=(const unsigned char*)(key);                      \
+  (hashv) = 0;                                                                   \
+  while (_hb_keylen-- != 0U) {                                                   \
+      (hashv) = (((hashv) << 5) + (hashv)) + *_hb_key++;                         \
+  }                                                                              \
+  bkt = (hashv) & (num_bkts-1U);                                                 \
+} while (0)
+
+
+/* SAX/FNV/OAT/JEN hash functions are macro variants of those listed at
+ * http://eternallyconfuzzled.com/tuts/algorithms/jsw_tut_hashing.aspx */
+#define HASH_SAX(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned _sx_i;                                                                \
+  const unsigned char *_hs_key=(const unsigned char*)(key);                      \
+  hashv = 0;                                                                     \
+  for(_sx_i=0; _sx_i < keylen; _sx_i++) {                                        \
+      hashv ^= (hashv << 5) + (hashv >> 2) + _hs_key[_sx_i];                     \
+  }                                                                              \
+  bkt = hashv & (num_bkts-1U);                                                   \
+} while (0)
+/* FNV-1a variation */
+#define HASH_FNV(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned _fn_i;                                                                \
+  const unsigned char *_hf_key=(const unsigned char*)(key);                      \
+  hashv = 2166136261U;                                                           \
+  for(_fn_i=0; _fn_i < keylen; _fn_i++) {                                        \
+      hashv = hashv ^ _hf_key[_fn_i];                                            \
+      hashv = hashv * 16777619U;                                                 \
+  }                                                                              \
+  bkt = hashv & (num_bkts-1U);                                                   \
+} while(0)
+
+#define HASH_OAT(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned _ho_i;                                                                \
+  const unsigned char *_ho_key=(const unsigned char*)(key);                      \
+  hashv = 0;                                                                     \
+  for(_ho_i=0; _ho_i < keylen; _ho_i++) {                                        \
+      hashv += _ho_key[_ho_i];                                                   \
+      hashv += (hashv << 10);                                                    \
+      hashv ^= (hashv >> 6);                                                     \
+  }                                                                              \
+  hashv += (hashv << 3);                                                         \
+  hashv ^= (hashv >> 11);                                                        \
+  hashv += (hashv << 15);                                                        \
+  bkt = hashv & (num_bkts-1U);                                                   \
+} while(0)
+
+#define HASH_JEN_MIX(a,b,c)                                                      \
+do {                                                                             \
+  a -= b; a -= c; a ^= ( c >> 13 );                                              \
+  b -= c; b -= a; b ^= ( a << 8 );                                               \
+  c -= a; c -= b; c ^= ( b >> 13 );                                              \
+  a -= b; a -= c; a ^= ( c >> 12 );                                              \
+  b -= c; b -= a; b ^= ( a << 16 );                                              \
+  c -= a; c -= b; c ^= ( b >> 5 );                                               \
+  a -= b; a -= c; a ^= ( c >> 3 );                                               \
+  b -= c; b -= a; b ^= ( a << 10 );                                              \
+  c -= a; c -= b; c ^= ( b >> 15 );                                              \
+} while (0)
+
+#define HASH_JEN(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned _hj_i,_hj_j,_hj_k;                                                    \
+  unsigned const char *_hj_key=(unsigned const char*)(key);                      \
+  hashv = 0xfeedbeefu;                                                           \
+  _hj_i = _hj_j = 0x9e3779b9u;                                                   \
+  _hj_k = (unsigned)(keylen);                                                    \
+  while (_hj_k >= 12U) {                                                         \
+    _hj_i +=    (_hj_key[0] + ( (unsigned)_hj_key[1] << 8 )                      \
+        + ( (unsigned)_hj_key[2] << 16 )                                         \
+        + ( (unsigned)_hj_key[3] << 24 ) );                                      \
+    _hj_j +=    (_hj_key[4] + ( (unsigned)_hj_key[5] << 8 )                      \
+        + ( (unsigned)_hj_key[6] << 16 )                                         \
+        + ( (unsigned)_hj_key[7] << 24 ) );                                      \
+    hashv += (_hj_key[8] + ( (unsigned)_hj_key[9] << 8 )                         \
+        + ( (unsigned)_hj_key[10] << 16 )                                        \
+        + ( (unsigned)_hj_key[11] << 24 ) );                                     \
+                                                                                 \
+     HASH_JEN_MIX(_hj_i, _hj_j, hashv);                                          \
+                                                                                 \
+     _hj_key += 12;                                                              \
+     _hj_k -= 12U;                                                               \
+  }                                                                              \
+  hashv += (unsigned)(keylen);                                                   \
+  switch ( _hj_k ) {                                                             \
+     case 11: hashv += ( (unsigned)_hj_key[10] << 24 ); /* FALLTHROUGH */        \
+     case 10: hashv += ( (unsigned)_hj_key[9] << 16 );  /* FALLTHROUGH */        \
+     case 9:  hashv += ( (unsigned)_hj_key[8] << 8 );   /* FALLTHROUGH */        \
+     case 8:  _hj_j += ( (unsigned)_hj_key[7] << 24 );  /* FALLTHROUGH */        \
+     case 7:  _hj_j += ( (unsigned)_hj_key[6] << 16 );  /* FALLTHROUGH */        \
+     case 6:  _hj_j += ( (unsigned)_hj_key[5] << 8 );   /* FALLTHROUGH */        \
+     case 5:  _hj_j += _hj_key[4];                      /* FALLTHROUGH */        \
+     case 4:  _hj_i += ( (unsigned)_hj_key[3] << 24 );  /* FALLTHROUGH */        \
+     case 3:  _hj_i += ( (unsigned)_hj_key[2] << 16 );  /* FALLTHROUGH */        \
+     case 2:  _hj_i += ( (unsigned)_hj_key[1] << 8 );   /* FALLTHROUGH */        \
+     case 1:  _hj_i += _hj_key[0];                                               \
+  }                                                                              \
+  HASH_JEN_MIX(_hj_i, _hj_j, hashv);                                             \
+  bkt = hashv & (num_bkts-1U);                                                   \
+} while(0)
+
+/* The Paul Hsieh hash function */
+#undef get16bits
+#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__)             \
+  || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
+#define get16bits(d) (*((const uint16_t *) (d)))
+#endif
+
+#if !defined (get16bits)
+#define get16bits(d) ((((uint32_t)(((const uint8_t *)(d))[1])) << 8)             \
+                       +(uint32_t)(((const uint8_t *)(d))[0]) )
+#endif
+#define HASH_SFH(key,keylen,num_bkts,hashv,bkt)                                  \
+do {                                                                             \
+  unsigned const char *_sfh_key=(unsigned const char*)(key);                     \
+  uint32_t _sfh_tmp, _sfh_len = (uint32_t)keylen;                                \
+                                                                                 \
+  unsigned _sfh_rem = _sfh_len & 3U;                                             \
+  _sfh_len >>= 2;                                                                \
+  hashv = 0xcafebabeu;                                                           \
+                                                                                 \
+  /* Main loop */                                                                \
+  for (;_sfh_len > 0U; _sfh_len--) {                                             \
+    hashv    += get16bits (_sfh_key);                                            \
+    _sfh_tmp  = ((uint32_t)(get16bits (_sfh_key+2)) << 11) ^ hashv;              \
+    hashv     = (hashv << 16) ^ _sfh_tmp;                                        \
+    _sfh_key += 2U*sizeof (uint16_t);                                            \
+    hashv    += hashv >> 11;                                                     \
+  }                                                                              \
+                                                                                 \
+  /* Handle end cases */                                                         \
+  switch (_sfh_rem) {                                                            \
+    case 3: hashv += get16bits (_sfh_key);                                       \
+            hashv ^= hashv << 16;                                                \
+            hashv ^= (uint32_t)(_sfh_key[sizeof (uint16_t)]) << 18;              \
+            hashv += hashv >> 11;                                                \
+            break;                                                               \
+    case 2: hashv += get16bits (_sfh_key);                                       \
+            hashv ^= hashv << 11;                                                \
+            hashv += hashv >> 17;                                                \
+            break;                                                               \
+    case 1: hashv += *_sfh_key;                                                  \
+            hashv ^= hashv << 10;                                                \
+            hashv += hashv >> 1;                                                 \
+  }                                                                              \
+                                                                                 \
+    /* Force "avalanching" of final 127 bits */                                  \
+    hashv ^= hashv << 3;                                                         \
+    hashv += hashv >> 5;                                                         \
+    hashv ^= hashv << 4;                                                         \
+    hashv += hashv >> 17;                                                        \
+    hashv ^= hashv << 25;                                                        \
+    hashv += hashv >> 6;                                                         \
+    bkt = hashv & (num_bkts-1U);                                                 \
+} while(0)
+
+#ifdef HASH_USING_NO_STRICT_ALIASING
+/* The MurmurHash exploits some CPU's (x86,x86_64) tolerance for unaligned reads.
+ * For other types of CPU's (e.g. Sparc) an unaligned read causes a bus error.
+ * MurmurHash uses the faster approach only on CPU's where we know it's safe.
+ *
+ * Note the preprocessor built-in defines can be emitted using:
+ *
+ *   gcc -m64 -dM -E - < /dev/null                  (on gcc)
+ *   cc -## a.c (where a.c is a simple test file)   (Sun Studio)
+ */
+#if (defined(__i386__) || defined(__x86_64__)  || defined(_M_IX86))
+#define MUR_GETBLOCK(p,i) p[i]
+#else /* non intel */
+#define MUR_PLUS0_ALIGNED(p) (((unsigned long)p & 3UL) == 0UL)
+#define MUR_PLUS1_ALIGNED(p) (((unsigned long)p & 3UL) == 1UL)
+#define MUR_PLUS2_ALIGNED(p) (((unsigned long)p & 3UL) == 2UL)
+#define MUR_PLUS3_ALIGNED(p) (((unsigned long)p & 3UL) == 3UL)
+#define WP(p) ((uint32_t*)((unsigned long)(p) & ~3UL))
+#if (defined(__BIG_ENDIAN__) || defined(SPARC) || defined(__ppc__) || defined(__ppc64__))
+#define MUR_THREE_ONE(p) ((((*WP(p))&0x00ffffff) << 8) | (((*(WP(p)+1))&0xff000000) >> 24))
+#define MUR_TWO_TWO(p)   ((((*WP(p))&0x0000ffff) <<16) | (((*(WP(p)+1))&0xffff0000) >> 16))
+#define MUR_ONE_THREE(p) ((((*WP(p))&0x000000ff) <<24) | (((*(WP(p)+1))&0xffffff00) >>  8))
+#else /* assume little endian non-intel */
+#define MUR_THREE_ONE(p) ((((*WP(p))&0xffffff00) >> 8) | (((*(WP(p)+1))&0x000000ff) << 24))
+#define MUR_TWO_TWO(p)   ((((*WP(p))&0xffff0000) >>16) | (((*(WP(p)+1))&0x0000ffff) << 16))
+#define MUR_ONE_THREE(p) ((((*WP(p))&0xff000000) >>24) | (((*(WP(p)+1))&0x00ffffff) <<  8))
+#endif
+#define MUR_GETBLOCK(p,i) (MUR_PLUS0_ALIGNED(p) ? ((p)[i]) :           \
+                            (MUR_PLUS1_ALIGNED(p) ? MUR_THREE_ONE(p) : \
+                             (MUR_PLUS2_ALIGNED(p) ? MUR_TWO_TWO(p) :  \
+                                                      MUR_ONE_THREE(p))))
+#endif
+#define MUR_ROTL32(x,r) (((x) << (r)) | ((x) >> (32 - (r))))
+#define MUR_FMIX(_h) \
+do {                 \
+  _h ^= _h >> 16;    \
+  _h *= 0x85ebca6bu; \
+  _h ^= _h >> 13;    \
+  _h *= 0xc2b2ae35u; \
+  _h ^= _h >> 16;    \
+} while(0)
+
+#define HASH_MUR(key,keylen,num_bkts,hashv,bkt)                        \
+do {                                                                   \
+  const uint8_t *_mur_data = (const uint8_t*)(key);                    \
+  const int _mur_nblocks = (int)(keylen) / 4;                          \
+  uint32_t _mur_h1 = 0xf88D5353u;                                      \
+  uint32_t _mur_c1 = 0xcc9e2d51u;                                      \
+  uint32_t _mur_c2 = 0x1b873593u;                                      \
+  uint32_t _mur_k1 = 0;                                                \
+  const uint8_t *_mur_tail;                                            \
+  const uint32_t *_mur_blocks = (const uint32_t*)(_mur_data+(_mur_nblocks*4)); \
+  int _mur_i;                                                          \
+  for(_mur_i = -_mur_nblocks; _mur_i!=0; _mur_i++) {                   \
+    _mur_k1 = MUR_GETBLOCK(_mur_blocks,_mur_i);                        \
+    _mur_k1 *= _mur_c1;                                                \
+    _mur_k1 = MUR_ROTL32(_mur_k1,15);                                  \
+    _mur_k1 *= _mur_c2;                                                \
+                                                                       \
+    _mur_h1 ^= _mur_k1;                                                \
+    _mur_h1 = MUR_ROTL32(_mur_h1,13);                                  \
+    _mur_h1 = (_mur_h1*5U) + 0xe6546b64u;                              \
+  }                                                                    \
+  _mur_tail = (const uint8_t*)(_mur_data + (_mur_nblocks*4));          \
+  _mur_k1=0;                                                           \
+  switch((keylen) & 3U) {                                              \
+    case 3: _mur_k1 ^= (uint32_t)_mur_tail[2] << 16; /* FALLTHROUGH */ \
+    case 2: _mur_k1 ^= (uint32_t)_mur_tail[1] << 8;  /* FALLTHROUGH */ \
+    case 1: _mur_k1 ^= (uint32_t)_mur_tail[0];                         \
+    _mur_k1 *= _mur_c1;                                                \
+    _mur_k1 = MUR_ROTL32(_mur_k1,15);                                  \
+    _mur_k1 *= _mur_c2;                                                \
+    _mur_h1 ^= _mur_k1;                                                \
+  }                                                                    \
+  _mur_h1 ^= (uint32_t)(keylen);                                       \
+  MUR_FMIX(_mur_h1);                                                   \
+  hashv = _mur_h1;                                                     \
+  bkt = hashv & (num_bkts-1U);                                         \
+} while(0)
+#endif  /* HASH_USING_NO_STRICT_ALIASING */
+
+/* key comparison function; return 0 if keys equal */
+#define HASH_KEYCMP(a,b,len) memcmp(a,b,(unsigned long)(len))
+
+/* iterate over items in a known bucket to find desired item */
+#define HASH_FIND_IN_BKT(tbl,hh,head,keyptr,keylen_in,out)                       \
+do {                                                                             \
+ if (head.hh_head != NULL) { DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,head.hh_head)); } \
+ else { out=NULL; }                                                              \
+ while (out != NULL) {                                                           \
+    if ((out)->hh.keylen == (keylen_in)) {                                       \
+        if ((HASH_KEYCMP((out)->hh.key,keyptr,keylen_in)) == 0) { break; }         \
+    }                                                                            \
+    if ((out)->hh.hh_next != NULL) { DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,(out)->hh.hh_next)); } \
+    else { out = NULL; }                                                         \
+ }                                                                               \
+} while(0)
+
+/* add an item to a bucket  */
+#define HASH_ADD_TO_BKT(head,addhh)                                              \
+do {                                                                             \
+ head.count++;                                                                   \
+ (addhh)->hh_next = head.hh_head;                                                \
+ (addhh)->hh_prev = NULL;                                                        \
+ if (head.hh_head != NULL) { (head).hh_head->hh_prev = (addhh); }                \
+ (head).hh_head=addhh;                                                           \
+ if ((head.count >= ((head.expand_mult+1U) * HASH_BKT_CAPACITY_THRESH))          \
+     && ((addhh)->tbl->noexpand != 1U)) {                                        \
+       HASH_EXPAND_BUCKETS((addhh)->tbl);                                        \
+ }                                                                               \
+} while(0)
+
+/* remove an item from a given bucket */
+#define HASH_DEL_IN_BKT(hh,head,hh_del)                                          \
+    (head).count--;                                                              \
+    if ((head).hh_head == hh_del) {                                              \
+      (head).hh_head = hh_del->hh_next;                                          \
+    }                                                                            \
+    if (hh_del->hh_prev) {                                                       \
+        hh_del->hh_prev->hh_next = hh_del->hh_next;                              \
+    }                                                                            \
+    if (hh_del->hh_next) {                                                       \
+        hh_del->hh_next->hh_prev = hh_del->hh_prev;                              \
+    }
+
+/* Bucket expansion has the effect of doubling the number of buckets
+ * and redistributing the items into the new buckets. Ideally the
+ * items will distribute more or less evenly into the new buckets
+ * (the extent to which this is true is a measure of the quality of
+ * the hash function as it applies to the key domain).
+ *
+ * With the items distributed into more buckets, the chain length
+ * (item count) in each bucket is reduced. Thus by expanding buckets
+ * the hash keeps a bound on the chain length. This bounded chain
+ * length is the essence of how a hash provides constant time lookup.
+ *
+ * The calculation of tbl->ideal_chain_maxlen below deserves some
+ * explanation. First, keep in mind that we're calculating the ideal
+ * maximum chain length based on the *new* (doubled) bucket count.
+ * In fractions this is just n/b (n=number of items,b=new num buckets).
+ * Since the ideal chain length is an integer, we want to calculate
+ * ceil(n/b). We don't depend on floating point arithmetic in this
+ * hash, so to calculate ceil(n/b) with integers we could write
+ *
+ *      ceil(n/b) = (n/b) + ((n%b)?1:0)
+ *
+ * and in fact a previous version of this hash did just that.
+ * But now we have improved things a bit by recognizing that b is
+ * always a power of two. We keep its base 2 log handy (call it lb),
+ * so now we can write this with a bit shift and logical AND:
+ *
+ *      ceil(n/b) = (n>>lb) + ( (n & (b-1)) ? 1:0)
+ *
+ */
+#define HASH_EXPAND_BUCKETS(tbl)                                                 \
+do {                                                                             \
+    unsigned _he_bkt;                                                            \
+    unsigned _he_bkt_i;                                                          \
+    struct UT_hash_handle *_he_thh, *_he_hh_nxt;                                 \
+    UT_hash_bucket *_he_new_buckets, *_he_newbkt;                                \
+    _he_new_buckets = (UT_hash_bucket*)uthash_malloc(                            \
+             2UL * tbl->num_buckets * sizeof(struct UT_hash_bucket));            \
+    if (!_he_new_buckets) { uthash_fatal( "out of memory"); }                    \
+    memset(_he_new_buckets, 0,                                                   \
+            2UL * tbl->num_buckets * sizeof(struct UT_hash_bucket));             \
+    tbl->ideal_chain_maxlen =                                                    \
+       (tbl->num_items >> (tbl->log2_num_buckets+1U)) +                          \
+       (((tbl->num_items & ((tbl->num_buckets*2U)-1U)) != 0U) ? 1U : 0U);        \
+    tbl->nonideal_items = 0;                                                     \
+    for(_he_bkt_i = 0; _he_bkt_i < tbl->num_buckets; _he_bkt_i++)                \
+    {                                                                            \
+        _he_thh = tbl->buckets[ _he_bkt_i ].hh_head;                             \
+        while (_he_thh != NULL) {                                                \
+           _he_hh_nxt = _he_thh->hh_next;                                        \
+           HASH_TO_BKT( _he_thh->hashv, tbl->num_buckets*2U, _he_bkt);           \
+           _he_newbkt = &(_he_new_buckets[ _he_bkt ]);                           \
+           if (++(_he_newbkt->count) > tbl->ideal_chain_maxlen) {                \
+             tbl->nonideal_items++;                                              \
+             _he_newbkt->expand_mult = _he_newbkt->count /                       \
+                                        tbl->ideal_chain_maxlen;                 \
+           }                                                                     \
+           _he_thh->hh_prev = NULL;                                              \
+           _he_thh->hh_next = _he_newbkt->hh_head;                               \
+           if (_he_newbkt->hh_head != NULL) { _he_newbkt->hh_head->hh_prev =     \
+                _he_thh; }                                                       \
+           _he_newbkt->hh_head = _he_thh;                                        \
+           _he_thh = _he_hh_nxt;                                                 \
+        }                                                                        \
+    }                                                                            \
+    uthash_free( tbl->buckets, tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \
+    tbl->num_buckets *= 2U;                                                      \
+    tbl->log2_num_buckets++;                                                     \
+    tbl->buckets = _he_new_buckets;                                              \
+    tbl->ineff_expands = (tbl->nonideal_items > (tbl->num_items >> 1)) ?         \
+        (tbl->ineff_expands+1U) : 0U;                                            \
+    if (tbl->ineff_expands > 1U) {                                               \
+        tbl->noexpand=1;                                                         \
+        uthash_noexpand_fyi(tbl);                                                \
+    }                                                                            \
+    uthash_expand_fyi(tbl);                                                      \
+} while(0)
+
+
+/* This is an adaptation of Simon Tatham's O(n log(n)) mergesort */
+/* Note that HASH_SORT assumes the hash handle name to be hh.
+ * HASH_SRT was added to allow the hash handle name to be passed in. */
+#define HASH_SORT(head,cmpfcn) HASH_SRT(hh,head,cmpfcn)
+#define HASH_SRT(hh,head,cmpfcn)                                                 \
+do {                                                                             \
+  unsigned _hs_i;                                                                \
+  unsigned _hs_looping,_hs_nmerges,_hs_insize,_hs_psize,_hs_qsize;               \
+  struct UT_hash_handle *_hs_p, *_hs_q, *_hs_e, *_hs_list, *_hs_tail;            \
+  if (head != NULL) {                                                            \
+      _hs_insize = 1;                                                            \
+      _hs_looping = 1;                                                           \
+      _hs_list = &((head)->hh);                                                  \
+      while (_hs_looping != 0U) {                                                \
+          _hs_p = _hs_list;                                                      \
+          _hs_list = NULL;                                                       \
+          _hs_tail = NULL;                                                       \
+          _hs_nmerges = 0;                                                       \
+          while (_hs_p != NULL) {                                                \
+              _hs_nmerges++;                                                     \
+              _hs_q = _hs_p;                                                     \
+              _hs_psize = 0;                                                     \
+              for ( _hs_i = 0; _hs_i  < _hs_insize; _hs_i++ ) {                  \
+                  _hs_psize++;                                                   \
+                  _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ?              \
+                          ((void*)((char*)(_hs_q->next) +                        \
+                          (head)->hh.tbl->hho)) : NULL);                         \
+                  if (! (_hs_q) ) { break; }                                     \
+              }                                                                  \
+              _hs_qsize = _hs_insize;                                            \
+              while ((_hs_psize > 0U) || ((_hs_qsize > 0U) && (_hs_q != NULL))) {\
+                  if (_hs_psize == 0U) {                                         \
+                      _hs_e = _hs_q;                                             \
+                      _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ?          \
+                              ((void*)((char*)(_hs_q->next) +                    \
+                              (head)->hh.tbl->hho)) : NULL);                     \
+                      _hs_qsize--;                                               \
+                  } else if ( (_hs_qsize == 0U) || (_hs_q == NULL) ) {           \
+                      _hs_e = _hs_p;                                             \
+                      if (_hs_p != NULL){                                        \
+                        _hs_p = (UT_hash_handle*)((_hs_p->next != NULL) ?        \
+                                ((void*)((char*)(_hs_p->next) +                  \
+                                (head)->hh.tbl->hho)) : NULL);                   \
+                       }                                                         \
+                      _hs_psize--;                                               \
+                  } else if ((                                                   \
+                      cmpfcn(DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_p)), \
+                             DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_q))) \
+                             ) <= 0) {                                           \
+                      _hs_e = _hs_p;                                             \
+                      if (_hs_p != NULL){                                        \
+                        _hs_p = (UT_hash_handle*)((_hs_p->next != NULL) ?        \
+                               ((void*)((char*)(_hs_p->next) +                   \
+                               (head)->hh.tbl->hho)) : NULL);                    \
+                       }                                                         \
+                      _hs_psize--;                                               \
+                  } else {                                                       \
+                      _hs_e = _hs_q;                                             \
+                      _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ?          \
+                              ((void*)((char*)(_hs_q->next) +                    \
+                              (head)->hh.tbl->hho)) : NULL);                     \
+                      _hs_qsize--;                                               \
+                  }                                                              \
+                  if ( _hs_tail != NULL ) {                                      \
+                      _hs_tail->next = ((_hs_e != NULL) ?                        \
+                            ELMT_FROM_HH((head)->hh.tbl,_hs_e) : NULL);          \
+                  } else {                                                       \
+                      _hs_list = _hs_e;                                          \
+                  }                                                              \
+                  if (_hs_e != NULL) {                                           \
+                  _hs_e->prev = ((_hs_tail != NULL) ?                            \
+                     ELMT_FROM_HH((head)->hh.tbl,_hs_tail) : NULL);              \
+                  }                                                              \
+                  _hs_tail = _hs_e;                                              \
+              }                                                                  \
+              _hs_p = _hs_q;                                                     \
+          }                                                                      \
+          if (_hs_tail != NULL){                                                 \
+            _hs_tail->next = NULL;                                               \
+          }                                                                      \
+          if ( _hs_nmerges <= 1U ) {                                             \
+              _hs_looping=0;                                                     \
+              (head)->hh.tbl->tail = _hs_tail;                                   \
+              DECLTYPE_ASSIGN(head,ELMT_FROM_HH((head)->hh.tbl, _hs_list));      \
+          }                                                                      \
+          _hs_insize *= 2U;                                                      \
+      }                                                                          \
+      HASH_FSCK(hh,head);                                                        \
+ }                                                                               \
+} while (0)
+
+/* This function selects items from one hash into another hash.
+ * The end result is that the selected items have dual presence
+ * in both hashes. There is no copy of the items made; rather
+ * they are added into the new hash through a secondary hash
+ * hash handle that must be present in the structure. */
+#define HASH_SELECT(hh_dst, dst, hh_src, src, cond)                              \
+do {                                                                             \
+  unsigned _src_bkt, _dst_bkt;                                                   \
+  void *_last_elt=NULL, *_elt;                                                   \
+  UT_hash_handle *_src_hh, *_dst_hh, *_last_elt_hh=NULL;                         \
+  ptrdiff_t _dst_hho = ((char*)(&(dst)->hh_dst) - (char*)(dst));                 \
+  if (src != NULL) {                                                             \
+    for(_src_bkt=0; _src_bkt < (src)->hh_src.tbl->num_buckets; _src_bkt++) {     \
+      for(_src_hh = (src)->hh_src.tbl->buckets[_src_bkt].hh_head;                \
+          _src_hh != NULL;                                                       \
+          _src_hh = _src_hh->hh_next) {                                          \
+          _elt = ELMT_FROM_HH((src)->hh_src.tbl, _src_hh);                       \
+          if (cond(_elt)) {                                                      \
+            _dst_hh = (UT_hash_handle*)(((char*)_elt) + _dst_hho);               \
+            _dst_hh->key = _src_hh->key;                                         \
+            _dst_hh->keylen = _src_hh->keylen;                                   \
+            _dst_hh->hashv = _src_hh->hashv;                                     \
+            _dst_hh->prev = _last_elt;                                           \
+            _dst_hh->next = NULL;                                                \
+            if (_last_elt_hh != NULL) { _last_elt_hh->next = _elt; }             \
+            if (dst == NULL) {                                                   \
+              DECLTYPE_ASSIGN(dst,_elt);                                         \
+              HASH_MAKE_TABLE(hh_dst,dst);                                       \
+            } else {                                                             \
+              _dst_hh->tbl = (dst)->hh_dst.tbl;                                  \
+            }                                                                    \
+            HASH_TO_BKT(_dst_hh->hashv, _dst_hh->tbl->num_buckets, _dst_bkt);    \
+            HASH_ADD_TO_BKT(_dst_hh->tbl->buckets[_dst_bkt],_dst_hh);            \
+            (dst)->hh_dst.tbl->num_items++;                                      \
+            _last_elt = _elt;                                                    \
+            _last_elt_hh = _dst_hh;                                              \
+          }                                                                      \
+      }                                                                          \
+    }                                                                            \
+  }                                                                              \
+  HASH_FSCK(hh_dst,dst);                                                         \
+} while (0)
+
+#define HASH_CLEAR(hh,head)                                                      \
+do {                                                                             \
+  if (head != NULL) {                                                            \
+    uthash_free((head)->hh.tbl->buckets,                                         \
+                (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket));      \
+    HASH_BLOOM_FREE((head)->hh.tbl);                                             \
+    uthash_free((head)->hh.tbl, sizeof(UT_hash_table));                          \
+    (head)=NULL;                                                                 \
+  }                                                                              \
+} while(0)
+
+#define HASH_OVERHEAD(hh,head)                                                   \
+ ((head != NULL) ? (                                                             \
+ (size_t)(((head)->hh.tbl->num_items   * sizeof(UT_hash_handle))   +             \
+          ((head)->hh.tbl->num_buckets * sizeof(UT_hash_bucket))   +             \
+           sizeof(UT_hash_table)                                   +             \
+           (HASH_BLOOM_BYTELEN))) : 0U)
+
+#ifdef NO_DECLTYPE
+#define HASH_ITER(hh,head,el,tmp)                                                \
+for(((el)=(head)), ((*(char**)(&(tmp)))=(char*)((head!=NULL)?(head)->hh.next:NULL)); \
+  (el) != NULL; ((el)=(tmp)), ((*(char**)(&(tmp)))=(char*)((tmp!=NULL)?(tmp)->hh.next:NULL)))
+#else
+#define HASH_ITER(hh,head,el,tmp)                                                \
+for(((el)=(head)), ((tmp)=DECLTYPE(el)((head!=NULL)?(head)->hh.next:NULL));      \
+  (el) != NULL; ((el)=(tmp)), ((tmp)=DECLTYPE(el)((tmp!=NULL)?(tmp)->hh.next:NULL)))
+#endif
+
+/* obtain a count of items in the hash */
+#define HASH_COUNT(head) HASH_CNT(hh,head)
+#define HASH_CNT(hh,head) ((head != NULL)?((head)->hh.tbl->num_items):0U)
+
+typedef struct UT_hash_bucket {
+   struct UT_hash_handle *hh_head;
+   unsigned count;
+
+   /* expand_mult is normally set to 0. In this situation, the max chain length
+    * threshold is enforced at its default value, HASH_BKT_CAPACITY_THRESH. (If
+    * the bucket's chain exceeds this length, bucket expansion is triggered).
+    * However, setting expand_mult to a non-zero value delays bucket expansion
+    * (that would be triggered by additions to this particular bucket)
+    * until its chain length reaches a *multiple* of HASH_BKT_CAPACITY_THRESH.
+    * (The multiplier is simply expand_mult+1). The whole idea of this
+    * multiplier is to reduce bucket expansions, since they are expensive, in
+    * situations where we know that a particular bucket tends to be overused.
+    * It is better to let its chain length grow to a longer yet-still-bounded
+    * value, than to do an O(n) bucket expansion too often.
+    */
+   unsigned expand_mult;
+
+} UT_hash_bucket;
+
+/* random signature used only to find hash tables in external analysis */
+#define HASH_SIGNATURE 0xa0111fe1u
+#define HASH_BLOOM_SIGNATURE 0xb12220f2u
+
+typedef struct UT_hash_table {
+   UT_hash_bucket *buckets;
+   unsigned num_buckets, log2_num_buckets;
+   unsigned num_items;
+   struct UT_hash_handle *tail; /* tail hh in app order, for fast append    */
+   ptrdiff_t hho; /* hash handle offset (byte pos of hash handle in element */
+
+   /* in an ideal situation (all buckets used equally), no bucket would have
+    * more than ceil(#items/#buckets) items. that's the ideal chain length. */
+   unsigned ideal_chain_maxlen;
+
+   /* nonideal_items is the number of items in the hash whose chain position
+    * exceeds the ideal chain maxlen. these items pay the penalty for an uneven
+    * hash distribution; reaching them in a chain traversal takes >ideal steps */
+   unsigned nonideal_items;
+
+   /* ineffective expands occur when a bucket doubling was performed, but
+    * afterward, more than half the items in the hash had nonideal chain
+    * positions. If this happens on two consecutive expansions we inhibit any
+    * further expansion, as it's not helping; this happens when the hash
+    * function isn't a good fit for the key domain. When expansion is inhibited
+    * the hash will still work, albeit no longer in constant time. */
+   unsigned ineff_expands, noexpand;
+
+   uint32_t signature; /* used only to find hash tables in external analysis */
+#ifdef HASH_BLOOM
+   uint32_t bloom_sig; /* used only to test bloom exists in external analysis */
+   uint8_t *bloom_bv;
+   uint8_t bloom_nbits;
+#endif
+
+} UT_hash_table;
+
+typedef struct UT_hash_handle {
+   struct UT_hash_table *tbl;
+   void *prev;                       /* prev element in app order      */
+   void *next;                       /* next element in app order      */
+   struct UT_hash_handle *hh_prev;   /* previous hh in bucket order    */
+   struct UT_hash_handle *hh_next;   /* next hh in bucket order        */
+   void *key;                        /* ptr to enclosing struct's key  */
+   unsigned keylen;                  /* enclosing struct's key len     */
+   unsigned hashv;                   /* result of hash-fcn(key)        */
+} UT_hash_handle;
+
+#endif /* UTHASH_H */
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
new file mode 100644
index 0000000..ebe192c
--- /dev/null
+++ b/lib/js/urweb.js
@@ -0,0 +1,2252 @@
+// Detect browser quirks that we should be aware of.
+
+function needsDynPrefix() {
+    var span = document.createElement("span");
+    span.innerHTML = "<script>alert('test');</script>";
+    var scripts = span.getElementsByTagName("script");
+    return scripts.length == 0;
+}
+
+var dynPrefix = needsDynPrefix() ? "<span style=\"display:none\">A</span>" : "";
+
+// Function versions of operators
+
+function not(x) { return !x; }
+function neg(x) { return -x; }
+
+function eq(x, y) { return x == y; }
+function plus(x, y) { return x + y; }
+function minus(x, y) { return x - y; }
+function times(x, y) { return x * y; }
+function div(x, y) { return x / y; }
+function divInt(x, y) { if (y == 0) er("Division by zero"); var n = x / y; return n < 0 ? Math.ceil(n) : Math.floor(n); }
+function mod(x, y) { return x % y; }
+function modInt(x, y) { if (y == 0) er("Division by zero"); var n = x % y; return n < 0 ? Math.ceil(n) : Math.floor(n); }
+function lt(x, y) { return x < y; }
+function le(x, y) { return x <= y; }
+
+// Characters
+
+function isLower(c) { return c >= 'a' && c <= 'z'; }
+function isUpper(c) { return c >= 'A' && c <= 'Z'; }
+function isAlpha(c) { return isLower(c) || isUpper(c); }
+function isDigit(c) { return c >= '0' && c <= '9'; }
+function isAlnum(c) { return isAlpha(c) || isDigit(c); }
+function isBlank(c) { return c == ' ' || c == '\t'; }
+function isSpace(c) { return isBlank(c) || c == '\r' || c == '\n'; }
+function isXdigit(c) { return isDigit(c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'); }
+function ord(c) { return c.charCodeAt(0); }
+function isPrint(c) { return ord(c) > 31 && ord(c) < 127; }
+function toLower(c) { return c.toLowerCase(); }
+function toUpper(c) { return c.toUpperCase(); }
+
+// Lists
+
+function cons(v, ls) {
+    return { next : ls, data : v };
+}
+function rev(ls) {
+    var acc = null;
+    for (; ls; ls = ls.next)
+       acc = cons(ls.data, acc);
+    return acc;
+}
+function concat(ls1, ls2) {
+    var acc = ls2;
+    ls1 = rev(ls1);
+    for (; ls1; ls1 = ls1.next)
+        acc = cons(ls1.data, acc);
+    return acc;
+}
+function member(x, ls) {
+    for (; ls; ls = ls.next)
+        if (ls.data == x)
+            return true;
+    return false;
+}
+function remove(x, ls) {
+    var acc = null;
+
+    for (; ls; ls = ls.next)
+        if (ls.data == x)
+            return concat(acc, ls.next);
+        else
+            acc = cons(ls.data, acc);
+
+    return ls;
+}
+function union(ls1, ls2) {
+    var acc = ls2;
+
+    for (; ls1; ls1 = ls1.next)
+        if (!member(ls1.data, ls2))
+            acc = cons(ls1.data, acc);
+
+    return acc;
+}
+function length(ls) {
+    var acc = 0;
+
+    for (; ls; ls = ls.next)
+        ++acc;
+
+    return acc;
+}
+
+
+// Floats
+
+function float(n) {
+    return n;
+}
+
+function trunc(n) {
+    return ~~n;
+}
+
+function ceil(n) {
+    return Math.ceil(n);
+}
+
+function round(n) {
+    return Math.round(n);
+}
+
+function pow(n, m) {
+    return Math.pow(n, m);
+}
+
+function sqrt(n){
+    return Math.sqrt(n);
+}
+
+function sin(n){
+    return Math.sin(n);
+}
+
+function cos(n){
+    return Math.cos(n);
+}
+
+function log(n){
+    return Math.log(n);
+}
+
+function exp(n){
+    return Math.exp(n);
+}
+
+function asin(n){
+    return Math.asin(n);
+}
+function acos(n){
+    return Math.acos(n);
+}
+
+function atan(n){
+    return Math.atan(n);
+}
+
+function atan2(n, m){
+    return Math.atan2(n, m);
+}
+
+function floor(n){
+    return Math.floor(n);
+}
+
+function abs(n){
+    return Math.abs(n);
+}
+
+// Time, represented as counts of microseconds since the epoch
+
+var time_format = "%c";
+
+function showTime(tm) {
+    return strftime(time_format, tm);
+}
+
+function showTimeHtml(tm) {
+    return eh(showTime(tm));
+}
+
+function now() {
+    return (new Date()).getTime() * 1000;
+}
+
+function diffInSeconds(tm1, tm2) {
+    return Math.round((tm2 - tm1) / 1000000);
+}
+
+function diffInMilliseconds(tm1, tm2) {
+    return Math.round((tm2 - tm1) / 1000);
+}
+
+function toSeconds(tm) {
+    return Math.round(tm / 1000000);
+}
+
+function toMilliseconds(tm) {
+    return Math.round(tm / 1000);
+}
+
+function fromMilliseconds(tm) {
+    return tm * 1000;
+}
+
+function addSeconds(tm, n) {
+    return tm + n * 1000000;
+}
+
+function stringToTime_error(string) {
+    var t = Date.parse(string);
+    if (isNaN(t))
+        er("Invalid date string: " + string);
+    else
+        return t * 1000;
+}
+
+function stringToTime(string) {
+    try {
+        var t = Date.parse(string);
+        if (isNaN(t))
+            return null;
+        else
+            return t * 1000;
+    } catch (e) {
+        return null;
+    }
+}
+
+/*
+strftime() implementation from:
+YUI 3.4.1 (build 4118)
+Copyright 2011 Yahoo! Inc. All rights reserved.
+Licensed under the BSD License.
+http://yuilibrary.com/license/
+*/
+
+var xPad=function (x, pad, r)
+{
+    if(typeof r === "undefined")
+    {
+	r=10;
+    }
+    pad = pad.toString();
+    for( ; parseInt(x, 10)<r && r>1; r/=10) {
+	x = pad + x;
+    }
+    return x.toString();
+};
+
+var YDateEn = {
+    a: ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"],
+    A: ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"],
+    b: ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"],
+    B: ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"],
+    c: "%a %d %b %Y %T %Z",
+    p: ["AM", "PM"],
+    P: ["am", "pm"],
+    r: "%I:%M:%S %p",
+    x: "%d/%m/%y",
+    X: "%T"
+};
+
+var Dt = {
+    formats: {
+	a: function (d, l) { return l.a[d.getDay()]; },
+	A: function (d, l) { return l.A[d.getDay()]; },
+	b: function (d, l) { return l.b[d.getMonth()]; },
+	B: function (d, l) { return l.B[d.getMonth()]; },
+	C: function (d) { return xPad(parseInt(d.getFullYear()/100, 10), 0); },
+	d: ["getDate", "0"],
+	e: ["getDate", " "],
+	g: function (d) { return xPad(parseInt(Dt.formats.G(d)%100, 10), 0); },
+	G: function (d) {
+	    var y = d.getFullYear();
+	    var V = parseInt(Dt.formats.V(d), 10);
+	    var W = parseInt(Dt.formats.W(d), 10);
+
+	    if(W > V) {
+		y++;
+	    } else if(W===0 && V>=52) {
+		y--;
+	    }
+
+	    return y;
+	},
+	H: ["getHours", "0"],
+	I: function (d) { var I=d.getHours()%12; return xPad(I===0?12:I, 0); },
+	j: function (d) {
+	    var gmd_1 = new Date("" + d.getFullYear() + "/1/1 GMT");
+	    var gmdate = new Date("" + d.getFullYear() + "/" + (d.getMonth()+1) + "/" + d.getDate() + " GMT");
+	    var ms = gmdate - gmd_1;
+	    var doy = parseInt(ms/60000/60/24, 10)+1;
+	    return xPad(doy, 0, 100);
+	},
+	k: ["getHours", " "],
+	l: function (d) { var I=d.getHours()%12; return xPad(I===0?12:I, " "); },
+	m: function (d) { return xPad(d.getMonth()+1, 0); },
+	M: ["getMinutes", "0"],
+	p: function (d, l) { return l.p[d.getHours() >= 12 ? 1 : 0 ]; },
+	P: function (d, l) { return l.P[d.getHours() >= 12 ? 1 : 0 ]; },
+	s: function (d, l) { return parseInt(d.getTime()/1000, 10); },
+	S: ["getSeconds", "0"],
+	u: function (d) { var dow = d.getDay(); return dow===0?7:dow; },
+	U: function (d) {
+	    var doy = parseInt(Dt.formats.j(d), 10);
+	    var rdow = 6-d.getDay();
+	    var woy = parseInt((doy+rdow)/7, 10);
+	    return xPad(woy, 0);
+	},
+	V: function (d) {
+	    var woy = parseInt(Dt.formats.W(d), 10);
+	    var dow1_1 = (new Date("" + d.getFullYear() + "/1/1")).getDay();
+	    var idow = woy + (dow1_1 > 4 || dow1_1 <= 1 ? 0 : 1);
+	    if(idow === 53 && (new Date("" + d.getFullYear() + "/12/31")).getDay() < 4)
+	    {
+		idow = 1;
+	    }
+	    else if(idow === 0)
+	    {
+		idow = Dt.formats.V(new Date("" + (d.getFullYear()-1) + "/12/31"));
+	    }
+
+	    return xPad(idow, 0);
+	},
+	w: "getDay",
+	W: function (d) {
+	    var doy = parseInt(Dt.formats.j(d), 10);
+	    var rdow = 7-Dt.formats.u(d);
+	    var woy = parseInt((doy+rdow)/7, 10);
+	    return xPad(woy, 0, 10);
+	},
+	y: function (d) { return xPad(d.getFullYear()%100, 0); },
+	Y: "getFullYear",
+	z: function (d) {
+	    var o = d.getTimezoneOffset();
+	    var H = xPad(parseInt(Math.abs(o/60), 10), 0);
+	    var M = xPad(Math.abs(o%60), 0);
+	    return (o>0?"-":"+") + H + M;
+	},
+	Z: function (d) {
+	    var tz = d.toString().replace(/^.*:\d\d( GMT[+-]\d+)? \(?([A-Za-z ]+)\)?\d*$/, "$2").replace(/[a-z ]/g, "");
+	    if(tz.length > 4) {
+		tz = Dt.formats.z(d);
+	    }
+	    return tz;
+	},
+	"%": function (d) { return "%"; }
+    },
+
+    aggregates: {
+	c: "locale",
+	D: "%m/%d/%y",
+	F: "%Y-%m-%d",
+	h: "%b",
+	n: "\n",
+	r: "%I:%M:%S %p",
+	R: "%H:%M",
+	t: "\t",
+	T: "%H:%M:%S",
+	x: "locale",
+	X: "locale"
+    },
+
+    format : function (oDate, format) {
+	var replace_aggs = function (m0, m1) {
+	    var f = Dt.aggregates[m1];
+	    return (f === "locale" ? YDateEn[m1] : f);
+	};
+
+	var replace_formats = function (m0, m1) {
+	    var f = Dt.formats[m1];
+	    switch(typeof f) {
+	    case "string":
+		return oDate[f]();
+	    case "function":
+		return f.call(oDate, oDate, YDateEn);
+	    case "array":
+            case "object":
+		if(typeof(f[0]) === "string")
+		    return xPad(oDate[f[0]](), f[1]);
+	    default:
+		return m1;
+	    }
+	};
+
+	while(format.match(/%[cDFhnrRtTxX]/)) {
+	    format = format.replace(/%([cDFhnrRtTxX])/g, replace_aggs);
+	}
+
+	var str = format.replace(/%([aAbBCdegGHIjklmMpPsSuUVwWyYzZ%])/g, replace_formats);
+
+	replace_aggs = replace_formats = undefined;
+
+	return str;
+    }
+};
+
+// End of YUI code
+
+function strftime(fmt, thisTime)
+{
+    var thisDate = new Date();
+    thisDate.setTime(Math.floor(thisTime / 1000));
+    return Dt.format(thisDate, fmt);
+};
+
+function fromDatetime(year, month, date, hour, minute, second) {
+  return (new Date(year, month, date, hour, minute, second)).getTime() * 1000;
+};
+
+function datetimeYear(t) {
+  return (new Date(t / 1000)).getYear() + 1900;
+};
+
+function datetimeMonth(t) {
+  return (new Date(t / 1000)).getMonth();
+};
+
+function datetimeDay(t) {
+  return (new Date(t / 1000)).getDate();
+};
+
+function datetimeHour(t) {
+  return (new Date(t / 1000)).getHours();
+};
+
+function datetimeMinute(t) {
+  return (new Date(t / 1000)).getMinutes();
+};
+
+function datetimeSecond(t) {
+  return (new Date(t / 1000)).getSeconds();
+};
+
+function datetimeDayOfWeek(t) {
+  return (new Date(t / 1000)).getDay();
+};
+
+
+// Error handling
+
+function uw_debug(msg) {
+    try {
+        console.debug(msg);
+    } catch (e) {
+        alert("DEBUG: " + msg);
+    }
+
+    return 0;
+}
+
+function whine(msg) {
+    alert(msg);
+    throw msg;
+}
+
+function pf(loc) {
+    throw ("Pattern match failure (" + loc + ")");
+}
+
+var lameDuck = false;
+
+function runHandlers(kind, ls, arg) {
+    if (!lameDuck) {
+        if (ls == null)
+            alert(kind + ": " + arg);
+        for (; ls; ls = ls.next)
+            try {
+                exec({c:"a", f:{c:"a", f:ls.data, x:{c:"c", v:arg}}, x:{c:"c", v:null}});
+            } catch (v) { }
+    }
+}
+
+var errorHandlers = null;
+
+function flift0(v) {
+    return {c:"c", v:v};
+}
+
+function onError(f) {
+    errorHandlers = cons(flift0(f), errorHandlers);
+}
+
+function er(s) {
+    runHandlers("Error", errorHandlers, s);
+    throw {uw_error: s};
+}
+
+var failHandlers = null;
+
+function onFail(f) {
+    failHandlers = cons(flift0(f), failHandlers);
+}
+
+function doExn(v) {
+    if (v == null || v.uw_error == null) {
+        var s = (v == null ? "null" : v.message ? v.message : v.toString());
+        if (v != null && v.fileName && v.lineNumber)
+            s += " (" + v.fileName + ":" + v.lineNumber + ")";
+        runHandlers("Fail", failHandlers, s);
+    }
+}
+
+var disconnectHandlers = null;
+
+function flift(f) {
+    return {c: "c", v:{env:cons(f,null), body:{c:"v", n:1}}};
+}
+
+function onDisconnect(f) {
+    disconnectHandlers = cons(flift(f), disconnectHandlers);
+}
+
+function discon() {
+    runHandlers("Disconnect", disconnectHandlers, null);
+}
+
+var connectHandlers = null;
+
+function onConnectFail(f) {
+    connectHandlers = cons(flift(f), connectHandlers);
+}
+
+function conn(msg) {
+    var rx = /(.*)<body>((.|\n|\r)*)<\/body>(.*)/g;
+    var arr = rx.exec(msg);
+    msg = (arr && arr.length >= 3) ? arr[2] : msg;
+    runHandlers("RPC failure", connectHandlers, msg);
+}
+
+var serverHandlers = null;
+
+function onServerError(f) {
+    serverHandlers = cons(flift0(f), serverHandlers);
+}
+
+function servErr(s) {
+    window.setTimeout(function () { runHandlers("Server", serverHandlers, s); }, 0);
+}
+
+// Key and mouse events
+
+var uw_event = null;
+
+function uw_getEvent() {
+    return window.event ? window.event : uw_event;
+}
+
+function firstGood(x, y) {
+    if (x == undefined || x == 0)
+        return y;
+    else
+        return x;
+}
+
+function uw_mouseEvent() {
+    var ev = uw_getEvent();
+
+    return {_ScreenX : firstGood(ev.screenX, 0),
+            _ScreenY : firstGood(ev.screenY, 0),
+            _ClientX : firstGood(ev.clientX, 0),
+            _ClientY : firstGood(ev.clientY, 0),
+            _CtrlKey : firstGood(ev.ctrlKey, false),
+            _ShiftKey : firstGood(ev.shiftKey, false),
+            _AltKey : firstGood(ev.altKey, false),
+            _MetaKey : firstGood(ev.metaKey, false),
+            _Button : ev.button == 2 ? "Right" : ev.button == 1 ? "Middle" : "Left"};
+}
+
+function uw_keyEvent() {
+    var ev = uw_getEvent();
+
+    return {_KeyCode : firstGood(ev.keyCode, ev.which),
+            _CtrlKey : firstGood(ev.ctrlKey, false),
+            _ShiftKey : firstGood(ev.shiftKey, false),
+            _AltKey : firstGood(ev.altKey, false),
+            _MetaKey : firstGood(ev.metaKey, false)};
+}
+
+
+
+// Document events
+
+function uw_handler(name, f) {
+    var old = document[name];
+    if (old == undefined)
+        document[name] = function(event) { uw_event = event; execF(execF(f, uw_mouseEvent())); };
+    else
+        document[name] = function(event) { uw_event = event; old(); execF(execF(f, uw_mouseEvent())); };
+}
+
+function uw_onClick(f) {
+    uw_handler("onclick", f);
+}
+
+function uw_onContextmenu(f) {
+    uw_handler("oncontextmenu", f);
+}
+
+function uw_onDblclick(f) {
+    uw_handler("ondblclick", f);
+}
+
+function uw_onMousedown(f) {
+    uw_handler("onmousedown", f);
+}
+
+function uw_onMouseenter(f) {
+    uw_handler("onmouseenter", f);
+}
+
+function uw_onMouseleave(f) {
+    uw_handler("onmouseleave", f);
+}
+
+function uw_onMousemove(f) {
+    uw_handler("onmousemove", f);
+}
+
+function uw_onMouseout(f) {
+    uw_handler("onmouseout", f);
+}
+
+function uw_onMouseover(f) {
+    uw_handler("onmouseover", f);
+}
+
+function uw_onMouseup(f) {
+    uw_handler("onmouseup", f);
+}
+
+function uw_keyHandler(name, f) {
+    var old = document[name];
+    if (old == undefined)
+        document[name] = function(event) { uw_event = event; execF(execF(f, uw_keyEvent())); };
+    else
+        document[name] = function(event) { uw_event = event; old(); execF(execF(f, uw_keyEvent())); };
+}
+
+function uw_onKeydown(f) {
+    uw_keyHandler("onkeydown", f);
+}
+
+function uw_onKeypress(f) {
+    uw_keyHandler("onkeypress", f);
+}
+
+function uw_onKeyup(f) {
+    uw_keyHandler("onkeyup", f);
+}
+
+// Cancelling of further event processing
+
+function uw_preventDefault() {
+    var e = window.event ? window.event : uw_event;
+    e.returnValue = false;
+    if (e.preventDefault) e.preventDefault();
+}
+
+function uw_stopPropagation() {
+    var e = window.event ? window.event : uw_event;
+    e.cancelBubble = true;
+    if (e.stopPropagation) e.stopPropagation();
+}
+
+// Embedding closures in XML strings
+
+function cs(f) {
+    return {closure: f};
+}
+
+function isWeird(v) {
+    return v.closure != null || v.cat1 != null;
+}
+
+function cat(s1, s2) {
+    if (isWeird(s1) || isWeird(s2))
+        return {cat1: s1, cat2: s2};
+    else
+        return s1 + s2;
+}
+
+var closures = [];
+var freeClosures = null;
+
+function newClosure(f) {
+    var n;
+    if (freeClosures == null) {
+        n = closures.length;
+    } else {
+        n = freeClosures.data;
+        freeClosures = freeClosures.next;
+    }
+    closures[n] = f;
+    return n;
+}
+
+function freeClosure(n) {
+    closures[n] = null;
+    freeClosures = cons(n, freeClosures);
+}
+
+function cr(n) {
+    return closures[n];
+}
+
+function flattenAcc(a, cls, trs) {
+    while (trs) {
+        var tr = trs.data;
+        trs = trs.next;
+
+        if (tr.cat1 != null) {
+            trs = cons(tr.cat1, cons(tr.cat2, trs));
+        } else if (tr.closure != null) {
+            var cl = newClosure(tr.closure);
+            cls.v = cons(cl, cls.v);
+            a.push("cr(", cl.toString(), ")");
+        } else
+            a.push(tr);
+    }
+}
+
+function flatten(cls, tr) {
+    var a = [];
+    flattenAcc(a, cls, cons(tr, null));
+    return a.join("");
+}
+
+function flattenLocal(s) {
+    var cls = {v : null};
+    var r = flatten(cls, s);
+    for (cl = cls.v; cl != null; cl = cl.next)
+        freeClosure(cl.data);
+    return r;
+}
+
+
+// Dynamic tree management
+
+function populate(node) {
+    if (node.dead) return;
+
+    var s = node.signal;
+    var oldSources = node.sources;
+    try {
+        var sr = execF(s, null);
+        var newSources = sr._sources;
+
+        for (var sp = oldSources; sp; sp = sp.next)
+            if (!member(sp.data, newSources))
+                sp.data.dyns = remove(node, sp.data.dyns);
+
+        for (var sp = newSources; sp; sp = sp.next)
+            if (!member(sp.data, oldSources))
+                sp.data.dyns = cons(node, sp.data.dyns);
+
+        node.sources = newSources;
+        node.recreate(sr._data);
+    } catch (v) {
+        doExn(v);
+    }
+}
+
+function sc(v) {
+    return {data : v, dyns : null};
+}
+function sv(s, v) {
+    if (s.data != v) {
+        s.data = v;
+
+        for (var ls = s.dyns; ls; ls = ls.next)
+            populate(ls.data);
+    }
+}
+function sg(s) {
+    return s.data;
+}
+
+function ss(s) {
+    return {env:cons(s, null), body:{c:"r", l:
+            cons({n:"sources", v:{c:"c", v:cons(s, null)}},
+                 cons({n:"data", v:{c:"f", f:sg, a:cons({c:"v", n:1}, null)}}, null))}};
+}
+function sr(v) {
+    return {env:null, body:{c:"c", v:{_sources : null, _data : v}}};
+}
+function sb(x,y) {
+    return {env:cons(y,cons(x,null)),
+            body:{c:"=",
+                e1:{c:"a", f:{c:"v", n:2}, x:{c:"c", v:null}},
+                e2:{c:"=",
+                    e1:{c:"a",
+                        f:{c:"a", f:{c:"v", n:2}, x:{c:".", r:{c:"v", n:0}, f:"data"}},
+                        x:{c:"c", v:null}},
+                    e2:{c:"r", l:cons(
+                                      {n:"sources", v:{c:"f", f:union, a:cons({c:".", r:{c:"v", n:1}, f:"sources"},
+                                                                              cons({c:".", r:{c:"v", n:0}, f:"sources"}, null))}},
+                                      cons({n:"data", v:{c:".", r:{c:"v", n:0}, f:"data"}}, null))}}}};
+}
+function scur(s) {
+    return execF(s, null)._data;
+}
+
+function lastParent() {
+    var pos = document.body;
+
+    while (pos.lastChild && pos.lastChild.nodeType == 1)
+        pos = pos.lastChild;
+
+    pos = pos.parentNode;
+
+    return pos;
+}
+
+var thisScript = null;
+
+function addNode(node) {
+    if (thisScript) {
+        if (thisScript.parentNode)
+            thisScript.parentNode.replaceChild(node, thisScript);
+    } else
+        lastParent().appendChild(node);
+}
+
+function runScripts(node) {
+    if (node.tagName == "SCRIPT") {
+        var savedScript = thisScript;
+        thisScript = node;
+
+        try {
+            eval(thisScript.text);
+        } catch (v) {
+            doExn(v);
+        }
+        if (thisScript.parentNode)
+            thisScript.parentNode.removeChild(thisScript);
+
+        thisScript = savedScript;
+    } else if (node.getElementsByTagName) {
+        var savedScript = thisScript;
+
+        var scripts = node.getElementsByTagName("script"), scriptsCopy = [];
+        var len = scripts.length;
+        for (var i = 0; i < len; ++i)
+            scriptsCopy[i] = scripts[i];
+        for (var i = 0; i < len; ++i) {
+            thisScript = scriptsCopy[i];
+
+            try {
+                eval(thisScript.text);
+            } catch (v) {
+                doExn(v);
+            }
+            if (thisScript.parentNode)
+                thisScript.parentNode.removeChild(thisScript);
+        }
+
+        thisScript = savedScript;
+    }
+}
+
+
+// Dynamic tree entry points
+
+function killScript(scr) {
+    scr.dead = true;
+    for (var ls = scr.sources; ls; ls = ls.next)
+        ls.data.dyns = remove(scr, ls.data.dyns);
+    for (var ls = scr.closures; ls; ls = ls.next)
+        freeClosure(ls.data);
+}
+
+// Sometimes we wind up with tables that contain <script>s outside the single <tbody>.
+// To avoid dealing with that case, we normalize by moving <script>s into <tbody>.
+function normalizeTable(table) {
+    var orig = table;
+
+    var script, next;
+
+    while (table && table.tagName != "TABLE")
+        table = table.parentNode;
+
+    for (var tbody = table.firstChild; tbody; tbody = tbody.nextSibling) {
+        if (tbody.tagName == "TBODY") {
+            var firstChild = tbody.firstChild;
+
+            for (script = table.firstChild; script && script != tbody; script = next) {
+                next = script.nextSibling;
+
+                if (script.tagName === "SCRIPT") {
+                    if (firstChild)
+                        tbody.insertBefore(script, firstChild);
+                    else
+                        tbody.appendChild(script);
+                }
+            }
+
+            return;
+        }
+    }
+
+    var tbody = document.createElement("tbody");
+    for (script = table.firstChild; script; script = next) {
+        next = script.nextSibling;
+
+        tbody.appendChild(script);
+    }
+    table.appendChild(tbody);
+}
+
+var suspendScripts = false;
+
+function dyn(pnode, s) {
+    if (suspendScripts)
+        return;
+
+    var x = document.createElement("script");
+    x.dead = false;
+    x.signal = s;
+    x.sources = null;
+    x.closures = null;
+
+    var firstChild = null;
+
+    x.recreate = function(v) {
+        for (var ls = x.closures; ls; ls = ls.next)
+            freeClosure(ls.data);
+
+        var next;
+        for (var child = firstChild; child && child != x; child = next) {
+            next = child.nextSibling;
+
+            killScript(child);
+            if (child.getElementsByTagName) {
+                var arr = child.getElementsByTagName("script");
+                for (var i = 0; i < arr.length; ++i)
+                    killScript(arr[i]);
+            }
+
+            if (child.parentNode)
+                child.parentNode.removeChild(child);
+        }
+
+        var cls = {v : null};
+        var html = flatten(cls, v);
+        if (pnode != "table" && pnode != "tr")
+            html = dynPrefix + html;
+        x.closures = cls.v;
+
+        if (pnode == "table") {
+            normalizeTable(x.parentNode);
+
+            var dummy = document.createElement("body");
+            suspendScripts = true;
+            try {
+                dummy.innerHTML = "<table>" + html + "</table>";
+            } catch (e) {
+                suspendScripts = false;
+                throw e;
+            }
+
+            var table = x.parentNode;
+
+            if (table) {
+                firstChild = null;
+                var tbody;
+
+                var arr = dummy.getElementsByTagName("tbody");
+
+                var tbody;
+                if (arr.length > 0 && arr[0].parentNode == dummy.firstChild) {
+                    tbody = arr[0];
+                    var next;
+                    for (var node = dummy.firstChild.firstChild; node; node = next) {
+                        next = node.nextSibling;
+
+                        if (node.tagName != "TBODY")
+                            tbody.appendChild(node);
+                    }
+                } else
+                    tbody = dummy.firstChild;
+
+                var next;
+                firstChild = document.createElement("script");
+                table.insertBefore(firstChild, x);
+                for (var node = tbody.firstChild; node; node = next) {
+                    next = node.nextSibling;
+                    table.insertBefore(node, x);
+                    suspendScripts = false;
+                    runScripts(node);
+                    suspendScripts = true;
+                }
+            }
+
+            suspendScripts = false;
+        } else if (pnode == "tr") {
+            var dummy = document.createElement("body");
+            suspendScripts = true;
+            try {
+                dummy.innerHTML = "<table><tr>" + html + "</tr></table>";
+            } catch (e) {
+                suspendScripts = false;
+                throw e;
+            }
+
+            var table = x.parentNode;
+
+            if (table) {
+                var arr = dummy.getElementsByTagName("tr");
+                firstChild = null;
+                var tr;
+                if (arr.length > 0 && table != null)
+                    tr = arr[0];
+                else
+                    tr = dummy.firstChild;
+
+                var next;
+                firstChild = document.createElement("script");
+                table.insertBefore(firstChild, x);
+                for (var node = tr.firstChild; node; node = next) {
+                    next = node.nextSibling;
+                    table.insertBefore(node, x);
+                    suspendScripts = false;
+                    runScripts(node);
+                    suspendScripts = true;
+                }
+            };
+
+            suspendScripts = false;
+        } else {
+            firstChild = document.createElement("span");
+
+            suspendScripts = true;
+            try {
+                firstChild.innerHTML = html;
+                if (x.parentNode)
+                    x.parentNode.insertBefore(firstChild, x);
+            } catch (e) {
+                suspendScripts = false;
+                throw e;
+            }
+            suspendScripts = false;
+            runScripts(firstChild);
+        }
+    };
+
+    addNode(x);
+    populate(x);
+}
+
+function setInnerHTML(node, html) {
+    var x;
+
+    if (node.previousSibling && node.previousSibling.closures != undefined) {
+        x = node.previousSibling;
+
+        for (var ls = x.closures; ls; ls = ls.next)
+            freeClosure(ls.data);
+
+        if (node.getElementsByTagName) {
+            var arr = node.getElementsByTagName("script");
+            for (var i = 0; i < arr.length; ++i)
+                killScript(arr[i]);
+        }
+    } else {
+        x = document.createElement("script");
+        x.dead = false;
+        x.sources = null;
+
+        if (node.parentNode)
+            node.parentNode.insertBefore(x, node);
+        else
+            whine("setInnerHTML: node is not already in the DOM tree");
+    }
+
+    var cls = {v : null};
+    var html = flatten(cls, html);
+    x.closures = cls.v;
+    suspendScripts = true;
+    node.innerHTML = html;
+    suspendScripts = false;
+    runScripts(node);
+}
+
+var maySuspend = true;
+
+function active(s) {
+    if (suspendScripts)
+        return;
+
+    var ms = maySuspend;
+    maySuspend = false;
+    try {
+        var html = execF(s);
+    } catch (e) {
+        maySuspend = ms;
+        throw e;
+    }
+    maySuspend = ms;
+    if (html != "") {
+        var span = document.createElement("span");
+        addNode(span);
+        setInnerHTML(span, html);
+    }
+}
+
+function input(x, s, recreate, type, name) {
+    if (name) x.name = name;
+    if (type) x.type = type;
+    addNode(x);
+
+    var sc = document.createElement("script");
+    sc.dead = false;
+    sc.signal = ss(s);
+    sc.sources = null;
+    sc.recreate = recreate(x);
+
+    if (x.parentNode)
+        x.parentNode.insertBefore(sc, x);
+
+    populate(sc);
+
+    return x;
+}
+
+function inpt(type, s, name) {
+    if (suspendScripts)
+        return;
+
+    var x = input(document.createElement("input"), s,
+                  function(x) { return function(v) { if (x.value != v) x.value = v; }; }, type, name);
+    x.value = s.data;
+    x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
+
+    return x;
+}
+function inpt_float(type, s, name) {
+    if (suspendScripts)
+        return;
+
+    var filterFloat = function(value) {
+	if (/^(\-|\+)?([0-9]+(\.[0-9]+)?|Infinity)$/
+	    .test(value))
+	    return Number(value);
+	return null;
+    }
+    var x = input(document.createElement("input"), s, function(x) { return function(v) { if (x.value != v) x.value = v; }; }, type, name);
+    x.value = s.data;
+    x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, filterFloat(x.value)) };
+
+    return x;
+}
+
+
+function inp(s, name) {
+    return inpt("text", s, name);
+}
+
+function password(s, name) {
+    return inpt("password", s, name);
+}
+
+function email(s, name) {
+    return inpt("email", s, name);
+}
+
+function search(s, name) {
+    return inpt("search", s, name);
+}
+
+function url(s, name) {
+    return inpt("url", s, name);
+}
+
+function tel(s, name) {
+    return inpt("tel", s, name);
+}
+
+function color(s, name) {
+    return inpt("color", s, name);
+}
+
+function number(s, name) {
+    return inpt_float("number", s, name);
+}
+
+function range(s, name) {
+    return inpt_float("range", s, name);
+}
+
+function date(s, name) {
+    return inpt("date", s, name);
+}
+
+function datetime(s, name) {
+    return inpt("datetime", s, name);
+}
+
+function datetime_local(s, name) {
+    return inpt("datetime-local", s, name);
+}
+
+function month(s, name) {
+    return inpt("month", s, name);
+}
+
+function week(s, name) {
+    return inpt("week", s, name);
+}
+
+function time(s, name) {
+    return inpt("time", s, name);
+}
+
+
+function selectValue(x) {
+    if (x.options.length == 0)
+        return "";
+    else
+        return x.options[x.selectedIndex].value;
+}
+
+function setSelectValue(x, v) {
+  for (var i = 0; i < x.options.length; ++i) {
+      if(x.options[i].value == v) {
+          x.selectedIndex = i;
+          return;
+      }
+  }
+}
+
+function sel(s, content) {
+    if (suspendScripts)
+        return;
+
+    var dummy = document.createElement("span");
+    dummy.innerHTML = "<select>" + content + "</select>";
+    var x = input(dummy.firstChild, s, function(x) { return function(v) { if (selectValue(x) != v) setSelectValue(x, v); }; });
+
+    for (var i = 0; i < x.options.length; ++i) {
+        if (x.options[i].value == "")
+            x.options[i].value = x.options[i].text;
+        else
+            x.options[i].value = x.options[i].value.substring(1);
+    }
+
+    setSelectValue(x, s.data);
+    if (selectValue(x) != s.data)
+        sv(s, selectValue(x));
+    x.onchange = function() { sv(s, selectValue(x)) };
+
+    return x;
+}
+
+function chk(s) {
+    if (suspendScripts)
+        return;
+
+    var x = input(document.createElement("input"), s,
+                  function(x) { return function(v) { if (x.checked != v) x.checked = v; }; }, "checkbox");
+    x.defaultChecked = x.checked = s.data;
+    x.onclick = x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.checked) };
+
+    return x;
+}
+
+function tbx(s) {
+    if (suspendScripts)
+        return;
+
+    var x = input(document.createElement("textarea"), s,
+                  function(x) { return function(v) { if (x.value != v) x.value = v; }; });
+    x.innerHTML = s.data;
+    x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
+
+    return x;
+}
+
+function dynClass(pnode, html, s_class, s_style) {
+    if (suspendScripts)
+        return;
+
+    var htmlCls = {v : null};
+    html = flatten(htmlCls, html);
+    htmlCls = htmlCls.v;
+
+    var dummy = document.createElement(pnode);
+    suspendScripts = true;
+    dummy.innerHTML = html;
+    suspendScripts = false;
+    var html = dummy.firstChild;
+    dummy.removeChild(html);
+    if (pnode == "table" && html.tagName == "TBODY") {
+        html = html.firstChild;
+    }
+    addNode(html);
+    runScripts(html);
+
+    if (s_class) {
+        var x = document.createElement("script");
+        x.dead = false;
+        x.signal = s_class;
+        x.sources = null;
+        x.closures = htmlCls;
+
+        x.recreate = function(v) {
+            for (var ls = x.closures; ls != htmlCls; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            html.className = flatten(cls, v);
+	    x.closures = concat(cls.v, htmlCls);
+        }
+
+        html.appendChild(x);
+        populate(x);
+    }
+
+    if (s_style) {
+        var htmlCls2 = s_class ? null : htmlCls;
+        var y = document.createElement("script");
+        y.dead = false;
+        y.signal = s_style;
+        y.sources = null;
+        y.closures = htmlCls2;
+
+        y.recreate = function(v) {
+            for (var ls = y.closures; ls != htmlCls2; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            html.style.cssText = flatten(cls, v);
+	    y.closures = concat(cls.v, htmlCls2);
+        }
+
+        html.appendChild(y);
+        populate(y);
+    }
+}
+
+function bodyDynClass(s_class, s_style) {
+    if (suspendScripts)
+        return;
+
+    var htmlCls = null;
+
+    if (s_class) {
+        var x = document.createElement("script");
+        x.dead = false;
+        x.signal = s_class;
+        x.sources = null;
+        x.closures = htmlCls;
+
+        x.recreate = function(v) {
+            for (var ls = x.closures; ls != htmlCls; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            document.body.className = flatten(cls, v);
+            console.log("className to + " + document.body.className);
+	    x.closures = concat(cls.v, htmlCls);
+        }
+
+        document.body.appendChild(x);
+        populate(x);
+    }
+
+    if (s_style) {
+        var htmlCls2 = s_class ? null : htmlCls;
+        var y = document.createElement("script");
+        y.dead = false;
+        y.signal = s_style;
+        y.sources = null;
+        y.closures = htmlCls2;
+
+        y.recreate = function(v) {
+            for (var ls = y.closures; ls != htmlCls2; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            document.body.style.cssText = flatten(cls, v);
+            console.log("style to + " + document.body.style.cssText);
+	    y.closures = concat(cls.v, htmlCls2);
+        }
+
+        document.body.appendChild(y);
+        populate(y);
+    }
+}
+
+function addOnChange(x, f) {
+    var old = x.onchange;
+    if (old == null)
+        x.onchange = f;
+    else
+        x.onchange = function() { old(); f(); };
+}
+
+function addOnKeyUp(x, f) {
+    var old = x.onkeyup;
+    if (old == null)
+        x.onkeyup = f;
+    else
+        x.onkeyup = function(x) { old(x); f(x); };
+}
+
+
+// Basic string operations
+
+function eh(x) {
+    if (x == null)
+        return "NULL";
+    else
+        return x.split("&").join("&amp;").split("<").join("&lt;").split(">").join("&gt;");
+}
+
+function ts(x) { return x.toString() }
+function bs(b) { return (b ? "True" : "False") }
+function s2b(s) { return s == "True" ? true : s == "False" ? false : null; }
+function s2be(s) { return s == "True" ? true : s == "False" ? false : er("Illegal Boolean " ^ s); }
+
+function id(x) { return x; }
+function sub(s, i) { return s.charAt(i); }
+function suf(s, i) { return s.substring(i); }
+function slen(s) { return s.length; }
+function sidx(s, ch) {
+    var r = s.indexOf(ch);
+    if (r == -1)
+        return null;
+    else
+        return r;
+}
+function ssidx(h, n) {
+    var r = h.indexOf(n);
+    if (r == -1)
+        return null;
+    else
+        return r;
+}
+function sspn(s, chs) {
+    for (var i = 0; i < s.length; ++i)
+        if (chs.indexOf(s.charAt(i)) != -1)
+            return i;
+
+    return s.length;
+}
+function schr(s, ch) {
+    var r = s.indexOf(ch);
+    if (r == -1)
+        return null;
+    else
+        return s.substring(r);
+}
+function ssub(s, start, len) {
+    return s.substring(start, start+len);
+}
+function strlenGe(s, len) {
+    return s.length >= len;
+}
+
+function trimZeroes(s) {
+    for (var i = 0; i < s.length; ++i)
+        if (s.charAt(i) != '0') {
+            if (i > 0)
+                return s.substring(i);
+            else
+                return s;
+        }
+
+    if (s.length == 0)
+        return s;
+    else
+        return "0";
+}
+
+function pi(s) {
+    var st = trimZeroes(s);
+    var r = parseInt(st);
+    if (r.toString() == st)
+        return r;
+    else
+        er("Can't parse int: " + s);
+}
+
+function pfl(s) {
+    var r = parseFloat(s);
+    if (r.toString() == s)
+        return r;
+    else
+        er("Can't parse float: " + s);
+}
+
+function pio(s) {
+    var st = trimZeroes(s);
+    var r = parseInt(st);
+    if (r.toString() == st)
+        return r;
+    else
+        return null;
+}
+
+function pflo(s) {
+    var r = parseFloat(s);
+    if (r.toString() == s)
+        return r;
+    else
+        return null;
+}
+
+function parseSource(s1, s2) {
+    return eval("s" + s1 + "_" + s2);
+}
+
+function uf(s) {
+    if (s.length == 0)
+        return "_";
+    s = s.replace(/\./g, ".2E");
+    return (s.charAt(0) == '_' ? "_" : "") + encodeURIComponent(s).replace(/%/g, ".");
+}
+
+function uu(s) {
+    if (s.length > 0 && s.charAt(0) == '_') {
+        s = s.substring(1);
+    } else if (s.length >= 3 && (s.charAt(0) == '%' || s.charAt(0) == '.')
+               && s.charAt(1) == '5' && (s.charAt(2) == 'f' || s.charAt(2) == 'F'))
+        s = s.substring(3);
+    s = s.replace(/\+/g, " ");
+    s = s.replace(/\./g, "%");
+    return decodeURIComponent(s);
+}
+
+function atr(s) {
+    return s.replace(/\"/g, "&quot;").replace(/&/g, "&amp;")
+}
+
+function ub(b) {
+    return b ? "1" : "0";
+}
+
+function uul(getToken, getData) {
+    var tok = getToken();
+    if (tok == "Nil") {
+        return null;
+    } else if (tok == "Cons") {
+        var d = getData();
+        var l = uul(getToken, getData);
+        return {_1:d, _2:l};
+    } else
+        whine("Can't unmarshal list (" + tok + ")");
+}
+
+function strcmp(str1, str2) {
+    return ((str1 == str2) ? 0 : ((str1 > str2) ? 1 : -1));
+}
+
+function chr(n) {
+    return String.fromCharCode(n);
+}
+
+function htmlifySpecialChar(ch) {
+    return "&#" + ch.charCodeAt(0) + ";";
+}
+
+
+// Remote calls
+
+var client_id = null;
+var client_pass = 0;
+var url_prefix = "/";
+var timeout = 60;
+var isPost = false;
+
+function getXHR(uri)
+{
+    try {
+        return new XMLHttpRequest();
+    } catch (e) {
+        try {
+            return new ActiveXObject("Msxml2.XMLHTTP");
+        } catch (e) {
+            try {
+                return new ActiveXObject("Microsoft.XMLHTTP");
+            } catch (e) {
+                whine("Your browser doesn't seem to support AJAX.");
+            }
+        }
+    }
+}
+
+var sig = null;
+
+var unloading = false, inFlight = null;
+
+function unload() {
+    for (; inFlight; inFlight = inFlight.next) {
+        inFlight.data.abort();
+    }
+}
+
+function requestUri(xhr, uri, needsSig, isRpc) {
+    var extraData = null;
+
+    if (isRpc && uri.length > 2000) {
+        extraData = uri.substring(2000);
+        uri = uri.substring(0, 2000);
+    }
+
+    xhr.open("POST", uri, !unloading);
+    xhr.setRequestHeader("Content-type", "text/plain");
+
+    if (client_id != null) {
+        xhr.setRequestHeader("UrWeb-Client", client_id.toString());
+        xhr.setRequestHeader("UrWeb-Pass", client_pass.toString());
+    }
+
+    if (needsSig) {
+        if (sig == null)
+            whine("Missing cookie signature!");
+
+        xhr.setRequestHeader("UrWeb-Sig", sig);
+    }
+
+    inFlight = cons(xhr, inFlight);
+    xhr.send(extraData);
+}
+
+function xhrFinished(xhr) {
+    xhr.abort();
+    inFlight = remove(xhr, inFlight);
+}
+
+function unurlify(parse, s) {
+    return parse(s);
+}
+
+function redirect(s) {
+    window.location = s;
+}
+
+function makeSome(isN, v) {
+    if (isN)
+        return {v: v};
+    else
+        return v;
+}
+
+function rc(prefix, uri, parse, k, needsSig, isN) {
+    if (!maySuspend)
+        er("May not 'rpc' in main thread of 'code' for <active>");
+
+    uri = cat(prefix, uri);
+    uri = flattenLocal(uri);
+    var xhr = getXHR();
+
+    xhr.onreadystatechange = function() {
+        if (xhr.readyState == 4) {
+            var isok = false;
+
+            try {
+                if (xhr.status == 200)
+                    isok = true;
+            } catch (e) { }
+
+            if (isok) {
+                var lines = xhr.responseText.split("\n");
+                if (lines.length != 2) {
+                    if (isN == null)
+                        whine("Bad RPC response lines");
+                    else
+                        k(null);
+                } else {
+                    eval(lines[0]);
+
+                    try {
+                        var v = parse(lines[1]);
+                        try {
+                            k(makeSome(isN, v));
+                        } catch (v) {
+                            doExn(v);
+                        }
+                    } catch (v) {
+                        k(null);
+                    }
+                }
+            } else {
+                if (isN == null)
+                    conn(xhr.responseText);
+                else
+                    k(null);
+            }
+
+            xhrFinished(xhr);
+        }
+    };
+
+    requestUri(xhr, uri, needsSig, true);
+}
+
+function path_join(s1, s2) {
+    if (s1.length > 0 && s1.charAt(s1.length-1) == '/')
+        return s1 + s2;
+    else
+        return s1 + "/" + s2;
+}
+
+var channels = [];
+
+function newQueue() {
+    return { front : null, back : null };
+}
+function enqueue(q, v) {
+    if (q.front == null) {
+        q.front = cons(v, null);
+        q.back = q.front;
+    } else {
+        var node = cons(v, null);
+        q.back.next = node;
+        q.back = node;
+    }
+}
+function dequeue(q) {
+    if (q.front == null)
+        return null;
+    else {
+        var r = q.front.data;
+        q.front = q.front.next;
+        if (q.front == null)
+            q.back = null;
+        return r;
+    }
+}
+
+function newChannel() {
+    return { msgs : newQueue(), listeners : newQueue() };
+}
+
+function listener() {
+    var uri = path_join(url_prefix, ".msgs");
+    var xhr = getXHR();
+    var tid, orsc, onTimeout, lastTick;
+
+    var connect = function () {
+        xhr.onreadystatechange = orsc;
+        lastTick = new Date().getTime();
+        tid = window.setTimeout(onTimeout, timeout * 500);
+        requestUri(xhr, uri, false, false);
+    }
+
+    orsc = function() {
+        if (xhr.readyState == 4) {
+            window.clearTimeout(tid);
+
+            var isok = false;
+
+            try {
+                if (xhr.status == 200)
+                    isok = true;
+            } catch (e) { }
+
+            if (isok) {
+                var text = xhr.responseText;
+                if (text == "")
+                    return;
+                var lines = text.split("\n");
+
+                if (lines.length == 1 && lines[0] == "R") {
+                    lameDuck = true;
+
+                    if (isPost)
+                        history.back();
+                    else
+                        location.reload();
+
+                    return;
+                }
+
+                if (lines.length < 2) {
+                    discon();
+                    return;
+                }
+
+                var messageReader = function(i) {
+                    if (i+1 >= lines.length) {
+                        xhrFinished(xhr);
+                        connect();
+                    }
+                    else {
+                        var chn = lines[i];
+                        var msg = lines[i+1];
+
+                        if (chn == "E") {
+                            eval(msg);
+                            window.setTimeout(function() { messageReader(i+2); }, 0);
+                        } else {
+                            if (chn < 0)
+                                whine("Out-of-bounds channel in message from remote server");
+
+                            var ch;
+
+                            if (chn >= channels.length || channels[chn] == null) {
+                                ch = newChannel();
+                                channels[chn] = ch;
+                            } else
+                                ch = channels[chn];
+
+                            var listener = dequeue(ch.listeners);
+                            if (listener == null) {
+                                enqueue(ch.msgs, msg);
+                            } else {
+                                try {
+                                    listener(msg);
+                                } catch (v) {
+                                    doExn(v);
+                                }
+                            }
+
+                            messageReader(i+2);
+                        }
+                    }
+                }
+
+                messageReader(0);
+            }
+            else {
+                try {
+                    if (xhr.status != 0)
+                        servErr("Error querying remote server for messages: " + xhr.status);
+                } catch (e) { }
+            }
+        }
+    };
+
+    onTimeout = function() {
+        var thisTick = new Date().getTime();
+        xhrFinished(xhr);
+
+        if (thisTick - lastTick > timeout * 1000) {
+            if (confirm("The session for this page has expired.  Please choose \"OK\" to reload.")) {
+                if (isPost)
+                    history.back();
+                else
+                    location.reload();
+            }
+        } else {
+            connect();
+        }
+    };
+
+    connect();
+}
+
+function rv(chn, parse, k) {
+    if (!maySuspend)
+        er("May not 'recv' in main thread of 'code' for <active>");
+
+    if (chn == null)
+        er("Client-side code tried to recv() from a channel belonging to a different page view.");
+
+    if (chn < 0)
+        whine("Out-of-bounds channel receive");
+
+    var ch;
+
+    if (chn >= channels.length || channels[chn] == null) {
+        ch = newChannel();
+        channels[chn] = ch;
+    } else
+        ch = channels[chn];
+
+    var msg = dequeue(ch.msgs);
+    if (msg == null) {
+        enqueue(ch.listeners, function(msg) { k(parse(msg)); });
+    } else {
+        try {
+            k(parse(msg));
+        } catch (v) {
+            doExn(v);
+        }
+    }
+}
+
+function sl(ms, k) {
+    if (!maySuspend)
+        er("May not 'sleep' in main thread of 'code' for <active>");
+
+    window.setTimeout(function() { k(null); }, ms);
+}
+
+function sp(e) {
+    window.setTimeout(function() { execF(e); }, 0);
+}
+
+
+// The Ur interpreter
+
+var urfuncs = [];
+
+function lookup(env, n) {
+    while (env != null) {
+        if (n == 0)
+            return env.data;
+        else {
+            --n;
+            env = env.next;
+        }
+    }
+
+    whine("Out-of-bounds Ur variable reference");
+}
+
+function execP(env, p, v) {
+    switch (p.c) {
+    case "v":
+        return cons(v, env);
+    case "c":
+        if (v == p.v)
+            return env;
+        else
+            return false;
+    case "s":
+        if (v == null)
+            return false;
+        else
+            return execP(env, p.p, p.n ? v.v : v);
+    case "1":
+        if (v.n != p.n)
+            return false;
+        else
+            return execP(env, p.p, v.v);
+    case "r":
+        for (var fs = p.l; fs != null; fs = fs.next) {
+            env = execP(env, fs.data.p, v["_" + fs.data.n]);
+            if (env == false)
+                return false;
+        }
+        return env;
+    default:
+        whine("Unknown Ur pattern kind " + p.c);
+    }
+}
+
+function exec0(env, e) {
+    return exec1(env, null, e);
+}
+
+function exec1(env, stack, e) {
+    var stack, usedK = false;
+
+    var saveEnv = function() {
+        if (stack.next != null && stack.next.data.c != "<")
+            stack = cons({c: "<", env: env}, stack.next);
+        else
+            stack = stack.next;
+    };
+
+    while (true) {
+        switch (e.c) {
+        case "c":
+            var v = e.v;
+            if (stack == null)
+                return v;
+            var fr = stack.data;
+
+            switch (fr.c) {
+            case "s":
+                e = {c: "c", v: {v: v}};
+                stack = stack.next;
+                break;
+            case "1":
+                e = {c: "c", v: {n: fr.n, v: v}};
+                stack = stack.next;
+                break;
+            case "f":
+                fr.args[fr.pos++] = v;
+                if (fr.a == null) {
+                    var res;
+                    stack = stack.next;
+
+                    if (fr.f.apply)
+                        res = fr.f.apply(null, fr.args);
+                    else if (fr.args.length == 0)
+                        res = fr.f();
+                    else if (fr.args.length == 1)
+                        res = fr.f(fr.args[0]);
+                    else if (fr.args.length == 2)
+                        res = fr.f(fr.args[0], fr.args[1]);
+                    else if (fr.args.length == 3)
+                        res = fr.f(fr.args[0], fr.args[1], fr.args[2]);
+                    else if (fr.args.length == 4)
+                        res = fr.f(fr.args[0], fr.args[1], fr.args[2], fr.args[3]);
+                    else if (fr.args.length == 5)
+                        res = fr.f(fr.args[0], fr.args[1], fr.args[2], fr.args[3], fr.args[4]);
+                    else
+                        whine("Native function has " + fr.args.length + " args, but there is no special case for that count.");
+
+                    e = {c: "c", v: res};
+                    if (usedK) return null;
+                } else {
+                    e = fr.a.data;
+                    fr.a = fr.a.next;
+                }
+                break;
+            case "a1":
+                e = fr.x;
+                stack = cons({c: "a2", f: v}, stack.next);
+                break;
+            case "a2":
+                if (fr.f == null)
+                    whine("Ur: applying null function");
+                else if (fr.f.body) {
+                    saveEnv();
+                    env = cons(v, fr.f.env);
+                    e = fr.f.body;
+                } else {
+                    e = {c: "c", v: fr.f(v)};
+                    stack = stack.next;
+                }
+                break;
+            case "<":
+                env = fr.env;
+                stack = stack.next;
+                break;
+            case "r":
+                fr.fs["_" + fr.n] = v;
+                if (fr.l == null) {
+                    e = {c: "c", v: fr.fs};
+                    stack = stack.next;
+                } else {
+                    fr.n = fr.l.data.n;
+                    e = fr.l.data.v;
+                    fr.l = fr.l.next;
+                }
+                break;
+            case ".":
+                e = {c: "c", v: v["_" + fr.f]};
+                stack = stack.next;
+                break;
+            case ";":
+                e = fr.e2;
+                stack = stack.next;
+                break;
+            case "=":
+                saveEnv();
+                env = cons(v, env);
+                e = fr.e2;
+                break;
+            case "m":
+                var ps;
+                for (ps = fr.p; ps != null; ps = ps.next) {
+                    var r = execP(env, ps.data.p, v);
+                    if (r != false) {
+                        saveEnv();
+                        env = r;
+                        e = ps.data.b;
+                        break;
+                    }
+                }
+                if (ps == null)
+                    whine("Match failure in Ur interpretation");
+                break;
+            default:
+                whine("Unknown Ur continuation kind " + fr.c);
+            }
+
+            break;
+        case "v":
+            e = {c: "c", v: lookup(env, e.n)};
+            break;
+        case "n":
+            var idx = e.n;
+            e = urfuncs[idx];
+            if (e.c == "t")
+                e = urfuncs[idx] = eval("(" + e.f + ")");
+            break;
+        case "s":
+            stack = cons({c: "s"}, stack);
+            e = e.v;
+            break;
+        case "1":
+            stack = cons({c: "1", n: e.n}, stack);
+            e = e.v;
+            break;
+        case "f":
+            if (e.a == null)
+                e = {c: "c", v: e.f()};
+            else {
+                var args = [];
+                stack = cons({c: "f", f: e.f, args: args, pos: 0, a: e.a.next}, stack);
+                if (!e.a.data.c) alert("[2] fr.f = " + e.f + "; 0 = " + e.a.data);
+                e = e.a.data;
+            }
+            break;
+        case "l":
+            e = {c: "c", v: {env: env, body: e.b}};
+            break;
+        case "a":
+            stack = cons({c: "a1", x: e.x}, stack);
+            e = e.f;
+            break;
+        case "r":
+            if (e.l == null)
+                whine("Empty Ur record in interpretation");
+            var fs = {};
+            stack = cons({c: "r", n: e.l.data.n, fs: fs, l: e.l.next}, stack);
+            e = e.l.data.v;
+            break;
+        case ".":
+            stack = cons({c: ".", f: e.f}, stack);
+            e = e.r;
+            break;
+        case ";":
+            stack = cons({c: ";", e2: e.e2}, stack);
+            e = e.e1;
+            break;
+        case "=":
+            stack = cons({c: "=", e2: e.e2}, stack);
+            e = e.e1;
+            break;
+        case "m":
+            stack = cons({c: "m", p: e.p}, stack);
+            e = e.e;
+            break;
+        case "e":
+            e = {c: "c", v: cs({c: "wc", env: env, body: e.e})};
+            break;
+        case "wc":
+            env = e.env;
+            e = e.body;
+            break;
+        case "K":
+            { var savedStack = stack.next, savedEnv = env;
+                e = {c: "c", v: function(v) { return exec1(savedEnv, savedStack, {c: "c", v: v}); } };}
+            usedK = true;
+            break;
+        default:
+            whine("Unknown Ur expression kind " + e.c);
+        }
+    }
+}
+
+function execD(e) {
+    return exec0(null, e);
+}
+
+function exec(e) {
+    var r = exec0(null, e);
+
+    if (r != null && r.body != null)
+        return function(v) { return exec0(cons(v, r.env), r.body); };
+    else
+        return r;
+}
+
+function execF(f, x) {
+    return exec0(cons(x, f.env), f.body);
+}
+
+
+// Wrappers
+
+function confrm(s) {
+    return confirm(s) ? true : false;
+}
+
+
+// URL blessing
+
+var urlRules = null;
+
+function checkUrl(s) {
+    for (var r = urlRules; r; r = r.next) {
+        var ru = r.data;
+        if (ru.prefix ? s.indexOf(ru.pattern) == 0 : s == ru.pattern)
+            return ru.allow ? s : null;
+    }
+
+    return null;
+}
+
+function bless(s) {
+    u = checkUrl(s);
+    if (u == null)
+        er("Disallowed URL: " + s);
+    return u;
+}
+
+
+// Attribute name blessing
+
+function blessData(s) {
+    for (var i = 0; i < s.length; ++i) {
+        var c = s[i];
+        if (!isAlnum(c) && c != '-' && c != '_')
+            er("Disallowed character in data-* attribute name");
+    }
+
+    return s;
+}
+
+
+// CSS validation
+
+function atom(s) {
+    for (var i = 0; i < s.length; ++i) {
+        var c = s[i];
+        if (!isAlnum(c) && c != '+' && c != '-' && c != '.' && c != '%' && c != '#')
+            er("Disallowed character in CSS atom");
+    }
+
+    return s;
+}
+
+function css_url(s) {
+    for (var i = 0; i < s.length; ++i) {
+        var c = s[i];
+        if (!isAlnum(c) && c != ':' && c != '/' && c != '.' && c != '_' && c != '+'
+            && c != '-' && c != '%' && c != '?' && c != '&' && c != '=' && c != '#')
+            er("Disallowed character in CSS URL");
+    }
+
+    return s;
+}
+
+function property(s) {
+    if (s.length <= 0)
+        er("Empty CSS property");
+
+    if (!isLower(s[0]) && s[0] != '_')
+        er("Bad initial character in CSS property");
+
+    for (var i = 0; i < s.length; ++i) {
+        var c = s[i];
+        if (!isLower(c) && !isDigit(c) && c != '_' && c != '-')
+            er("Disallowed character in CSS property");
+    }
+
+    return s;
+}
+
+
+// ID generation
+
+var nextId = 0;
+
+function fresh() {
+    return "uw" + (--nextId);
+}
+
+function giveFocus(id) {
+    var node = document.getElementById(id);
+
+    if (node)
+        node.focus();
+    else
+        er("Tried to give focus to ID not used in document: " + id);
+}
+
+
+// App-specific code
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
new file mode 100644
index 0000000..89a48d5
--- /dev/null
+++ b/lib/ur/basis.urs
@@ -0,0 +1,1207 @@
+type int
+type float
+type string
+type char
+type time
+type blob
+
+type unit = {}
+
+datatype bool = False | True
+
+datatype option t = None | Some of t
+
+datatype list t = Nil | Cons of t * list t
+
+
+(** Polymorphic variants *)
+
+con variant :: {Type} -> Type
+val make : nm :: Name -> t ::: Type -> ts ::: {Type} -> [[nm] ~ ts] => t -> variant ([nm = t] ++ ts)
+val match : ts ::: {Type} -> t ::: Type -> variant ts -> $(map (fn t' => t' -> t) ts) -> t
+
+
+(** Basic type classes *)
+
+class eq
+val eq : t ::: Type -> eq t -> t -> t -> bool
+val ne : t ::: Type -> eq t -> t -> t -> bool
+val eq_int : eq int
+val eq_float : eq float
+val eq_string : eq string
+val eq_char : eq char
+val eq_bool : eq bool
+val eq_time : eq time
+val mkEq : t ::: Type -> (t -> t -> bool) -> eq t
+
+class num
+val zero : t ::: Type -> num t -> t
+val neg : t ::: Type -> num t -> t -> t
+val plus : t ::: Type -> num t -> t -> t -> t
+val minus : t ::: Type -> num t -> t -> t -> t
+val times : t ::: Type -> num t -> t -> t -> t
+val divide : t ::: Type -> num t -> t -> t -> t
+val mod : t ::: Type -> num t -> t -> t -> t
+val pow : t ::: Type -> num t -> t -> t -> t
+val num_int : num int
+val num_float : num float
+
+class ord
+val lt : t ::: Type -> ord t -> t -> t -> bool
+val le : t ::: Type -> ord t -> t -> t -> bool
+val gt : t ::: Type -> ord t -> t -> t -> bool
+val ge : t ::: Type -> ord t -> t -> t -> bool
+val ord_int : ord int
+val ord_float : ord float
+val ord_string : ord string
+val ord_char : ord char
+val ord_bool : ord bool
+val ord_time : ord time
+val mkOrd : t ::: Type -> {Lt : t -> t -> bool, Le : t -> t -> bool} -> ord t
+
+
+(** Character operations *)
+
+val isalnum : char -> bool
+val isalpha : char -> bool
+val isblank : char -> bool
+val iscntrl : char -> bool
+val isdigit : char -> bool
+val isgraph : char -> bool
+val islower : char -> bool
+val isprint : char -> bool
+val ispunct : char -> bool
+val isspace : char -> bool
+val isupper : char -> bool
+val isxdigit : char -> bool
+val tolower : char -> char
+val toupper : char -> char
+val ord : char -> int
+val chr : int -> char
+
+(** String operations *)
+
+val strlen : string -> int
+val strlenGe : string -> int -> bool
+val strcat : string -> string -> string
+val strsub : string -> int -> char
+val strsuffix : string -> int -> string
+val strchr : string -> char -> option string
+val strindex : string -> char -> option int
+val strsindex : string -> string -> option int
+val strcspn : string -> string -> int
+val substring : string -> int -> int -> string
+val str1 : char -> string
+
+class show
+val show : t ::: Type -> show t -> t -> string
+val show_int : show int
+val show_float : show float
+val show_string : show string
+val show_char : show char
+val show_bool : show bool
+val show_time : show time
+val mkShow : t ::: Type -> (t -> string) -> show t
+
+class read
+val read : t ::: Type -> read t -> string -> option t
+val readError : t ::: Type -> read t -> string -> t
+(* [readError] calls [error] if the input is malformed. *)
+val read_int : read int
+val read_float : read float
+val read_string : read string
+val read_char : read char
+val read_bool : read bool
+val read_time : read time
+val mkRead : t ::: Type -> (string -> t) -> (string -> option t) -> read t
+
+
+(** * Monads *)
+
+class monad :: (Type -> Type) -> Type
+val return : m ::: (Type -> Type) -> t ::: Type
+             -> monad m
+             -> t -> m t
+val bind : m ::: (Type -> Type) -> t1 ::: Type -> t2 ::: Type
+           -> monad m
+           -> m t1 -> (t1 -> m t2)
+           -> m t2
+
+val mkMonad : m ::: (Type -> Type)
+              -> {Return : t ::: Type -> t -> m t,
+                  Bind : t1 ::: Type -> t2 ::: Type -> m t1 -> (t1 -> m t2) -> m t2}
+              -> monad m
+
+con transaction :: Type -> Type
+val transaction_monad : monad transaction
+
+con source :: Type -> Type
+val source : t ::: Type -> t -> transaction (source t)
+val set : t ::: Type -> source t -> t -> transaction unit
+val get : t ::: Type -> source t -> transaction t
+
+con signal :: Type -> Type
+val signal_monad : monad signal
+val signal : t ::: Type -> source t -> signal t
+val current : t ::: Type -> signal t -> transaction t
+
+
+(** * Floats *)
+
+val float : int -> float
+val ceil : float -> int
+val trunc : float -> int
+val round : float -> int
+val floor : float -> int
+
+(** * Basic Math *)
+
+val sqrt : float -> float
+val sin : float -> float
+val cos : float -> float
+val log : float -> float
+val exp : float -> float
+val asin : float -> float
+val acos : float -> float
+val atan : float -> float
+val atan2 : float -> float -> float
+val abs: float -> float
+
+(** * Time *)
+
+val now : transaction time
+val minTime : time
+val addSeconds : time -> int -> time
+val toSeconds : time -> int
+val diffInSeconds : time -> time -> int
+(* Earlier time first *)
+val toMilliseconds : time -> int
+val fromMilliseconds : int -> time
+val diffInMilliseconds : time -> time -> int
+val timef : string -> time -> string (* Uses strftime() format string *)
+val readUtc : string -> option time
+
+(* Takes a year, month, day, hour, minute, second. *)
+val fromDatetime : int -> int -> int -> int -> int -> int -> time
+val datetimeYear : time -> int
+val datetimeMonth : time -> int
+val datetimeDay : time -> int
+val datetimeHour : time -> int
+val datetimeMinute: time -> int
+val datetimeSecond : time -> int
+val datetimeDayOfWeek : time -> int
+
+
+(** * Encryption *)
+
+val crypt : string -> string -> string
+
+
+(** HTTP operations *)
+
+con http_cookie :: Type -> Type
+val getCookie : t ::: Type -> http_cookie t -> transaction (option t)
+val setCookie : t ::: Type -> http_cookie t -> {Value : t,
+                                                Expires : option time,
+                                                Secure : bool} -> transaction unit
+val clearCookie : t ::: Type -> http_cookie t -> transaction unit
+
+type requestHeader
+val blessRequestHeader : string -> requestHeader
+val checkRequestHeader : string -> option requestHeader
+val getHeader : requestHeader -> transaction (option string)
+
+type responseHeader
+val blessResponseHeader : string -> responseHeader
+val checkResponseHeader : string -> option responseHeader
+val setHeader : responseHeader -> string -> transaction unit
+
+type envVar
+val blessEnvVar : string -> envVar
+val checkEnvVar : string -> option envVar
+val getenv : envVar -> transaction (option string)
+
+type meta
+val blessMeta : string -> meta
+val checkMeta : string -> option meta
+
+
+(** JavaScript-y gadgets *)
+
+val alert : string -> transaction unit
+val confirm : string -> transaction bool
+val spawn : transaction unit -> transaction unit
+val sleep : int -> transaction unit
+
+val rpc : t ::: Type -> transaction t -> transaction t
+val tryRpc : t ::: Type -> transaction t -> transaction (option t)
+(* Returns [None] on error condition. *)
+
+
+(** Channels *)
+
+con channel :: Type -> Type
+val channel : t ::: Type -> transaction (channel t)
+val send : t ::: Type -> channel t -> t -> transaction unit
+val recv : t ::: Type -> channel t -> transaction t
+
+type client
+val self : transaction client
+
+
+(** SQL *)
+
+con sql_table :: {Type} -> {{Unit}} -> Type
+con sql_view :: {Type} -> Type
+
+class fieldsOf :: Type -> {Type} -> Type
+val fieldsOf_table : fs ::: {Type} -> keys ::: {{Unit}}
+                     -> fieldsOf (sql_table fs keys) fs
+val fieldsOf_view : fs ::: {Type}
+                    -> fieldsOf (sql_view fs) fs
+
+(*** Constraints *)
+
+(**** Primary keys *)
+
+class sql_injectable_prim
+val sql_bool : sql_injectable_prim bool
+val sql_int : sql_injectable_prim int
+val sql_float : sql_injectable_prim float
+val sql_string : sql_injectable_prim string
+val sql_char : sql_injectable_prim char
+val sql_time : sql_injectable_prim time
+val sql_blob : sql_injectable_prim blob
+val sql_channel : t ::: Type -> sql_injectable_prim (channel t)
+val sql_client : sql_injectable_prim client
+
+con serialized :: Type -> Type
+val serialize : t ::: Type -> t -> serialized t
+val deserialize : t ::: Type -> serialized t -> t
+val sql_serialized : t ::: Type -> sql_injectable_prim (serialized t)
+
+con primary_key :: {Type} -> {{Unit}} -> Type
+val no_primary_key : fs ::: {Type} -> primary_key fs []
+val primary_key : rest ::: {Type} -> t ::: Type -> key1 :: Name -> keys :: {Type}
+                  -> [[key1] ~ keys] => [[key1 = t] ++ keys ~ rest]
+    => $([key1 = sql_injectable_prim t] ++ map sql_injectable_prim keys)
+       -> primary_key ([key1 = t] ++ keys ++ rest)
+          [Pkey = [key1] ++ map (fn _ => ()) keys]
+
+(**** Other constraints *)
+
+con sql_constraints :: {Type} -> {{Unit}} -> Type
+(* Arguments: column types, uniqueness implications of constraints *)
+
+con sql_constraint :: {Type} -> {Unit} -> Type
+
+val no_constraint : fs ::: {Type} -> sql_constraints fs []
+val one_constraint : fs ::: {Type} -> unique ::: {Unit} -> name :: Name
+                     -> sql_constraint fs unique
+                     -> sql_constraints fs [name = unique]
+val join_constraints : fs ::: {Type}
+                       -> uniques1 ::: {{Unit}} -> uniques2 ::: {{Unit}} -> [uniques1 ~ uniques2]
+    => sql_constraints fs uniques1 -> sql_constraints fs uniques2
+       -> sql_constraints fs (uniques1 ++ uniques2)
+
+
+val unique : rest ::: {Type} -> t ::: Type -> unique1 :: Name -> unique :: {Type}
+             -> [[unique1] ~ unique] => [[unique1 = t] ++ unique ~ rest]
+    => sql_constraint ([unique1 = t] ++ unique ++ rest) ([unique1] ++ map (fn _ => ()) unique)
+
+class linkable :: Type -> Type -> Type
+val linkable_same : t ::: Type -> linkable t t
+val linkable_from_nullable : t ::: Type -> linkable (option t) t
+val linkable_to_nullable : t ::: Type -> linkable t (option t)
+
+con matching :: {Type} -> {Type} -> Type
+val mat_nil : matching [] []
+val mat_cons : t1 ::: Type -> rest1 ::: {Type} -> t2 ::: Type -> rest2 ::: {Type}
+               -> nm1 :: Name -> nm2 :: Name
+               -> [[nm1] ~ rest1] => [[nm2] ~ rest2]
+    => linkable t1 t2
+       -> matching rest1 rest2
+       -> matching ([nm1 = t1] ++ rest1) ([nm2 = t2] ++ rest2)
+
+con propagation_mode :: {Type} -> Type
+val restrict : fs ::: {Type} -> propagation_mode fs
+val cascade : fs ::: {Type} -> propagation_mode fs
+val no_action : fs ::: {Type} -> propagation_mode fs
+val set_null : fs ::: {Type} -> propagation_mode (map option fs)
+
+
+val foreign_key : mine1 ::: Name -> t ::: Type -> mine ::: {Type} -> munused ::: {Type}
+                  -> foreign ::: {Type} -> funused ::: {Type}
+                  -> nm ::: Name -> uniques ::: {{Unit}}
+                  -> [[mine1] ~ mine] => [[mine1 = t] ++ mine ~ munused]
+    => [foreign ~ funused] => [[nm] ~ uniques]
+    => matching ([mine1 = t] ++ mine) foreign
+       -> sql_table (foreign ++ funused) ([nm = map (fn _ => ()) foreign] ++ uniques)
+       -> {OnDelete : propagation_mode ([mine1 = t] ++ mine),
+           OnUpdate : propagation_mode ([mine1 = t] ++ mine)}
+       -> sql_constraint ([mine1 = t] ++ mine ++ munused) []
+
+con sql_exp :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
+val sql_exp_weaken : fs ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+                     -> fs' ::: {{Type}} -> agg' ::: {{Type}} -> exps' ::: {Type}
+                     -> [fs ~ fs'] => [agg ~ agg'] => [exps ~ exps'] =>
+                     sql_exp fs agg exps t
+                     -> sql_exp (fs ++ fs') (agg ++ agg') (exps ++ exps') t
+
+val check : fs ::: {Type}
+            -> sql_exp [] [] fs bool
+            -> sql_constraint fs []
+
+
+(*** Queries *)
+
+con sql_query :: {{Type}} -> {{Type}} -> {{Type}} -> {Type} -> Type
+con sql_query1 :: {{Type}} -> {{Type}} -> {{Type}} -> {{Type}} -> {Type} -> Type
+
+con sql_subset :: {{Type}} -> {{Type}} -> Type
+val sql_subset : keep_drop :: {({Type} * {Type})}
+                              -> sql_subset
+                                     (map (fn fields :: ({Type} * {Type}) => fields.1 ++ fields.2) keep_drop)
+                                     (map (fn fields :: ({Type} * {Type}) => fields.1) keep_drop)
+val sql_subset_all : tables :: {{Type}} -> sql_subset tables tables
+val sql_subset_concat : big1 ::: {{Type}} -> little1 ::: {{Type}}
+                        -> big2 ::: {{Type}} -> little2 ::: {{Type}}
+                        -> [big1 ~ big2] => [little1 ~ little2] =>
+    sql_subset big1 little1
+    -> sql_subset big2 little2
+    -> sql_subset (big1 ++ big2) (little1 ++ little2)
+
+con sql_from_items :: {{Type}} -> {{Type}} -> Type
+
+val sql_from_nil : free ::: {{Type}} -> sql_from_items free []
+val sql_from_table : free ::: {{Type}} -> t ::: Type -> fs ::: {Type}
+                     -> fieldsOf t fs -> name :: Name
+                     -> t -> sql_from_items free [name = fs]
+val sql_from_query : free ::: {{Type}} -> fs ::: {Type} -> name :: Name
+                     -> sql_query free [] [] fs
+                     -> sql_from_items free [name = fs]
+val sql_from_comma : free ::: {{Type}} -> tabs1 ::: {{Type}} -> tabs2 ::: {{Type}}
+                     -> [tabs1 ~ tabs2]
+    => sql_from_items free tabs1 -> sql_from_items free tabs2
+       -> sql_from_items free (tabs1 ++ tabs2)
+val sql_inner_join : free ::: {{Type}} -> tabs1 ::: {{Type}} -> tabs2 ::: {{Type}}
+                     -> [free ~ tabs1] => [free ~ tabs2] => [tabs1 ~ tabs2]
+    => sql_from_items free tabs1 -> sql_from_items free tabs2
+       -> sql_exp (free ++ tabs1 ++ tabs2) [] [] bool
+       -> sql_from_items free (tabs1 ++ tabs2)
+
+class nullify :: Type -> Type -> Type
+val nullify_option : t ::: Type -> nullify (option t) (option t)
+val nullify_prim : t ::: Type -> sql_injectable_prim t -> nullify t (option t)
+
+val sql_left_join : free ::: {{Type}} -> tabs1 ::: {{Type}} -> tabs2 ::: {{(Type * Type)}}
+                     -> [free ~ tabs1] => [free ~ tabs2] => [tabs1 ~ tabs2]
+    => $(map (fn r => $(map (fn p :: (Type * Type) => nullify p.1 p.2) r)) tabs2)
+       -> sql_from_items free tabs1 -> sql_from_items free (map (map (fn p :: (Type * Type) => p.1)) tabs2)
+       -> sql_exp (free ++ tabs1 ++ map (map (fn p :: (Type * Type) => p.1)) tabs2) [] [] bool
+       -> sql_from_items free (tabs1 ++ map (map (fn p :: (Type * Type) => p.2)) tabs2)
+
+val sql_right_join : free ::: {{Type}} -> tabs1 ::: {{(Type * Type)}} -> tabs2 ::: {{Type}}
+                     -> [free ~ tabs1] => [free ~ tabs2] => [tabs1 ~ tabs2]
+    => $(map (fn r => $(map (fn p :: (Type * Type) => nullify p.1 p.2) r)) tabs1)
+       -> sql_from_items free (map (map (fn p :: (Type * Type) => p.1)) tabs1) -> sql_from_items free tabs2
+       -> sql_exp (free ++ map (map (fn p :: (Type * Type) => p.1)) tabs1 ++ tabs2) [] [] bool
+       -> sql_from_items free (map (map (fn p :: (Type * Type) => p.2)) tabs1 ++ tabs2)
+
+val sql_full_join : free ::: {{Type}} -> tabs1 ::: {{(Type * Type)}} -> tabs2 ::: {{(Type * Type)}}
+                     -> [free ~ tabs1] => [free ~ tabs2] => [tabs1 ~ tabs2]
+    => $(map (fn r => $(map (fn p :: (Type * Type) => nullify p.1 p.2) r)) (tabs1 ++ tabs2))
+       -> sql_from_items free (map (map (fn p :: (Type * Type) => p.1)) tabs1)
+       -> sql_from_items free (map (map (fn p :: (Type * Type) => p.1)) tabs2)
+       -> sql_exp (free ++ map (map (fn p :: (Type * Type) => p.1)) (tabs1 ++ tabs2)) [] [] bool
+       -> sql_from_items free (map (map (fn p :: (Type * Type) => p.2)) (tabs1 ++ tabs2))
+
+(** [ORDER BY] and [SELECT] expressions may use window functions, so we introduce a type family for such expressions. *)
+con sql_expw :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
+
+val sql_query1 : free ::: {{Type}}
+                 -> afree ::: {{Type}}
+                 -> tables ::: {{Type}}
+                 -> grouped ::: {{Type}}
+                 -> selectedFields ::: {{Type}}
+                 -> selectedExps ::: {Type}
+                 -> empties :: {Unit}
+                 -> [free ~ tables]
+                 => [free ~ grouped]
+                 => [afree ~ tables]
+                 => [empties ~ selectedFields]
+                 => {Distinct : bool,
+                     From : sql_from_items free tables,
+                     Where : sql_exp (free ++ tables) afree [] bool,
+                     GroupBy : sql_subset tables grouped,
+                     Having : sql_exp (free ++ grouped) (afree ++ tables) [] bool,
+                     SelectFields : sql_subset grouped (map (fn _ => []) empties ++ selectedFields),
+                     SelectExps : $(map (sql_expw (free ++ grouped) (afree ++ tables) [])
+                                            selectedExps) }
+                 -> sql_query1 free afree tables selectedFields selectedExps
+
+type sql_relop
+val sql_union : sql_relop
+val sql_intersect : sql_relop
+val sql_except : sql_relop
+val sql_relop : free ::: {{Type}}
+                -> afree ::: {{Type}}
+                -> tables1 ::: {{Type}}
+                -> tables2 ::: {{Type}}
+                -> selectedFields ::: {{Type}}
+                -> selectedExps ::: {Type}
+                -> sql_relop
+                -> bool (* ALL *)
+                -> sql_query1 free afree tables1 selectedFields selectedExps
+                -> sql_query1 free afree tables2 selectedFields selectedExps
+                -> sql_query1 free afree [] selectedFields selectedExps
+val sql_forget_tables : free ::: {{Type}} -> afree ::: {{Type}} -> tables ::: {{Type}} -> selectedFields ::: {{Type}} -> selectedExps ::: {Type}
+                        -> sql_query1 free afree tables selectedFields selectedExps
+                        -> sql_query1 free afree [] selectedFields selectedExps
+
+type sql_direction
+val sql_asc : sql_direction
+val sql_desc : sql_direction
+
+(** This type class supports automatic injection of either regular or window expressions into [sql_expw]. *)
+class sql_window :: ({{Type}} -> {{Type}} -> {Type} -> Type -> Type) -> Type
+val sql_window_normal : sql_window sql_exp
+val sql_window_fancy : sql_window sql_expw
+val sql_window : tf ::: ({{Type}} -> {{Type}} -> {Type} -> Type -> Type)
+                 -> tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+                 -> sql_window tf
+                 -> tf tables agg exps t
+                 -> sql_expw tables agg exps t
+
+con sql_order_by :: {{Type}} -> {Type} -> Type
+val sql_order_by_Nil : tables ::: {{Type}} -> exps :: {Type} -> sql_order_by tables exps
+val sql_order_by_Cons : tf ::: ({{Type}} -> {{Type}} -> {Type} -> Type -> Type) -> tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+                        -> sql_window tf
+                        -> tf tables [] exps t -> sql_direction
+                        -> sql_order_by tables exps
+                        -> sql_order_by tables exps
+val sql_order_by_random : tables ::: {{Type}} -> exps ::: {Type}
+                          -> sql_order_by tables exps
+
+type sql_limit
+val sql_no_limit : sql_limit
+val sql_limit : int -> sql_limit
+
+type sql_offset
+val sql_no_offset : sql_offset
+val sql_offset : int -> sql_offset
+
+val sql_query : free ::: {{Type}}
+                -> afree ::: {{Type}}
+                -> tables ::: {{Type}}
+                -> selectedFields ::: {{Type}}
+                -> selectedExps ::: {Type}
+                -> [free ~ tables]
+                => {Rows : sql_query1 free afree tables selectedFields selectedExps,
+                    OrderBy : sql_order_by (free ++ tables) selectedExps,
+                    Limit : sql_limit,
+                    Offset : sql_offset}
+                -> sql_query free afree selectedFields selectedExps
+
+val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type}
+                -> fieldType ::: Type -> agg ::: {{Type}}
+                -> exps ::: {Type}
+                -> tab :: Name -> field :: Name
+                -> sql_exp
+                       ([tab = [field = fieldType] ++ otherFields] ++ otherTabs)
+                       agg exps fieldType
+
+val sql_exp : tabs ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> rest ::: {Type}
+              -> nm :: Name
+              -> sql_exp tabs agg ([nm = t] ++ rest) t
+
+class sql_injectable
+val sql_prim : t ::: Type -> sql_injectable_prim t -> sql_injectable t
+val sql_option_prim : t ::: Type -> sql_injectable_prim t -> sql_injectable (option t)
+
+val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                 -> t ::: Type
+                 -> sql_injectable t -> t -> sql_exp tables agg exps t
+
+val sql_is_null : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                  -> t ::: Type
+                  -> sql_exp tables agg exps (option t)
+                  -> sql_exp tables agg exps bool
+
+val sql_coalesce : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                  -> t ::: Type
+                  -> sql_exp tables agg exps (option t)
+                  -> sql_exp tables agg exps t
+                  -> sql_exp tables agg exps t
+
+val sql_if_then_else : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                       -> t ::: Type
+                       -> sql_exp tables agg exps bool
+                       -> sql_exp tables agg exps t
+                       -> sql_exp tables agg exps t
+                       -> sql_exp tables agg exps t
+
+class sql_arith
+val sql_arith_int : sql_arith int
+val sql_arith_float : sql_arith float
+val sql_arith_option : t ::: Type -> sql_arith t -> sql_arith (option t)
+
+con sql_unary :: Type -> Type -> Type
+val sql_not : sql_unary bool bool
+val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> arg ::: Type -> res ::: Type
+                -> sql_unary arg res -> sql_exp tables agg exps arg
+                -> sql_exp tables agg exps res
+
+val sql_neg : t ::: Type -> sql_arith t -> sql_unary t t
+
+con sql_binary :: Type -> Type -> Type -> Type
+val sql_and : sql_binary bool bool bool
+val sql_or : sql_binary bool bool bool
+val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                 -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
+                 -> sql_binary arg1 arg2 res -> sql_exp tables agg exps arg1
+                 -> sql_exp tables agg exps arg2
+                 -> sql_exp tables agg exps res
+
+val sql_plus : t ::: Type -> sql_arith t -> sql_binary t t t
+val sql_minus : t ::: Type -> sql_arith t -> sql_binary t t t
+val sql_times : t ::: Type -> sql_arith t -> sql_binary t t t
+val sql_div : t ::: Type -> sql_arith t -> sql_binary t t t
+val sql_mod : sql_binary int int int
+
+val sql_eq : t ::: Type -> sql_binary t t bool
+(* Note that the semantics of this operator on nullable types are different than for standard SQL!
+ * Instead, we do it the sane way, where [NULL = NULL]. *)
+
+val sql_ne : t ::: Type -> sql_binary t t bool
+val sql_lt : t ::: Type -> sql_binary t t bool
+val sql_le : t ::: Type -> sql_binary t t bool
+val sql_gt : t ::: Type -> sql_binary t t bool
+val sql_ge : t ::: Type -> sql_binary t t bool
+
+val sql_like : sql_binary string string bool
+
+val sql_count : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> sql_exp tables agg exps int
+
+con sql_aggregate :: Type -> Type -> Type
+val sql_aggregate : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                    -> dom ::: Type -> ran ::: Type
+                    -> sql_aggregate dom ran -> sql_exp agg agg exps dom
+                    -> sql_exp tables agg exps ran
+
+val sql_count_col : t ::: Type -> sql_aggregate (option t) int
+
+class sql_summable
+val sql_summable_int : sql_summable int
+val sql_summable_float : sql_summable float
+val sql_summable_option : t ::: Type -> sql_summable t -> sql_summable (option t)
+val sql_avg : t ::: Type -> sql_summable t -> sql_aggregate t (option float)
+val sql_sum : t ::: Type -> nt ::: Type -> sql_summable t -> nullify t nt -> sql_aggregate t nt
+
+class sql_maxable
+val sql_maxable_int : sql_maxable int
+val sql_maxable_float : sql_maxable float
+val sql_maxable_string : sql_maxable string
+val sql_maxable_time : sql_maxable time
+val sql_maxable_option : t ::: Type -> sql_maxable t -> sql_maxable (option t)
+val sql_max : t ::: Type -> nt ::: Type -> sql_maxable t -> nullify t nt -> sql_aggregate t nt
+val sql_min : t ::: Type -> nt ::: Type -> sql_maxable t -> nullify t nt -> sql_aggregate t nt
+
+con sql_nfunc :: Type -> Type
+val sql_nfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> t ::: Type
+                -> sql_nfunc t -> sql_exp tables agg exps t
+val sql_current_timestamp : sql_nfunc time
+
+con sql_ufunc :: Type -> Type -> Type
+val sql_ufunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                -> dom ::: Type -> ran ::: Type
+                -> sql_ufunc dom ran -> sql_exp tables agg exps dom
+                -> sql_exp tables agg exps ran
+val sql_octet_length : sql_ufunc blob int
+val sql_known : t ::: Type -> sql_ufunc t bool
+val sql_lower : sql_ufunc string string
+val sql_upper : sql_ufunc string string
+
+val sql_nullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+                   -> sql_injectable_prim t
+                   -> sql_exp tables agg exps t
+                   -> sql_exp tables agg exps (option t)
+
+val sql_subquery : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> nm ::: Name -> t ::: Type -> nt ::: Type
+                   -> nullify t nt
+                   -> sql_query tables agg [] [nm = t]
+                   -> sql_exp tables agg exps nt
+
+(** Window function expressions *)
+
+con sql_partition :: {{Type}} -> {{Type}} -> {Type} -> Type
+val sql_no_partition : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                       -> sql_partition tables agg exps
+val sql_partition : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+                    -> sql_exp tables agg exps t
+                    -> sql_partition tables agg exps
+
+con sql_window_function :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
+val sql_window_function : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                          -> t ::: Type
+                          -> sql_window_function tables agg exps t
+                          -> sql_partition tables agg exps
+                          -> sql_order_by tables exps
+                          -> sql_expw tables agg exps t
+
+val sql_window_aggregate : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                           -> t ::: Type -> nt ::: Type
+                           -> sql_aggregate t nt
+                           -> sql_exp tables agg exps t
+                           -> sql_window_function tables agg exps nt
+val sql_window_count : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                       -> sql_window_function tables agg exps int
+val sql_rank : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+               -> sql_window_function tables agg exps int
+
+
+(*** Executing queries *)
+
+val query : tables ::: {{Type}} -> exps ::: {Type}
+            -> [tables ~ exps] =>
+                  state ::: Type
+                  -> sql_query [] [] tables exps
+                  -> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
+                      -> state
+                      -> transaction state)
+                  -> state
+                  -> transaction state
+
+val show_sql_query : freeTables ::: {{Type}} -> freeAggs ::: {{Type}} -> tables ::: {{Type}} -> exps ::: {Type}
+                     -> show (sql_query freeTables freeAggs tables exps)
+
+
+(*** Database mutators *)
+
+type dml
+val dml : dml -> transaction unit
+val tryDml : dml -> transaction (option string)
+(* Returns an error message on failure. *)
+
+val insert : fields ::: {Type} -> uniques ::: {{Unit}}
+             -> sql_table fields uniques
+             -> $(map (fn t :: Type => sql_exp [] [] [] t) fields)
+             -> dml
+
+val update : unchanged ::: {Type} -> uniques ::: {{Unit}} -> changed :: {Type} ->
+             [changed ~ unchanged] =>
+                $(map (fn t :: Type => sql_exp [T = changed ++ unchanged] [] [] t) changed)
+                -> sql_table (changed ++ unchanged) uniques
+                -> sql_exp [T = changed ++ unchanged] [] [] bool
+                -> dml
+
+val delete : fields ::: {Type} -> uniques ::: {{Unit}}
+             -> sql_table fields uniques
+             -> sql_exp [T = fields] [] [] bool
+             -> dml
+
+(*** Sequences *)
+
+type sql_sequence
+val nextval : sql_sequence -> transaction int
+val setval : sql_sequence -> int -> transaction unit
+
+
+(** XML *)
+
+type css_class
+val show_css_class : show css_class
+val null : css_class
+(* No special formatting *)
+val classes : css_class -> css_class -> css_class
+(* The equivalent of writing one class after the other, separated by a space, in
+ * an HTML 'class' attribute *)
+
+type css_value
+val atom : string -> css_value
+type url
+val css_url : url -> css_value
+val sql_url : sql_injectable_prim url
+type css_property
+val property : string -> css_property
+val value : css_property -> css_value -> css_property
+type css_style
+val noStyle : css_style
+val oneProperty : css_style -> css_property -> css_style
+
+con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type
+
+con xml :: {Unit} -> {Type} -> {Type} -> Type
+val cdata : ctx ::: {Unit} -> use ::: {Type} -> string -> xml ctx use []
+val cdataChar : ctx ::: {Unit} -> use ::: {Type} -> char -> xml ctx use []
+val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type}
+          -> ctxOuter ::: {Unit} -> ctxInner ::: {Unit}
+          -> useOuter ::: {Type} -> useInner ::: {Type}
+          -> bindOuter ::: {Type} -> bindInner ::: {Type}
+          -> [attrsGiven ~ attrsAbsent] =>
+             [useOuter ~ useInner] =>
+             [bindOuter ~ bindInner] =>
+           css_class
+	   -> option (signal css_class)
+           -> css_style
+	   -> option (signal css_style)
+           -> $attrsGiven
+           -> tag (attrsGiven ++ attrsAbsent)
+                  ctxOuter ctxInner useOuter bindOuter
+           -> xml ctxInner useInner bindInner
+           -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner)
+val join : ctx ::: {Unit}
+        -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type}
+        -> [use1 ~ bind1] => [bind1 ~ bind2] =>
+              xml ctx use1 bind1
+              -> xml ctx (use1 ++ bind1) bind2
+              -> xml ctx use1 (bind1 ++ bind2)
+val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type}
+              -> bind ::: {Type}
+              -> [use1 ~ use2] =>
+                    xml ctx use1 bind
+                    -> xml ctx (use1 ++ use2) bind
+
+con html = [Html]
+con head = [Head]
+
+con body' = [MakeForm, Body]
+con form' = [Body, Form]
+con subform' = [Body, Subform]
+con tabl' = [MakeForm, Table]
+con tr' = [MakeForm, Tr]
+
+con body = [Dyn] ++ body'
+con form = [Dyn] ++ form'
+con subform = [Dyn] ++ subform'
+con tabl = [Dyn] ++ tabl'
+con tr = [Dyn] ++ tr'
+
+con xhtml = xml html
+con page = xhtml [] []
+con xbody = xml body [] []
+con xhead = xml head [] []
+con xtable = xml tabl [] []
+con xtr = xml tr [] []
+con xform = xml form [] []
+
+
+(*** HTML details *)
+
+type queryString
+val show_queryString : show queryString
+
+val show_url : show url
+val bless : string -> url
+val checkUrl : string -> option url
+val currentUrl : transaction url
+val currentUrlHasPost : transaction bool
+val currentUrlHasQueryString : transaction bool
+val url : transaction page -> url
+val effectfulUrl : (option queryString -> transaction page) -> url
+val redirect : t ::: Type -> url -> transaction t
+
+type id
+val fresh : transaction id
+val giveFocus : id -> transaction unit
+val show_id : show id
+
+val dyn : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> [ctx ~ [Dyn]] => unit
+          -> tag [Signal = signal (xml ([Dyn] ++ ctx) use bind)] ([Dyn] ++ ctx) [] use bind
+
+val active : unit
+             -> tag [Code = transaction xbody] body [] [] []
+
+val script : unit
+             -> tag [Code = transaction unit] head [] [] []
+
+(* Type for HTML5 "data-*" and "aria-*" attributes. *)
+type data_attr_kind
+val data_kind : data_attr_kind
+val aria_kind : data_attr_kind
+
+type data_attr
+val data_attr : data_attr_kind -> string (* Key *) -> string (* Value *) -> data_attr
+(* This function will fail if the key doesn't meet HTML's lexical rules! *)
+val data_attrs : data_attr -> data_attr -> data_attr
+
+val head : unit -> tag [Data = data_attr] html head [] []
+val title : unit -> tag [Data = data_attr] head [] [] []
+val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string] head [] [] []
+val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] []
+
+datatype mouseButton = Left | Right | Middle
+
+type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int,
+                    CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool,
+                    Button : mouseButton }
+
+con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit)
+                          [Onclick, Oncontextmenu, Ondblclick, Onmousedown, Onmouseenter, Onmouseleave, Onmousemove, Onmouseout, Onmouseover, Onmouseup]
+
+type keyEvent = { KeyCode : int,
+                  CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool }
+
+con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit)
+                        [Onkeydown, Onkeypress, Onkeyup]
+
+val body : unit -> tag ([Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
+                            ++ mouseEvents ++ keyEvents)
+                       html body [] []
+
+con bodyTag = fn (attrs :: {Type}) =>
+                 ctx ::: {Unit} ->
+                 [[Body] ~ ctx] =>
+                    unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
+con bodyTagStandalone = fn (attrs :: {Type}) =>
+                           ctx ::: {Unit}
+                           -> [[Body] ~ ctx] =>
+                                 unit -> tag attrs ([Body] ++ ctx) [] [] []
+
+val br : bodyTagStandalone [Data = data_attr, Id = id]
+
+con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
+
+
+(* Key arguments are character codes. *)
+con resizeEvents = [Onresize = transaction unit]
+con scrollEvents = [Onscroll = transaction unit]
+
+con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents
+con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
+
+con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string, Align = string] ++ boxEvents
+con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents
+
+val span : bodyTag boxAttrs
+val div : bodyTag boxAttrs
+
+val p : bodyTag boxAttrs
+val strong : bodyTag boxAttrs
+val em : bodyTag boxAttrs
+val b : bodyTag boxAttrs
+val i : bodyTag boxAttrs
+val tt : bodyTag boxAttrs
+val sub : bodyTag boxAttrs
+val sup : bodyTag boxAttrs
+
+val h1 : bodyTag boxAttrs
+val h2 : bodyTag boxAttrs
+val h3 : bodyTag boxAttrs
+val h4 : bodyTag boxAttrs
+val h5 : bodyTag boxAttrs
+val h6 : bodyTag boxAttrs
+
+val li : bodyTag boxAttrs
+val ol : bodyTag boxAttrs
+val ul : bodyTag boxAttrs
+
+val hr : bodyTag boxAttrs
+
+val pre : bodyTag boxAttrs
+
+(** sections **)
+val section : bodyTag boxAttrs
+val article : bodyTag boxAttrs
+val nav : bodyTag boxAttrs
+val aside : bodyTag boxAttrs
+val footer : bodyTag boxAttrs
+val header : bodyTag boxAttrs
+val main : bodyTag boxAttrs
+
+(** forms **)
+val meter : bodyTag boxAttrs
+val progress : bodyTag boxAttrs
+val output : bodyTag boxAttrs
+val keygen : bodyTag boxAttrs
+val datalist : bodyTag boxAttrs
+
+(** Interactive Elements **)
+val details : bodyTag boxAttrs
+val dialog : bodyTag boxAttrs
+val menuitem : bodyTag boxAttrs
+
+(** Grouping Content **)
+val figure : bodyTag boxAttrs
+val figcaption : bodyTag boxAttrs
+
+(** Text Level Semantics **)
+val data : bodyTag boxAttrs
+val mark : bodyTag boxAttrs
+val rp  : bodyTag boxAttrs
+val rt  : bodyTag boxAttrs
+val ruby : bodyTag boxAttrs
+val summary : bodyTag boxAttrs
+val time  : bodyTag boxAttrs
+val wbr : bodyTag boxAttrs
+val bdi : bodyTag boxAttrs
+
+val a : bodyTag ([Link = transaction page, Href = url, Target = string, Rel = string, Download = string] ++ boxAttrs)
+
+val img : bodyTag ([Alt = string, Src = url, Width = int, Height = int,
+                    Onabort = transaction unit, Onerror = transaction unit,
+                    Onload = transaction unit] ++ boxAttrs)
+
+val form : ctx ::: {Unit} -> bind ::: {Type}
+           -> [[MakeForm, Form] ~ ctx] =>
+    option id
+    -> option css_class
+    -> xml ([Form] ++ ctx) [] bind
+    -> xml ([MakeForm] ++ ctx) [] []
+
+val subform : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type}
+              -> [[Form] ~ ctx] =>
+    nm :: Name -> [[nm] ~ use] =>
+    xml ([Form] ++ ctx) [] bind
+    -> xml ([Form] ++ ctx) use [nm = $bind]
+
+val subforms : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type}
+              -> [[Form, Subform] ~ ctx] =>
+    nm :: Name -> [[nm] ~ use] =>
+    xml ([Subform] ++ ctx) [Entry = $bind] []
+    -> xml ([Form] ++ ctx) use [nm = list ($bind)]
+
+val entry : ctx ::: {Unit} -> bind ::: {Type}
+              -> [[Subform, Form] ~ ctx] =>
+    xml ([Form] ++ ctx) [] bind
+    -> xml ([Subform] ++ ctx) [Entry = $bind] []
+
+con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) =>
+                  ctx ::: {Unit}
+                  -> [[Form] ~ ctx] =>
+                        nm :: Name -> unit
+                        -> tag attrs ([Form] ++ ctx) inner [] [nm = ty]
+
+con inputAttrs = [Required = bool, Autofocus = bool]
+
+
+val hidden : formTag string [] [Data = data_attr, Id = string, Value = string]
+val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit,
+                                  Ontext = transaction unit] ++ boxAttrs ++ inputAttrs)
+val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string, Onchange = transaction unit,
+                                   Ontext = transaction unit] ++ boxAttrs ++ inputAttrs)
+
+val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs)
+
+(* HTML5 widgets galore! *)
+
+type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+
+val email : textWidget
+val search : textWidget
+val url_ : textWidget
+val tel : textWidget
+val color : textWidget
+
+val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+
+
+
+type file
+val fileName : file -> option string
+val fileMimeType : file -> string
+val fileData : file -> blob
+
+val upload : formTag file [] ([Value = string, Size = int] ++ boxAttrs)
+
+type mimeType
+val blessMime : string -> mimeType
+val checkMime : string -> option mimeType
+val returnBlob : t ::: Type -> blob -> mimeType -> transaction t
+val blobSize : blob -> int
+val textBlob : string -> blob
+
+type postBody
+val postType : postBody -> string
+val postData : postBody -> string
+
+type postField
+val firstFormField : string -> option postField
+val fieldName : postField -> string
+val fieldValue : postField -> string
+val remainingFields : postField -> string
+
+con radio = [Body, Radio]
+val radio : formTag (option string) radio [Data = data_attr, Id = id]
+val radioOption : unit -> tag ([Value = string, Checked = bool, Onchange = transaction unit] ++ boxAttrs) radio [] [] []
+
+con select = [Select]
+val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs)
+val option : unit -> tag [Data = data_attr, Value = string, Selected = bool] select [] [] []
+
+val submit : ctx ::: {Unit} -> use ::: {Type}
+             -> [[Form] ~ ctx] =>
+                   unit
+                   -> tag ([Value = string, Action = $use -> transaction page] ++ boxAttrs)
+                          ([Form] ++ ctx) ([Form] ++ ctx) use []
+
+val image : ctx ::: {Unit} -> use ::: {Type}
+             -> [[Form] ~ ctx] =>
+                   unit
+                   -> tag ([Src = url, Width = int, Height = int, Alt = string, Action = $use -> transaction page] ++ boxAttrs)
+                          ([Form] ++ ctx) ([Form] ++ ctx) use []
+
+val label : bodyTag ([For = id, Accesskey = string] ++ tableAttrs)
+
+val fieldset : bodyTag boxAttrs
+val legend : bodyTag boxAttrs
+
+
+(*** AJAX-oriented widgets *)
+
+con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
+                  ctx ::: {Unit}
+                  -> [[Body] ~ ctx] => [[Body] ~ inner] =>
+                        unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] []
+
+type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string,
+                        Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
+
+val ctextbox : ctext
+val cpassword : ctext
+val cemail : ctext
+val csearch : ctext
+val curl : ctext
+val ctel : ctext
+val ccolor : ctext
+
+val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+
+val button : cformTag ([Value = string, Disabled = bool] ++ boxAttrs) []
+
+val ccheckbox : cformTag ([Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+
+val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect]
+val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] []
+
+val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, Onchange = transaction unit,
+                           Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
+
+(*** Tables *)
+
+val tabl : other ::: {Unit} -> [other ~ [Body, Table]] => unit
+  -> tag ([Border = int] ++ boxAttrs)
+         ([Body] ++ other) ([Table] ++ other) [] []
+val tr : other ::: {Unit} -> [other ~ [Table, Tr]] => unit
+  -> tag tableAttrs
+         ([Table] ++ other) ([Tr] ++ other) [] []
+val th : other ::: {Unit} -> [other ~ [Body, Tr]] => unit
+  -> tag ([Colspan = int, Rowspan = int] ++ tableAttrs)
+         ([Tr] ++ other) ([Body] ++ other) [] []
+val td : other ::: {Unit} -> [other ~ [Body, Tr]] => unit
+  -> tag ([Colspan = int, Rowspan = int] ++ tableAttrs)
+         ([Tr] ++ other) ([Body] ++ other) [] []
+
+val thead : other ::: {Unit} -> [other ~ [Table]] => unit
+  -> tag tableAttrs
+         ([Table] ++ other) ([Table] ++ other) [] []
+val tbody : other ::: {Unit} -> [other ~ [Table]] => unit
+  -> tag tableAttrs
+         ([Table] ++ other) ([Table] ++ other) [] []
+val tfoot : other ::: {Unit} -> [other ~ [Table]] => unit
+  -> tag tableAttrs
+         ([Table] ++ other) ([Table] ++ other) [] []
+
+(** Definition lists *)
+
+val dl : other ::: {Unit} -> [other ~ [Body,Dl]]
+  => unit
+  -> tag [Data = data_attr] ([Body] ++ other) ([Dl] ++ other) [] []
+
+val dt : other ::: {Unit} -> [other ~ [Body,Dl]]
+  => unit
+  -> tag [Data = data_attr] ([Dl] ++ other) ([Body] ++ other) [] []
+
+val dd : other ::: {Unit} -> [other ~ [Body,Dl]]
+  => unit
+  -> tag [Data = data_attr] ([Dl] ++ other) ([Body] ++ other) [] []
+
+
+(** Aborting *)
+
+val error : t ::: Type -> xbody -> t
+
+(* Client-side-only handlers: *)
+val onError : (xbody -> transaction unit) -> transaction unit
+val onFail : (string -> transaction unit) -> transaction unit
+val onConnectFail : transaction unit -> transaction unit
+val onDisconnect : transaction unit -> transaction unit
+val onServerError : (string -> transaction unit) -> transaction unit
+
+(* More standard document-level JavaScript handlers *)
+val onClick : (mouseEvent -> transaction unit) -> transaction unit
+val onDblclick : (mouseEvent -> transaction unit) -> transaction unit
+val onContextmenu : (mouseEvent -> transaction unit) -> transaction unit
+val onKeydown : (keyEvent -> transaction unit) -> transaction unit
+val onKeypress : (keyEvent -> transaction unit) -> transaction unit
+val onKeyup : (keyEvent -> transaction unit) -> transaction unit
+val onMousedown : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseenter : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseleave : (mouseEvent -> transaction unit) -> transaction unit
+val onMousemove : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseout : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseover : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseup : (mouseEvent -> transaction unit) -> transaction unit
+
+(* Prevents default handling of current event *)
+val preventDefault : transaction unit
+(* Stops propagation of current event *)
+val stopPropagation : transaction unit
+
+val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind)
+
+
+(** Tasks *)
+
+con task_kind :: Type -> Type
+val initialize : task_kind unit
+val clientLeaves : task_kind client
+val periodic : int -> task_kind unit
+
+
+(** Information flow security *)
+
+type sql_policy
+
+val sendClient : tables ::: {{Type}} -> exps ::: {Type}
+                 -> [tables ~ exps] => sql_query [] [] tables exps
+                 -> sql_policy
+
+val sendOwnIds : sql_sequence -> sql_policy
+
+val mayInsert : fs ::: {Type} -> tables ::: {{Type}} -> [[New] ~ tables]
+                => sql_query [] [] ([New = fs] ++ tables) []
+                -> sql_policy
+
+val mayDelete : fs ::: {Type} -> tables ::: {{Type}} -> [[Old] ~ tables]
+                => sql_query [] [] ([Old = fs] ++ tables) []
+                -> sql_policy
+
+val mayUpdate : fs ::: {Type} -> tables ::: {{Type}} -> [[Old, New] ~ tables]
+                => sql_query [] [] ([Old = fs, New = fs] ++ tables) []
+                -> sql_policy
+
+val also : sql_policy -> sql_policy -> sql_policy
+
+val debug : string -> transaction unit
+val naughtyDebug : string -> int
+
+val rand : transaction int
diff --git a/lib/ur/char.ur b/lib/ur/char.ur
new file mode 100644
index 0000000..d2890be
--- /dev/null
+++ b/lib/ur/char.ur
@@ -0,0 +1,19 @@
+type t = char
+
+val isAlnum = Basis.isalnum
+val isAlpha = Basis.isalpha
+val isBlank = Basis.isblank
+val isCntrl = Basis.iscntrl
+val isDigit = Basis.isdigit
+val isGraph = Basis.isgraph
+val isLower = Basis.islower
+val isPrint = Basis.isprint
+val isPunct = Basis.ispunct
+val isSpace = Basis.isspace
+val isUpper = Basis.isupper
+val isXdigit = Basis.isxdigit
+val toLower = Basis.tolower
+val toUpper = Basis.toupper
+
+val toInt = Basis.ord
+val fromInt = Basis.chr
diff --git a/lib/ur/char.urs b/lib/ur/char.urs
new file mode 100644
index 0000000..c185af9
--- /dev/null
+++ b/lib/ur/char.urs
@@ -0,0 +1,19 @@
+type t = char
+
+val isAlnum : t -> bool
+val isAlpha : t -> bool
+val isBlank : t -> bool
+val isCntrl : t -> bool
+val isDigit : t -> bool
+val isGraph : t -> bool
+val isLower : t -> bool
+val isPrint : t -> bool
+val isPunct : t -> bool
+val isSpace : t -> bool
+val isUpper : t -> bool
+val isXdigit : t -> bool
+val toLower : t -> t
+val toUpper : t -> t
+
+val toInt : t -> int
+val fromInt : int -> t
diff --git a/lib/ur/datetime.ur b/lib/ur/datetime.ur
new file mode 100644
index 0000000..9aeab29
--- /dev/null
+++ b/lib/ur/datetime.ur
@@ -0,0 +1,135 @@
+datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
+         Friday | Saturday
+
+val show_day_of_week = mkShow (fn dow => case dow of
+                                          Sunday => "Sunday"
+                                        | Monday => "Monday"
+                                        | Tuesday => "Tuesday"
+                                        | Wednesday => "Wednesday"
+                                        | Thursday => "Thursday"
+                                        | Friday => "Friday"
+                                        | Saturday => "Saturday")
+
+fun dayOfWeekToInt dow = case dow of
+                             Sunday => 0
+                           | Monday => 1
+                           | Tuesday => 2
+                           | Wednesday => 3
+                           | Thursday => 4
+                           | Friday => 5
+                           | Saturday => 6
+
+fun intToDayOfWeek i = case i of
+                           0 => Sunday
+                         | 1 => Monday
+                         | 2 => Tuesday
+                         | 3 => Wednesday
+                         | 4 => Thursday
+                         | 5 => Friday
+                         | 6 => Saturday
+                         | n => error <xml>Invalid day of week {[n]}</xml>
+
+val eq_day_of_week = mkEq (fn a b => dayOfWeekToInt a = dayOfWeekToInt b)
+
+
+datatype month = January | February | March | April | May | June | July |
+         August | September | October | November | December
+
+val show_month = mkShow (fn m => case m of
+                                     January => "January"
+                                   | February => "February"
+                                   | March => "March"
+                                   | April => "April"
+                                   | May => "May"
+                                   | June => "June"
+                                   | July => "July"
+                                   | August => "August"
+                                   | September => "September"
+                                   | October => "October"
+                                   | November => "November"
+                                   | December => "December")
+
+type t = {
+     Year : int,
+     Month : month,
+     Day : int,
+     Hour : int,
+     Minute : int,
+     Second : int
+}
+
+fun monthToInt m = case m of
+                       January => 0
+                     | February => 1
+                     | March => 2
+                     | April => 3
+                     | May => 4
+                     | June => 5
+                     | July => 6
+                     | August => 7
+                     | September => 8
+                     | October => 9
+                     | November => 10
+                     | December => 11
+
+fun intToMonth i = case i of
+                       0 => January
+                     | 1 => February
+                     | 2 => March
+                     | 3 => April
+                     | 4 => May
+                     | 5 => June
+                     | 6 => July
+                     | 7 => August
+                     | 8 => September
+                     | 9 => October
+                     | 10 => November
+                     | 11 => December
+                     | n => error <xml>Invalid month number {[n]}</xml>
+
+val eq_month = mkEq (fn a b => monthToInt a = monthToInt b)
+
+
+fun toTime dt : time = fromDatetime dt.Year (monthToInt dt.Month) dt.Day
+                                    dt.Hour dt.Minute dt.Second
+
+fun fromTime t : t = {
+    Year = datetimeYear t,
+    Month = intToMonth (datetimeMonth t),
+    Day = datetimeDay t,
+    Hour = datetimeHour t,
+    Minute = datetimeMinute t,
+    Second = datetimeSecond t
+}
+
+val ord_datetime = mkOrd { Lt = fn a b => toTime a < toTime b,
+                           Le = fn a b => toTime a <= toTime b }
+
+fun format fmt dt : string = timef fmt (toTime dt)
+
+fun dayOfWeek dt : day_of_week = intToDayOfWeek (datetimeDayOfWeek (toTime dt))
+
+val now : transaction t =
+    n <- now;
+    return (fromTime n)
+
+(* Normalize a datetime. This will convert, e.g., January 32nd into February
+   1st. *)
+
+fun normalize dt = fromTime (toTime dt)
+fun addToField [nm :: Name] [rest ::: {Type}] [[nm] ~ rest]
+               (delta : int) (r : $([nm = int] ++ rest))
+    : $([nm = int] ++ rest) =
+      (r -- nm) ++ {nm = r.nm + delta}
+
+
+(* Functions for adding to a datetime. There is no addMonths or addYears since
+   it's not clear what should be done; what's 1 month after January 31, or 1
+   year after February 29th?
+
+   These can't all be defined in terms of addSeconds because of leap seconds. *)
+
+fun addSeconds n dt = normalize (addToField [#Second] n dt)
+fun addMinutes n dt = normalize (addToField [#Minute] n dt)
+fun addHours n dt = normalize (addToField [#Hour] n dt)
+fun addDays n dt = normalize (addToField [#Day] n dt)
diff --git a/lib/ur/datetime.urs b/lib/ur/datetime.urs
new file mode 100644
index 0000000..972f86b
--- /dev/null
+++ b/lib/ur/datetime.urs
@@ -0,0 +1,38 @@
+datatype day_of_week = Sunday | Monday | Tuesday | Wednesday | Thursday |
+         Friday | Saturday
+
+datatype month = January | February | March | April | May | June | July |
+         August | September | October | November | December
+
+
+type t = {
+     Year : int,
+     Month : month,
+     Day : int,
+     Hour : int,
+     Minute : int,
+     Second : int
+}
+
+val ord_datetime : ord t
+
+val show_day_of_week : show day_of_week
+val show_month : show month
+val eq_day_of_week : eq day_of_week
+val eq_month : eq month
+val dayOfWeekToInt : day_of_week -> int
+val intToDayOfWeek : int -> day_of_week
+val monthToInt : month -> int
+val intToMonth : int -> month
+
+val toTime : t -> time
+val fromTime : time -> t
+val format : string -> t -> string
+val dayOfWeek : t -> day_of_week
+val now : transaction t
+val normalize : t -> t
+
+val addSeconds : int -> t -> t
+val addMinutes : int -> t -> t
+val addHours : int -> t -> t
+val addDays : int -> t -> t
diff --git a/lib/ur/json.ur b/lib/ur/json.ur
new file mode 100644
index 0000000..9288a6d
--- /dev/null
+++ b/lib/ur/json.ur
@@ -0,0 +1,387 @@
+con json a = {ToJson : a -> string,
+              FromJson : string -> a * string}
+
+fun mkJson [a] (x : {ToJson : a -> string,
+                     FromJson : string -> a * string}) = x
+
+fun skipSpaces s =
+    let
+        val len = String.length s
+
+        fun skip i =
+            if i >= len then
+                ""
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    if Char.isSpace ch then
+                        skip (i+1)
+                    else
+                        String.substring s {Start = i, Len = len-i}
+                end
+    in
+        skip 0
+    end
+
+fun toJson [a] (j : json a) : a -> string = j.ToJson
+fun fromJson' [a] (j : json a) : string -> a * string = j.FromJson
+
+fun fromJson [a] (j : json a) (s : string) : a =
+    let
+        val (v, s') = j.FromJson (skipSpaces s)
+    in
+        if String.all Char.isSpace s' then
+            v
+        else
+            error <xml>Extra content at end of JSON record: {[s']}</xml>
+    end
+
+fun escape s =
+    let
+        fun esc s =
+            case s of
+                "" => "\""
+              | _ =>
+                let
+                    val ch = String.sub s 0
+                in
+                    (if ch = #"\"" || ch = #"\\" then
+                         "\\" ^ String.str ch
+                     else
+                         String.str ch) ^ esc (String.suffix s 1)
+                end
+    in
+        "\"" ^ esc s
+    end
+
+fun unescape s =
+    let
+        val len = String.length s
+
+        fun findEnd i =
+            if i >= len then
+                error <xml>JSON unescape: string ends before quote: {[s]}</xml>
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    case ch of
+                        #"\"" => i
+                      | #"\\" =>
+                        if i+1 >= len then
+                            error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else
+                            findEnd (i+2)
+                      | _ => findEnd (i+1)
+                end
+
+        val last = findEnd 1
+
+        fun unesc i =
+            if i >= last then
+                ""
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    case ch of
+                        #"\\" =>
+                        if i+1 >= len then
+                            error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
+                        else
+                            String.str (String.sub s (i+1)) ^ unesc (i+2)
+                      | _ => String.str ch ^ unesc (i+1)
+                end
+    in
+        if len = 0 || String.sub s 0 <> #"\"" then
+            error <xml>JSON unescape: String doesn't start with double quote: {[s]}</xml>
+        else
+            (unesc 1, String.substring s {Start = last+1, Len = len-last-1})
+    end
+
+val json_string = {ToJson = escape,
+                   FromJson = unescape}
+
+fun numIn [a] (_ : read a) s : a * string =
+    let
+        val len = String.length s
+
+        fun findEnd i =
+            if i >= len then
+                i
+            else
+                let
+                    val ch = String.sub s i
+                in
+                    if Char.isDigit ch || ch = #"-" || ch = #"." || ch = #"E" || ch = #"e" then
+                        findEnd (i+1)
+                    else
+                        i
+                end
+
+        val last = findEnd 0
+    in
+        (readError (String.substring s {Start = 0, Len = last}), String.substring s {Start = last, Len = len-last})
+    end
+
+fun json_num [a] (_ : show a) (_ : read a) : json a = {ToJson = show,
+                                                       FromJson = numIn}
+
+val json_int = json_num
+val json_float = json_num
+
+val json_bool = {ToJson = fn b => if b then "true" else "false",
+                 FromJson = fn s => if String.isPrefix {Full = s, Prefix = "true"} then
+                                        (True, String.substring s {Start = 4, Len = String.length s - 4})
+                                    else if String.isPrefix {Full = s, Prefix = "false"} then
+                                        (False, String.substring s {Start = 5, Len = String.length s - 5})
+                                    else
+                                        error <xml>JSON: bad boolean string: {[s]}</xml>}
+
+fun json_option [a] (j : json a) : json (option a) =
+    {ToJson = fn v => case v of
+                          None => "null"
+                        | Some v => j.ToJson v,
+     FromJson = fn s => if String.isPrefix {Full = s, Prefix = "null"} then
+                            (None, String.substring s {Start = 4, Len = String.length s - 4})
+                        else
+                            let
+                                val (v, s') = j.FromJson s
+                            in
+                                (Some v, s')
+                            end}
+
+fun json_list [a] (j : json a) : json (list a) =
+    let
+        fun toJ' (ls : list a) : string =
+            case ls of
+                [] => ""
+              | x :: ls => "," ^ toJson j x ^ toJ' ls
+
+        fun toJ (x : list a) : string =
+            case x of
+                [] => "[]"
+              | x :: [] => "[" ^ toJson j x ^ "]"
+              | x :: ls => "[" ^ toJson j x ^ toJ' ls ^ "]"
+
+        fun fromJ (s : string) : list a * string =
+            let
+                fun fromJ' (s : string) : list a * string =
+                    if String.length s = 0 then
+                        error <xml>JSON list doesn't end with ']'</xml>
+                    else
+                        let
+                            val ch = String.sub s 0
+                        in
+                            case ch of
+                                #"]" => ([], String.substring s {Start = 1, Len = String.length s - 1})
+                              | _ =>
+                                let
+                                    val (x, s') = j.FromJson s
+                                    val s' = skipSpaces s'
+                                    val s' = if String.length s' = 0 then
+                                                 error <xml>JSON list doesn't end with ']'</xml>
+                                             else if String.sub s' 0 = #"," then
+                                                 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                             else
+                                                 s'
+
+                                    val (ls, s'') = fromJ' s'
+                                in
+                                    (x :: ls, s'')
+                                end
+                        end
+            in
+                if String.length s = 0 || String.sub s 0 <> #"[" then
+                    error <xml>JSON list doesn't start with '[': {[s]}</xml>
+                else
+                    fromJ' (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1}))
+            end
+    in
+        {ToJson = toJ,
+         FromJson = fromJ}
+    end
+
+fun skipOne s =
+    let
+        fun skipOne s dquote squote brace bracket =
+            if String.length s = 0 then
+                s
+            else
+                let
+                    val ch = String.sub s 0
+                    val rest = String.suffix s 1
+                in
+                    case ch of
+                        #"\"" => skipOne rest (not dquote) squote brace bracket
+                      | #"'" => skipOne rest dquote (not squote) brace bracket
+                      | #"\\" => if String.length s >= 2 then
+                                     skipOne (String.suffix s 2) dquote squote brace bracket
+                                 else
+                                     ""
+                      | #"{" => skipOne rest dquote squote (brace + 1) bracket
+                      | #"}" => if brace = 0 then
+                                    s
+                                else
+                                    skipOne rest dquote squote (brace - 1) bracket
+
+                      | #"[" => skipOne rest dquote squote brace (bracket + 1)
+                      | #"]" =>
+                        if bracket = 0 then
+                            s
+                        else
+                            skipOne rest dquote squote brace (bracket - 1)
+
+                      | #"," =>
+                        if not dquote && not squote && brace = 0 && bracket = 0 then
+                            s
+                        else
+                            skipOne rest dquote squote brace bracket
+
+                      | _ => skipOne rest dquote squote brace bracket
+                end
+    in
+        skipOne s False False 0 0
+    end
+
+fun json_record [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json $ts =
+    {ToJson = fn r => "{" ^ @foldR3 [json] [fn _ => string] [ident] [fn _ => string]
+                             (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
+                                 escape name ^ ":" ^ j.ToJson v ^ (case acc of
+                                                                       "" => ""
+                                                                     | acc => "," ^ acc))
+                             "" fl jss names r ^ "}",
+     FromJson = fn s =>
+                   let
+                       fun fromJ s (r : $(map option ts)) : $(map option ts) * string =
+                           if String.length s = 0 then
+                               error <xml>JSON object doesn't end in brace</xml>
+                           else if String.sub s 0 = #"}" then
+                               (r, String.substring s {Start = 1, Len = String.length s - 1})
+                           else let
+                                   val (name, s') = unescape s
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
+                                                error <xml>No colon after JSON object field name</xml>
+                                            else
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+
+                                   val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string]
+                                                  (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r =>
+                                                      if name = name' then
+                                                          let
+                                                              val (v, s') = j.FromJson s'
+                                                          in
+                                                              (r -- nm ++ {nm = Some v}, s')
+                                                          end
+                                                      else
+                                                          let
+                                                              val (r', s') = acc (r -- nm)
+                                                          in
+                                                              (r' ++ {nm = r.nm}, s')
+                                                          end)
+                                                  (fn r => (r, skipOne s'))
+                                                  fl jss names r
+
+                                   val s' = skipSpaces s'
+                                   val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
+                                                skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                            else
+                                                s'
+                               in
+                                   fromJ s' r
+                               end
+                   in
+                       if String.length s = 0 || String.sub s 0 <> #"{" then
+                           error <xml>JSON record doesn't begin with brace</xml>
+                       else
+                           let
+                               val (r, s') = fromJ (skipSpaces (String.substring s {Start = 1, Len = String.length s - 1}))
+                                                   (@map0 [option] (fn [t ::_] => None) fl)
+                           in
+                               (@map2 [option] [fn _ => string] [ident] (fn [t] (v : option t) name =>
+                                                                            case v of
+                                                                                None => error <xml>Missing JSON object field {[name]}</xml>
+                                                                              | Some v => v) fl r names, s')
+                           end
+                   end}
+
+fun destrR [K] [f :: K -> Type] [fr :: K -> Type] [t ::: Type]
+    (f : p :: K -> f p -> fr p -> t)
+    [r ::: {K}] (fl : folder r) (v : variant (map f r)) (r : $(map fr r)) : t =
+    match v
+    (@Top.mp [fr] [fn p => f p -> t]
+     (fn [p] (m : fr p) (v : f p) => f [p] v m)
+     fl r)
+
+fun json_variant [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json (variant ts) =
+    {ToJson = fn r => let val jnames = @map2 [json] [fn _ => string] [fn x => json x * string]
+                                     (fn [t] (j : json t) (name : string) => (j, name)) fl jss names
+                      in @destrR [ident] [fn x => json x * string]
+                          (fn [p ::_] (v : p) (j : json p, name : string) =>
+                            "{" ^ escape name ^ ":" ^ j.ToJson v ^ "}") fl r jnames
+                      end,
+     FromJson = fn s =>
+                   if String.length s = 0 || String.sub s 0 <> #"{" then
+                       error <xml>JSON variant doesn't begin with brace</xml>
+                   else
+                       let
+                           val (name, s') = unescape (skipSpaces (String.suffix s 1))
+                           val s' = skipSpaces s'
+                           val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
+                                        error <xml>No colon after JSON object field name</xml>
+                                    else
+                                        skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+
+                           val (r, s') = (@foldR2 [json] [fn _ => string]
+                                            [fn ts => ts' :: {Type} -> [ts ~ ts'] => variant (ts ++ ts') * string]
+                                            (fn [nm ::_] [t ::_] [rest ::_] [[nm] ~ rest] (j : json t) name'
+                                             (acc : ts' :: {Type} -> [rest ~ ts'] => variant (rest ++ ts') * string) [fwd ::_] [[nm = t] ++ rest ~ fwd] =>
+                                                if name = name'
+                                                    then
+                                                        let val (v, s') = j.FromJson s'
+                                                        in (make [nm] v, s')
+                                                        end
+                                                    else acc [fwd ++ [nm = t]]
+                                            )
+                                            (fn [fwd ::_] [[] ~ fwd] => error <xml>Unknown JSON object variant name {[name]}</xml>)
+                                            fl jss names) [[]] !
+
+                           val s' = skipSpaces s'
+                           val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
+                                        skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
+                                    else
+                                        s'
+                       in
+                           if String.length s' = 0 then
+                               error <xml>JSON object doesn't end in brace</xml>
+                           else if String.sub s' 0 = #"}" then
+                               (r, String.substring s' {Start = 1, Len = String.length s' - 1})
+                           else error <xml>Junk after JSON value in object</xml>
+                       end
+                   }
+
+val json_unit : json unit = json_record {} {}
+
+functor Recursive (M : sig
+                       con t :: Type -> Type
+                       val json_t : a ::: Type -> json a -> json (t a)
+                   end) = struct
+    open M
+
+    datatype r = Rec of t r
+
+    fun rTo (Rec x) = (json_t {ToJson = rTo,
+                               FromJson = fn _ => error <xml>Tried to FromJson in ToJson!</xml>}).ToJson x
+
+    fun rFrom s =
+        let
+            val (x, s') = (json_t {ToJson = fn _ => error <xml>Tried to ToJson in FromJson!</xml>,
+                                   FromJson = rFrom}).FromJson s
+        in
+            (Rec x, s')
+        end
+
+    val json_r = {ToJson = rTo, FromJson = rFrom}
+end
diff --git a/lib/ur/json.urs b/lib/ur/json.urs
new file mode 100644
index 0000000..b4bd635
--- /dev/null
+++ b/lib/ur/json.urs
@@ -0,0 +1,31 @@
+(** The JSON text-based serialization format *)
+
+class json
+
+val toJson : a ::: Type -> json a -> a -> string
+val fromJson : a ::: Type -> json a -> string -> a
+val fromJson' : a ::: Type -> json a -> string -> a * string
+
+val mkJson : a ::: Type -> {ToJson : a -> string,
+                            FromJson : string -> a * string} -> json a
+
+val json_string : json string
+val json_int : json int
+val json_float : json float
+val json_bool : json bool
+val json_option : a ::: Type -> json a -> json (option a)
+val json_list : a ::: Type -> json a -> json (list a)
+
+val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts
+val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts)
+
+val json_unit : json unit
+
+functor Recursive (M : sig
+                       con t :: Type -> Type
+                       val json_t : a ::: Type -> json a -> json (t a)
+                   end) : sig
+    datatype r = Rec of M.t r
+
+    val json_r : json r
+end
diff --git a/lib/ur/list.ur b/lib/ur/list.ur
new file mode 100644
index 0000000..cc53367
--- /dev/null
+++ b/lib/ur/list.ur
@@ -0,0 +1,498 @@
+datatype t = datatype Basis.list
+
+val show = fn [a] (_ : show a) =>
+              let
+                  fun show' (ls : list a) =
+                      case ls of
+                          [] => "[]"
+                        | x :: ls => show x ^ " :: " ^ show' ls
+              in
+                  mkShow show'
+              end
+
+val eq = fn [a] (_ : eq a) =>
+            let
+                fun eq' (ls1 : list a) ls2 =
+                    case (ls1, ls2) of
+                        ([], []) => True
+                      | (x1 :: ls1, x2 :: ls2) => x1 = x2 && eq' ls1 ls2
+                      | _ => False
+            in
+                mkEq eq'
+            end
+
+fun foldl [a] [b] (f : a -> b -> b) =
+    let
+        fun foldl' acc ls =
+            case ls of
+                [] => acc
+              | x :: ls => foldl' (f x acc) ls
+    in
+        foldl'
+    end
+
+val rev = fn [a] =>
+             let
+                 fun rev' acc (ls : list a) =
+                     case ls of
+                         [] => acc
+                       | x :: ls => rev' (x :: acc) ls
+             in
+                 rev' []
+             end
+
+fun foldr [a] [b] f (acc : b) (ls : list a) = foldl f acc (rev ls)
+
+fun foldlAbort [a] [b] f =
+    let
+        fun foldlAbort' acc ls =
+            case ls of
+                [] => Some acc
+              | x :: ls =>
+                case f x acc of
+                    None => None
+                  | Some acc' => foldlAbort' acc' ls
+    in
+        foldlAbort'
+    end
+
+val length = fn [a] =>
+                let
+                    fun length' acc (ls : list a) =
+                        case ls of
+                            [] => acc
+                          | _ :: ls => length' (acc + 1) ls
+                in
+                    length' 0
+                end
+
+fun foldlMapAbort [a] [b] [c] f =
+    let
+        fun foldlMapAbort' ls' acc ls =
+            case ls of
+                [] => Some (rev ls', acc)
+              | x :: ls =>
+                case f x acc of
+                    None => None
+                  | Some (x', acc') => foldlMapAbort' (x' :: ls') acc' ls
+    in
+        foldlMapAbort' []
+    end
+
+val revAppend = fn [a] =>
+                   let
+                       fun ra (ls : list a) acc =
+                           case ls of
+                               [] => acc
+                             | x :: ls => ra ls (x :: acc)
+                   in
+                       ra
+                   end
+
+fun append [a] (ls1 : t a) (ls2 : t a) = revAppend (rev ls1) ls2                
+
+fun mp [a] [b] f =
+    let
+        fun mp' acc ls =
+            case ls of
+                [] => rev acc
+              | x :: ls => mp' (f x :: acc) ls
+    in
+        mp' []
+    end
+
+fun mapi [a] [b] f =
+    let
+        fun mp' n acc ls =
+            case ls of
+                [] => rev acc
+              | x :: ls => mp' (n + 1) (f n x :: acc) ls
+    in
+        mp' 0 []
+    end
+
+fun mapPartial [a] [b] f =
+    let
+        fun mp' acc ls =
+            case ls of
+                [] => rev acc
+              | x :: ls => mp' (case f x of
+                                    None => acc
+                                  | Some y => y :: acc) ls
+    in
+        mp' []
+    end
+
+fun mapX [a] [ctx ::: {Unit}] f =
+    let
+        fun mapX' ls =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f x}{mapX' ls}</xml>
+    in
+        mapX'
+    end
+
+fun mapXi [a] [ctx ::: {Unit}] f =
+    let
+        fun mapX' i ls =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f i x}{mapX' (i + 1) ls}</xml>
+    in
+        mapX' 0
+    end
+
+fun mapM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f =
+    let
+        fun mapM' acc ls =
+            case ls of
+                [] => return (rev acc)
+              | x :: ls => x' <- f x; mapM' (x' :: acc) ls
+    in
+        mapM' []
+    end
+
+fun mapPartialM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f =
+    let
+        fun mapPartialM' acc ls =
+            case ls of
+                [] => return (rev acc)
+              | x :: ls =>
+                v <- f x;
+                mapPartialM' (case v of
+                                  None => acc
+                                | Some x' => x' :: acc) ls
+    in
+        mapPartialM' []
+    end
+
+fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f =
+    let
+        fun mapXM' ls =
+            case ls of
+                [] => return <xml/>
+              | x :: ls =>
+                this <- f x;
+                rest <- mapXM' ls;
+                return <xml>{this}{rest}</xml>
+    in
+        mapXM'
+    end
+
+fun filter [a] f =
+    let
+        fun fil acc ls =
+            case ls of
+                [] => rev acc
+              | x :: ls => fil (if f x then x :: acc else acc) ls
+    in
+        fil []
+    end
+
+fun exists [a] f =
+    let
+        fun ex ls =
+            case ls of
+                [] => False
+              | x :: ls =>
+                if f x then
+                    True
+                else
+                    ex ls
+    in
+        ex
+    end
+
+fun foldlMap [a] [b] [c] f =
+    let
+        fun fold ls' st ls =
+            case ls of
+                [] => (rev ls', st)
+              | x :: ls =>
+                case f x st of
+                    (y, st) => fold (y :: ls') st ls
+    in
+        fold []
+    end
+
+fun mem [a] (_ : eq a) (x : a) =
+    let
+        fun mm ls =
+            case ls of
+                [] => False
+              | y :: ls => y = x || mm ls
+    in
+        mm
+    end
+
+fun find [a] f =
+    let
+        fun find' ls =
+            case ls of
+                [] => None
+              | x :: ls =>
+                if f x then
+                    Some x
+                else
+                    find' ls
+    in
+        find'
+    end
+
+fun search [a] [b] f =
+    let
+        fun search' ls =
+            case ls of
+                [] => None
+              | x :: ls =>
+                case f x of
+                    None => search' ls
+                  | v => v
+    in
+        search'
+    end
+
+fun foldlM [m] (_ : monad m) [a] [b] f =
+    let
+        fun foldlM' acc ls =
+            case ls of
+                [] => return acc
+              | x :: ls =>
+                acc <- f x acc;
+                foldlM' acc ls
+    in
+        foldlM'
+    end
+
+fun foldlMi [m] (_ : monad m) [a] [b] f =
+    let
+        fun foldlMi' i acc ls =
+            case ls of
+                [] => return acc
+              | x :: ls =>
+                acc <- f i x acc;
+                foldlMi' (i + 1) acc ls
+    in
+        foldlMi' 0
+    end
+
+fun filterM [m] (_ : monad m) [a] (p : a -> m bool) =
+    let
+        fun filterM' (acc : list a) (xs : list a) : m (list a) =
+            case xs of
+                [] => return (rev acc)
+              | x :: xs =>
+                c <- p x;
+                filterM' (if c then x :: acc else acc) xs
+    in
+        filterM' []
+    end
+
+fun all [m] f =
+    let
+        fun all' ls =
+            case ls of
+                [] => True
+              | x :: ls => f x && all' ls
+    in
+        all'
+    end
+
+fun app [m] (_ : monad m) [a] f =
+    let
+        fun app' ls =
+            case ls of
+                [] => return ()
+              | x :: ls =>
+                f x;
+                app' ls
+    in
+        app'
+    end
+
+fun appi [m] (_ : monad m) [a] f =
+    let
+        fun app' i ls =
+            case ls of
+                [] => return ()
+              | x :: ls =>
+                f i x;
+                app' (i + 1) ls
+    in
+        app' 0
+    end
+
+fun mapQuery [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
+             [tables ~ exps] (q : sql_query [] [] tables exps)
+             (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> t) =
+    ls <- query q
+                (fn fs acc => return (f fs :: acc))
+                [];
+    return (rev ls)
+
+fun mapQueryM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
+             [tables ~ exps] (q : sql_query [] [] tables exps)
+             (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) =
+    ls <- query q
+                (fn fs acc => v <- f fs; return (v :: acc))
+                [];
+    return (rev ls)
+
+fun mapQueryPartialM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type]
+             [tables ~ exps] (q : sql_query [] [] tables exps)
+             (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) =
+    ls <- query q
+                (fn fs acc => v <- f fs;
+                    return (case v of
+                                None => acc
+                              | Some v => v :: acc))
+                [];
+    return (rev ls)
+
+fun sort [a] (gt : a -> a -> bool) (ls : t a) : t a =
+    let
+        fun split ls acc1 acc2 =
+            case ls of
+                [] => (rev acc1, rev acc2)
+              | x :: [] => (rev (x :: acc1), rev acc2)
+              | x1 :: x2 :: ls' => split ls' (x1 :: acc1) (x2 :: acc2)
+
+        fun merge ls1 ls2 acc =
+            case (ls1, ls2) of
+                ([], _) => revAppend acc ls2
+              | (_, []) => revAppend acc ls1
+              | (x1 :: ls1', x2 :: ls2') => if gt x1 x2 then merge ls1 ls2' (x2 :: acc) else merge ls1' ls2 (x1 :: acc)
+
+        fun sort' ls =
+            case ls of
+                [] => ls
+              | _ :: [] => ls
+              | _ =>
+                let
+                    val (ls1, ls2) = split ls [] []
+                in
+                    merge (sort' ls1) (sort' ls2) []
+                end
+    in
+        sort' ls
+    end
+
+val nth [a] =
+    let
+        fun nth (ls : list a) (n : int) : option a =
+            case ls of
+                [] => None
+              | x :: ls' =>
+                if n <= 0 then
+                    Some x
+                else
+                    nth ls' (n-1)
+    in
+        nth
+    end
+
+fun replaceNth [a] (ls : list a) (n : int) (v : a) : list a =
+    let
+        fun repNth (ls : list a) (n : int) (acc : list a) =
+            case ls of
+                [] => rev acc
+              | x :: ls' => if n <= 0 then
+                                revAppend acc (v :: ls')
+                            else
+                                repNth ls' (n-1) (x :: acc)
+    in
+        repNth ls n []
+    end
+
+fun assoc [a] [b] (_ : eq a) (x : a) =
+    let
+        fun assoc' (ls : list (a * b)) =
+            case ls of
+                [] => None
+              | (y, z) :: ls =>
+                if x = y then
+                    Some z
+                else
+                    assoc' ls
+    in
+        assoc'
+    end
+
+fun assocAdd [a] [b] (_ : eq a) (x : a) (y : b) (ls : t (a * b)) =
+    case assoc x ls of
+        None => (x, y) :: ls
+      | Some _ => ls
+
+fun recToList [a ::: Type] [r ::: {Unit}] (fl : folder r)
+  = @foldUR [a] [fn _ => list a] (fn [nm ::_] [rest ::_] [[nm] ~ rest] x xs =>
+				      x :: xs) [] fl
+
+fun take [a] (n : int) (xs : list a) : list a = 
+    if n <= 0 then
+        []
+    else
+        case xs of
+            [] => []
+          | x :: xs => x :: take (n-1) xs
+
+fun drop [a] (n : int) (xs : list a) : list a =
+    if n <= 0 then
+        xs
+    else
+        case xs of
+            [] => []
+          | x :: xs => drop (n-1) xs
+
+fun splitAt [a] (n : int) (xs : list a) : list a * list a =
+    (take n xs, drop n xs)
+    
+fun span [a] (f : a -> bool) (ls : list a) : list a * list a  = 
+    let
+        fun span' ls acc =
+            case ls of
+                []      =>  (rev acc, [])
+              | x :: xs =>  if f x then span' xs (x :: acc) else (rev acc, ls)
+    in
+        span' ls []
+    end
+    
+fun groupBy [a] (f : a -> a -> bool) (ls : list a) : list (list a) = 
+    let
+        fun groupBy' ls acc =
+            case ls of
+                [] => rev ([] :: acc)
+              | x :: xs => 
+                let
+                    val (ys, zs) = span (f x) xs
+                in 
+                    groupBy' zs ((x :: ys) :: acc)
+                end
+    in
+        groupBy' ls []
+    end
+
+fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
+    let
+        fun mapXiM' i ls =
+            case ls of
+                [] => return <xml/>
+              | x :: ls =>
+                this <- f i x;
+                rest <- mapXiM' (i+1) ls;
+                return <xml>{this}{rest}</xml>
+    in
+        mapXiM' 0
+    end
+
+fun tabulateM [m] (_ : monad m) [a] (f : int -> m a) n =
+    let
+        fun tabulate' n acc =
+            if n <= 0 then
+                return acc
+            else
+                (v <- f (n-1);
+                 tabulate' (n-1) (v :: acc))
+    in
+        tabulate' n []
+    end
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
new file mode 100644
index 0000000..fd56679
--- /dev/null
+++ b/lib/ur/list.urs
@@ -0,0 +1,116 @@
+datatype t = datatype Basis.list
+
+val show : a ::: Type -> show a -> show (t a)
+val eq : a ::: Type -> eq a -> eq (t a)
+
+val foldl : a ::: Type -> b ::: Type -> (a -> b -> b) -> b -> t a -> b
+val foldlAbort : a ::: Type -> b ::: Type -> (a -> b -> option b) -> b -> t a -> option b
+val foldlMapAbort : a ::: Type -> b ::: Type -> c ::: Type
+                    -> (a -> b -> option (c * b)) -> b -> t a -> option (t c * b)
+
+val foldr : a ::: Type -> b ::: Type -> (a -> b -> b) -> b -> t a -> b
+
+val length : a ::: Type -> t a -> int
+
+val rev : a ::: Type -> t a -> t a
+
+val revAppend : a ::: Type -> t a -> t a -> t a
+
+val append : a ::: Type -> t a -> t a -> t a
+
+val mp : a ::: Type -> b ::: Type -> (a -> b) -> t a -> t b
+
+val mapPartial : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> t b
+
+val mapi : a ::: Type -> b ::: Type -> (int -> a -> b) -> t a -> t b
+
+val mapX : a ::: Type -> ctx ::: {Unit} -> (a -> xml ctx [] []) -> t a -> xml ctx [] []
+
+val mapXi : a ::: Type -> ctx ::: {Unit} -> (int -> a -> xml ctx [] []) -> t a -> xml ctx [] []
+
+val mapM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+           -> (a -> m b) -> t a -> m (t b)
+
+val mapPartialM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> m (option b)) -> t a -> m (t b)
+                                                                        
+val mapXM : m ::: (Type -> Type) -> monad m -> a ::: Type -> ctx ::: {Unit}
+            -> (a -> m (xml ctx [] [])) -> t a -> m (xml ctx [] [])
+
+val mapXiM : m ::: (Type -> Type) -> monad m -> a ::: Type -> ctx ::: {Unit} -> (int -> a -> m (xml ctx [] [])) -> t a -> m (xml ctx [] [])
+
+val filter : a ::: Type -> (a -> bool) -> t a -> t a
+
+val exists : a ::: Type -> (a -> bool) -> t a -> bool
+
+val foldlM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+             -> (a -> b -> m b) -> b -> t a -> m b
+
+val foldlMi : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+             -> (int -> a -> b -> m b) -> b -> t a -> m b
+
+val filterM : m ::: (Type -> Type) -> monad m -> a ::: Type
+              -> (a -> m bool) -> t a -> m (t a)
+
+val foldlMap : a ::: Type -> b ::: Type -> c ::: Type
+               -> (a -> b -> c * b) -> b -> t a -> t c * b
+
+val mem : a ::: Type -> eq a -> a -> t a -> bool
+
+val find : a ::: Type -> (a -> bool) -> t a -> option a
+
+val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b
+
+val all : a ::: Type -> (a -> bool) -> t a -> bool
+
+val app : m ::: (Type -> Type) -> monad m -> a ::: Type
+          -> (a -> m unit) -> t a -> m unit
+
+val appi : m ::: (Type -> Type) -> monad m -> a ::: Type
+           -> (int -> a -> m unit) -> t a -> m unit
+
+val tabulateM : m ::: (Type -> Type) -> monad m -> a ::: Type
+                -> (int -> m a) -> int -> m (t a)
+
+val mapQuery : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+               -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> t)
+    -> transaction (list t)
+
+val mapQueryM : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+               -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t)
+    -> transaction (list t)
+
+val mapQueryPartialM : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
+               -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t))
+    -> transaction (list t)
+
+val sort : a ::: Type -> (a -> a -> bool) (* > predicate *) -> t a -> t a
+
+val nth : a ::: Type -> list a -> int -> option a
+val replaceNth : a ::: Type -> list a -> int -> a -> list a
+
+(** Association lists *)
+
+val assoc : a ::: Type -> b ::: Type -> eq a -> a -> t (a * b) -> option b
+
+val assocAdd : a ::: Type -> b ::: Type -> eq a -> a -> b -> t (a * b) -> t (a * b)
+
+(** Converting records to lists *)
+
+val recToList : a ::: Type -> r ::: {Unit} -> folder r -> $(mapU a r) -> t a
+
+(* Divide a list into two sections at a particular 0-based position, returning the second, first, or both parts, respectively. *)
+val drop : t ::: Type -> int -> list t -> list t
+val take : t ::: Type -> int -> list t -> list t
+val splitAt : t ::: Type -> int -> list t -> list t * list t
+
+(** Longest prefix of elements that satisfy a predicate, returned along with the remaining suffix *)
+val span : a ::: Type -> (a -> bool) -> t a -> t a * t a
+
+(** Group a list into maximal adjacent segments where all elements compare as equal, according to the provided predicate. *)
+val groupBy : a ::: Type -> (a -> a -> bool) -> t a -> t (t a)
diff --git a/lib/ur/listPair.ur b/lib/ur/listPair.ur
new file mode 100644
index 0000000..94b9287
--- /dev/null
+++ b/lib/ur/listPair.ur
@@ -0,0 +1,46 @@
+fun foldlAbort [a] [b] [c] f =
+    let
+        fun foldlAbort' acc ls1 ls2 =
+            case (ls1, ls2) of
+                ([], []) => Some acc
+              | (x1 :: ls1, x2 :: ls2) =>
+                (case f x1 x2 acc of
+                     None => None
+                   | Some acc' => foldlAbort' acc' ls1 ls2)
+              | _ => None
+    in
+        foldlAbort'
+    end
+
+fun mapX [a] [b] [ctx ::: {Unit}] f =
+    let
+        fun mapX' ls1 ls2 =
+            case (ls1, ls2) of
+                ([], []) => <xml/>
+              | (x1 :: ls1, x2 :: ls2) => <xml>{f x1 x2}{mapX' ls1 ls2}</xml>
+              | _ => error <xml>ListPair.mapX: Unequal list lengths</xml>
+    in
+        mapX'
+    end
+
+fun all [a] [b] f =
+    let
+        fun all' ls1 ls2 =
+            case (ls1, ls2) of
+                ([], []) => True
+              | (x1 :: ls1, x2 :: ls2) => f x1 x2 && all' ls1 ls2
+              | _ => False
+    in
+        all'
+    end
+
+fun mp [a] [b] [c] (f : a -> b -> c) =
+    let
+        fun map' ls1 ls2 =
+            case (ls1, ls2) of
+                ([], []) => []
+              | (x1 :: ls1, x2 :: ls2) => f x1 x2 :: map' ls1 ls2
+              | _ => error <xml>ListPair.map2: Unequal list lengths</xml>
+    in
+        map'
+    end
diff --git a/lib/ur/listPair.urs b/lib/ur/listPair.urs
new file mode 100644
index 0000000..b473e22
--- /dev/null
+++ b/lib/ur/listPair.urs
@@ -0,0 +1,10 @@
+val foldlAbort : a ::: Type -> b ::: Type -> c ::: Type
+                 -> (a -> b -> c -> option c) -> c -> list a -> list b -> option c
+
+val mapX : a ::: Type -> b ::: Type -> ctx ::: {Unit}
+           -> (a -> b -> xml ctx [] []) -> list a -> list b -> xml ctx [] []
+
+val all : a ::: Type -> b ::: Type -> (a -> b -> bool) -> list a -> list b -> bool
+
+val mp : a ::: Type -> b ::: Type -> c ::: Type
+         -> (a -> b -> c) -> list a -> list b -> list c
diff --git a/lib/ur/monad.ur b/lib/ur/monad.ur
new file mode 100644
index 0000000..8bff013
--- /dev/null
+++ b/lib/ur/monad.ur
@@ -0,0 +1,140 @@
+fun exec [m ::: Type -> Type] (_ : monad m) [ts ::: {Type}] r (fd : folder ts) =
+    @foldR [m] [fn ts => m $ts]
+     (fn [nm :: Name] [v :: Type] [rest :: {Type}] [[nm] ~ rest] action acc =>
+         this <- action;
+         others <- acc;
+         return ({nm = this} ++ others))
+     (return {}) fd r
+
+fun ignore [m ::: Type -> Type] (_ : monad m) [t] (v : m t) = x <- v; return ()
+
+fun mp [m] (_ : monad m) [a] [b] f m =
+    v <- m;
+    return (f v)
+
+val liftM = @@mp
+
+fun foldR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: {K} -> Type]
+          (f : nm :: Name -> t :: K -> rest :: {K}
+               -> [[nm] ~ rest] =>
+           tf t -> tr rest -> m (tr ([nm = t] ++ rest)))
+          (i : tr []) [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf r) -> m (tr r)]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                      (acc : _ -> m (tr rest)) r =>
+         acc' <- acc (r -- nm);
+         f [nm] [t] [rest] r.nm acc')
+     (fn _ => return i)
+     fl
+
+fun foldR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: {K} -> Type]
+           (f : nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+            tf1 t -> tf2 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+           (i : tr []) [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> m (tr r)]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                      (acc : _ -> _ -> m (tr rest)) r1 r2 =>
+         acc' <- acc (r1 -- nm) (r2 -- nm);
+         f [nm] [t] [rest] r1.nm r2.nm acc')
+     (fn _ _ => return i)
+     fl
+
+fun foldR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
+           (f : nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+            tf1 t -> tf2 t -> tf3 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+           (i : tr []) [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m (tr r)]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                      (acc : _ -> _ -> _ -> m (tr rest)) r1 r2 r3 =>
+         acc' <- acc (r1 -- nm) (r2 -- nm) (r3 -- nm);
+         f [nm] [t] [rest] r1.nm r2.nm r3.nm acc')
+     (fn _ _ _ => return i)
+     fl
+
+fun mapR0 [K] [m] (_ : monad m) [tr :: K -> Type]
+         (f : nm :: Name -> t :: K -> m (tr t)) [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r => m ($(map tr r))]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (acc : m ($(map tr rest))) =>
+        v <- f [nm] [t];
+        vs <- acc;
+        return (vs ++ {nm = v}))
+    (return {})
+    fl
+
+fun mapR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: K -> Type]
+         (f : nm :: Name -> t :: K -> tf t -> m (tr t)) =
+    @@foldR [m] _ [tf] [fn r => $(map tr r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (v : tf t)
+                     (acc : $(map tr rest)) =>
+        v' <- f [nm] [t] v;
+        return (acc ++ {nm = v'}))
+    {}
+
+fun mapR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: K -> Type]
+         (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> m (tr t)) =
+    @@foldR2 [m] _ [tf1] [tf2] [fn r => $(map tr r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (v1 : tf1 t) (v2 : tf2 t)
+                     (acc : $(map tr rest)) =>
+        v' <- f [nm] [t] v1 v2;
+        return (acc ++ {nm = v'}))
+    {}
+
+fun mapR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: K -> Type]
+         (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m (tr t)) =
+    @@foldR3 [m] _ [tf1] [tf2] [tf3] [fn r => $(map tr r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (v1 : tf1 t) (v2 : tf2 t) (v3 : tf3 t)
+                     (acc : $(map tr rest)) =>
+        v' <- f [nm] [t] v1 v2 v3;
+        return (acc ++ {nm = v'}))
+    {}
+
+fun foldMapR [K] [m] (_ : monad m) [tf :: K -> Type] [tf' :: K -> Type] [tr :: {K} -> Type]
+             (f : nm :: Name -> t :: K -> rest :: {K}
+                  -> [[nm] ~ rest] =>
+              tf t -> tr rest -> m (tf' t * tr ([nm = t] ++ rest)))
+             (i : tr []) [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf r) -> m ($(map tf' r) * tr r)]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                      (acc : _ -> m ($(map tf' rest) * tr rest)) r =>
+         p <- acc (r -- nm);
+         p' <- f [nm] [t] [rest] r.nm p.2;
+         return ({nm = p'.1} ++ p.1, p'.2))
+     (fn _ => return ({}, i))
+     fl
+
+fun appR [K] [m] (_ : monad m) [tf :: K -> Type]
+           (f : nm :: Name -> t :: K -> tf t -> m unit)
+           [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf r) -> m unit]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r =>
+         acc (r -- nm);
+         f [nm] [t] r.nm)
+     (fn _ => return ())
+     fl
+
+fun appR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type]
+           (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> m unit)
+           [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> m unit]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 =>
+         acc (r1 -- nm) (r2 -- nm);
+         f [nm] [t] r1.nm r2.nm)
+     (fn _ _ => return ())
+     fl
+
+fun appR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type]
+           (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m unit)
+           [r ::: {K}] (fl : folder r) =
+    @Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m unit]
+     (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 r3 =>
+         acc (r1 -- nm) (r2 -- nm) (r3 -- nm);
+         f [nm] [t] r1.nm r2.nm r3.nm)
+     (fn _ _ _ => return ())
+     fl
+
+fun liftM2 [m ::: Type -> Type] (_ : monad m) [a] [b] [c] (f : a -> b -> c) (mx : m a) (my : m b) : m c =
+    x <- mx;
+    y <- my;
+    return (f x y)
diff --git a/lib/ur/monad.urs b/lib/ur/monad.urs
new file mode 100644
index 0000000..8ca8d0a
--- /dev/null
+++ b/lib/ur/monad.urs
@@ -0,0 +1,90 @@
+val exec : m ::: (Type -> Type) -> monad m -> ts ::: {Type}
+           -> $(map m ts) -> folder ts -> m $ts
+
+val ignore : m ::: (Type -> Type) -> monad m -> t ::: Type
+             -> m t -> m unit
+
+val mp : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+         -> (a -> b) -> m a -> m b
+
+val liftM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+            -> (a -> b) -> m a -> m b
+(* Haskell-style synonym for [mp] *)
+
+val liftM2 : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> c ::: Type
+             -> (a -> b -> c) -> m a -> m b -> m c
+
+val foldR : K --> m ::: (Type -> Type) -> monad m
+            -> tf :: (K -> Type)
+            -> tr :: ({K} -> Type)
+            -> (nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+                tf t -> tr rest -> m (tr ([nm = t] ++ rest)))
+            -> tr []
+            -> r ::: {K} -> folder r -> $(map tf r) -> m (tr r)
+
+val foldR2 : K --> m ::: (Type -> Type) -> monad m
+             -> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+             -> tr []
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m (tr r)
+
+val foldR3 : K --> m ::: (Type -> Type) -> monad m
+             -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> m (tr ([nm = t] ++ rest)))
+             -> tr []
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m (tr r)
+
+val mapR0 : K --> m ::: (Type -> Type) -> monad m
+           -> tr :: (K -> Type)
+           -> (nm :: Name -> t :: K -> m (tr t))
+           -> r ::: {K} -> folder r -> m ($(map tr r))
+
+val mapR : K --> m ::: (Type -> Type) -> monad m
+           -> tf :: (K -> Type)
+           -> tr :: (K -> Type)
+           -> (nm :: Name -> t :: K -> tf t -> m (tr t))
+           -> r ::: {K} -> folder r -> $(map tf r) -> m ($(map tr r))
+
+val mapR2 : K --> m ::: (Type -> Type) -> monad m
+            -> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+            -> tr :: (K -> Type)
+            -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> m (tr t))
+            -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m ($(map tr r))
+
+val mapR3 : K --> m ::: (Type -> Type) -> monad m
+            -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+            -> tr :: (K -> Type)
+            -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m (tr t))
+            -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m ($(map tr r))
+
+val foldMapR : K --> m ::: (Type -> Type) -> monad m
+               -> tf :: (K -> Type)
+               -> tf' :: (K -> Type)
+               -> tr :: ({K} -> Type)
+               -> (nm :: Name -> t :: K -> rest :: {K}
+                   -> [[nm] ~ rest] =>
+                   tf t -> tr rest -> m (tf' t * tr ([nm = t] ++ rest)))
+               -> tr []
+               -> r ::: {K} -> folder r -> $(map tf r) -> m ($(map tf' r) * tr r)
+
+val appR : K --> m ::: (Type -> Type) -> monad m
+           -> tf :: (K -> Type)
+           -> (nm :: Name -> t :: K -> tf t -> m unit)
+           -> r ::: {K} -> folder r -> $(map tf r) -> m unit
+
+val appR2 : K --> m ::: (Type -> Type) -> monad m
+             -> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+             -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> m unit)
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m unit
+
+val appR3 : K --> m ::: (Type -> Type) -> monad m
+             -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+             -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m unit)
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m unit
diff --git a/lib/ur/option.ur b/lib/ur/option.ur
new file mode 100644
index 0000000..baa0846
--- /dev/null
+++ b/lib/ur/option.ur
@@ -0,0 +1,61 @@
+datatype t = datatype Basis.option
+
+val monad = mkMonad {Return = @@Some,
+                     Bind = fn [a] [b] (m1 : t a) (m2 : a -> t b) =>
+                               case m1 of
+                                   None => None
+                                 | Some v => m2 v}
+
+fun eq [a] (_ : eq a) =
+    mkEq (fn x y =>
+             case (x, y) of
+                 (None, None) => True
+               | (Some x, Some y) => x = y
+               | _ => False)
+
+fun ord [a] (_ : ord a) =
+    mkOrd {Lt = fn x y =>
+                   case (x, y) of
+                       (None, Some _) => True
+                     | (Some x, Some y) => x < y
+                     | _ => False,
+           Le = fn x y =>
+                   case (x, y) of
+                       (None, _) => True
+                     | (Some x, Some y) => x <= y
+                     | _ => False}
+
+fun isNone [a] x =
+    case x of
+        None => True
+      | Some _ => False
+
+fun isSome [a] x =
+    case x of
+        None => False
+      | Some _ => True
+
+fun mp [a] [b] f x =
+    case x of
+        None => None
+      | Some y => Some (f y)
+
+fun app [m] [a] (_ : monad m) (f : a -> m {}) x =
+    case x of
+        None => return ()
+      | Some y => f y
+
+fun bind [a] [b] f x =
+    case x of
+        None => None
+      | Some y => f y
+
+fun get [a] (x : a) (o : option a) =
+    case o of
+        None => x
+      | Some v => v
+
+fun unsafeGet [a] (o : option a) =
+    case o of
+        None   => error <xml>Option.unsafeGet: encountered None</xml>
+      | Some v => v
diff --git a/lib/ur/option.urs b/lib/ur/option.urs
new file mode 100644
index 0000000..c30c40e
--- /dev/null
+++ b/lib/ur/option.urs
@@ -0,0 +1,16 @@
+datatype t = datatype Basis.option
+
+val monad : monad t
+
+val eq : a ::: Type -> eq a -> eq (t a)
+val ord : a ::: Type -> ord a -> ord (t a)
+
+val isNone : a ::: Type -> t a -> bool
+val isSome : a ::: Type -> t a -> bool
+
+val mp : a ::: Type -> b ::: Type -> (a -> b) -> t a -> t b
+val app : m ::: (Type -> Type) -> a ::: Type -> monad m -> (a -> m {}) -> t a -> m {}
+val bind : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> t b
+
+val get : a ::: Type -> a -> option a -> a
+val unsafeGet : a ::: Type -> option a -> a
diff --git a/lib/ur/string.ur b/lib/ur/string.ur
new file mode 100644
index 0000000..da4e7eb
--- /dev/null
+++ b/lib/ur/string.ur
@@ -0,0 +1,113 @@
+type t = Basis.string
+
+val str = Basis.str1
+
+val length = Basis.strlen
+val lengthGe = Basis.strlenGe
+val append = Basis.strcat
+
+val sub = Basis.strsub
+val suffix = Basis.strsuffix
+
+val index = Basis.strindex
+fun sindex r = Basis.strsindex r.Haystack r.Needle
+val atFirst = Basis.strchr
+
+fun mindex {Haystack = s, Needle = chs} =
+    let
+        val n = Basis.strcspn s chs
+    in
+        if n >= length s then
+            None
+        else
+            Some n
+    end
+
+fun substring s {Start = start, Len = len} = Basis.substring s start len
+
+fun seek s ch =
+    case index s ch of
+        None => None
+      | Some i => Some (suffix s (i + 1))
+fun mseek {Haystack = s, Needle = chs} =
+    case mindex {Haystack = s, Needle = chs} of
+        None => None
+      | Some i => Some (sub s i, suffix s (i + 1))
+
+fun split s ch =
+    case index s ch of
+        None => None
+      | Some i => Some (substring s {Start = 0, Len = i},
+                        suffix s (i + 1))
+fun split' s ch =
+    case index s ch of
+        None => None
+      | Some i => Some (substring s {Start = 0, Len = i},
+                        suffix s i)
+fun msplit {Haystack = s, Needle = chs} =
+    case mindex {Haystack = s, Needle = chs} of
+        None => None
+      | Some i => Some (substring s {Start = 0, Len = i},
+                        sub s i,
+                        suffix s (i + 1))
+
+fun ssplit r =
+    case sindex r of
+        None => None
+      | Some i => Some (substring r.Haystack {Start = 0, Len = i},
+                        suffix r.Haystack (i + length r.Needle))
+
+fun all f s =
+    let
+        val len = length s
+
+        fun al i =
+            i >= len
+            || (f (sub s i) && al (i + 1))
+    in
+        al 0
+    end
+
+fun mp f s =
+    let
+        fun mp' i acc =
+            if i < 0 then
+                acc
+            else
+                mp' (i - 1) (str (f (sub s i)) ^ acc)
+    in
+        mp' (length s - 1) ""
+    end
+
+fun newlines [ctx] [[Body] ~ ctx] (s : string) : xml ([Body] ++ ctx) [] [] =
+    case split s #"\n" of
+        None => cdata s
+      | Some (s1, s2) => <xml>{[s1]}<br/>{newlines s2}</xml>
+
+fun isPrefix {Full = f, Prefix = p} =
+    length f >= length p && substring f {Start = 0, Len = length p} = p
+
+fun trim s =
+    let
+        val len = length s
+
+        fun findStart i =
+            if i < len && isspace (sub s i) then
+                findStart (i+1)
+            else
+                i
+
+        fun findFinish i =
+            if i >= 0 && isspace (sub s i) then
+                findFinish (i-1)
+            else
+                i
+
+        val start = findStart 0
+        val finish = findFinish (len - 1)
+    in
+        if finish >= start then
+            substring s {Start = start, Len = finish - start + 1}
+        else
+            ""
+    end
diff --git a/lib/ur/string.urs b/lib/ur/string.urs
new file mode 100644
index 0000000..1bdca96
--- /dev/null
+++ b/lib/ur/string.urs
@@ -0,0 +1,37 @@
+type t = string
+
+val str : char -> t
+
+val length : t -> int
+val lengthGe : t -> int -> bool
+
+val append : t -> t -> t
+
+val sub : t -> int -> char
+val suffix : t -> int -> string
+
+val index : t -> char -> option int
+val sindex : {Haystack : t, Needle : t} -> option int
+val atFirst : t -> char -> option string
+
+val mindex : {Haystack : t, Needle : t} -> option int
+
+val substring : t -> {Start : int, Len : int} -> string
+
+val seek : t -> char -> option string
+val mseek : {Haystack : t, Needle : t} -> option (char * string)
+
+val split : t -> char -> option (string * string)
+val split' : t -> char -> option (string * string) (* The matched character is kept at the beginning of the suffix. *)
+val msplit : {Haystack : t, Needle : t} -> option (string * char * string)
+
+val ssplit : {Haystack : t, Needle : t} -> option (string * string)
+
+val all : (char -> bool) -> string -> bool
+val mp : (char -> char) -> string -> string
+
+val newlines : ctx ::: {Unit} -> [[Body] ~ ctx] => string -> xml ([Body] ++ ctx) [] []
+
+val isPrefix : {Full : t, Prefix : t} -> bool
+
+val trim : t -> t
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
new file mode 100644
index 0000000..0256791
--- /dev/null
+++ b/lib/ur/top.ur
@@ -0,0 +1,430 @@
+(** Row folding *)
+
+con folder = K ==> fn r :: {K} =>
+                      tf :: ({K} -> Type)
+                      -> (nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+                          tf r -> tf ([nm = v] ++ r))
+                      -> tf [] -> tf r
+
+fun fold [K] [tf :: {K} -> Type]
+         (f : (nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+               tf r -> tf ([nm = v] ++ r)))
+         (i : tf []) [r ::: {K}] (fl : folder r) = fl [tf] f i
+
+structure Folder = struct
+    fun nil [K] [tf :: {K} -> Type]
+            (f : nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+             tf r -> tf ([nm = v] ++ r))
+            (i : tf []) = i
+
+    fun cons [K] [r ::: {K}] [nm :: Name] [v :: K] [[nm] ~ r] (fold : folder r)
+             [tf :: {K} -> Type]
+             (f : nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+              tf r -> tf ([nm = v] ++ r))
+             (i : tf []) = f [nm] [v] [r] (fold [tf] f i)
+
+    fun concat [K] [r1 ::: {K}] [r2 ::: {K}] [r1 ~ r2]
+        (f1 : folder r1) (f2 : folder r2)
+        [tf :: {K} -> Type]
+        (f : nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+         tf r -> tf ([nm = v] ++ r))
+        (i : tf []) =
+        f1 [fn r1' => [r1' ~ r2] => tf (r1' ++ r2)]
+           (fn [nm :: Name] [v :: K] [r1' :: {K}] [[nm] ~ r1']
+                            (acc : [r1' ~ r2] => tf (r1' ++ r2))
+                            [[nm = v] ++ r1' ~ r2] =>
+               f [nm] [v] [r1' ++ r2] acc)
+           (fn [[] ~ r2] => f2 [tf] f i)
+
+    fun mp [K1] [K2] [f ::: K1 -> K2] [r ::: {K1}]
+        (fold : folder r)
+        [tf :: {K2} -> Type]
+        (f : nm :: Name -> v :: K2 -> r :: {K2} -> [[nm] ~ r] =>
+         tf r -> tf ([nm = v] ++ r))
+        (i : tf []) =
+        fold [fn r => tf (map f r)]
+        (fn [nm :: Name] [v :: K1] [rest :: {K1}] [[nm] ~ rest] (acc : tf (map f rest)) =>
+            f [nm] [f v] [map f rest] acc)
+        i
+end
+
+
+fun not b = if b then False else True
+
+con ident = K ==> fn t :: K => t
+con record (t :: {Type}) = $t
+con fst = K1 ==> K2 ==> fn t :: (K1 * K2) => t.1
+con snd = K1 ==> K2 ==> fn t :: (K1 * K2) => t.2
+con fst3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.1
+con snd3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.2
+con thd3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.3
+
+con mapU = K ==> fn f :: K => map (fn _ :: Unit => f)
+
+con ex = K ==> fn tf :: (K -> Type) =>
+            res ::: Type -> (choice :: K -> tf choice -> res) -> res
+
+fun ex_intro [K] [tf :: K -> Type] [choice :: K] (body : tf choice) : ex tf =
+ fn [res] (f : choice :: K -> tf choice -> res) =>
+    f [choice] body
+
+fun ex_elim [K] [tf ::: K -> Type] (v : ex tf) [res ::: Type] = @@v [res]
+
+fun compose [t1 ::: Type] [t2 ::: Type] [t3 ::: Type]
+            (f1 : t2 -> t3) (f2 : t1 -> t2) (x : t1) = f1 (f2 x)
+
+fun show_option [t ::: Type] (_ : show t) =
+    mkShow (fn opt : option t =>
+               case opt of
+                   None => ""
+                 | Some x => show x)
+
+fun read_option [t ::: Type] (_ : read t) =
+    mkRead (fn s =>
+               case s of
+                   "" => None
+                 | _ => Some (readError s : t))
+           (fn s =>
+               case s of
+                   "" => Some None
+                 | _ => case read s of
+                            None => None
+                          | v => Some v)
+
+fun txt [t] [ctx ::: {Unit}] [use ::: {Type}] (_ : show t) (v : t) : xml ctx use [] =
+    cdata (show v)
+
+fun map0 [K] [tf :: K -> Type] (f : t :: K -> tf t) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc =>
+        acc ++ {nm = f [t]})
+    {}
+
+fun mp [K] [tf1 :: K -> Type] [tf2 :: K -> Type] (f : t ::: K -> tf1 t -> tf2 t) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r =>
+        acc (r -- nm) ++ {nm = f r.nm})
+    (fn _ => {})
+
+fun map2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type]
+         (f : t ::: K -> tf1 t -> tf2 t -> tf3 t) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 =>
+        acc (r1 -- nm) (r2 -- nm) ++ {nm = f r1.nm r2.nm})
+    (fn _ _ => {})
+
+fun map3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tf :: K -> Type]
+         (f : t ::: K -> tf1 t -> tf2 t -> tf3 t -> tf t) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> $(map tf r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 r3 =>
+        acc (r1 -- nm) (r2 -- nm) (r3 -- nm) ++ {nm = f r1.nm r2.nm r3.nm})
+    (fn _ _ _ => {})
+
+fun foldUR [tf :: Type] [tr :: {Unit} -> Type]
+           (f : nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+                      tf -> tr rest -> tr ([nm] ++ rest))
+           (i : tr []) [r ::: {Unit}] (fl : folder r) =
+    fl [fn r :: {Unit} => $(mapU tf r) -> tr r]
+       (fn [nm :: Name] [t :: Unit] [rest :: {Unit}] [[nm] ~ rest] acc r =>
+           f [nm] [rest] r.nm (acc (r -- nm)))
+       (fn _ => i)
+
+fun foldUR2 [tf1 :: Type] [tf2 :: Type] [tr :: {Unit} -> Type]
+           (f : nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+                      tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
+           (i : tr []) [r ::: {Unit}] (fl : folder r) =
+    fl [fn r :: {Unit} => $(mapU tf1 r) -> $(mapU tf2 r) -> tr r]
+       (fn [nm :: Name] [t :: Unit] [rest :: {Unit}] [[nm] ~ rest] acc r1 r2 =>
+           f [nm] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
+       (fn _ _ => i)
+
+fun foldR [K] [tf :: K -> Type] [tr :: {K} -> Type]
+           (f : nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+                      tf t -> tr rest -> tr ([nm = t] ++ rest))
+           (i : tr []) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf r) -> tr r]
+       (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (acc : _ -> tr rest) r =>
+           f [nm] [t] [rest] r.nm (acc (r -- nm)))
+       (fn _ => i)
+
+fun foldR2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: {K} -> Type]
+            (f : nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
+            (i : tr []) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> tr r]
+       (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                        (acc : _ -> _ -> tr rest) r1 r2 =>
+           f [nm] [t] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
+       (fn _ _ => i)
+
+fun foldR3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
+            (f : nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
+            (i : tr []) [r ::: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r]
+       (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 
+                        (acc : _ -> _ -> _ -> tr rest) r1 r2 r3 =>
+           f [nm] [t] [rest] r1.nm r2.nm r3.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm)))
+       (fn _ _ _ => i)
+
+fun mapUX [tf :: Type] [ctx :: {Unit}]
+          (f : nm :: Name -> rest :: {Unit} -> [[nm] ~ rest] => tf -> xml ctx [] []) =
+    @@foldR [fn _ => tf] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [u :: Unit] [rest :: {Unit}] [[nm] ~ rest] r acc =>
+          <xml>{f [nm] [rest] r}{acc}</xml>)
+      <xml/>
+
+fun mapUX_rev [tf :: Type] [ctx :: {Unit}]
+          (f : nm :: Name -> rest :: {Unit} -> [[nm] ~ rest] => tf -> xml ctx [] []) =
+    @@foldR [fn _ => tf] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [u :: Unit] [rest :: {Unit}] [[nm] ~ rest] r acc =>
+          <xml>{acc}{f [nm] [rest] r}</xml>)
+      <xml/>
+
+fun mapX [K] [tf :: K -> Type] [ctx :: {Unit}]
+            (f : nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf t -> xml ctx [] []) =
+    @@foldR [tf] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] r acc =>
+          <xml>{f [nm] [t] [rest] r}{acc}</xml>)
+      <xml/>
+
+fun mapUX2 [tf1 :: Type] [tf2 :: Type] [ctx :: {Unit}]
+           (f : nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+            tf1 -> tf2 -> xml ctx [] []) =
+    @@foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] v1 v2 acc =>
+          <xml>{f [nm] [rest] v1 v2}{acc}</xml>)
+      <xml/>
+
+fun mapX2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [ctx :: {Unit}]
+             (f : nm :: Name -> t :: K -> rest :: {K}
+                  -> [[nm] ~ rest] =>
+                        tf1 t -> tf2 t -> xml ctx [] []) =
+    @@foldR2 [tf1] [tf2] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+                       r1 r2 acc =>
+          <xml>{f [nm] [t] [rest] r1 r2}{acc}</xml>)
+      <xml/>
+
+fun mapX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx :: {Unit}]
+             (f : nm :: Name -> t :: K -> rest :: {K}
+                  -> [[nm] ~ rest] =>
+                        tf1 t -> tf2 t -> tf3 t -> xml ctx [] []) =
+    @@foldR3 [tf1] [tf2] [tf3] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+                       r1 r2 r3 acc =>
+          <xml>{f [nm] [t] [rest] r1 r2 r3}{acc}</xml>)
+      <xml/>
+
+fun query1 [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [] [t = fs] [])
+           (f : $fs -> state -> transaction state) (i : state) =
+    query q (fn r => f r.t) i
+
+fun query1' [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [] [] [t = fs] [])
+            (f : $fs -> state -> state) (i : state) =
+    query q (fn r s => return (f r.t s)) i
+
+val rev = fn [a] =>
+             let
+                 fun rev' acc (ls : list a) =
+                     case ls of
+                         [] => acc
+                       | x :: ls => rev' (x :: acc) ls
+             in
+                 rev' []
+             end
+
+fun queryL [tables] [exps] [tables ~ exps] (q : sql_query [] [] tables exps) =
+    ls <- query q (fn r ls => return (r :: ls)) [];
+    return (rev ls)
+
+fun queryL1 [t ::: Name] [fs ::: {Type}] (q : sql_query [] [] [t = fs] []) =
+    ls <- query q (fn r ls => return (r.t :: ls)) [];
+    return (rev ls)
+
+fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
+           [tables ~ exps] (q : sql_query [] [] tables exps)
+           (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
+                -> transaction unit) =
+    query q
+          (fn fs _ => f fs)
+          ()
+
+fun queryI1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] [])
+            (f : $fs -> transaction unit) =
+    query q
+          (fn fs _ => f fs.nm)
+          ()
+
+fun queryX [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+           [tables ~ exps] (q : sql_query [] [] tables exps)
+           (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
+                -> xml ctx inp []) =
+    query q
+          (fn fs acc => return <xml>{acc}{f fs}</xml>)
+          <xml/>
+
+fun rev [a] (ls : list a) : list a =
+    let
+        fun rev' ls acc =
+            case ls of
+                [] => acc
+              | x :: ls => rev' ls (x :: acc)
+    in
+        rev' ls []
+    end
+
+fun queryXI [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+            [tables ~ exps] (q : sql_query [] [] tables exps)
+            (f : int -> $(exps ++ map (fn fields :: {Type} => $fields) tables)
+                 -> xml ctx inp []) =
+    let
+        fun qxi ls i =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f i x}{qxi ls (i+1)}</xml>
+    in
+        ls <- queryL q;
+        return (qxi (rev ls) 0)
+    end
+
+fun queryX1 [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+            (q : sql_query [] [] [nm = fs] [])
+            (f : $fs -> xml ctx inp []) =
+    query q
+          (fn fs acc => return <xml>{acc}{f fs.nm}</xml>)
+          <xml/>
+
+fun queryX1I [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+             (q : sql_query [] [] [nm = fs] [])
+             (f : int -> $fs -> xml ctx inp []) =
+    let
+        fun qx1i ls i =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f i x.nm}{qx1i ls (i+1)}</xml>
+    in
+        ls <- queryL q;
+        return (qx1i (rev ls) 0)
+    end
+
+fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+            [tables ~ exps] (q : sql_query [] [] tables exps)
+            (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
+                 -> transaction (xml ctx inp [])) =
+    query q
+          (fn fs acc =>
+              r <- f fs;
+              return <xml>{acc}{r}</xml>)
+          <xml/>
+
+fun queryX1' [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+             (q : sql_query [] [] [nm = fs] [])
+             (f : $fs -> transaction (xml ctx inp [])) =
+    query q
+          (fn fs acc =>
+              r <- f fs.nm;
+              return <xml>{acc}{r}</xml>)
+          <xml/>
+
+fun queryXE' [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+             (q : sql_query [] [] [] exps)
+             (f : $exps -> transaction (xml ctx inp [])) =
+    query q
+          (fn fs acc =>
+              r <- f fs;
+              return <xml>{acc}{r}</xml>)
+          <xml/>
+
+fun hasRows [tables ::: {{Type}}] [exps ::: {Type}]
+            [tables ~ exps]
+            (q : sql_query [] [] tables exps) =
+    query q
+          (fn _ _ => return True)
+          False
+
+fun oneOrNoRows [tables ::: {{Type}}] [exps ::: {Type}]
+                [tables ~ exps]
+                (q : sql_query [] [] tables exps) =
+    query q
+          (fn fs _ => return (Some fs))
+          None
+
+fun oneOrNoRows1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] []) =
+    query q
+          (fn fs _ => return (Some fs.nm))
+          None
+
+fun oneOrNoRowsE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] [] (mapU [] tabs) [nm = t]) =
+    query q
+          (fn fs _ => return (Some fs.nm))
+          None
+
+fun oneRow [tables ::: {{Type}}] [exps ::: {Type}]
+           [tables ~ exps] (q : sql_query [] [] tables exps) =
+    o <- oneOrNoRows q;
+    return (case o of
+                None => error <xml>Query returned no rows</xml>
+              | Some r => r)
+
+fun oneRow1 [nm ::: Name] [fs ::: {Type}] (q : sql_query [] [] [nm = fs] []) =
+    o <- oneOrNoRows q;
+    return (case o of
+                None => error <xml>Query returned no rows</xml>
+              | Some r => r.nm)
+
+fun oneRowE1 [tabs ::: {Unit}] [nm ::: Name] [t ::: Type] [tabs ~ [nm]] (q : sql_query [] [] (mapU [] tabs) [nm = t]) =
+    o <- oneOrNoRows q;
+    return (case o of
+                None => error <xml>Query returned no rows</xml>
+              | Some r => r.nm)
+
+fun nonempty [fs] [us] (t : sql_table fs us) =
+    oneRowE1 (SELECT COUNT( * ) > 0 AS B FROM t)
+
+fun eqNullable [tables ::: {{Type}}] [agg ::: {{Type}}] [exps ::: {Type}]
+    [t ::: Type] (_ : sql_injectable (option t))
+    (e1 : sql_exp tables agg exps (option t))
+    (e2 : sql_exp tables agg exps (option t)) =
+    (SQL ({e1} IS NULL AND {e2} IS NULL) OR {e1} = {e2})
+
+fun eqNullable' [tables ::: {{Type}}] [agg ::: {{Type}}] [exps ::: {Type}]
+    [t ::: Type] (_ : sql_injectable (option t))
+    (e1 : sql_exp tables agg exps (option t))
+    (e2 : option t) =
+    case e2 of
+        None => (SQL {e1} IS NULL)
+      | Some _ => sql_binary sql_eq e1 (sql_inject e2)
+
+fun mkRead' [t ::: Type] (f : string -> option t) (name : string) : read t =
+    mkRead (fn s => case f s of
+                        None => error <xml>Invalid {txt name}: {txt s}</xml>
+                      | Some v => v) f
+
+fun postFields pb =
+    let
+        fun postFields' s =
+            case firstFormField s of
+                None => []
+              | Some f => (fieldName f, fieldValue f) :: postFields' (remainingFields f)
+    in
+        case postType pb of
+            "application/x-www-form-urlencoded" => postFields' (postData pb)
+          | _ => error <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
+    end
+
+fun max [t] ( _ : ord t) (x : t) (y : t) : t =
+    if x > y then x else y
+fun min [t] ( _ : ord t) (x : t) (y : t) : t =
+    if x < y then x else y
+
+fun assert [a] (cond: bool) (msg: string) (loc: string) (x:a): a =
+  if cond then x else error <xml>{txt msg} at {txt loc}</xml>
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
new file mode 100644
index 0000000..ec09895
--- /dev/null
+++ b/lib/ur/top.urs
@@ -0,0 +1,303 @@
+(** Row folding *)
+
+con folder :: K --> {K} -> Type
+
+val fold : K --> tf :: ({K} -> Type)
+           -> (nm :: Name -> v :: K -> r :: {K} -> [[nm] ~ r] =>
+               tf r -> tf ([nm = v] ++ r))
+           -> tf []
+           -> r ::: {K} -> folder r -> tf r
+
+structure Folder : sig
+    val nil : K --> folder (([]) :: {K})
+    val cons : K --> r ::: {K} -> nm :: Name -> v :: K
+               -> [[nm] ~ r] => folder r -> folder ([nm = v] ++ r)
+    val concat : K --> r1 ::: {K} -> r2 ::: {K}
+                 -> [r1 ~ r2] => folder r1 -> folder r2 -> folder (r1 ++ r2)
+    val mp : K1 --> K2 --> f ::: (K1 -> K2) -> r ::: {K1}
+             -> folder r -> folder (map f r)
+end
+
+
+val not : bool -> bool
+
+(* Type-level identity function *)
+con ident = K ==> fn t :: K => t
+
+(* Type-level function which yields the value-level record
+   described by the given type-level record *)
+con record = fn t :: {Type} => $t
+
+con fst = K1 ==> K2 ==> fn t :: (K1 * K2) => t.1
+con snd = K1 ==> K2 ==> fn t :: (K1 * K2) => t.2
+con fst3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.1
+con snd3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.2
+con thd3 = K1 ==> K2 ==> K3 ==> fn t :: (K1 * K2 * K3) => t.3
+
+(* Convert a record of n Units into a type-level record where
+   each field has the same value (which describes a uniformly
+   typed record) *)
+con mapU = K ==> fn f :: K => map (fn _ :: Unit => f)
+
+(* Existential type former *)
+con ex :: K --> (K -> Type) -> Type
+
+(* Introduction of existential type *)
+val ex_intro : K --> tf :: (K -> Type) -> choice :: K -> tf choice -> ex tf
+
+(* Eliminator for existential type *)
+val ex_elim : K --> tf ::: (K -> Type) -> ex tf -> res ::: Type -> (choice :: K -> tf choice -> res) -> res
+
+(* Composition of ordinary (value-level) functions *)
+val compose : t1 ::: Type -> t2 ::: Type -> t3 ::: Type
+              -> (t2 -> t3) -> (t1 -> t2) -> (t1 -> t3)
+
+val show_option : t ::: Type -> show t -> show (option t)
+val read_option : t ::: Type -> read t -> read (option t)
+
+val txt : t ::: Type -> ctx ::: {Unit} -> use ::: {Type} -> show t -> t
+          -> xml ctx use []
+
+(* Given a polymorphic type (tf) and a means of constructing
+   "default" values of tf applied to arbitrary arguments,
+   constructs records consisting of those "default" values *)
+val map0 : K --> tf :: (K -> Type)
+           -> (t :: K -> tf t)
+           -> r ::: {K} -> folder r -> $(map tf r)
+
+(* Given two polymorphic types (tf1 and tf2) and a means of
+   converting from tf1 t to tf2 t for arbitrary t,
+   converts records of tf1's to records of tf2's *)
+val mp : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+         -> (t ::: K -> tf1 t -> tf2 t)
+         -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r)
+
+(* Two-argument conversion form of mp *)
+val map2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf :: (K -> Type)
+           -> (t ::: K -> tf1 t -> tf2 t -> tf t)
+           -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf r)
+
+(* Three-argument conversion form of mp *)
+val map3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) -> tf :: (K -> Type)
+           -> (t ::: K -> tf1 t -> tf2 t -> tf3 t -> tf t)
+           -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> $(map tf r)
+
+(* Fold along a uniformly (homogenously) typed record *)
+val foldUR : tf :: Type -> tr :: ({Unit} -> Type)
+             -> (nm :: Name -> rest :: {Unit}
+                 -> [[nm] ~ rest] =>
+                       tf -> tr rest -> tr ([nm] ++ rest))
+             -> tr [] -> r ::: {Unit} -> folder r -> $(mapU tf r) -> tr r
+
+(* Fold (generalized safe zip) along two equal-length uniformly-typed records *)
+val foldUR2 : tf1 :: Type -> tf2 :: Type -> tr :: ({Unit} -> Type)
+             -> (nm :: Name -> rest :: {Unit}
+                 -> [[nm] ~ rest] =>
+                       tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
+             -> tr [] -> r ::: {Unit} -> folder r -> $(mapU tf1 r) -> $(mapU tf2 r) -> tr r
+
+(* Fold along a heterogenously-typed record *)
+val foldR : K --> tf :: (K -> Type) -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf t -> tr rest -> tr ([nm = t] ++ rest))
+             -> tr [] -> r ::: {K} -> folder r -> $(map tf r) -> tr r
+
+(* Fold (generalized safe zip) along two heterogenously-typed records *)
+val foldR2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest))
+             -> tr []
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> tr r
+
+(* Fold (generalized safe zip) along three heterogenously-typed records *)
+val foldR3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
+             -> tr :: ({K} -> Type)
+             -> (nm :: Name -> t :: K -> rest :: {K}
+                 -> [[nm] ~ rest] =>
+                       tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
+             -> tr []
+             -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r
+
+(* Generate some XML by mapping over a uniformly-typed record *)
+val mapUX : tf :: Type -> ctx :: {Unit}
+            -> (nm :: Name -> rest :: {Unit} -> [[nm] ~ rest] =>
+                tf -> xml ctx [] [])
+            -> r ::: {Unit} -> folder r -> $(mapU tf r) -> xml ctx [] []
+val mapUX_rev : tf :: Type -> ctx :: {Unit}
+                -> (nm :: Name -> rest :: {Unit} -> [[nm] ~ rest] =>
+                    tf -> xml ctx [] [])
+                -> r ::: {Unit} -> folder r -> $(mapU tf r) -> xml ctx [] []
+
+(* Generate some XML by mapping over a heterogenously-typed record *)
+val mapX : K --> tf :: (K -> Type) -> ctx :: {Unit}
+           -> (nm :: Name -> t :: K -> rest :: {K}
+               -> [[nm] ~ rest] =>
+               tf t -> xml ctx [] [])
+           -> r ::: {K} -> folder r -> $(map tf r) -> xml ctx [] []
+
+val mapUX2 : tf1 :: Type -> tf2 :: Type -> ctx :: {Unit}
+            -> (nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+                tf1 -> tf2 -> xml ctx [] [])
+            -> r ::: {Unit} -> folder r
+            -> $(mapU tf1 r) -> $(mapU tf2 r) -> xml ctx [] []
+
+val mapX2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> ctx :: {Unit}
+            -> (nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+                tf1 t -> tf2 t -> xml ctx [] [])
+            -> r ::: {K} -> folder r
+            -> $(map tf1 r) -> $(map tf2 r) -> xml ctx [] []
+
+val mapX3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) -> ctx :: {Unit}
+            -> (nm :: Name -> t :: K -> rest :: {K}
+                -> [[nm] ~ rest] =>
+                tf1 t -> tf2 t -> tf3 t -> xml ctx [] [])
+            -> r ::: {K} -> folder r
+            -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> xml ctx [] []
+
+(* Note that the next two functions return elements in the _reverse_ of the natural order!
+ * Such a choice interacts well with the time complexity of standard list operations.
+ * It's easy to regain the natural order by inverting a query's 'ORDER BY' condition. *)
+
+val queryL : tables ::: {{Type}} -> exps ::: {Type}
+             -> [tables ~ exps] =>
+                  sql_query [] [] tables exps
+                  -> transaction (list $(exps ++ map (fn fields :: {Type} => $fields) tables))
+
+val queryL1 : t ::: Name -> fs ::: {Type}
+              -> sql_query [] [] [t = fs] []
+              -> transaction (list $fs)
+
+val query1 : t ::: Name -> fs ::: {Type} -> state ::: Type
+             -> sql_query [] [] [t = fs] []
+             -> ($fs -> state -> transaction state)
+             -> state
+             -> transaction state
+
+val query1' : t ::: Name -> fs ::: {Type} -> state ::: Type
+              -> sql_query [] [] [t = fs] []
+              -> ($fs -> state -> state)
+              -> state
+              -> transaction state
+
+val queryI : tables ::: {{Type}} -> exps ::: {Type}
+             -> [tables ~ exps] =>
+             sql_query [] [] tables exps
+             -> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
+                 -> transaction unit)
+             -> transaction unit
+
+val queryI1 : nm ::: Name -> fs ::: {Type}
+              -> sql_query [] [] [nm = fs] []
+              -> ($fs -> transaction unit)
+              -> transaction unit
+
+val queryX : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+             -> [tables ~ exps] =>
+             sql_query [] [] tables exps
+             -> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
+                 -> xml ctx inp [])
+             -> transaction (xml ctx inp [])
+
+val queryXI : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> (int -> $(exps ++ map (fn fields :: {Type} => $fields) tables)
+        -> xml ctx inp [])
+    -> transaction (xml ctx inp [])
+
+val queryX1 : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> sql_query [] [] [nm = fs] []
+              -> ($fs -> xml ctx inp [])
+              -> transaction (xml ctx inp [])
+
+val queryX1I : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+               -> sql_query [] [] [nm = fs] []
+               -> (int -> $fs -> xml ctx inp [])
+               -> transaction (xml ctx inp [])
+
+val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> [tables ~ exps] =>
+              sql_query [] [] tables exps
+              -> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
+                  -> transaction (xml ctx inp []))
+              -> transaction (xml ctx inp [])
+val queryX1' : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> sql_query [] [] [nm = fs] []
+              -> ($fs -> transaction (xml ctx inp []))
+              -> transaction (xml ctx inp [])
+val queryXE' : exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+              -> sql_query [] [] [] exps
+              -> ($exps -> transaction (xml ctx inp []))
+              -> transaction (xml ctx inp [])
+
+val hasRows : tables ::: {{Type}} -> exps ::: {Type}
+              -> [tables ~ exps] =>
+    sql_query [] [] tables exps
+    -> transaction bool
+
+val oneOrNoRows : tables ::: {{Type}} -> exps ::: {Type}
+                  -> [tables ~ exps] =>
+                  sql_query [] [] tables exps
+                  -> transaction
+                         (option
+                              $(exps
+                                    ++ map (fn fields :: {Type} => $fields) tables))
+
+val oneOrNoRows1 : nm ::: Name -> fs ::: {Type}
+                   -> sql_query [] [] [nm = fs] []
+                   -> transaction (option $fs)
+
+val oneOrNoRowsE1 : tabs ::: {Unit} -> nm ::: Name -> t ::: Type
+                    -> [tabs ~ [nm]] =>
+    sql_query [] [] (mapU [] tabs) [nm = t]
+    -> transaction (option t)
+
+val oneRow : tables ::: {{Type}} -> exps ::: {Type}
+             -> [tables ~ exps] =>
+             sql_query [] [] tables exps
+             -> transaction
+                    $(exps
+                          ++ map (fn fields :: {Type} => $fields) tables)
+
+val oneRow1 : nm ::: Name -> fs ::: {Type}
+    -> sql_query [] [] [nm = fs] []
+    -> transaction $fs
+
+val oneRowE1 : tabs ::: {Unit} -> nm ::: Name -> t ::: Type
+               -> [tabs ~ [nm]] =>
+    sql_query [] [] (mapU [] tabs) [nm = t]
+    -> transaction t
+
+val nonempty : fs ::: {Type} -> us ::: {{Unit}} -> sql_table fs us
+               -> transaction bool
+
+val eqNullable : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                 -> t ::: Type -> sql_injectable (option t)
+                 -> sql_exp tables agg exps (option t)
+                 -> sql_exp tables agg exps (option t)
+                 -> sql_exp tables agg exps bool
+
+val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+                  -> t ::: Type -> sql_injectable (option t)
+                  -> sql_exp tables agg exps (option t)
+                  -> option t
+                  -> sql_exp tables agg exps bool
+
+val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
+
+val postFields : postBody -> list (string * string)
+
+val max : t ::: Type -> ord t -> t -> t -> t
+val min : t ::: Type -> ord t -> t -> t -> t
+
+val assert : t ::: Type
+             -> bool   (* Did we avoid something bad? *)
+             -> string (* Explanation of the bad thing *)
+             -> string (* Source location of the bad thing *)
+             -> t      (* Return this value if all went well. *)
+             -> t
diff --git a/m4/ax_check_openssl.m4 b/m4/ax_check_openssl.m4
new file mode 100644
index 0000000..065fff8
--- /dev/null
+++ b/m4/ax_check_openssl.m4
@@ -0,0 +1,123 @@
+# ===========================================================================
+#     http://www.gnu.org/software/autoconf-archive/ax_check_openssl.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_CHECK_OPENSSL([action-if-found[, action-if-not-found]])
+#
+# DESCRIPTION
+#
+#   Look for OpenSSL in a number of default spots, or in a user-selected
+#   spot (via --with-openssl).  Sets
+#
+#     OPENSSL_INCLUDES to the include directives required
+#     OPENSSL_LIBS to the -l directives required
+#     OPENSSL_LDFLAGS to the -L or -R flags required
+#
+#   and calls ACTION-IF-FOUND or ACTION-IF-NOT-FOUND appropriately
+#
+#   This macro sets OPENSSL_INCLUDES such that source files should use the
+#   openssl/ directory in include directives:
+#
+#     #include <openssl/hmac.h>
+#
+# LICENSE
+#
+#   Copyright (c) 2009,2010 Zmanda Inc. <http://www.zmanda.com/>
+#   Copyright (c) 2009,2010 Dustin J. Mitchell <dustin@zmanda.com>
+#
+#   Copying and distribution of this file, with or without modification, are
+#   permitted in any medium without royalty provided the copyright notice
+#   and this notice are preserved. This file is offered as-is, without any
+#   warranty.
+
+#serial 7
+
+AU_ALIAS([CHECK_SSL], [AX_CHECK_OPENSSL])
+AC_DEFUN([AX_CHECK_OPENSSL], [
+    found=false
+    AC_ARG_WITH(openssl,
+        AS_HELP_STRING([--with-openssl=DIR],
+            [root of the OpenSSL directory]),
+        [
+            case "$withval" in
+            "" | y | ye | yes | n | no)
+            AC_MSG_ERROR([Invalid --with-openssl value])
+              ;;
+            *) ssldirs="$withval"
+              ;;
+            esac
+        ], [
+            # if pkg-config is installed and openssl has installed a .pc file,
+            # then use that information and don't search ssldirs
+            AC_PATH_PROG(PKG_CONFIG, pkg-config)
+            if test x"$PKG_CONFIG" != x""; then
+                OPENSSL_LDFLAGS=`$PKG_CONFIG openssl --libs-only-L 2>/dev/null`
+                if test $? = 0; then
+                    OPENSSL_LIBS=`$PKG_CONFIG openssl --libs-only-l 2>/dev/null`
+                    OPENSSL_INCLUDES=`$PKG_CONFIG openssl --cflags-only-I 2>/dev/null`
+                    found=true
+                fi
+            fi
+
+            # no such luck; use some default ssldirs
+            if ! $found; then
+                ssldirs="/usr/local/ssl /usr/lib/ssl /usr/ssl /usr/pkg /usr/local /usr"
+            fi
+        ]
+        )
+
+
+    # note that we #include <openssl/foo.h>, so the OpenSSL headers have to be in
+    # an 'openssl' subdirectory
+
+    if ! $found; then
+        OPENSSL_INCLUDES=
+        for ssldir in $ssldirs; do
+            AC_MSG_CHECKING([for openssl/ssl.h in $ssldir])
+            if test -f "$ssldir/include/openssl/ssl.h"; then
+                OPENSSL_INCLUDES="-I$ssldir/include"
+                OPENSSL_LDFLAGS="-L$ssldir/lib"
+                OPENSSL_LIBS="-lssl -lcrypto"
+                found=true
+                AC_MSG_RESULT([yes])
+                break
+            else
+                AC_MSG_RESULT([no])
+            fi
+        done
+
+        # if the file wasn't found, well, go ahead and try the link anyway -- maybe
+        # it will just work!
+    fi
+
+    # try the preprocessor and linker with our new flags,
+    # being careful not to pollute the global LIBS, LDFLAGS, and CPPFLAGS
+
+    AC_MSG_CHECKING([whether compiling and linking against OpenSSL works])
+    echo "Trying link with OPENSSL_LDFLAGS=$OPENSSL_LDFLAGS;" \
+        "OPENSSL_LIBS=$OPENSSL_LIBS; OPENSSL_INCLUDES=$OPENSSL_INCLUDES" >&AS_MESSAGE_LOG_FD
+
+    save_LIBS="$LIBS"
+    save_LDFLAGS="$LDFLAGS"
+    save_CPPFLAGS="$CPPFLAGS"
+    LDFLAGS="$LDFLAGS $OPENSSL_LDFLAGS"
+    LIBS="$OPENSSL_LIBS $LIBS"
+    CPPFLAGS="$OPENSSL_INCLUDES $CPPFLAGS"
+    AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <openssl/ssl.h>], [SSL_new(NULL)])],
+        [
+            AC_MSG_RESULT([yes])
+            $1
+        ], [
+            AC_MSG_RESULT([no])
+            $2
+        ])
+    CPPFLAGS="$save_CPPFLAGS"
+    LDFLAGS="$save_LDFLAGS"
+    LIBS="$save_LIBS"
+
+    AC_SUBST([OPENSSL_INCLUDES])
+    AC_SUBST([OPENSSL_LIBS])
+    AC_SUBST([OPENSSL_LDFLAGS])
+])
diff --git a/m4/ax_tls.m4 b/m4/ax_tls.m4
new file mode 100644
index 0000000..809b761
--- /dev/null
+++ b/m4/ax_tls.m4
@@ -0,0 +1,74 @@
+# ===========================================================================
+#          http://www.gnu.org/software/autoconf-archive/ax_tls.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_TLS([action-if-found], [action-if-not-found])
+#
+# DESCRIPTION
+#
+#   Provides a test for the compiler support of thread local storage (TLS)
+#   extensions. Defines TLS if it is found. Currently knows about GCC/ICC
+#   and MSVC. I think SunPro uses the same as GCC, and Borland apparently
+#   supports either.
+#
+# LICENSE
+#
+#   Copyright (c) 2008 Alan Woodland <ajw05@aber.ac.uk>
+#   Copyright (c) 2010 Diego Elio Petteno` <flameeyes@gmail.com>
+#
+#   This program is free software: you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation, either version 3 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 11
+
+AC_DEFUN([AX_TLS], [
+  AC_MSG_CHECKING([for thread local storage (TLS) class])
+  AC_CACHE_VAL([ac_cv_tls],
+   [for ax_tls_keyword in __thread '__declspec(thread)' none; do
+       AS_CASE([$ax_tls_keyword],
+          [none], [ac_cv_tls=none ; break],
+          [AC_TRY_COMPILE(
+              [#include <stdlib.h>
+               static void
+               foo(void) {
+               static ] $ax_tls_keyword [ int bar;
+               exit(1);
+               }],
+               [],
+               [ac_cv_tls=$ax_tls_keyword ; break],
+               ac_cv_tls=none
+           )])
+    done
+  ])
+  AC_MSG_RESULT([$ac_cv_tls])
+
+  AS_IF([test "$ac_cv_tls" != "none"],
+    [AC_DEFINE_UNQUOTED([TLS],[$ac_cv_tls],[If the compiler supports a TLS storage class define it to that here])
+     m4_ifnblank([$1],[$1])],
+    [m4_ifnblank([$2],[$2])])
+])
diff --git a/m4/m4_ax_pthread.m4 b/m4/m4_ax_pthread.m4
new file mode 100644
index 0000000..0b2718f
--- /dev/null
+++ b/m4/m4_ax_pthread.m4
@@ -0,0 +1,328 @@
+# ===========================================================================
+#        http://www.gnu.org/software/autoconf-archive/ax_pthread.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+#   AX_PTHREAD([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+#
+# DESCRIPTION
+#
+#   This macro figures out how to build C programs using POSIX threads. It
+#   sets the PTHREAD_LIBS output variable to the threads library and linker
+#   flags, and the PTHREAD_CFLAGS output variable to any special C compiler
+#   flags that are needed. (The user can also force certain compiler
+#   flags/libs to be tested by setting these environment variables.)
+#
+#   Also sets PTHREAD_CC to any special C compiler that is needed for
+#   multi-threaded programs (defaults to the value of CC otherwise). (This
+#   is necessary on AIX to use the special cc_r compiler alias.)
+#
+#   NOTE: You are assumed to not only compile your program with these flags,
+#   but also link it with them as well. e.g. you should link with
+#   $PTHREAD_CC $CFLAGS $PTHREAD_CFLAGS $LDFLAGS ... $PTHREAD_LIBS $LIBS
+#
+#   If you are only building threads programs, you may wish to use these
+#   variables in your default LIBS, CFLAGS, and CC:
+#
+#     LIBS="$PTHREAD_LIBS $LIBS"
+#     CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+#     CC="$PTHREAD_CC"
+#
+#   In addition, if the PTHREAD_CREATE_JOINABLE thread-attribute constant
+#   has a nonstandard name, defines PTHREAD_CREATE_JOINABLE to that name
+#   (e.g. PTHREAD_CREATE_UNDETACHED on AIX).
+#
+#   Also HAVE_PTHREAD_PRIO_INHERIT is defined if pthread is found and the
+#   PTHREAD_PRIO_INHERIT symbol is defined when compiling with
+#   PTHREAD_CFLAGS.
+#
+#   ACTION-IF-FOUND is a list of shell commands to run if a threads library
+#   is found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it
+#   is not found. If ACTION-IF-FOUND is not specified, the default action
+#   will define HAVE_PTHREAD.
+#
+#   Please let the authors know if this macro fails on any platform, or if
+#   you have any other suggestions or comments. This macro was based on work
+#   by SGJ on autoconf scripts for FFTW (http://www.fftw.org/) (with help
+#   from M. Frigo), as well as ac_pthread and hb_pthread macros posted by
+#   Alejandro Forero Cuervo to the autoconf macro repository. We are also
+#   grateful for the helpful feedback of numerous users.
+#
+#   Updated for Autoconf 2.68 by Daniel Richard G.
+#
+# LICENSE
+#
+#   Copyright (c) 2008 Steven G. Johnson <stevenj@alum.mit.edu>
+#   Copyright (c) 2011 Daniel Richard G. <skunk@iSKUNK.ORG>
+#
+#   This program is free software: you can redistribute it and/or modify it
+#   under the terms of the GNU General Public License as published by the
+#   Free Software Foundation, either version 3 of the License, or (at your
+#   option) any later version.
+#
+#   This program is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+#   Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License along
+#   with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+#   As a special exception, the respective Autoconf Macro's copyright owner
+#   gives unlimited permission to copy, distribute and modify the configure
+#   scripts that are the output of Autoconf when processing the Macro. You
+#   need not follow the terms of the GNU General Public License when using
+#   or distributing such scripts, even though portions of the text of the
+#   Macro appear in them. The GNU General Public License (GPL) does govern
+#   all other use of the material that constitutes the Autoconf Macro.
+#
+#   This special exception to the GPL applies to versions of the Autoconf
+#   Macro released by the Autoconf Archive. When you make and distribute a
+#   modified version of the Autoconf Macro, you may extend this special
+#   exception to the GPL to apply to your modified version as well.
+
+#serial 21
+
+AU_ALIAS([ACX_PTHREAD], [AX_PTHREAD])
+AC_DEFUN([AX_PTHREAD], [
+AC_REQUIRE([AC_CANONICAL_HOST])
+AC_LANG_PUSH([C])
+ax_pthread_ok=no
+
+# We used to check for pthread.h first, but this fails if pthread.h
+# requires special compiler flags (e.g. on True64 or Sequent).
+# It gets checked for in the link test anyway.
+
+# First of all, check if the user has set any of the PTHREAD_LIBS,
+# etcetera environment variables, and if threads linking works using
+# them:
+if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then
+        save_CFLAGS="$CFLAGS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        save_LIBS="$LIBS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        AC_MSG_CHECKING([for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS])
+        AC_TRY_LINK_FUNC([pthread_join], [ax_pthread_ok=yes])
+        AC_MSG_RESULT([$ax_pthread_ok])
+        if test x"$ax_pthread_ok" = xno; then
+                PTHREAD_LIBS=""
+                PTHREAD_CFLAGS=""
+        fi
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+fi
+
+# We must check for the threads library under a number of different
+# names; the ordering is very important because some systems
+# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
+# libraries is broken (non-POSIX).
+
+# Create a list of thread flags to try.  Items starting with a "-" are
+# C compiler flags, and other items are library names, except for "none"
+# which indicates that we try without any flags at all, and "pthread-config"
+# which is a program returning the flags for the Pth emulation library.
+
+ax_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
+
+# The ordering *is* (sometimes) important.  Some notes on the
+# individual items follow:
+
+# pthreads: AIX (must check this before -lpthread)
+# none: in case threads are in libc; should be tried before -Kthread and
+#       other compiler flags to prevent continual compiler warnings
+# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h)
+# -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able)
+# lthread: LinuxThreads port on FreeBSD (also preferred to -pthread)
+# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads)
+# -pthreads: Solaris/gcc
+# -mthreads: Mingw32/gcc, Lynx/gcc
+# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it
+#      doesn't hurt to check since this sometimes defines pthreads too;
+#      also defines -D_REENTRANT)
+#      ... -mt is also the pthreads flag for HP/aCC
+# pthread: Linux, etcetera
+# --thread-safe: KAI C++
+# pthread-config: use pthread-config program (for GNU Pth library)
+
+case ${host_os} in
+        solaris*)
+
+        # On Solaris (at least, for some versions), libc contains stubbed
+        # (non-functional) versions of the pthreads routines, so link-based
+        # tests will erroneously succeed.  (We need to link with -pthreads/-mt/
+        # -lpthread.)  (The stubs are missing pthread_cleanup_push, or rather
+        # a function called by this macro, so we could check for that, but
+        # who knows whether they'll stub that too in a future libc.)  So,
+        # we'll just look for -pthreads and -lpthread first:
+
+        ax_pthread_flags="-pthreads pthread -mt -pthread $ax_pthread_flags"
+        ;;
+esac
+
+# Clang doesn't consider unrecognized options an error unless we specify
+# -Werror. We throw in some extra Clang-specific options to ensure that
+# this doesn't happen for GCC, which also accepts -Werror.
+
+AC_MSG_CHECKING([if compiler needs -Werror to reject unknown flags])
+save_CFLAGS="$CFLAGS"
+ax_pthread_extra_flags="-Werror"
+CFLAGS="$CFLAGS $ax_pthread_extra_flags -Wunknown-warning-option -Wsizeof-array-argument"
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM([int foo(void);],[foo()])],
+                  [AC_MSG_RESULT([yes])],
+                  [ax_pthread_extra_flags=
+                   AC_MSG_RESULT([no])])
+CFLAGS="$save_CFLAGS"
+
+if test x"$ax_pthread_ok" = xno; then
+for flag in $ax_pthread_flags; do
+
+        case $flag in
+                none)
+                AC_MSG_CHECKING([whether pthreads work without any flags])
+                ;;
+
+                -*)
+                AC_MSG_CHECKING([whether pthreads work with $flag])
+                PTHREAD_CFLAGS="$flag"
+                ;;
+
+                pthread-config)
+                AC_CHECK_PROG([ax_pthread_config], [pthread-config], [yes], [no])
+                if test x"$ax_pthread_config" = xno; then continue; fi
+                PTHREAD_CFLAGS="`pthread-config --cflags`"
+                PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
+                ;;
+
+                *)
+                AC_MSG_CHECKING([for the pthreads library -l$flag])
+                PTHREAD_LIBS="-l$flag"
+                ;;
+        esac
+
+        save_LIBS="$LIBS"
+        save_CFLAGS="$CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS $ax_pthread_extra_flags"
+
+        # Check for various functions.  We must include pthread.h,
+        # since some functions may be macros.  (On the Sequent, we
+        # need a special flag -Kthread to make this header compile.)
+        # We check for pthread_join because it is in -lpthread on IRIX
+        # while pthread_create is in libc.  We check for pthread_attr_init
+        # due to DEC craziness with -lpthreads.  We check for
+        # pthread_cleanup_push because it is one of the few pthread
+        # functions on Solaris that doesn't have a non-functional libc stub.
+        # We try pthread_create on general principles.
+        AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <pthread.h>
+                        static void routine(void *a) { a = 0; }
+                        static void *start_routine(void *a) { return a; }],
+                       [pthread_t th; pthread_attr_t attr;
+                        pthread_create(&th, 0, start_routine, 0);
+                        pthread_join(th, 0);
+                        pthread_attr_init(&attr);
+                        pthread_cleanup_push(routine, 0);
+                        pthread_cleanup_pop(0) /* ; */])],
+                [ax_pthread_ok=yes],
+                [])
+
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+
+        AC_MSG_RESULT([$ax_pthread_ok])
+        if test "x$ax_pthread_ok" = xyes; then
+                break;
+        fi
+
+        PTHREAD_LIBS=""
+        PTHREAD_CFLAGS=""
+done
+fi
+
+# Various other checks:
+if test "x$ax_pthread_ok" = xyes; then
+        save_LIBS="$LIBS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        save_CFLAGS="$CFLAGS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+
+        # Detect AIX lossage: JOINABLE attribute is called UNDETACHED.
+        AC_MSG_CHECKING([for joinable pthread attribute])
+        attr_name=unknown
+        for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do
+            AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <pthread.h>],
+                           [int attr = $attr; return attr /* ; */])],
+                [attr_name=$attr; break],
+                [])
+        done
+        AC_MSG_RESULT([$attr_name])
+        if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then
+            AC_DEFINE_UNQUOTED([PTHREAD_CREATE_JOINABLE], [$attr_name],
+                               [Define to necessary symbol if this constant
+                                uses a non-standard name on your system.])
+        fi
+
+        AC_MSG_CHECKING([if more special flags are required for pthreads])
+        flag=no
+        case ${host_os} in
+            aix* | freebsd* | darwin*) flag="-D_THREAD_SAFE";;
+            osf* | hpux*) flag="-D_REENTRANT";;
+            solaris*)
+            if test "$GCC" = "yes"; then
+                flag="-D_REENTRANT"
+            else
+                # TODO: What about Clang on Solaris?
+                flag="-mt -D_REENTRANT"
+            fi
+            ;;
+        esac
+        AC_MSG_RESULT([$flag])
+        if test "x$flag" != xno; then
+            PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS"
+        fi
+
+        AC_CACHE_CHECK([for PTHREAD_PRIO_INHERIT],
+            [ax_cv_PTHREAD_PRIO_INHERIT], [
+                AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <pthread.h>]],
+                                                [[int i = PTHREAD_PRIO_INHERIT;]])],
+                    [ax_cv_PTHREAD_PRIO_INHERIT=yes],
+                    [ax_cv_PTHREAD_PRIO_INHERIT=no])
+            ])
+        AS_IF([test "x$ax_cv_PTHREAD_PRIO_INHERIT" = "xyes"],
+            [AC_DEFINE([HAVE_PTHREAD_PRIO_INHERIT], [1], [Have PTHREAD_PRIO_INHERIT.])])
+
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+
+        # More AIX lossage: compile with *_r variant
+        if test "x$GCC" != xyes; then
+            case $host_os in
+                aix*)
+                AS_CASE(["x/$CC"],
+                  [x*/c89|x*/c89_128|x*/c99|x*/c99_128|x*/cc|x*/cc128|x*/xlc|x*/xlc_v6|x*/xlc128|x*/xlc128_v6],
+                  [#handle absolute path differently from PATH based program lookup
+                   AS_CASE(["x$CC"],
+                     [x/*],
+                     [AS_IF([AS_EXECUTABLE_P([${CC}_r])],[PTHREAD_CC="${CC}_r"])],
+                     [AC_CHECK_PROGS([PTHREAD_CC],[${CC}_r],[$CC])])])
+                ;;
+            esac
+        fi
+fi
+
+test -n "$PTHREAD_CC" || PTHREAD_CC="$CC"
+
+AC_SUBST([PTHREAD_LIBS])
+AC_SUBST([PTHREAD_CFLAGS])
+AC_SUBST([PTHREAD_CC])
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x"$ax_pthread_ok" = xyes; then
+        ifelse([$1],,[AC_DEFINE([HAVE_PTHREAD],[1],[Define if you have POSIX threads libraries and header files.])],[$1])
+        :
+else
+        ax_pthread_ok=no
+        $2
+fi
+AC_LANG_POP
+])dnl AX_PTHREAD
diff --git a/src/c/Makefile.am b/src/c/Makefile.am
new file mode 100644
index 0000000..f4d9bef
--- /dev/null
+++ b/src/c/Makefile.am
@@ -0,0 +1,21 @@
+lib_LTLIBRARIES = liburweb.la liburweb_http.la liburweb_cgi.la liburweb_fastcgi.la liburweb_static.la
+
+liburweb_la_SOURCES = memmem.c openssl.c urweb.c request.c queue.c
+liburweb_http_la_SOURCES = http.c
+liburweb_cgi_la_SOURCES = cgi.c
+liburweb_fastcgi_la_SOURCES = fastcgi.c fastcgi.h
+liburweb_static_la_SOURCES = static.c
+
+AM_CPPFLAGS = -I$(srcdir)/../../include/urweb $(OPENSSL_INCLUDES)
+AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS)
+liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS) \
+	-export-symbols-regex '^(client_pruner|pthread_create_big|strcmp_nullsafe|uw_.*)'
+liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS)
+liburweb_http_la_LIBADD = liburweb.la
+liburweb_http_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
+liburweb_cgi_la_LIBADD = liburweb.la
+liburweb_cgi_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
+liburweb_fastcgi_la_LIBADD = liburweb.la
+liburweb_fastcgi_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
+liburweb_static_la_LIBADD = liburweb.la
+liburweb_static_la_LDFLAGS = -export-symbols-regex '^(main|uw_.*)'
diff --git a/src/c/cgi.c b/src/c/cgi.c
new file mode 100644
index 0000000..d060532
--- /dev/null
+++ b/src/c/cgi.c
@@ -0,0 +1,149 @@
+#include "config.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <stdarg.h>
+
+#include "urweb.h"
+#include "request.h"
+
+extern uw_app uw_application;
+
+static char *uppercased;
+static size_t uppercased_len;
+
+static char *get_header(void *data, const char *h) {
+  size_t len = strlen(h);
+  char *s, *r;
+  const char *saved_h = h;
+
+  if (len > uppercased_len) {
+    uppercased_len = len;
+    uppercased = realloc(uppercased, len + 6);
+  }
+
+  strcpy(uppercased, "HTTP_");
+  for (s = uppercased+5; *h; ++h)
+    *s++ = *h == '-' ? '_' : toupper((int)*h);
+  *s = 0;
+
+  if ((r = getenv(uppercased)))
+    return r;
+  else if (!strcasecmp(saved_h, "Content-length")
+           || !strcasecmp(saved_h, "Content-type"))
+    return getenv(uppercased + 5);
+  else
+    return NULL;
+}
+
+static char *get_env(void *data, const char *name) {
+  return getenv(name);
+}
+
+static void on_success(uw_context ctx) { }
+
+static void on_failure(uw_context ctx) {
+  uw_write_header(ctx, "Status: 500 Internal Server Error\r\n");
+}
+
+static void log_error(void *data, const char *fmt, ...) {
+  va_list ap;
+  va_start(ap, fmt);
+
+  vfprintf(stderr, fmt, ap);
+}
+
+static void log_debug(void *data, const char *fmt, ...) {
+}
+
+static uw_loggers ls = {NULL, log_error, log_debug};
+
+int main(int argc, char *argv[]) {
+  uw_context ctx = uw_request_new_context(0, &uw_application, &ls);
+  uw_request_context rc = uw_new_request_context();
+  request_result rr;
+  char *method = getenv("REQUEST_METHOD"),
+    *path = getenv("SCRIPT_NAME"), *path_info = getenv("PATH_INFO"),
+    *query_string = getenv("QUERY_STRING");
+  char *body = malloc(1);
+  ssize_t body_len = 1, body_pos = 0, res;
+
+  uppercased = malloc(6);
+
+  if (!method) {
+    log_error(NULL, "REQUEST_METHOD not set\n");
+    exit(1);
+  }
+
+  if (!path) {
+    log_error(NULL, "SCRIPT_NAME not set\n");
+    exit(1);
+  }
+
+  if (path_info) {
+    char *new_path = malloc(strlen(path) + strlen(path_info) + 1);
+    sprintf(new_path, "%s%s", path, path_info);
+    path = new_path;
+  }
+
+  if (!query_string)
+    query_string = "";
+
+  while ((res = read(0, body + body_pos, body_len - body_pos)) > 0) {
+    body_pos += res;
+
+    if (body_pos == body_len) {
+      body_len *= 2;
+      body = realloc(body, body_len);
+    }
+  }
+
+  if (res < 0) {
+    log_error(NULL, "Error reading stdin\n");
+    exit(1);
+  }
+
+  uw_set_on_success("");
+  uw_set_headers(ctx, get_header, NULL);
+  uw_set_env(ctx, get_env, NULL);
+  uw_request_init(&uw_application, &ls);
+
+  body[body_pos] = 0;
+  rr = uw_request(rc, ctx, method, path, query_string, body, body_pos,
+                  on_success, on_failure,
+                  NULL, log_error, log_debug,
+                  -1, NULL, NULL);
+  uw_print(ctx, 1);
+
+  if (rr == SERVED)
+    return 0;
+  else
+    return 1;
+}
+
+void *uw_init_client_data() {
+  return NULL;
+}
+
+void uw_free_client_data(void *data) {
+}
+
+void uw_copy_client_data(void *dst, void *src) {
+}
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+  uw_ensure_transaction(ctx);
+  uw_get_app(ctx)->expunger(ctx, cli);
+
+  if (uw_commit(ctx))
+    uw_error(ctx, UNLIMITED_RETRY, "Rerunning expunge transaction");
+}
+
+void uw_post_expunge(uw_context ctx, void *data) {
+}
+
+int uw_supports_direct_status = 0;
diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c
new file mode 100644
index 0000000..c37debf
--- /dev/null
+++ b/src/c/fastcgi.c
@@ -0,0 +1,693 @@
+#include "config.h"
+
+#include <assert.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <unistd.h>
+#include <signal.h>
+#include <stdarg.h>
+#include <ctype.h>
+
+#include <pthread.h>
+
+#include "urweb.h"
+#include "request.h"
+#include "queue.h"
+
+#include "fastcgi.h"
+
+#define THREAD_LOCAL __thread
+
+extern uw_app uw_application;
+
+typedef struct {
+  unsigned char version;
+  unsigned char type;
+  unsigned char requestIdB1;
+  unsigned char requestIdB0;
+  unsigned char contentLengthB1;
+  unsigned char contentLengthB0;
+  unsigned char paddingLength;
+  unsigned char reserved;
+  unsigned char contentData[65535];
+} FCGI_Record;
+
+typedef struct {
+  FCGI_Record r;
+  int sock;
+} FCGI_Output;
+
+typedef struct {
+  FCGI_Record r;
+  int available, used, sock;
+} FCGI_Input;
+
+// The FastCGI request ID corresponding to the request being handled by the
+// current worker thread.  (Each worker thread can only handle one request at a
+// time.)
+static THREAD_LOCAL int current_request_id;
+
+// Reads the FastCGI request ID from a FastCGI record.  The result is guaranteed
+// to be in the range [0, 2^16); this function returns an int to avoid C type
+// promotion insanity.
+static int fastcgi_request_id(const FCGI_Record* const r) {
+  const int requestid = r->requestIdB1 << 8 | r->requestIdB0;
+  assert(requestid >= 0);
+  assert(requestid <= UINT16_MAX);
+  return requestid;
+}
+
+static FCGI_Output *fastcgi_output() {
+  FCGI_Output *o = malloc(sizeof(FCGI_Output));
+
+  o->r.version = FCGI_VERSION_1;
+  o->r.paddingLength = 0;
+  o->r.reserved = 0;
+
+  return o;
+}
+
+static FCGI_Input *fastcgi_input() {
+  FCGI_Input *i = malloc(sizeof(FCGI_Input));
+
+  i->available = i->used = 0;
+
+  return i;
+}
+
+static void fastcgi_input_reset(FCGI_Input *i) {
+  i->available = i->used = 0;
+}
+
+static int fastcgi_send(FCGI_Output *o,
+                        unsigned char type,
+                        unsigned short contentLength) {
+  o->r.type = type;
+  assert(current_request_id <= UINT16_MAX);
+  o->r.requestIdB1 = current_request_id >> 8;
+  o->r.requestIdB0 = current_request_id & 0x000000ff;
+  o->r.contentLengthB1 = contentLength >> 8;
+  o->r.contentLengthB0 = contentLength & 255;
+  return uw_really_send(o->sock, &o->r, sizeof(o->r) - 65535 + contentLength);
+}
+
+static FCGI_Record *fastcgi_recv(FCGI_Input *i) {
+  if (i->used > 0) {
+    memmove((void*)&i->r, (void*)&i->r + i->used, i->available - i->used);
+    i->available -= i->used;
+    i->used = 0;
+  }
+
+  while (1) {
+    ssize_t n;
+
+    if (i->available >= sizeof(FCGI_Record) - 65535
+        && i->available >= sizeof(FCGI_Record) - 65535
+        + ((i->r.contentLengthB1 << 8) | i->r.contentLengthB0)
+        + i->r.paddingLength) {
+      i->used = sizeof(FCGI_Record) - 65535
+        + ((i->r.contentLengthB1 << 8) | i->r.contentLengthB0)
+        + i->r.paddingLength;
+      
+      return &i->r;
+    }
+
+    n = recv(i->sock, (void*)&i->r + i->available, sizeof(i->r) - i->available, 0);
+
+    if (n <= 0)
+      return NULL;
+
+    i->available += n;
+  }
+}
+
+static void on_success(uw_context ctx) { }
+
+static void on_failure(uw_context ctx) {
+  uw_write_header(ctx, "Status: 500 Internal Server Error\r\n");
+}
+
+static int write_stdout(void *data, const char *buf, size_t len) {
+  FCGI_Output *o = (FCGI_Output *)data;
+  while (len > 0) {
+    size_t len2 = len;
+    if (len2 > 65535)
+      len2 = 65535;
+    memcpy(o->r.contentData, buf, len2);
+    if (fastcgi_send(o, FCGI_STDOUT, len2)) {
+      fprintf(stderr, "fastcgi_send() failed in write_stdout().\n");
+      return -1;
+    }
+    buf += len2;
+    len -= len2;
+  }
+
+  return 0;
+}
+
+#include <errno.h>
+
+static void write_stderr(FCGI_Output *o, const char *fmt, ...) {
+  int len;
+  va_list ap;
+  va_start(ap, fmt);
+
+  len = vsnprintf((char *)o->r.contentData, 65535, fmt, ap);
+  if (len < 0)
+    fprintf(stderr, "vsnprintf() failed in write_stderr().\n");
+  else if (fastcgi_send(o, FCGI_STDERR, len))
+    fprintf(stderr, "fastcgi_send() failed in write_stderr().\n");
+}
+
+static void close_stream(FCGI_Output *o, unsigned char type) {
+  if (fastcgi_send(o, type, 0))
+    fprintf(stderr, "fastcgi_send() failed in close_stream().\n");
+}
+
+static void log_error(void *data, const char *fmt, ...) {
+  FCGI_Output *o = (FCGI_Output *)data;
+  va_list ap;
+  va_start(ap, fmt);
+
+  if (o) {
+    int len = vsnprintf((char *)o->r.contentData, 65535, fmt, ap);
+    if (len < 0)
+      fprintf(stderr, "vsnprintf() failed in log_error().\n");
+    else if (fastcgi_send(o, FCGI_STDERR, len))
+      fprintf(stderr, "fastcgi_send() failed in log_error().\n");
+  } else
+    vfprintf(stderr, fmt, ap);
+}
+
+static void log_debug(void *data, const char *fmt, ...) {
+  FCGI_Output *o = (FCGI_Output *)data;
+  va_list ap;
+  va_start(ap, fmt);
+
+  if (o) {
+    strcpy((char *)o->r.contentData, "DEBUG: ");
+    int len = vsnprintf((char *)o->r.contentData + 7, 65535 - 7, fmt, ap);
+    if (len < 0)
+      fprintf(stderr, "vsnprintf() failed in log_debug().\n");
+    else if (fastcgi_send(o, FCGI_STDERR, len + 7)) {
+      len += 7;
+      if (len >= 65535) len = 65534;
+      o->r.contentData[len] = 0;
+      fputs((char *)o->r.contentData, stderr);
+      fflush(stderr);
+    }
+  } else
+    vfprintf(stderr, fmt, ap);
+}
+
+typedef struct {
+  char *name, *value;
+  unsigned name_len, value_len;
+} nvp;
+
+static char *search_nvps(nvp *nvps, const char *h) {
+  for (; nvps->name[0]; ++nvps)
+    if (!strcmp(h, nvps->name))
+      return nvps->value;
+
+  return NULL;
+}
+
+typedef struct {
+  nvp *nvps;
+  char *uppercased;
+  int n_nvps, uppercased_len;
+} headers;
+
+static char *get_header(void *data, const char *h) {
+  headers *hs = (headers *)data;
+  size_t len = strlen(h);
+  char *s;
+  const char *saved_h = h;
+
+  if (len > hs->uppercased_len) {
+    hs->uppercased_len = len;
+    hs->uppercased = realloc(hs->uppercased, len + 6);
+  }
+
+  strcpy(hs->uppercased, "HTTP_");
+  for (s = hs->uppercased+5; *h; ++h)
+    *s++ = *h == '-' ? '_' : toupper((int)*h);
+  *s = 0;
+
+  if (!strcasecmp(saved_h, "Content-length")
+      || !strcasecmp(saved_h, "Content-type")) {
+    if ((s = search_nvps(hs->nvps, hs->uppercased + 5)))
+      return s;
+  }
+  
+  return search_nvps(hs->nvps, hs->uppercased);
+}
+
+static char *get_env(void *data, const char *h) {
+  headers *hs = (headers *)data;
+  
+  return search_nvps(hs->nvps, h);
+}
+
+static int read_funny_len(unsigned char **buf, int *len) {
+  if (*len <= 0)
+    return -1;
+
+  if ((*buf)[0] >> 7 == 0) {
+    int r = (*buf)[0];
+    ++*buf;
+    --*len;
+    return r;
+  }
+  else if (*len < 4)
+    return -1;
+  else {
+    int r = (((*buf)[0] & 0x7f) << 24) + ((*buf)[1] << 16) + ((*buf)[2] << 8) + (*buf)[3];
+    *buf += 4;
+    *len -= 4;
+    return r;
+  }
+}
+
+static int read_nvp(unsigned char **buf, int len, nvp *nv) {
+  int nameLength, valueLength;
+
+  if ((nameLength = read_funny_len(buf, &len)) < 0)
+    return -1;
+  if ((valueLength = read_funny_len(buf, &len)) < 0)
+    return -2;
+  if (len < nameLength + valueLength)
+    return -3;
+
+  if (nameLength+1 > nv->name_len) {
+    nv->name_len = nameLength+1;
+    nv->name = realloc(nv->name, nv->name_len);
+  }
+  if (valueLength+1 > nv->value_len) {
+    nv->value_len = valueLength+1;
+    nv->value = realloc(nv->value, nv->value_len);
+  }
+
+  memcpy(nv->name, *buf, nameLength);
+  nv->name[nameLength] = 0;
+
+  memcpy(nv->value, *buf + nameLength, valueLength);
+  nv->value[valueLength] = 0;
+
+  *buf += nameLength + valueLength;
+
+  return 0;
+}
+
+static int fastcgi_close_with(FCGI_Output *out, request_result rr) {
+  FCGI_EndRequestBody *erb = (FCGI_EndRequestBody *)out->r.contentData;
+
+  close_stream(out, FCGI_STDOUT);
+  close_stream(out, FCGI_STDERR);
+
+  if (rr == SERVED)
+    erb->appStatusB3 = erb->appStatusB2 = erb->appStatusB1 = erb->appStatusB0 = 0;
+  else
+    erb->appStatusB3 = erb->appStatusB2 = erb->appStatusB1 = erb->appStatusB0 = 0xFF;
+
+  erb->protocolStatus = FCGI_REQUEST_COMPLETE;
+  fastcgi_send(out, FCGI_END_REQUEST, sizeof(FCGI_EndRequestBody));
+  return close(out->sock);
+}
+
+static int fastcgi_close(int sock) {
+  FCGI_Output out;
+  out.sock = sock;
+  out.r.version = FCGI_VERSION_1;
+  out.r.paddingLength = 0;
+  out.r.reserved = 0;
+
+  return fastcgi_close_with(&out, SERVED);
+}
+
+int fastcgi_send_normal(int sock, const void *buf, ssize_t len) {
+  FCGI_Output out;
+  out.sock = sock;
+  out.r.version = FCGI_VERSION_1;
+  out.r.paddingLength = 0;
+  out.r.reserved = 0;
+
+  return write_stdout(&out, buf, len);
+}
+
+static void *worker(void *data) {
+  FCGI_Input *in = fastcgi_input();
+  FCGI_Output *out = fastcgi_output();
+  uw_loggers ls = {out, log_error, log_debug};
+  uw_context ctx = uw_request_new_context(*(int *)data, &uw_application, &ls);
+  uw_request_context rc = uw_new_request_context();
+  headers hs;
+  size_t body_size = 0;
+  char *body = malloc(0);
+  size_t path_size = 0;
+  char *path_buf = malloc(0);
+
+  hs.uppercased = malloc(6);
+  hs.uppercased_len = 0;
+  hs.nvps = malloc(sizeof(nvp));
+  hs.n_nvps = 1;
+  hs.nvps[0].name = malloc(1);
+  hs.nvps[0].name_len = 1;
+  hs.nvps[0].value = malloc(0);
+  hs.nvps[0].value_len = 0;
+
+  while (1) {
+    FCGI_Record *r;
+    size_t used_nvps = 0;
+    int body_len, body_read;
+    char *s;
+    char *method, *path, *path_info, *query_string;
+
+    in->sock = out->sock = uw_dequeue();
+
+    if (!(r = fastcgi_recv(in))) {
+      fprintf(stderr, "Error receiving initial message\n");
+      goto done;
+    }
+
+    // Save the FastCGI request ID this worker is handling so that fastcgi_send
+    // can include it in its response.
+    current_request_id = fastcgi_request_id(r);
+
+    if (r->type != FCGI_BEGIN_REQUEST) {
+      write_stderr(out, "First message is not BEGIN_REQUEST\n");
+      goto done;
+    } else if (r->contentData[1] != FCGI_RESPONDER) {
+      write_stderr(out, "Request is for a role besides RESPONDER\n");
+      goto done;
+    }
+
+    while (1) {
+      unsigned char *buf;
+      int len;
+
+      if (!(r = fastcgi_recv(in))) {
+        write_stderr(out, "Error receiving environment variables\n");
+        goto done;
+      }
+
+      if (fastcgi_request_id(r) != current_request_id) {
+        write_stderr(out,
+                     "Ignoring environment variables for request %d (current"
+                     " request has id %d)\n",
+                     fastcgi_request_id(r),
+                     current_request_id);
+        continue;
+      }
+
+      if (r->type != FCGI_PARAMS) {
+        write_stderr(out, "Expected FCGI_PARAMS but got %d\n", r->type);
+        goto done;
+      }
+
+      if (r->contentLengthB1 == 0 && r->contentLengthB0 == 0)
+        break;
+
+      len = (r->contentLengthB1 << 8) | r->contentLengthB0;
+
+      for (buf = r->contentData; buf < r->contentData + len; ) {
+        if (used_nvps == hs.n_nvps-1) {
+          ++hs.n_nvps;
+          hs.nvps = realloc(hs.nvps, hs.n_nvps * sizeof(nvp));
+          hs.nvps[hs.n_nvps-1].name = malloc(1);
+          hs.nvps[hs.n_nvps-1].value = malloc(0);
+          hs.nvps[hs.n_nvps-1].name_len = 1;
+          hs.nvps[hs.n_nvps-1].value_len = 0;
+        }
+        
+        if (read_nvp(&buf, len - (buf - r->contentData), &hs.nvps[used_nvps]) < 0) {
+          write_stderr(out, "Error reading FCGI_PARAMS name-value pair\n");
+          goto done;
+        }
+
+        //write_stderr(out, "PARAM: %s -> %s\n", hs.nvps[used_nvps].name, hs.nvps[used_nvps].value);
+
+        ++used_nvps;
+      }
+    }
+
+    hs.nvps[used_nvps].name[0] = 0;
+
+    if ((s = get_header(&hs, "Content-Length"))) {
+      body_len = atoi(s);
+      if (body_len < 0) {
+        write_stderr(out, "Invalid Content-Length\n");
+        goto done;
+      }
+    } else
+      body_len = 0;
+
+    if (body_len+1 > body_size) {
+      body_size = body_len+1;
+      body = realloc(body, body_size);
+    }
+
+    for (body_read = 0; body_read < body_len; ) {
+      int this_len;
+
+      if (!(r = fastcgi_recv(in))) {
+        write_stderr(out, "Error receiving STDIN\n");
+        goto done;
+      }
+
+      if (fastcgi_request_id(r) != current_request_id) {
+        write_stderr(out,
+                     "Ignoring STDIN for request %d (current request has id"
+                     " %d)\n",
+                     fastcgi_request_id(r),
+                     current_request_id);
+        continue;
+      }
+
+      if (r->type != FCGI_STDIN) {
+        write_stderr(out, "Expected FCGI_STDIN but got %d\n", r->type);
+        goto done;
+      }
+
+      if (r->contentLengthB1 == 0 && r->contentLengthB0 == 0) {
+        write_stderr(out, "End of STDIN\n");
+        break;
+      }
+
+      this_len = (r->contentLengthB1 << 8) | r->contentLengthB0;
+
+      if (body_read + this_len > body_len) {
+        write_stderr(out, "Too much STDIN\n");
+        goto done;
+      }
+
+      memcpy(&body[body_read], r->contentData, this_len);
+      body_read += this_len;
+    }
+
+    body[body_read] = 0;
+
+    if (!(method = search_nvps(hs.nvps, "REQUEST_METHOD"))) {
+      write_stderr(out, "REQUEST_METHOD not set\n");
+      goto done;
+    }
+
+    if (!(path = search_nvps(hs.nvps, "SCRIPT_NAME"))) {
+      write_stderr(out, "SCRIPT_NAME not set\n");
+      goto done;
+    }
+
+    if ((path_info = search_nvps(hs.nvps, "PATH_INFO"))) {
+      int len1 = strlen(path), len2 = strlen(path_info);
+      int len = len1 + len2 + 1;
+
+      if (len > path_size) {
+        path_size = len;
+        path_buf = realloc(path_buf, path_size);
+      }
+
+      sprintf(path_buf, "%s%s", path, path_info);
+      path = path_buf;
+    }
+
+    if (!(query_string = search_nvps(hs.nvps, "QUERY_STRING")))
+      query_string = "";
+
+    uw_set_headers(ctx, get_header, &hs);
+    uw_set_env(ctx, get_env, &hs);
+
+    {
+      request_result rr;
+
+      rr = uw_request(rc, ctx, method, path, query_string, body, body_read,
+                      on_success, on_failure,
+                      out, log_error, log_debug,
+                      in->sock, fastcgi_send_normal, fastcgi_close);
+
+      if (rr == KEEP_OPEN)
+        goto done2;
+
+      uw_output(ctx, write_stdout, out);
+      fastcgi_close_with(out, rr);
+      goto done2;
+    }
+
+  done:
+    close(in->sock);
+  done2:
+    fastcgi_input_reset(in);
+    uw_reset(ctx);
+  }
+
+  return NULL;
+}
+
+static void help(char *cmd) {
+  printf("Usage: %s [-t <thread-count>]\n", cmd);
+}
+
+static void sigint(int signum) {
+  printf("Exiting....\n");
+  exit(0);
+}
+
+static uw_loggers ls = {NULL, log_error, log_debug};
+
+int main(int argc, char *argv[]) {
+  // The skeleton for this function comes from Beej's sockets tutorial.
+  struct sockaddr_in their_addr; // connector's address information
+  socklen_t sin_size;
+  int nthreads = 1, i, *names, opt;
+  char *fwsa = getenv("FCGI_WEB_SERVER_ADDRS"), *nthreads_s = getenv("URWEB_NUM_THREADS");
+ 
+  if (nthreads_s) {
+    nthreads = atoi(nthreads_s);
+    if (nthreads <= 0) {
+      fprintf(stderr, "Bad URWEB_NUM_THREADS value\n");
+      return 1;
+    }
+  }
+
+  signal(SIGINT, sigint);
+  signal(SIGPIPE, SIG_IGN);
+  signal(SIGUSR1, sigint);
+  signal(SIGTERM, sigint);
+
+  while ((opt = getopt(argc, argv, "ht:")) != -1) {
+    switch (opt) {
+    case '?':
+      fprintf(stderr, "Unknown command-line option");
+      help(argv[0]);
+      return 1;
+
+    case 'h':
+      help(argv[0]);
+      return 0;
+
+    case 't':
+      nthreads = atoi(optarg);
+      if (nthreads <= 0) {
+        fprintf(stderr, "Invalid thread count\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    default:
+      fprintf(stderr, "Unexpected getopt() behavior\n");
+      return 1;
+    }
+  }
+
+  uw_set_on_success("");
+  uw_request_init(&uw_application, &ls);
+
+  names = calloc(nthreads, sizeof(int));
+
+  sin_size = sizeof their_addr;
+
+  {
+    pthread_t thread;
+
+    pruner_data *pd = (pruner_data *)malloc(sizeof(pruner_data));
+    pd->app = &uw_application;
+    pd->loggers = &ls;
+
+    if (pthread_create_big(&thread, NULL, client_pruner, pd)) {
+      fprintf(stderr, "Error creating pruner thread\n");
+      return 1;
+    }
+  }
+
+  for (i = 0; i < nthreads; ++i) {
+    pthread_t thread;    
+    names[i] = i;
+    if (pthread_create_big(&thread, NULL, worker, &names[i])) {
+      fprintf(stderr, "Error creating worker thread #%d\n", i);
+      return 1;
+    }
+  }
+
+  while (1) {
+    int new_fd = accept(FCGI_LISTENSOCK_FILENO, (struct sockaddr *)&their_addr, &sin_size);
+
+    if (new_fd < 0) {
+      fprintf(stderr, "Socket accept failed\n");
+      return 1;
+    }
+
+    if (fwsa) {
+      char host[100], matched = 0;
+      char *ips, *sep;
+
+      if (getnameinfo((struct sockaddr *)&their_addr, sin_size, host, sizeof host, NULL, 0, NI_NUMERICHOST)) {
+        fprintf(stderr, "Remote IP determination failed\n");
+        return 1;
+      }
+
+      for (ips = fwsa; (sep = strchr(ips, ',')); ips = sep+1) {
+        if (!strncmp(ips, host, sep - ips)) {
+          matched = 1;
+          break;
+        }
+      }
+
+      if (!matched && strcmp(ips, host)) {
+        fprintf(stderr, "Remote address is not in FCGI_WEB_SERVER_ADDRS");
+        return 1;
+      }
+    }
+
+    uw_enqueue(new_fd);
+  }
+}
+
+void *uw_init_client_data() {
+  return NULL;
+}
+
+void uw_free_client_data(void *data) {
+}
+
+void uw_copy_client_data(void *dst, void *src) {
+}
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+  uw_ensure_transaction(ctx);
+  uw_get_app(ctx)->expunger(ctx, cli);
+
+  if (uw_commit(ctx))
+    uw_error(ctx, UNLIMITED_RETRY, "Rerunning expunge transaction");
+}
+
+void uw_post_expunge(uw_context ctx, void *data) {
+}
+
+int uw_supports_direct_status = 0;
diff --git a/src/c/fastcgi.h b/src/c/fastcgi.h
new file mode 100644
index 0000000..826d808
--- /dev/null
+++ b/src/c/fastcgi.h
@@ -0,0 +1,113 @@
+// This code comes from the FastCGI 1.0 spec at:
+//   http://www.fastcgi.com/drupal/node/6?q=node/22
+
+/*
+ * Listening socket file number
+ */
+#define FCGI_LISTENSOCK_FILENO 0
+
+typedef struct {
+    unsigned char version;
+    unsigned char type;
+    unsigned char requestIdB1;
+    unsigned char requestIdB0;
+    unsigned char contentLengthB1;
+    unsigned char contentLengthB0;
+    unsigned char paddingLength;
+    unsigned char reserved;
+} FCGI_Header;
+
+/*
+ * Number of bytes in a FCGI_Header.  Future versions of the protocol
+ * will not reduce this number.
+ */
+#define FCGI_HEADER_LEN  8
+
+/*
+ * Value for version component of FCGI_Header
+ */
+#define FCGI_VERSION_1           1
+
+/*
+ * Values for type component of FCGI_Header
+ */
+#define FCGI_BEGIN_REQUEST       1
+#define FCGI_ABORT_REQUEST       2
+#define FCGI_END_REQUEST         3
+#define FCGI_PARAMS              4
+#define FCGI_STDIN               5
+#define FCGI_STDOUT              6
+#define FCGI_STDERR              7
+#define FCGI_DATA                8
+#define FCGI_GET_VALUES          9
+#define FCGI_GET_VALUES_RESULT  10
+#define FCGI_UNKNOWN_TYPE       11
+#define FCGI_MAXTYPE (FCGI_UNKNOWN_TYPE)
+
+/*
+ * Value for requestId component of FCGI_Header
+ */
+#define FCGI_NULL_REQUEST_ID     0
+
+typedef struct {
+    unsigned char roleB1;
+    unsigned char roleB0;
+    unsigned char flags;
+    unsigned char reserved[5];
+} FCGI_BeginRequestBody;
+
+typedef struct {
+    FCGI_Header header;
+    FCGI_BeginRequestBody body;
+} FCGI_BeginRequestRecord;
+
+/*
+ * Mask for flags component of FCGI_BeginRequestBody
+ */
+#define FCGI_KEEP_CONN  1
+
+/*
+ * Values for role component of FCGI_BeginRequestBody
+ */
+#define FCGI_RESPONDER  1
+#define FCGI_AUTHORIZER 2
+#define FCGI_FILTER     3
+
+typedef struct {
+    unsigned char appStatusB3;
+    unsigned char appStatusB2;
+    unsigned char appStatusB1;
+    unsigned char appStatusB0;
+    unsigned char protocolStatus;
+    unsigned char reserved[3];
+} FCGI_EndRequestBody;
+
+typedef struct {
+    FCGI_Header header;
+    FCGI_EndRequestBody body;
+} FCGI_EndRequestRecord;
+
+/*
+ * Values for protocolStatus component of FCGI_EndRequestBody
+ */
+#define FCGI_REQUEST_COMPLETE 0
+#define FCGI_CANT_MPX_CONN    1
+#define FCGI_OVERLOADED       2
+#define FCGI_UNKNOWN_ROLE     3
+
+/*
+ * Variable names for FCGI_GET_VALUES / FCGI_GET_VALUES_RESULT records
+ */
+#define FCGI_MAX_CONNS  "FCGI_MAX_CONNS"
+#define FCGI_MAX_REQS   "FCGI_MAX_REQS"
+#define FCGI_MPXS_CONNS "FCGI_MPXS_CONNS"
+
+typedef struct {
+    unsigned char type;    
+    unsigned char reserved[7];
+} FCGI_UnknownTypeBody;
+
+typedef struct {
+    FCGI_Header header;
+    FCGI_UnknownTypeBody body;
+} FCGI_UnknownTypeRecord;
diff --git a/src/c/http.c b/src/c/http.c
new file mode 100644
index 0000000..21ad809
--- /dev/null
+++ b/src/c/http.c
@@ -0,0 +1,561 @@
+#include "config.h"
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <arpa/inet.h>
+#include <unistd.h>
+#include <signal.h>
+#include <stdarg.h>
+
+#include <pthread.h>
+
+#include "urweb.h"
+#include "request.h"
+#include "queue.h"
+
+extern uw_app uw_application;
+
+int uw_backlog = SOMAXCONN;
+static int keepalive = 0, quiet = 0;
+
+#define qfprintf(f, fmt, args...) do { if(!quiet) fprintf(f, fmt, ##args); } while(0)
+#define qprintf(fmt, args...) do { if(!quiet) printf(fmt, ##args); } while(0)
+
+static char *get_header(void *data, const char *h) {
+  char *s = data;
+  int len = strlen(h);
+  char *p;
+
+  while ((p = strchr(s, ':'))) {
+    if (p - s == len && !strncasecmp(s, h, len)) {
+      return p + 2;
+    } else {
+      if ((s = strchr(p, 0)) && s[1] != 0)
+        s += 2;
+      else
+        return NULL;
+    }
+  }
+  
+  return NULL;
+}
+
+static char *get_env(void *data, const char *name) {
+  return getenv(name);
+}
+
+static void on_success(uw_context ctx) {
+  uw_write_header(ctx, "HTTP/1.1 200 OK\r\n");
+}
+
+static void on_failure(uw_context ctx) {
+  uw_write_header(ctx, "HTTP/1.1 500 Internal Server Error\r\n");
+}
+
+static void log_error(void *data, const char *fmt, ...) {
+  va_list ap;
+  va_start(ap, fmt);
+
+  vfprintf(stderr, fmt, ap);
+}
+
+static void log_debug(void *data, const char *fmt, ...) {
+  if (!quiet) {
+    va_list ap;
+    va_start(ap, fmt);
+
+    vprintf(fmt, ap);
+  }
+}
+
+static uw_loggers ls = {NULL, log_error, log_debug};
+
+static unsigned max_buf_size = 1024 * 1024; // That's 1MB.
+
+static void *worker(void *data) {
+  int me = *(int *)data;
+  uw_context ctx = uw_request_new_context(me, &uw_application, &ls);
+  size_t buf_size = 1024;
+  char *buf = malloc(buf_size), *back = buf;
+  uw_request_context rc = uw_new_request_context();
+  int sock = 0;
+
+  while (1) {
+    if (sock == 0) {
+      back = buf;
+      sock = uw_dequeue();
+    }
+
+    uw_set_remoteSock(ctx, sock);
+
+    qprintf("Handling connection with thread #%d.\n", me);
+
+    while (1) {
+      int r;
+      char *method, *path, *query_string, *headers, *body, *after, *s, *s2;
+
+      if (back - buf == buf_size - 1) {
+        char *new_buf;
+        size_t new_buf_size = buf_size*2;
+        if (new_buf_size > max_buf_size) {
+          qfprintf(stderr, "HTTP input exceeds buffer-size limit of %u bytes.\n", max_buf_size);
+          close(sock);
+          sock = 0;
+          break;
+        }
+        new_buf = realloc(buf, new_buf_size);
+        if(!new_buf) {
+          qfprintf(stderr, "Realloc failed while receiving header\n");
+          close(sock);
+          sock = 0;
+          break;
+        }
+        buf_size = new_buf_size;
+        back = new_buf + (back - buf);
+        buf = new_buf;
+      }
+
+      *back = 0;
+      body = strstr(buf, "\r\n\r\n");
+      if (body == NULL) {
+        r = recv(sock, back, buf_size - 1 - (back - buf), 0);
+
+        if (r < 0) {
+          qfprintf(stderr, "Recv failed while receiving header, retcode %d errno %m\n", r);
+          close(sock);
+          sock = 0;
+          break;
+        }
+
+        if (r == 0) {
+          qprintf("Connection closed.\n");
+          close(sock);
+          sock = 0;
+          break;
+        }
+
+        back += r;
+        *back = 0;
+      }
+
+      if (body != NULL || (body = strstr(buf, "\r\n\r\n"))) {
+        request_result rr;
+        int should_keepalive = 0;
+
+        body[0] = body[1] = 0;
+        body += 4;
+
+        if ((s = strcasestr(buf, "\r\nContent-Length: ")) && s < body) {
+          int clen;
+
+          if (sscanf(s + 18, "%d\r\n", &clen) != 1) {
+            fprintf(stderr, "Malformed Content-Length header\n");
+            close(sock);
+            sock = 0;
+            break;
+          }
+
+          while (back - body < clen) {
+            if (back - buf == buf_size - 1) {
+              char *new_buf;
+              size_t new_buf_size = buf_size * 2;
+              if (new_buf_size > max_buf_size) {
+                qfprintf(stderr, "HTTP input exceeds buffer-size limit of %u bytes.\n", max_buf_size);
+                close(sock);
+                sock = 0;
+                break;
+              }
+              new_buf = realloc(buf, new_buf_size);
+              if(!new_buf) {
+                qfprintf(stderr, "Realloc failed while receiving content\n");
+                close(sock);
+                sock = 0;
+                goto done;
+              }
+
+              buf_size = new_buf_size;
+              back = new_buf + (back - buf);
+              body = new_buf + (body - buf);
+              s = new_buf + (s - buf);
+
+              buf = new_buf;
+            }
+
+            r = recv(sock, back, buf_size - 1 - (back - buf), 0);
+
+            if (r < 0) {
+              qfprintf(stderr, "Recv failed while receiving content, retcode %d errno %m\n", r);
+              close(sock);
+              sock = 0;
+              goto done;
+            }
+
+            if (r == 0) {
+              qfprintf(stderr, "Connection closed.\n");
+              close(sock);
+              sock = 0;
+              goto done;
+            }
+
+            back += r;
+            *back = 0;      
+          }
+
+          after = body + clen;
+        } else
+          after = body;
+
+        body[-4] = '\r';
+        body[-3] = '\n';
+
+        if (!(s = strstr(buf, "\r\n"))) {
+          fprintf(stderr, "No newline in request\n");
+          close(sock);
+          sock = 0;
+          goto done;
+        }
+
+        body[-4] = body[-3] = 0;
+
+        *s = 0;
+        headers = s + 2;
+        method = s = buf;
+
+        strsep(&s, " ");
+        if (!s) {
+          fprintf(stderr, "No first space in HTTP command\n");
+          close(sock);
+          sock = 0;
+          goto done;
+        }
+        path = s;
+
+        if ((s = strchr(path, ' ')))
+          *s = 0;
+
+        if ((s = strchr(path, '?'))) {
+          *s = 0;
+          query_string = s+1;
+        }
+        else
+          query_string = NULL;
+
+        s = headers;
+        while ((s2 = strchr(s, '\r'))) {
+          if (s2 == s) {
+            *s = 0;
+            break;
+          }
+
+          s = s2;
+
+          if (s[1] == 0)
+            break;
+
+          *s = 0;
+          s += 2;
+        }
+
+        uw_set_headers(ctx, get_header, headers);
+        uw_set_env(ctx, get_env, NULL);
+
+        qprintf("Serving URI %s....\n", path);
+        rr = uw_request(rc, ctx, method, path, query_string, body, back - body,
+                        on_success, on_failure,
+                        NULL, log_error, log_debug,
+                        sock, uw_really_send, close);
+
+        if (rr != KEEP_OPEN) {
+          if (keepalive) {
+            char *connection = uw_Basis_requestHeader(ctx, "Connection");
+
+            should_keepalive = !(connection && !strcmp(connection, "close"));
+          }
+
+          if (!should_keepalive)
+            uw_write_header(ctx, "Connection: close\r\n");
+
+          if (!uw_has_contentLength(ctx)) {
+            char clen[100];
+
+            sprintf(clen, "Content-length: %d\r\n", uw_pagelen(ctx));
+            uw_write_header(ctx, clen);
+          }
+
+          uw_send(ctx, sock);
+        }
+
+        if (rr == SERVED || rr == FAILED) {
+          if (should_keepalive) {
+            // In case any other requests are queued up, shift
+            // unprocessed part of buffer to front.
+            int kept = back - after;
+
+            if (kept == 0) {
+              // No pipelining going on here.
+              // We'd might as well try to switch to a different connection,
+              // while we wait for more input on this one.
+              uw_enqueue(sock);
+              sock = 0;
+            } else {
+              // More input!  Move it to the front and continue in this loop.
+              memmove(buf, after, kept);
+              back = buf + kept;
+            }
+          } else {
+            close(sock);
+            sock = 0;
+          }
+        } else if (rr == KEEP_OPEN)
+          sock = 0;
+        else
+          fprintf(stderr, "Illegal uw_request return code: %d\n", rr);
+
+        break;
+      }
+    }
+
+  done:
+    uw_reset(ctx);
+  }
+
+  return NULL;
+}
+
+static void help(char *cmd) {
+  printf("Usage: %s [-p <port>] [-a <IPv4 address>] [-A <IPv6 address>] [-t <thread count>] [-m <bytes>] [-k] [-q] [-T SEC]\nThe '-k' option turns on HTTP keepalive.\nThe '-q' option turns off some chatter on stdout.\nThe '-T' option sets socket recv timeout (0 disables timeout, default is 5 sec).\nThe '-m' sets the maximum size (in bytes) for any buffer used to hold HTTP data sent by clients.  (The default is 1 MB.)\n", cmd);
+}
+
+static void sigint(int signum) {
+  printf("Exiting....\n");
+  exit(0);
+}
+
+union uw_sockaddr {
+  struct sockaddr sa;
+  struct sockaddr_in ipv4;
+  struct sockaddr_in6 ipv6;
+};
+
+int main(int argc, char *argv[]) {
+  // The skeleton for this function comes from Beej's sockets tutorial.
+  int sockfd;  // listen on sock_fd
+  union uw_sockaddr my_addr;
+  union uw_sockaddr their_addr; // connector's address information
+  socklen_t my_size = 0, sin_size;
+  int yes = 1, uw_port = 8080, nthreads = 1, i, *names, opt;
+  int recv_timeout_sec = 5;
+ 
+  signal(SIGINT, sigint);
+  signal(SIGPIPE, SIG_IGN); 
+
+  // default if not specified: IPv4 with my IP
+  memset(&my_addr, 0, sizeof my_addr);
+  my_addr.sa.sa_family = AF_INET;
+  my_addr.ipv4.sin_addr.s_addr = INADDR_ANY; // auto-fill with my IP
+
+  while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:m:")) != -1) {
+    switch (opt) {
+    case '?':
+      fprintf(stderr, "Unknown command-line option\n");
+      help(argv[0]);
+      return 1;
+
+    case 'h':
+      help(argv[0]);
+      return 0;
+
+    case 'p':
+      uw_port = atoi(optarg);
+      if (uw_port <= 0) {
+        fprintf(stderr, "Invalid port number\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    case 'a':
+      my_addr.sa.sa_family = AF_INET;
+      if (!inet_pton(AF_INET, optarg, &my_addr.ipv4.sin_addr)) {
+        fprintf(stderr, "Invalid IPv4 address\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    case 'A':
+      my_addr.sa.sa_family = AF_INET6;
+      if (!inet_pton(AF_INET6, optarg, &my_addr.ipv6.sin6_addr)) {
+        fprintf(stderr, "Invalid IPv6 address\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    case 't':
+      nthreads = atoi(optarg);
+      if (nthreads <= 0) {
+        fprintf(stderr, "Invalid thread count\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    case 'k':
+      keepalive = 1;
+      break;
+
+    case 'T':
+      recv_timeout_sec = atoi(optarg);
+      if (recv_timeout_sec < 0) {
+        fprintf(stderr, "Invalid recv timeout\n");
+        help(argv[0]);
+        return 1;
+      }
+      break;
+
+    case 'q':
+      quiet = 1;
+      break;
+
+    case 'm':
+      opt = atoi(optarg);
+      if (opt <= 0) {
+        fprintf(stderr, "Invalid maximum buffer size\n");
+        help(argv[0]);
+        return 1;
+      }
+      max_buf_size = opt;
+      break;
+
+    default:
+      fprintf(stderr, "Unexpected getopt() behavior\n");
+      return 1;
+    }
+  }
+
+  uw_request_init(&uw_application, &ls);
+
+  names = calloc(nthreads, sizeof(int));
+
+  sockfd = socket(my_addr.sa.sa_family, SOCK_STREAM, 0); // do some error checking!
+
+  if (sockfd < 0) {
+    fprintf(stderr, "Listener socket creation failed\n");
+    return 1;
+  }
+
+  if (setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int)) < 0) {
+    fprintf(stderr, "Listener socket option setting failed\n");
+    return 1;
+  }
+
+  switch (my_addr.sa.sa_family)
+  {
+  case AF_INET:
+    my_size = sizeof(my_addr.ipv4);
+    my_addr.ipv4.sin_port = htons(uw_port);
+    break;
+
+  case AF_INET6:
+    my_size = sizeof(my_addr.ipv6);
+    my_addr.ipv6.sin6_port = htons(uw_port);
+    break;
+  }
+
+  if (bind(sockfd, &my_addr.sa, my_size) < 0) {
+    fprintf(stderr, "Listener socket bind failed\n");
+    return 1;
+  }
+
+  if (listen(sockfd, uw_backlog) < 0) {
+    fprintf(stderr, "Socket listen failed\n");
+    return 1;
+  }
+
+  sin_size = sizeof their_addr;
+
+  qprintf("Starting the Ur/Web native HTTP server, which is intended for use\n"
+          "ONLY DURING DEVELOPMENT.  You probably want to use one of the other backends,\n"
+          "behind a production-quality HTTP server, for a real deployment.\n\n");
+
+  qprintf("Listening on port %d....\n", uw_port);
+
+  {
+    pthread_t thread;
+
+    pruner_data *pd = (pruner_data *)malloc(sizeof(pruner_data));
+    pd->app = &uw_application;
+    pd->loggers = &ls;
+
+    if (pthread_create_big(&thread, NULL, client_pruner, pd)) {
+      fprintf(stderr, "Error creating pruner thread\n");
+      return 1;
+    }
+  }
+
+  for (i = 0; i < nthreads; ++i) {
+    pthread_t thread;    
+    names[i] = i;
+    if (pthread_create_big(&thread, NULL, worker, &names[i])) {
+      fprintf(stderr, "Error creating worker thread #%d\n", i);
+      return 1;
+    }
+  }
+
+  while (1) {
+    int new_fd = accept(sockfd, &their_addr.sa, &sin_size);
+
+    if (new_fd < 0) {
+      qfprintf(stderr, "Socket accept failed\n");
+    } else {
+      qprintf("Accepted connection.\n");
+
+      if (keepalive) {
+        int flag = 1; 
+        setsockopt(new_fd, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
+      }
+
+      if(recv_timeout_sec>0) {
+        int ret;
+        struct timeval tv;
+        memset(&tv, 0, sizeof(struct timeval));
+        tv.tv_sec = recv_timeout_sec;
+        ret = setsockopt(new_fd, SOL_SOCKET, SO_RCVTIMEO, (char *)&tv, sizeof(struct timeval));
+        if(ret != 0) {
+          qfprintf(stderr, "Timeout setting failed, errcode %d errno '%m'\n", ret);
+        }
+      }
+
+      uw_enqueue(new_fd);
+    }
+  }
+}
+
+void *uw_init_client_data() {
+  return NULL;
+}
+
+void uw_free_client_data(void *data) {
+}
+
+void uw_copy_client_data(void *dst, void *src) {
+}
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+  uw_ensure_transaction(ctx);
+  uw_get_app(ctx)->expunger(ctx, cli);
+
+  if (uw_commit(ctx))
+    uw_error(ctx, UNLIMITED_RETRY, "Rerunning expunge transaction");
+}
+
+void uw_post_expunge(uw_context ctx, void *data) {
+}
+
+int uw_supports_direct_status = 1;
diff --git a/src/c/memmem.c b/src/c/memmem.c
new file mode 100644
index 0000000..f31f4e3
--- /dev/null
+++ b/src/c/memmem.c
@@ -0,0 +1,87 @@
+#include "config.h"
+
+/* $NetBSD$ */
+ 
+/*-
+ * Copyright (c) 2003 The NetBSD Foundation, Inc.
+ * All rights reserved.
+ *
+ * This code is derived from software contributed to The NetBSD Foundation
+ * by 
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *        This product includes software developed by the NetBSD
+ *        Foundation, Inc. and its contributors.
+ * 4. Neither the name of The NetBSD Foundation nor the names of its
+ *    contributors may be used to endorse or promote products derived
+ *    from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ */
+
+// Function renamed by Adam Chlipala in 2016.
+
+#include <sys/cdefs.h>
+#if defined(LIBC_SCCS) && !defined(lint)
+__RCSID("$NetBSD$");
+#endif /* LIBC_SCCS and not lint */
+
+#if !defined(_KERNEL) && !defined(_STANDALONE)
+#include <assert.h>
+#include <string.h>
+#else
+#include <lib/libkern/libkern.h>
+#define _DIAGASSERT(x)  (void)0
+#define NULL            ((char *)0)
+#endif
+
+/*
+ * urweb_memmem() returns the location of the first occurence of data
+ * pattern b2 of size len2 in memory block b1 of size len1 or
+ * NULL if none is found.
+ */
+void *
+urweb_memmem(const void *b1, size_t len1, const void *b2, size_t len2)
+{
+        /* Sanity check */
+        if(!(b1 != NULL && b2 != NULL && len1 != 0 && len2 != 0))
+                return NULL;
+
+        /* Initialize search pointer */
+        char *sp = (char *) b1;
+
+        /* Initialize pattern pointer */
+        char *pp = (char *) b2;
+
+        /* Intialize end of search address space pointer */
+        char *eos   = sp + len1 - len2;
+
+        while (sp <= eos) {
+                if (*sp == *pp)
+                        if (memcmp(sp, pp, len2) == 0)
+                                return sp;
+
+                sp++;
+        }
+
+        return NULL;
+}
diff --git a/src/c/openssl.c b/src/c/openssl.c
new file mode 100644
index 0000000..5982b83
--- /dev/null
+++ b/src/c/openssl.c
@@ -0,0 +1,139 @@
+#include "config.h"
+
+#include <stdlib.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <string.h>
+
+#include <openssl/opensslv.h>
+#include <openssl/sha.h>
+#include <openssl/rand.h>
+
+#define PASSSIZE 4
+
+int uw_hash_blocksize = 32;
+
+static int password[PASSSIZE];
+
+char *uw_sig_file = NULL;
+
+static void random_password() {
+  if (!RAND_bytes((unsigned char *)password, sizeof password)) {
+    fprintf(stderr, "Error generating random password\n");
+    perror("RAND_bytes");
+    exit(1);
+  }
+}
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+// We're using OpenSSL <1.1, so we need to specify threading callbacks.  See
+// threads(3SSL).
+
+#include <assert.h>
+#include <pthread.h>
+
+#include <openssl/crypto.h>
+
+static pthread_mutex_t *openssl_locks;
+
+// OpenSSL callbacks
+#ifdef PTHREAD_T_IS_POINTER
+static void thread_id(CRYPTO_THREADID *const result) {
+  CRYPTO_THREADID_set_pointer(result, pthread_self());
+}
+#else
+static void thread_id(CRYPTO_THREADID *const result) {
+  CRYPTO_THREADID_set_numeric(result, (unsigned long)pthread_self());
+}
+#endif
+
+static void lock_or_unlock(const int mode, const int type, const char *file,
+                           const int line) {
+  pthread_mutex_t *const lock = &openssl_locks[type];
+  if (mode & CRYPTO_LOCK) {
+    if (pthread_mutex_lock(lock)) {
+      fprintf(stderr, "Can't take lock at %s:%d\n", file, line);
+      exit(1);
+    }
+  } else {
+    if (pthread_mutex_unlock(lock)) {
+      fprintf(stderr, "Can't release lock at %s:%d\n", file, line);
+      exit(1);
+    }
+  }
+}
+
+static void init_openssl() {
+  int i;
+  // Set up OpenSSL.
+  assert(openssl_locks == NULL);
+  openssl_locks = malloc(CRYPTO_num_locks() * sizeof(pthread_mutex_t));
+  if (!openssl_locks) {
+    perror("malloc");
+    exit(1);
+  }
+  for (i = 0; i < CRYPTO_num_locks(); ++i) {
+    pthread_mutex_init(&(openssl_locks[i]), NULL);
+  }
+  CRYPTO_THREADID_set_callback(thread_id);
+  CRYPTO_set_locking_callback(lock_or_unlock);
+}
+
+#else
+// We're using OpenSSL >=1.1, which is thread-safe by default.  We don't need to
+// do anything here.
+
+static void init_openssl() {}
+
+#endif  // OPENSSL_VERSION_NUMBER < 0x10100000L
+
+void uw_init_crypto() {
+  init_openssl();
+  // Prepare signatures.
+  if (uw_sig_file) {
+    int fd;
+
+    if (access(uw_sig_file, F_OK)) {
+      random_password();
+
+      if ((fd = open(uw_sig_file, O_WRONLY | O_CREAT, 0700)) < 0) {
+        fprintf(stderr, "Can't open signature file %s\n", uw_sig_file);
+        perror("open");
+        exit(1);
+      }
+
+      if (write(fd, &password, sizeof password) != sizeof password) {
+        fprintf(stderr, "Error writing signature file\n");
+        exit(1);
+      }
+
+      close(fd);
+    } else {
+      if ((fd = open(uw_sig_file, O_RDONLY)) < 0) {
+        fprintf(stderr, "Can't open signature file %s\n", uw_sig_file);
+        perror("open");
+        exit(1);
+      }
+
+      if (read(fd, &password, sizeof password) != sizeof password) {
+        fprintf(stderr, "Error reading signature file\n");
+        exit(1);
+      }
+
+      close(fd);
+    }
+  } else
+    random_password();
+}
+
+void uw_sign(const char *in, unsigned char *out) {
+  SHA256_CTX c;
+
+  SHA256_Init(&c);
+  SHA256_Update(&c, password, sizeof password);
+  SHA256_Update(&c, in, strlen(in));
+  SHA256_Final(out, &c);
+}
diff --git a/src/c/queue.c b/src/c/queue.c
new file mode 100644
index 0000000..645f69e
--- /dev/null
+++ b/src/c/queue.c
@@ -0,0 +1,63 @@
+#include "config.h"
+
+#include <stdlib.h>
+
+#include <pthread.h>
+
+typedef struct node {
+  int fd;
+  struct node *next;
+} *node;
+
+static node front = NULL, back = NULL;
+
+static int empty() {
+  return front == NULL;
+}
+
+static void enqueue(int fd) {
+  node n = malloc(sizeof(struct node));
+
+  n->fd = fd;
+  n->next = NULL;
+  if (back)
+    back->next = n;
+  else
+    front = n;
+  back = n;
+}
+
+static int dequeue() {
+  int ret = front->fd;
+  node n = front->next;
+  free(front);
+
+  front = n;
+
+  if (!front)
+    back = NULL;
+
+  return ret;
+}
+
+static pthread_mutex_t queue_mutex = PTHREAD_MUTEX_INITIALIZER;
+static pthread_cond_t queue_cond = PTHREAD_COND_INITIALIZER;
+
+int uw_dequeue() {
+  int sock;
+
+  pthread_mutex_lock(&queue_mutex);
+  while (empty())
+    pthread_cond_wait(&queue_cond, &queue_mutex);
+  sock = dequeue();
+  pthread_mutex_unlock(&queue_mutex);
+
+  return sock;
+}
+
+void uw_enqueue(int new_fd) {
+  pthread_mutex_lock(&queue_mutex);
+  enqueue(new_fd);
+  pthread_cond_broadcast(&queue_cond);
+  pthread_mutex_unlock(&queue_mutex);
+}
diff --git a/src/c/request.c b/src/c/request.c
new file mode 100644
index 0000000..a7f2385
--- /dev/null
+++ b/src/c/request.c
@@ -0,0 +1,614 @@
+#include "config.h"
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <unistd.h>
+#include <signal.h>
+
+#include <pthread.h>
+
+#include "urweb.h"
+#include "request.h"
+
+#define MAX_RETRIES 5
+
+void *urweb_memmem(const void *b1, size_t len1, const void *b2, size_t len2);
+
+static int try_rollback(uw_context ctx, int will_retry, void *logger_data, uw_logger log_error) {
+  int r = uw_rollback(ctx, will_retry);
+
+  if (r) {
+    log_error(logger_data, "Error running SQL ROLLBACK\n");
+    uw_reset(ctx);
+    uw_write(ctx, "HTTP/1.1 500 Internal Server Error\r\n");
+    uw_write(ctx, "Content-type: text/plain\r\n\r\n");
+    uw_write(ctx, "Error running SQL ROLLBACK\n");
+    uw_set_error_message(ctx, "Database error; you are probably out of storage space.");
+  }
+
+  return r;
+}
+
+uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls) {
+  void *logger_data = ls->logger_data;
+  uw_logger log_debug = ls->log_debug;
+  uw_logger log_error = ls->log_error;
+  uw_context ctx = uw_init(id, ls);
+  int retries_left = MAX_RETRIES;
+
+  if (uw_set_app(ctx, app)) {
+    log_error(logger_data, "Unable to initialize request context.  Most likely the limit on number of form inputs has been exceeded.\n");
+    uw_free(ctx);
+    return NULL;
+  }
+
+  while (1) {
+    failure_kind fk = uw_begin_init(ctx);
+
+    if (fk == SUCCESS) {
+      log_debug(logger_data, "Database connection initialized.\n");
+      break;
+    } else if (fk == BOUNDED_RETRY) {
+      if (retries_left) {
+        log_debug(logger_data, "Initialization error triggers bounded retry: %s\n", uw_error_message(ctx));
+        --retries_left;
+      } else {
+        log_error(logger_data, "Fatal initialization error (out of retries): %s\n", uw_error_message(ctx));
+        uw_free(ctx);
+        return NULL;
+      }
+    } else if (fk == UNLIMITED_RETRY)
+      log_debug(logger_data, "Initialization error triggers unlimited retry: %s\n", uw_error_message(ctx));
+    else if (fk == FATAL) {
+      log_error(logger_data, "Fatal initialization error: %s\n", uw_error_message(ctx));
+      uw_free(ctx);
+      return NULL;
+    } else {
+      log_error(logger_data, "Unknown uw_begin_init return code!\n");
+      uw_free(ctx);
+      return NULL;
+    }
+  }
+
+  return ctx;
+}
+
+static void *ticker(void *data) {
+  while (1) {
+    usleep(100000);
+    ++uw_time;
+  }
+
+  return NULL;
+}
+
+typedef struct {
+  int id;
+  uw_loggers *ls;
+  uw_periodic pdic;
+  uw_app *app;
+} periodic;
+
+static void *periodic_loop(void *data) {
+  periodic *p = (periodic *)data;
+  uw_context ctx = uw_request_new_context(p->id, p->app, p->ls);
+
+  if (!ctx)
+    exit(1);
+
+  while (1) {
+    int retries_left = MAX_RETRIES;
+
+    failure_kind r;
+    do {
+      uw_reset(ctx);
+      r = uw_runCallback(ctx, p->pdic.callback);
+      if (r == BOUNDED_RETRY)
+        --retries_left;
+      else if (r == UNLIMITED_RETRY)
+        p->ls->log_debug(p->ls->logger_data, "Error triggers unlimited retry in periodic: %s\n", uw_error_message(ctx));
+      else if (r == BOUNDED_RETRY)
+        p->ls->log_debug(p->ls->logger_data, "Error triggers bounded retry in periodic: %s\n", uw_error_message(ctx));
+      else if (r == FATAL)
+        p->ls->log_error(p->ls->logger_data, "Fatal error: %s\n", uw_error_message(ctx));
+      if (r == FATAL || r == BOUNDED_RETRY || r == UNLIMITED_RETRY)
+        if (try_rollback(ctx, 0, p->ls->logger_data, p->ls->log_error))
+          return NULL;
+    } while (r == UNLIMITED_RETRY || (r == BOUNDED_RETRY && retries_left > 0));
+
+    if (r != FATAL && r != BOUNDED_RETRY) {
+      if (uw_commit(ctx))
+	r = UNLIMITED_RETRY;
+    }
+
+    sleep(p->pdic.period);
+  };
+}
+
+static unsigned long long stackSize;
+
+int pthread_create_big(pthread_t *outThread, void *foo, void *threadFunc, void *arg)
+{
+  if (stackSize > 0) {
+    int err;
+    pthread_attr_t stackSizeAttribute;
+
+    err = pthread_attr_init(&stackSizeAttribute);
+    if (err) return err;
+
+    err = pthread_attr_setstacksize(&stackSizeAttribute, stackSize);
+    if (err) return err;
+
+    return pthread_create(outThread, &stackSizeAttribute, threadFunc, arg);
+  } else {
+    return pthread_create(outThread, NULL, threadFunc, arg);
+  }
+}
+
+void uw_request_init(uw_app *app, uw_loggers* ls) {
+  uw_context ctx;
+  failure_kind fk;
+  uw_periodic *ps;
+  int id;
+  char *stackSize_s;
+
+  uw_logger log_debug = ls->log_debug;
+  uw_logger log_error = ls->log_error;
+  void* logger_data = ls->logger_data;
+
+  if ((stackSize_s = getenv("URWEB_STACK_SIZE")) != NULL && stackSize_s[0] != 0) {
+    stackSize = atoll(stackSize_s);
+
+    if (stackSize <= 0) {
+      fprintf(stderr, "Invalid stack size \"%s\"\n", stackSize_s);
+      exit(1);
+    }
+  }
+
+  uw_global_init();
+  uw_app_init(app);
+
+  {
+    pthread_t thread;
+    
+    if (uw_time_max && pthread_create_big(&thread, NULL, ticker, NULL)) {
+      fprintf(stderr, "Error creating ticker thread\n");
+      exit(1);
+    }
+  }
+
+  ctx = uw_request_new_context(0, app, ls);
+
+  if (!ctx)
+    exit(1);
+
+  for (fk = uw_initialize(ctx); fk == UNLIMITED_RETRY; fk = uw_initialize(ctx)) {
+    log_debug(logger_data, "Unlimited retry during init: %s\n", uw_error_message(ctx));
+    uw_rollback(ctx, 1);
+    uw_reset(ctx);
+  }
+
+  if (fk != SUCCESS) {
+    log_error(logger_data, "Failed to initialize database!  %s\n", uw_error_message(ctx));
+    uw_rollback(ctx, 0);
+    exit(1);
+  }
+
+  uw_free(ctx);
+
+  id = 1;
+  for (ps = app->periodics; ps->callback; ++ps) {
+    pthread_t thread;
+    periodic *arg = malloc(sizeof(periodic));
+    arg->id = id++;
+    arg->ls = ls;
+    arg->pdic = *ps;
+    arg->app = app;
+    
+    if (pthread_create_big(&thread, NULL, periodic_loop, arg)) {
+      fprintf(stderr, "Error creating periodic thread\n");
+      exit(1);
+    }
+  }  
+}
+
+
+struct uw_rc {
+  size_t path_copy_size, queryString_size;
+  char *path_copy, *queryString;
+};
+
+uw_request_context uw_new_request_context(void) {
+  uw_request_context r = malloc(sizeof(struct uw_rc));
+  r->path_copy_size = 0;
+  r->queryString_size = 1;
+  r->path_copy = malloc(0);
+  r->queryString = malloc(1);
+  return r;
+}
+
+void uw_free_request_context(uw_request_context r) {
+  free(r->path_copy);
+  free(r->queryString);
+  free(r);
+}
+
+request_result uw_request(uw_request_context rc, uw_context ctx,
+                          char *method, char *path, char *query_string,
+                          char *body, size_t body_len,
+                          void (*on_success)(uw_context), void (*on_failure)(uw_context),
+                          void *logger_data, uw_logger log_error, uw_logger log_debug,
+                          int sock,
+                          int (*send)(int sockfd, const void *buf, ssize_t len),
+                          int (*close)(int fd)) {
+  int retries_left = MAX_RETRIES;
+  failure_kind fk;
+  int is_post = 0;
+  char *boundary = NULL;
+  size_t boundary_len = 0;
+  char *inputs;
+  const char *prefix = uw_get_url_prefix(ctx);
+  char *s;
+  int had_error = 0, is_fancy = 0;
+  char errmsg[ERROR_BUF_LEN];
+
+  uw_reset(ctx);
+
+  rc->queryString[0] = 0;
+
+  for (s = path; *s; ++s) {
+    if (s[0] == '%' && s[1] == '2' && s[2] == '7') {
+      s[0] = '\'';
+      memmove(s+1, s+3, strlen(s+3)+1);
+    }
+  }
+
+  uw_set_currentUrl(ctx, path);
+
+  if (!strcmp(method, "POST")) {
+    char *clen_s = uw_Basis_requestHeader(ctx, "Content-length");
+    if (!clen_s) {
+      clen_s = "0";
+      /*log_error(logger_data, "No Content-length with POST\n");
+      return FAILED;*/
+    }
+    int clen = atoi(clen_s);
+    if (clen < 0) {
+      log_error(logger_data, "Negative Content-length with POST\n");
+      return FAILED;
+    }
+
+    if (body_len < clen) {
+      log_error(logger_data, "Request doesn't contain all POST data (according to Content-Length)\n");
+      return FAILED;
+    }
+
+    is_post = 1;
+    uw_isPost(ctx);
+
+    clen_s = uw_Basis_requestHeader(ctx, "Content-type");
+
+    if (!clen_s || strcasecmp(clen_s, "application/x-www-form-urlencoded"))
+      is_fancy = 1;
+
+    if (clen_s && !strncasecmp(clen_s, "multipart/form-data", 19)) {
+      if (strncasecmp(clen_s + 19, "; boundary=", 11)) {
+        log_error(logger_data, "Bad multipart boundary spec");
+        return FAILED;
+      }
+
+      boundary = clen_s + 28;
+      boundary[0] = '-';
+      boundary[1] = '-';
+      boundary_len = strlen(boundary);
+    } else if (clen_s) {
+      uw_Basis_postBody pb = {clen_s, body, body_len};
+      uw_postBody(ctx, pb);
+    }
+  } else if (strcmp(method, "GET")) {
+    log_error(logger_data, "Not ready for non-GET/POST command: %s\n", method);
+    return FAILED;
+  }
+
+  if (!strncmp(path, prefix, strlen(prefix))
+      && !strcmp(path + strlen(prefix), ".msgs")) {
+    char *id = uw_Basis_requestHeader(ctx, "UrWeb-Client");
+    char *pass = uw_Basis_requestHeader(ctx, "UrWeb-Pass");
+
+    if (sock < 0) {
+      log_error(logger_data, ".msgs requested, but not socket supplied\n");
+      return FAILED;
+    }
+
+    if (id && pass) {
+      unsigned idn = atoi(id);
+      uw_client_connect(idn, atoi(pass), sock, send, close, logger_data, log_error);
+      log_debug(logger_data, "Processed request for messages by client %u\n\n", idn);
+      return KEEP_OPEN;
+    }
+    else {
+      log_error(logger_data, "Missing fields in .msgs request: %s, %s\n\n", id, pass);
+      return FAILED;
+    }
+  }
+
+  if (boundary) {
+    char *part = body, *after_sub_headers, *header, *after_header;
+    size_t part_len;
+
+    part = strstr(part, boundary);
+    if (!part) {
+      log_error(logger_data, "Missing first multipart boundary\n");
+      return FAILED;
+    }
+    part += boundary_len;
+
+    while (1) {
+      char *name = NULL, *filename = NULL, *type = NULL;
+
+      if (part[0] == '-' && part[1] == '-')
+        break;
+
+      if (*part != '\r') {
+        log_error(logger_data, "No \\r after multipart boundary\n");
+        return FAILED;
+      }
+      ++part;
+      if (*part != '\n') {
+        log_error(logger_data, "No \\n after multipart boundary\n");
+        return FAILED;
+      }
+      ++part;
+            
+      if (!(after_sub_headers = strstr(part, "\r\n\r\n"))) {
+        log_error(logger_data, "Missing end of headers after multipart boundary\n");
+        return FAILED;
+      }
+      after_sub_headers[2] = 0;
+      after_sub_headers += 4;
+
+      for (header = part; (after_header = strstr(header, "\r\n")); header = after_header + 2) {
+        char *colon, *after_colon;
+
+        *after_header = 0;
+        if (!(colon = strchr(header, ':'))) {
+          log_error(logger_data, "Missing colon in multipart sub-header\n");
+          return FAILED;
+        }
+        *colon++ = 0;
+        if (*colon++ != ' ') {
+          log_error(logger_data, "No space after colon in multipart sub-header\n");
+          return FAILED;
+        }
+        
+        if (!strcasecmp(header, "Content-Disposition")) {
+          if (strncmp(colon, "form-data; ", 11)) {
+            log_error(logger_data, "Multipart data is not \"form-data\"\n");
+            return FAILED;
+          }
+
+          for (colon += 11; (after_colon = strchr(colon, '=')); colon = after_colon) {
+            char *data;
+            after_colon[0] = 0;
+            if (after_colon[1] != '"') {
+              log_error(logger_data, "Disposition setting is missing initial quote\n");
+              return FAILED;
+            }
+            data = after_colon+2;
+            if (!(after_colon = strchr(data, '"'))) {
+              log_error(logger_data, "Disposition setting is missing final quote\n");
+              return FAILED;
+            }
+            after_colon[0] = 0;
+            ++after_colon;
+            if (after_colon[0] == ';' && after_colon[1] == ' ')
+              after_colon += 2;
+
+            if (!strcasecmp(colon, "name"))
+              name = data;
+            else if (!strcasecmp(colon, "filename"))
+              filename = data;
+          }
+        } else if (!strcasecmp(header, "Content-Type")) {
+          type = colon;
+        }
+      }
+
+      part = urweb_memmem(after_sub_headers, body + body_len - after_sub_headers, boundary, boundary_len);
+      if (!part) {
+        log_error(logger_data, "Missing boundary after multipart payload\n");
+        return FAILED;
+      }
+      part[-2] = 0;
+      part_len = part - after_sub_headers - 2;
+      part[0] = 0;
+      part += boundary_len;
+
+      if (filename) {
+        uw_Basis_file f = {filename, type, {part_len, after_sub_headers}};
+
+        if (uw_set_file_input(ctx, name, f)) {
+          log_error(logger_data, "%s\n", uw_error_message(ctx));
+          return FAILED;
+        }
+      } else if (uw_set_input(ctx, name, after_sub_headers)) {
+        log_error(logger_data, "%s\n", uw_error_message(ctx));
+        return FAILED;
+      }
+    }
+  }
+  else if (!is_fancy) {
+    inputs = is_post ? body : query_string;
+
+    if (inputs) {
+      char *name, *value;
+      int len = strlen(inputs);
+
+      if (len+1 > rc->queryString_size) {
+        char *qs = realloc(rc->queryString, len+1); 
+        if(qs == NULL) {
+          log_error(logger_data, "queryString is too long (not enough memory)\n");
+          return FAILED;
+        }
+        rc->queryString = qs;
+        rc->queryString_size = len+1;
+      }
+      strcpy(rc->queryString, inputs);
+
+      while (*inputs) {
+        name = inputs;
+        if ((inputs = strchr(inputs, '&')))
+          *inputs++ = 0;
+        else
+          inputs = strchr(name, 0);
+
+        if ((value = strchr(name, '='))) {
+          *value++ = 0;
+          if (uw_set_input(ctx, name, value)) {
+            log_error(logger_data, "%s\n", uw_error_message(ctx));
+            return FAILED;
+          }
+        }
+        else if (uw_set_input(ctx, name, "")) {
+          log_error(logger_data, "%s\n", uw_error_message(ctx));
+          return FAILED;
+        }
+      }
+    }
+  }
+
+  while (1) {
+    uw_setQueryString(ctx, rc->queryString);
+
+    if (!had_error) {
+      size_t path_len = strlen(path);
+
+      on_success(ctx);
+
+      if (path_len + 1 > rc->path_copy_size) {
+        char *pc = realloc(rc->path_copy, path_len + 1);
+        if(pc == NULL) {
+          log_error(logger_data, "Path is too long (not enough memory)\n");
+          return FAILED;
+        }
+        rc->path_copy = pc;
+        rc->path_copy_size = path_len + 1;
+      }
+      strcpy(rc->path_copy, path);
+
+      uw_set_deadline(ctx, uw_time + uw_time_max);
+      fk = uw_begin(ctx, rc->path_copy);
+    } else {
+      uw_set_deadline(ctx, uw_time + uw_time_max);
+      fk = uw_begin_onError(ctx, errmsg);
+    }
+
+    if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
+      uw_commit(ctx);
+      if (uw_has_error(ctx) && !had_error) {
+        log_error(logger_data, "Fatal error: %s\n", uw_error_message(ctx));
+        uw_reset_keep_error_message(ctx);
+        on_failure(ctx);
+
+        if (uw_get_app(ctx)->on_error) {
+          had_error = 1;
+          strcpy(errmsg, uw_error_message(ctx));
+        } else {
+          try_rollback(ctx, 0, logger_data, log_error);
+
+          uw_write_header(ctx, "Content-type: text/html\r\n");
+          uw_write(ctx, "<html><head><title>Fatal Error</title></head><body>");
+          uw_write(ctx, "Fatal error: ");
+          uw_write(ctx, uw_error_message(ctx));
+          uw_write(ctx, "\n</body></html>");
+        
+          return FAILED;
+        }
+      } else
+        return had_error ? FAILED : SERVED;
+    } else if (fk == BOUNDED_RETRY) {
+      if (retries_left) {
+        log_debug(logger_data, "Error triggers bounded retry: %s\n", uw_error_message(ctx));
+        --retries_left;
+      }
+      else {
+        log_error(logger_data, "Fatal error (out of retries): %s\n", uw_error_message(ctx));
+
+        if (!had_error && uw_get_app(ctx)->on_error) {
+          had_error = 1;
+          strcpy(errmsg, uw_error_message(ctx));
+        } else {
+          try_rollback(ctx, 0, logger_data, log_error);
+
+          uw_reset_keep_error_message(ctx);
+          on_failure(ctx);
+          uw_write_header(ctx, "Content-type: text/plain\r\n");
+          uw_write(ctx, "Fatal error (out of retries): ");
+          uw_write(ctx, uw_error_message(ctx));
+          uw_write(ctx, "\n");
+
+          return FAILED;
+        }
+      }
+    } else if (fk == UNLIMITED_RETRY)
+      log_debug(logger_data, "Error triggers unlimited retry: %s\n", uw_error_message(ctx));
+    else if (fk == FATAL) {
+      log_error(logger_data, "Fatal error: %s\n", uw_error_message(ctx));
+
+      if (uw_get_app(ctx)->on_error && !had_error) {
+        had_error = 1;
+        strcpy(errmsg, uw_error_message(ctx));
+      } else {
+        try_rollback(ctx, 0, logger_data, log_error);
+
+        uw_reset_keep_error_message(ctx);
+        on_failure(ctx);
+        uw_write_header(ctx, "Content-type: text/html\r\n");
+        uw_write(ctx, "<html><head><title>Fatal Error</title></head><body>");
+        uw_write(ctx, "Fatal error: ");
+        uw_write(ctx, uw_error_message(ctx));
+        uw_write(ctx, "\n</body></html>");
+
+        return FAILED;
+      }
+    } else {
+      log_error(logger_data, "Unknown uw_handle return code!\n");
+
+      if (uw_get_app(ctx)->on_error && !had_error) {
+        had_error = 1;
+        strcpy(errmsg, "Unknown uw_handle return code");
+      } else {
+        try_rollback(ctx, 0, logger_data, log_error);
+
+        uw_reset_keep_request(ctx);
+        on_failure(ctx);
+        uw_write_header(ctx, "Content-type: text/plain\r\n");
+        uw_write(ctx, "Unknown uw_handle return code!\n");
+
+        return FAILED;
+      }
+    }
+
+    if (try_rollback(ctx, 1, logger_data, log_error))
+      return FAILED;
+
+    uw_reset_keep_request(ctx);
+  }
+}
+
+void *client_pruner(void *data) {
+  pruner_data *pd = (pruner_data *)data;
+  uw_context ctx = uw_request_new_context(0, pd->app, pd->loggers);
+
+  if (!ctx)
+    exit(1);
+
+  while (1) {
+    uw_prune_clients(ctx);
+    sleep(5);
+  }
+}
diff --git a/src/c/static.c b/src/c/static.c
new file mode 100644
index 0000000..d70881e
--- /dev/null
+++ b/src/c/static.c
@@ -0,0 +1,70 @@
+#include "config.h"
+
+#include <stdio.h>
+#include <stdarg.h>
+
+#include "urweb.h"
+
+extern uw_app uw_application;
+
+static void log_(void *data, const char *fmt, ...) {
+  va_list ap;
+  va_start(ap, fmt);
+
+  vprintf(fmt, ap);
+}
+
+static uw_loggers loggers = {NULL, log_, log_};
+
+static char *get_header(void *data, const char *h) {
+  return NULL;
+}
+
+int main(int argc, char *argv[]) {
+  uw_context ctx;
+  failure_kind fk;
+
+  if (argc != 2) {
+    fprintf(stderr, "Pass exactly one argument: the URI to run\n");
+    return 1;
+  }
+ 
+  ctx = uw_init(0, &loggers);
+  uw_set_app(ctx, &uw_application);
+  uw_set_headers(ctx, get_header, NULL);
+  uw_initialize(ctx);
+
+  while (1) {
+    fk = uw_begin(ctx, argv[1]);
+
+    if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
+      uw_commit(ctx);
+      uw_print(ctx, 1);
+      puts("");
+      return 0;
+    } else if (fk != UNLIMITED_RETRY) {
+      fprintf(stderr, "Error: %s\n", uw_error_message(ctx));
+      return 1;
+    }
+
+    uw_reset(ctx);
+  }
+}
+
+void *uw_init_client_data() {
+  return NULL;
+}
+
+void uw_free_client_data(void *data) {
+}
+
+void uw_copy_client_data(void *dst, void *src) {
+}
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+}
+
+void uw_post_expunge(uw_context ctx, void *data) {
+}
+
+int uw_supports_direct_status = 0;
diff --git a/src/c/urweb.c b/src/c/urweb.c
new file mode 100644
index 0000000..6f2dde3
--- /dev/null
+++ b/src/c/urweb.c
@@ -0,0 +1,4980 @@
+#include "config.h"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <strings.h>
+#include <ctype.h>
+#include <setjmp.h>
+#include <stdarg.h>
+#include <assert.h>
+#include <ctype.h>
+#include <limits.h>
+#include <stdint.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <openssl/des.h>
+#include <openssl/rand.h>
+#include <time.h>
+#include <math.h>
+
+#include <pthread.h>
+
+#include "types.h"
+
+#include "uthash.h"
+
+uw_unit uw_unit_v = 0;
+
+
+// Socket extras
+
+int uw_really_send(int sock, const void *buf, ssize_t len) {
+  while (len > 0) {
+    ssize_t n = send(sock, buf, len, 0);
+
+    if (n < 0)
+      return n;
+
+    buf += n;
+    len -= n;
+  }
+
+  return 0;
+}
+
+int uw_really_write(int fd, const void *buf, size_t len) {
+  while (len > 0) {
+    ssize_t n = write(fd, buf, len);
+
+    if (n < 0)
+      return n;
+
+    buf += n;
+    len -= n;
+  }
+
+  return 0;
+}
+
+
+// Buffers
+
+void uw_buffer_init(size_t max, uw_buffer *b, size_t s) {
+  b->max = max;
+  b->front = b->start = malloc(s);
+  b->back = b->front + s;
+}
+
+void uw_buffer_free(uw_buffer *b) {
+  free(b->start);
+}
+
+void uw_buffer_reset(uw_buffer *b) {
+  b->front = b->start;
+  if (b->front != b->back) {
+    *b->front = 0;
+  }
+}
+
+int uw_buffer_check(uw_buffer *b, size_t extra) {
+  if (b->back - b->front < extra) {
+    size_t desired = b->front - b->start + extra, next;
+    char *new_heap;
+
+    next = b->back - b->start;
+    if (next == 0)
+      next = 1;
+    for (; next < desired; next *= 2);
+
+    if (next > b->max) {
+      if (desired <= b->max)
+        next = desired;
+      else
+        return 1;
+    }
+
+    new_heap = realloc(b->start, next);
+    b->front = new_heap + (b->front - b->start);
+    b->back = new_heap + next;
+    b->start = new_heap;
+  }
+
+  return 0;
+}
+
+__attribute__((noreturn)) void uw_error(uw_context, failure_kind, const char *, ...);
+
+static void ctx_uw_buffer_check(uw_context ctx, const char *kind, uw_buffer *b, size_t extra) {
+  if (uw_buffer_check(b, extra))
+    uw_error(ctx, FATAL, "Memory limit exceeded (%s)", kind);
+}
+
+size_t uw_buffer_used(uw_buffer *b) {
+  return b->front - b->start;
+}
+
+size_t uw_buffer_avail(uw_buffer *b) {
+  return b->back - b->start;
+}
+
+int uw_buffer_append(uw_buffer *b, const char *s, size_t len) {
+  if (uw_buffer_check(b, len+1))
+    return 1;
+
+  memcpy(b->front, s, len);
+  b->front += len;
+  *b->front = 0;
+
+  return 0;
+}
+
+static void ctx_uw_buffer_append(uw_context ctx, const char *kind, uw_buffer *b, const char *s, size_t len) {
+  ctx_uw_buffer_check(ctx, kind, b, len+1);
+
+  memcpy(b->front, s, len);
+  b->front += len;
+  *b->front = 0;
+}
+
+
+// Persistent state types
+
+typedef enum { UNUSED, USED } usage;
+
+typedef struct client {
+  unsigned id;
+  usage mode;
+  int pass;
+  struct client *next;
+  pthread_mutex_t lock, pull_lock;
+  uw_buffer msgs;
+  int sock;
+  int (*send)(int sockfd, const void *buf, ssize_t len);
+  int (*close)(int fd);
+  time_t last_contact;
+  unsigned n_channels;
+  unsigned refcount;
+  void *data;
+} client;
+
+
+// Persistent client state
+
+static client **clients, *clients_free, *clients_used;
+static unsigned n_clients;
+
+static pthread_mutex_t clients_mutex = PTHREAD_MUTEX_INITIALIZER;
+size_t uw_messages_max = SIZE_MAX;
+size_t uw_clients_max = SIZE_MAX;
+
+void *uw_init_client_data();
+void uw_free_client_data(void *);
+void uw_copy_client_data(void *dst, void *src);
+
+static uw_Basis_int my_rand() {
+  int ret, r = RAND_bytes((unsigned char *)&ret, sizeof ret);
+  if (r)
+    return abs(ret);
+  else
+    return -1;
+}
+
+static client *new_client(uw_context ctx) {
+  client *c;
+  int pass = my_rand();
+
+  if (pass < 0) uw_error(ctx, FATAL, "Random number generation failed during client initialization");
+
+  pthread_mutex_lock(&clients_mutex);
+
+  if (clients_free) {
+    c = clients_free;
+    clients_free = clients_free->next;
+  }
+  else if (n_clients >= uw_clients_max) {
+    pthread_mutex_unlock(&clients_mutex);
+    return NULL;
+  } else {
+    ++n_clients;
+    clients = realloc(clients, sizeof(client) * n_clients);
+    c = malloc(sizeof(client));
+    c->id = n_clients-1;
+    pthread_mutex_init(&c->lock, NULL);
+    pthread_mutex_init(&c->pull_lock, NULL);
+    uw_buffer_init(uw_messages_max, &c->msgs, 0);
+    clients[n_clients-1] = c;
+  }
+
+  pthread_mutex_lock(&c->lock);
+  c->mode = USED;
+  c->pass = pass;
+  c->sock = -1;
+  c->last_contact = time(NULL);
+  uw_buffer_reset(&c->msgs);
+  c->n_channels = 0;
+  c->refcount = 0;
+  c->data = uw_init_client_data();
+  pthread_mutex_unlock(&c->lock);
+
+  c->next = clients_used;
+  clients_used = c;
+
+  pthread_mutex_unlock(&clients_mutex);
+
+  return c;
+}
+
+static void use_client(client *c) {
+  pthread_mutex_lock(&c->lock);
+  ++c->refcount;
+  pthread_mutex_unlock(&c->lock);
+  pthread_mutex_lock(&c->pull_lock);
+}
+
+static void release_client(client *c) {
+  pthread_mutex_unlock(&c->pull_lock);
+  pthread_mutex_lock(&c->lock);
+  --c->refcount;
+  pthread_mutex_unlock(&c->lock);
+}
+
+static const char begin_msgs[] = "Content-type: text/plain\r\n\r\n";
+static pthread_t pruning_thread;
+static int pruning_thread_initialized = 0;
+
+static client *find_client(unsigned id) {
+  client *c;
+  int i_am_pruner = pruning_thread_initialized && pthread_equal(pruning_thread, pthread_self());
+
+  if (!i_am_pruner) pthread_mutex_lock(&clients_mutex);
+
+  if (id >= n_clients) {
+    if (!i_am_pruner) pthread_mutex_unlock(&clients_mutex);
+    return NULL;
+  }
+
+  c = clients[id];
+
+  if (!i_am_pruner) pthread_mutex_unlock(&clients_mutex);
+  return c;
+}
+
+static char *on_success = "HTTP/1.1 200 OK\r\n";
+static char *on_redirect = "HTTP/1.1 303 See Other\r\n";
+
+void uw_set_on_success(char *s) {
+  on_success = s;
+}
+
+static void chastise(int (*send)(int sockfd, const void *buf, ssize_t len), int sock) {
+  send(sock, on_success, strlen(on_success));
+  send(sock, begin_msgs, sizeof(begin_msgs) - 1);
+  send(sock, "R", 1);
+  close(sock);
+}
+
+void uw_client_connect(unsigned id, int pass, int sock,
+                       int (*send)(int sockfd, const void *buf, ssize_t len),
+                       int (*close)(int fd),
+                       void *logger_data, uw_logger log_error) {
+  client *c = find_client(id);
+
+  if (c == NULL) {
+    chastise(send, sock);
+    log_error(logger_data, "Out-of-bounds client request (%u)\n", id);
+    return;
+  }
+
+  pthread_mutex_lock(&c->lock);
+
+  if (c->mode != USED) {
+    pthread_mutex_unlock(&c->lock);
+    chastise(send, sock);
+    log_error(logger_data, "Client request for unused slot (%u)\n", id);
+    return;
+  }
+
+  if (pass != c->pass) {
+    pthread_mutex_unlock(&c->lock);
+    chastise(send, sock);
+    log_error(logger_data, "Wrong client password (%u, %d)\n", id, pass);
+    return;
+  }
+
+  if (c->sock != -1) {
+    c->close(c->sock);
+    c->sock = -1;
+  }
+
+  c->last_contact = time(NULL);
+
+  if (uw_buffer_used(&c->msgs) > 0) {
+    send(sock, on_success, strlen(on_success));
+    send(sock, begin_msgs, sizeof(begin_msgs) - 1);
+    send(sock, c->msgs.start, uw_buffer_used(&c->msgs));
+    uw_buffer_reset(&c->msgs);
+    close(sock);
+  }
+  else {
+    c->sock = sock;
+    c->send = send;
+    c->close = close;
+  }
+
+  pthread_mutex_unlock(&c->lock);
+}
+
+static void free_client(client *c) {
+  c->mode = UNUSED;
+  c->pass = -1;
+
+  c->next = clients_free;
+  clients_free = c;
+}
+
+static uw_Basis_channel new_channel(client *c) {
+  uw_Basis_channel ch = {c->id, c->n_channels++};
+  return ch;
+}
+
+static void client_send(client *c, uw_buffer *msg, const char *script, int script_len) {
+  pthread_mutex_lock(&c->lock);
+
+  if (c->sock != -1) {
+    c->send(c->sock, on_success, strlen(on_success));
+    c->send(c->sock, begin_msgs, sizeof(begin_msgs) - 1);
+    if (script_len > 0) {
+      c->send(c->sock, "E\n", 2);
+      c->send(c->sock, script, script_len);
+      c->send(c->sock, "\n", 1);
+    }
+    c->send(c->sock, msg->start, uw_buffer_used(msg));
+    c->close(c->sock);
+    c->sock = -1;
+  } else if (uw_buffer_append(&c->msgs, msg->start, uw_buffer_used(msg)))
+    fprintf(stderr, "Client message buffer size exceeded");
+
+  pthread_mutex_unlock(&c->lock);
+}
+
+
+// Global entry points
+
+extern void uw_global_custom();
+extern void uw_init_crypto();
+
+void uw_global_init() {
+  clients = malloc(0);
+
+  uw_global_custom();
+  uw_init_crypto();
+
+  // Fast non-cryptographic strength randomness for Sqlcache.
+  srandom(clock());
+}
+
+void uw_app_init(uw_app *app) {
+  app->client_init();
+}
+
+int uw_time = 0, uw_time_max = 0, uw_min_heap = 0;
+
+
+// Single-request state
+
+typedef struct regions {
+  struct regions *next;
+} regions;
+
+typedef struct {
+  void (*func)(void*);
+  void *arg;
+} cleanup;
+
+typedef struct {
+  unsigned client;
+  uw_buffer msgs;
+} delta;
+
+typedef enum {
+  UNSET, NORMAL, FIL, SUBFORM, SUBFORMS, ENTRY
+} input_kind;
+
+typedef struct input {
+  input_kind kind;
+  union {
+    char *normal;
+    uw_Basis_file file;
+    struct {
+      struct input *fields, *parent;
+    } subform;
+    struct {
+      struct input *entries, *parent;
+    } subforms;
+    struct {
+      struct input *fields, *next, *parent;
+    } entry;
+  } data;
+} input;
+
+typedef struct {
+  void *data;
+  uw_callback commit, rollback;
+  uw_callback_with_retry free;
+} transactional;
+
+typedef struct {
+  char *name;
+  void *data;
+  void (*free)(void*);
+} global;
+
+typedef struct uw_Sqlcache_Update {
+  uw_Sqlcache_Cache *cache;
+  char **keys;
+  uw_Sqlcache_Value *value;
+  struct uw_Sqlcache_Update *next;
+} uw_Sqlcache_Update;
+
+typedef struct uw_Sqlcache_Unlock {
+  pthread_rwlock_t *lock;
+  struct uw_Sqlcache_Unlock *next;
+} uw_Sqlcache_Unlock;
+
+struct uw_context {
+  uw_app *app;
+  int id;
+
+  char *(*get_header)(void *, const char *);
+  void *get_header_data;
+
+  char *(*get_env)(void *, const char *);
+  void *get_env_data;
+
+  uw_buffer outHeaders, page, heap, script;
+  int allowed_to_return_indirectly, returning_indirectly;
+  input *inputs, *subinputs, *cur_container;
+  size_t sz_inputs, n_subinputs, used_subinputs;
+
+  unsigned long long source_count;
+
+  void *db;
+  int transaction_started;
+
+  jmp_buf jmp_buf;
+
+  regions *regions;
+
+  cleanup *cleanup, *cleanup_front, *cleanup_back;
+
+  const char *script_header;
+
+  int needs_push, needs_sig, could_write_db, at_most_one_query;
+
+  size_t n_deltas, used_deltas;
+  delta *deltas;
+
+  client *client;
+
+  transactional *transactionals;
+  size_t n_transactionals, used_transactionals;
+
+  global *globals;
+  size_t n_globals;
+
+  char *current_url;
+
+  int deadline;
+
+  void *client_data;
+
+  uw_loggers *loggers;
+
+  int isPost, hasPostBody;
+  uw_Basis_postBody postBody;
+  uw_Basis_string queryString;
+
+  unsigned nextId;
+
+  int amInitializing;
+
+  char error_message[ERROR_BUF_LEN];
+
+  int usedSig, needsResig;
+
+  char *output_buffer;
+  size_t output_buffer_size;
+
+  // Sqlcache.
+  int numRecording, recordingCapacity;
+  int *recordingOffsets, *scriptRecordingOffsets;
+  uw_Sqlcache_Update *cacheUpdate;
+  uw_Sqlcache_Update *cacheUpdateTail;
+  uw_Sqlcache_Unlock *cacheUnlock;
+
+  int remoteSock;
+};
+
+size_t uw_headers_max = SIZE_MAX;
+size_t uw_page_max = SIZE_MAX;
+size_t uw_heap_max = SIZE_MAX;
+size_t uw_script_max = SIZE_MAX;
+
+uw_context uw_init(int id, uw_loggers *lg) {
+  uw_context ctx = malloc(sizeof(struct uw_context));
+
+  ctx->app = NULL;
+  ctx->id = id;
+
+  ctx->get_header = NULL;
+  ctx->get_header_data = NULL;
+
+  ctx->get_env = NULL;
+  ctx->get_env_data = NULL;
+
+  uw_buffer_init(uw_headers_max, &ctx->outHeaders, 1);
+  ctx->outHeaders.start[0] = 0;
+  uw_buffer_init(uw_page_max, &ctx->page, 1);
+  ctx->page.start[0] = 0;
+  ctx->allowed_to_return_indirectly = ctx->returning_indirectly = 0;
+  uw_buffer_init(uw_heap_max, &ctx->heap, uw_min_heap);
+  uw_buffer_init(uw_script_max, &ctx->script, 1);
+  ctx->script.start[0] = 0;
+
+  ctx->inputs = malloc(0);
+  ctx->cur_container = NULL;
+  ctx->subinputs = malloc(0);
+  ctx->sz_inputs = ctx->n_subinputs = ctx->used_subinputs = 0;
+
+  ctx->db = NULL;
+  ctx->transaction_started = 0;
+
+  ctx->regions = NULL;
+
+  ctx->cleanup_front = ctx->cleanup_back = ctx->cleanup = malloc(0);
+
+  ctx->script_header = "";
+  ctx->needs_push = 0;
+  ctx->needs_sig = 0;
+  ctx->could_write_db = 1;
+  ctx->at_most_one_query = 0;
+
+  ctx->source_count = 0;
+
+  ctx->n_deltas = ctx->used_deltas = 0;
+  ctx->deltas = malloc(0);
+
+  ctx->client = NULL;
+
+  ctx->error_message[0] = 0;
+
+  ctx->transactionals = malloc(0);
+  ctx->n_transactionals = ctx->used_transactionals = 0;
+
+  ctx->globals = malloc(0);
+  ctx->n_globals = 0;
+
+  ctx->current_url = "";
+
+  ctx->deadline = INT_MAX;
+
+  ctx->client_data = uw_init_client_data();
+
+  ctx->loggers = lg;
+
+  ctx->isPost = ctx->hasPostBody = 0;
+
+  ctx->queryString = NULL;
+
+  ctx->nextId = 0;
+
+  ctx->amInitializing = 0;
+
+  ctx->usedSig = 0;
+  ctx->needsResig = 0;
+
+  ctx->output_buffer = malloc(1);
+  ctx->output_buffer_size = 1;
+
+  ctx->numRecording = 0;
+  ctx->recordingCapacity = 0;
+  ctx->recordingOffsets = malloc(0);
+  ctx->scriptRecordingOffsets = malloc(0);
+  ctx->cacheUpdate = NULL;
+  ctx->cacheUpdateTail = NULL;
+
+  ctx->remoteSock = -1;
+
+  ctx->cacheUnlock = NULL;
+
+  return ctx;
+}
+
+size_t uw_inputs_max = SIZE_MAX;
+
+uw_app *uw_get_app(uw_context ctx) {
+  return ctx->app;
+}
+
+int uw_set_app(uw_context ctx, uw_app *app) {
+  ctx->app = app;
+
+  if (app && app->inputs_len > ctx->sz_inputs) {
+    if (app->inputs_len > uw_inputs_max)
+      return 1;
+
+    ctx->sz_inputs = app->inputs_len;
+    ctx->inputs = realloc(ctx->inputs, ctx->sz_inputs * sizeof(input));
+    memset(ctx->inputs, 0, ctx->sz_inputs * sizeof(input));
+  }
+
+  return 0;
+}
+
+void uw_set_client_data(uw_context ctx, void *data) {
+  uw_copy_client_data(ctx->client_data, data);
+}
+
+void uw_set_db(uw_context ctx, void *db) {
+  ctx->db = db;
+}
+
+void *uw_get_db(uw_context ctx) {
+  return ctx->db;
+}
+
+
+uw_loggers* uw_get_loggers(struct uw_context *ctx) {
+  return ctx->loggers;
+}
+
+void uw_free(uw_context ctx) {
+  size_t i;
+
+  uw_buffer_free(&ctx->outHeaders);
+  uw_buffer_free(&ctx->script);
+  uw_buffer_free(&ctx->page);
+  uw_buffer_free(&ctx->heap);
+  free(ctx->inputs);
+  free(ctx->subinputs);
+  free(ctx->cleanup);
+  free(ctx->transactionals);
+  uw_free_client_data(ctx->client_data);
+
+  for (i = 0; i < ctx->n_deltas; ++i)
+    uw_buffer_free(&ctx->deltas[i].msgs);
+  free(ctx->deltas);
+
+  for (i = 0; i < ctx->n_globals; ++i)
+    if (ctx->globals[i].free)
+      ctx->globals[i].free(ctx->globals[i].data);
+  free(ctx->globals);
+
+  free(ctx->output_buffer);
+
+  free(ctx->recordingOffsets);
+  free(ctx->scriptRecordingOffsets);
+
+  free(ctx);
+}
+
+void uw_reset_keep_error_message(uw_context ctx) {
+  uw_buffer_reset(&ctx->outHeaders);
+  uw_buffer_reset(&ctx->script);
+  ctx->script.start[0] = 0;
+  uw_buffer_reset(&ctx->page);
+  ctx->allowed_to_return_indirectly = ctx->returning_indirectly = 0;
+  uw_buffer_reset(&ctx->heap);
+  ctx->regions = NULL;
+  ctx->cleanup_front = ctx->cleanup;
+  ctx->used_deltas = 0;
+  ctx->client = NULL;
+  ctx->cur_container = NULL;
+  ctx->used_transactionals = 0;
+  ctx->script_header = "";
+  ctx->queryString = NULL;
+  ctx->nextId = 0;
+  ctx->amInitializing = 0;
+  ctx->usedSig = 0;
+  ctx->needsResig = 0;
+  ctx->remoteSock = -1;
+  ctx->numRecording = 0;
+}
+
+void uw_reset_keep_request(uw_context ctx) {
+  uw_reset_keep_error_message(ctx);
+  ctx->error_message[0] = 0;
+}
+
+void uw_reset(uw_context ctx) {
+  uw_reset_keep_request(ctx);
+  if (ctx->app)
+    memset(ctx->inputs, 0, ctx->app->inputs_len * sizeof(input));
+  memset(ctx->subinputs, 0, ctx->n_subinputs * sizeof(input));
+  ctx->used_subinputs = ctx->hasPostBody = ctx->isPost = 0;
+  ctx->transaction_started = 0;
+}
+
+failure_kind uw_begin_init(uw_context ctx) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0 && ctx->app)
+    ctx->app->db_init(ctx);
+
+  return r;
+}
+
+void uw_close(uw_context ctx) {
+  ctx->app->db_close(ctx);
+}
+
+uw_Basis_string uw_Basis_requestHeader(uw_context ctx, uw_Basis_string h) {
+  return ctx->get_header(ctx->get_header_data, h);
+}
+
+void uw_set_headers(uw_context ctx, char *(*get_header)(void *, const char *), void *get_header_data) {
+  ctx->get_header = get_header;
+  ctx->get_header_data = get_header_data;
+}
+
+void uw_set_env(uw_context ctx, char *(*get_env)(void *, const char *), void *get_env_data) {
+  ctx->get_env = get_env;
+  ctx->get_env_data = get_env_data;
+}
+
+static void uw_set_error(uw_context ctx, const char *fmt, ...) {
+  va_list ap;
+  va_start(ap, fmt);
+
+  vsnprintf(ctx->error_message, ERROR_BUF_LEN, fmt, ap);
+}
+
+int uw_has_error(uw_context ctx) {
+  return ctx->error_message[0] != 0;
+}
+
+__attribute__((noreturn)) void uw_error(uw_context ctx, failure_kind fk, const char *fmt, ...) {
+  cleanup *cl;
+
+  va_list ap;
+  va_start(ap, fmt);
+
+  vsnprintf(ctx->error_message, ERROR_BUF_LEN, fmt, ap);
+
+  for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+    cl->func(cl->arg);
+
+  ctx->cleanup_front = ctx->cleanup;
+
+  longjmp(ctx->jmp_buf, fk);
+}
+
+size_t uw_cleanup_max = SIZE_MAX;
+
+void uw_push_cleanup(uw_context ctx, void (*func)(void *), void *arg) {
+  if (ctx->cleanup_front >= ctx->cleanup_back) {
+    int len = ctx->cleanup_back - ctx->cleanup, newLen;
+    if (len == 0)
+      newLen = 1;
+    else
+      newLen = len * 2;
+
+    if (newLen > uw_cleanup_max) {
+      if (len+1 <= uw_cleanup_max)
+        newLen = uw_cleanup_max;
+      else
+        uw_error(ctx, FATAL, "Exceeded limit on number of cleanup handlers");
+    }
+
+    ctx->cleanup = realloc(ctx->cleanup, newLen * sizeof(cleanup));
+    ctx->cleanup_front = ctx->cleanup + len;
+    ctx->cleanup_back = ctx->cleanup + newLen;
+  }
+
+  ctx->cleanup_front->func = func;
+  ctx->cleanup_front->arg = arg;
+  ++ctx->cleanup_front;
+}
+
+char *uw_Basis_htmlifyString(uw_context, const char *);
+
+void uw_login(uw_context ctx) {
+  char *id_s, *pass_s;
+
+  if ((id_s = uw_Basis_requestHeader(ctx, "UrWeb-Client"))
+      && (pass_s = uw_Basis_requestHeader(ctx, "UrWeb-Pass"))) {
+    unsigned id = atoi(id_s);
+    int pass = atoi(pass_s);
+    client *c = find_client(id);
+
+    if (c == NULL)
+      uw_error(ctx, FATAL, "Unknown client ID in HTTP headers (%s, %s)", uw_Basis_htmlifyString(ctx, id_s), uw_Basis_htmlifyString(ctx, pass_s));
+    else {
+      use_client(c);
+      ctx->client = c;
+
+      if (c->mode != USED)
+        uw_error(ctx, FATAL, "Stale client ID (%u) in subscription request", id);
+      if (c->pass != pass)
+        uw_error(ctx, FATAL, "Wrong client password (%u, %d) in subscription request", id, pass);
+    }
+  } else if (ctx->needs_push) {
+    client *c = new_client(ctx);
+
+    if (c == NULL)
+      uw_error(ctx, FATAL, "Limit exceeded on number of message-passing clients");
+
+    use_client(c);
+    uw_copy_client_data(c->data, ctx->client_data);
+    ctx->client = c;
+  }
+}
+
+failure_kind uw_begin(uw_context ctx, char *path) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0)
+    ctx->app->handle(ctx, path);
+
+  return r;
+}
+
+static void uw_try_reconnecting(uw_context ctx) {
+  // Hm, error starting transaction.
+  // Maybe the database server died but has since come back up.
+  // Let's try starting from scratch.
+  if (ctx->db) {
+    ctx->app->db_close(ctx);
+    ctx->db = NULL;
+  }
+  ctx->app->db_init(ctx);
+}
+
+void uw_try_reconnecting_and_restarting(uw_context ctx) {
+  uw_try_reconnecting(ctx);
+  uw_error(ctx, BOUNDED_RETRY, "Restarting transaction after fixing database connection");
+}
+
+void uw_ensure_transaction(uw_context ctx) {
+  if (!ctx->transaction_started && !ctx->at_most_one_query) {
+    if (!ctx->db || ctx->app->db_begin(ctx, ctx->could_write_db)) {
+      uw_try_reconnecting(ctx);
+
+      if (ctx->app->db_begin(ctx, ctx->could_write_db))
+        uw_error(ctx, FATAL, "Error running SQL BEGIN");
+    }
+
+    ctx->transaction_started = 1;
+  } else if (ctx->at_most_one_query && !ctx->db)
+    uw_try_reconnecting(ctx);
+}
+
+uw_Basis_client uw_Basis_self(uw_context ctx) {
+  if (ctx->client == NULL)
+    uw_error(ctx, FATAL, "Call to Basis.self() from page that has only server-side code");
+
+  return ctx->client->id;
+}
+
+void uw_pop_cleanup(uw_context ctx) {
+  if (ctx->cleanup_front == ctx->cleanup)
+    uw_error(ctx, FATAL, "Attempt to pop from empty cleanup action stack");
+
+  --ctx->cleanup_front;
+  ctx->cleanup_front->func(ctx->cleanup_front->arg);
+}
+
+char *uw_error_message(uw_context ctx) {
+  return ctx->error_message;
+}
+
+void uw_set_error_message(uw_context ctx, const char *msg) {
+  strncpy(ctx->error_message, msg, sizeof(ctx->error_message));
+  ctx->error_message[sizeof(ctx->error_message)-1] = 0;
+}
+
+static input *INP(uw_context ctx) {
+  if (ctx->cur_container == NULL)
+    return ctx->inputs;
+  else if (ctx->cur_container->kind == SUBFORM)
+    return ctx->cur_container->data.subform.fields;
+  else if (ctx->cur_container->kind == ENTRY)
+    return ctx->cur_container->data.entry.fields;
+  else
+    uw_error(ctx, FATAL, "INP: Wrong kind (%d, %p)", ctx->cur_container->kind, ctx->cur_container);
+}
+
+static void adjust_pointer(input **ptr, input *old_start, input *new_start, size_t len) {
+  if (*ptr != NULL && *ptr >= old_start && *ptr < old_start + len)
+    *ptr += new_start - old_start;
+}
+
+static void adjust_input(input *x, input *old_start, input *new_start, size_t len) {
+  switch (x->kind) {
+  case SUBFORM:
+    adjust_pointer(&x->data.subform.fields, old_start, new_start, len);
+    adjust_pointer(&x->data.subform.parent, old_start, new_start, len);
+    break;
+  case SUBFORMS:
+    adjust_pointer(&x->data.subforms.entries, old_start, new_start, len);
+    adjust_pointer(&x->data.subforms.parent, old_start, new_start, len);
+    break;
+  case ENTRY:
+    adjust_pointer(&x->data.entry.fields, old_start, new_start, len);
+    adjust_pointer(&x->data.entry.next, old_start, new_start, len);
+    adjust_pointer(&x->data.entry.parent, old_start, new_start, len);
+    break;
+  default:
+    break;
+  }
+}
+
+size_t uw_subinputs_max = SIZE_MAX;
+
+static input *check_input_space(uw_context ctx, size_t len) {
+  size_t i;
+  input *r;
+
+  if (ctx->used_subinputs + len >= ctx->n_subinputs) {
+    if (ctx->used_subinputs + len > uw_subinputs_max)
+      uw_error(ctx, FATAL, "Exceeded limit on number of subinputs");
+
+    input *new_subinputs = realloc(ctx->subinputs, sizeof(input) * (ctx->used_subinputs + len));
+
+    if (ctx->subinputs != new_subinputs) {
+      for (i = 0; i < ctx->used_subinputs; ++i)
+        adjust_input(&new_subinputs[i], ctx->subinputs, new_subinputs, ctx->used_subinputs);
+      for (i = 0; i < ctx->app->inputs_len; ++i)
+        adjust_input(&ctx->inputs[i], ctx->subinputs, new_subinputs, ctx->used_subinputs);
+
+      adjust_pointer(&ctx->cur_container, ctx->subinputs, new_subinputs, ctx->used_subinputs);
+
+      ctx->n_subinputs = ctx->used_subinputs + len;
+      ctx->subinputs = new_subinputs;
+    }
+  }
+
+  r = &ctx->subinputs[ctx->used_subinputs];
+
+  for (i = 0; i < len; ++i)
+    ctx->subinputs[ctx->used_subinputs++].kind = UNSET;
+
+  return r;
+}
+
+int uw_set_input(uw_context ctx, const char *name, char *value) {
+  //printf("Input name %s\n", name);
+
+  if (!strcasecmp(name, ".b")) {
+    int n = ctx->app->input_num(value);
+    input *inps;
+
+    if (n < 0) {
+      uw_set_error(ctx, "Bad subform name %s", uw_Basis_htmlifyString(ctx, value));
+      return -1;
+    }
+
+    if (n >= ctx->app->inputs_len) {
+      uw_set_error(ctx, "For subform name %s, index %d is out of range", uw_Basis_htmlifyString(ctx, value), n);
+      return -1;
+    }
+
+    inps = check_input_space(ctx, ctx->app->inputs_len);
+
+    INP(ctx)[n].kind = SUBFORM;
+    INP(ctx)[n].data.subform.parent = ctx->cur_container;
+    INP(ctx)[n].data.subform.fields = inps;
+    ctx->cur_container = &INP(ctx)[n];
+  } else if (!strcasecmp(name, ".e")) {
+    input *tmp;
+
+    if (ctx->cur_container == NULL) {
+      uw_set_error(ctx, "Unmatched subform closer");
+      return -1;
+    }
+
+    tmp = ctx->cur_container;
+    switch (tmp->kind) {
+    case SUBFORM:
+      ctx->cur_container = tmp->data.subform.parent;
+      tmp->data.subform.parent = NULL;
+      break;
+    case SUBFORMS:
+      ctx->cur_container = tmp->data.subforms.parent;
+      tmp->data.subforms.parent = NULL;
+      break;
+    case ENTRY:
+      ctx->cur_container = tmp->data.entry.parent;
+      break;
+    default:
+      uw_set_error(ctx, "uw_set_input: Wrong kind");
+      return -1;
+    }
+  } else if (!strcasecmp(name, ".s")) {
+    int n = ctx->app->input_num(value);
+
+    if (n < 0) {
+      uw_set_error(ctx, "Bad subforms name %s", uw_Basis_htmlifyString(ctx, value));
+      return -1;
+    }
+
+    if (n >= ctx->app->inputs_len) {
+      uw_set_error(ctx, "For subforms name %s, index %d is out of range", uw_Basis_htmlifyString(ctx, value), n);
+      return -1;
+    }
+
+    INP(ctx)[n].kind = SUBFORMS;
+    INP(ctx)[n].data.subforms.parent = ctx->cur_container;
+    INP(ctx)[n].data.subforms.entries = NULL;
+    ctx->cur_container = &INP(ctx)[n];
+  } else if (!strcasecmp(name, ".i")) {
+    input *inps;
+
+    if (!ctx->cur_container) {
+      uw_set_error(ctx, "New entry without container");
+      return -1;
+    }
+
+    if (ctx->cur_container->kind != SUBFORMS) {
+      uw_set_error(ctx, "Bad kind for entry parent");
+      return -1;
+    }
+
+    inps = check_input_space(ctx, ctx->app->inputs_len + 1);
+
+    inps->kind = ENTRY;
+    inps->data.entry.parent = ctx->cur_container;
+    inps->data.entry.next = ctx->cur_container->data.subforms.entries;
+    ctx->cur_container->data.subforms.entries = inps;
+
+    inps->data.entry.fields = inps+1;
+    ctx->cur_container = inps;
+  } else {
+    int n = ctx->app->input_num(name);
+
+    if (n < 0)
+      return 0;
+
+    if (n >= ctx->app->inputs_len) {
+      uw_set_error(ctx, "For input name %s, index %d is out of range", uw_Basis_htmlifyString(ctx, name), n);
+      return -1;
+    }
+
+    INP(ctx)[n].kind = NORMAL;
+    INP(ctx)[n].data.normal = value;
+  }
+
+  return 0;
+}
+
+char *uw_get_input(uw_context ctx, int n) {
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative input index %d", n);
+  if (n >= ctx->app->inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds input index %d", n);
+
+  switch (INP(ctx)[n].kind) {
+  case UNSET:
+    return NULL;
+  case FIL:
+    uw_error(ctx, FATAL, "Tried to read a file form input as normal");
+  case SUBFORM:
+    uw_error(ctx, FATAL, "Tried to read a subform form input as normal");
+  case SUBFORMS:
+    uw_error(ctx, FATAL, "Tried to read a subforms form input as normal");
+  case ENTRY:
+    uw_error(ctx, FATAL, "Tried to read an entry form input as normal");
+  case NORMAL:
+    return INP(ctx)[n].data.normal;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+char *uw_get_optional_input(uw_context ctx, int n) {
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative input index %d", n);
+  if (n >= ctx->app->inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds input index %d", n);
+
+  switch (INP(ctx)[n].kind) {
+  case UNSET:
+    return "";
+  case FIL:
+    uw_error(ctx, FATAL, "Tried to read a file form input as normal");
+  case SUBFORM:
+    uw_error(ctx, FATAL, "Tried to read a subform form input as normal");
+  case SUBFORMS:
+    uw_error(ctx, FATAL, "Tried to read a subforms form input as normal");
+  case ENTRY:
+    uw_error(ctx, FATAL, "Tried to read an entry form input as normal");
+  case NORMAL:
+    return INP(ctx)[n].data.normal;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+int uw_set_file_input(uw_context ctx, const char *name, uw_Basis_file f) {
+  int n = ctx->app->input_num(name);
+
+  if (n < 0) {
+    uw_set_error(ctx, "Bad file input name");
+    return -1;
+  }
+
+  if (n >= ctx->app->inputs_len) {
+    uw_set_error(ctx, "For file input name, index %d is out of range", n);
+    return -1;
+  }
+
+  ctx->inputs[n].kind = FIL;
+  ctx->inputs[n].data.file = f;
+
+  return 0;
+}
+
+void *uw_malloc(uw_context ctx, size_t len);
+
+uw_Basis_file uw_get_file_input(uw_context ctx, int n) {
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative file input index %d", n);
+  if (n >= ctx->app->inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds file input index %d", n);
+
+  switch (INP(ctx)[n].kind) {
+  case UNSET:
+    {
+      char *data = uw_malloc(ctx, 0);
+      uw_Basis_file f = {NULL, "", {0, data}};
+      return f;
+    }
+  case FIL:
+    return INP(ctx)[n].data.file;
+  case NORMAL:
+    uw_error(ctx, FATAL, "Tried to read a normal form input as files");
+  case SUBFORM:
+    uw_error(ctx, FATAL, "Tried to read a subform form input as files");
+  case SUBFORMS:
+    uw_error(ctx, FATAL, "Tried to read a subforms form input as files");
+  case ENTRY:
+    uw_error(ctx, FATAL, "Tried to read an entry form input as files");
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+void uw_enter_subform(uw_context ctx, int n) {
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative subform index %d", n);
+  if (n >= ctx->app->inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds subform index %d", n);
+
+  switch (INP(ctx)[n].kind) {
+  case UNSET:
+    uw_error(ctx, FATAL, "Missing subform");
+  case FIL:
+    uw_error(ctx, FATAL, "Tried to read a file form input as subform");
+  case NORMAL:
+    uw_error(ctx, FATAL, "Tried to read a normal form input as subform");
+  case SUBFORMS:
+    uw_error(ctx, FATAL, "Tried to read a subforms form input as subform");
+  case ENTRY:
+    uw_error(ctx, FATAL, "Tried to read an entry form input as subform");
+  case SUBFORM:
+    INP(ctx)[n].data.subform.parent = ctx->cur_container;
+    ctx->cur_container = &INP(ctx)[n];
+    return;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+void uw_leave_subform(uw_context ctx) {
+  input *tmp;
+
+  if (ctx->cur_container == NULL)
+    uw_error(ctx, FATAL, "Unmatched uw_leave_subform");
+
+  tmp = ctx->cur_container;
+  ctx->cur_container = tmp->data.subform.parent;
+  tmp->data.subform.parent = NULL;
+}
+
+int uw_enter_subforms(uw_context ctx, int n) {
+  input *inps;
+
+  if (n < 0)
+    uw_error(ctx, FATAL, "Negative subforms index %d", n);
+  if (n >= ctx->app->inputs_len)
+    uw_error(ctx, FATAL, "Out-of-bounds subforms index %d", n);
+
+  switch (INP(ctx)[n].kind) {
+  case UNSET:
+    uw_error(ctx, FATAL, "Missing subforms");
+  case FIL:
+    uw_error(ctx, FATAL, "Tried to read a file form input as subforms");
+  case NORMAL:
+    uw_error(ctx, FATAL, "Tried to read a normal form input %p as subforms", &INP(ctx)[n]);
+  case SUBFORM:
+    uw_error(ctx, FATAL, "Tried to read a subform form input as subforms");
+  case ENTRY:
+    uw_error(ctx, FATAL, "Tried to read an entry form input as subforms");
+  case SUBFORMS:
+    inps = INP(ctx)[n].data.subforms.entries;
+    if (inps) {
+      INP(ctx)[n].data.subforms.parent = ctx->cur_container;
+      ctx->cur_container = INP(ctx)[n].data.subforms.entries;
+      return 1;
+    } else
+      return 0;
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+int uw_next_entry(uw_context ctx) {
+  if (ctx->cur_container == NULL)
+    uw_error(ctx, FATAL, "uw_next_entry(NULL)");
+
+  switch (ctx->cur_container->kind) {
+  case UNSET:
+    uw_error(ctx, FATAL, "Missing entry");
+  case FIL:
+    uw_error(ctx, FATAL, "Tried to read a file form input as entry");
+  case NORMAL:
+    uw_error(ctx, FATAL, "Tried to read a normal form input as entry");
+  case SUBFORM:
+    uw_error(ctx, FATAL, "Tried to read a subform form input as entry");
+  case SUBFORMS:
+    uw_error(ctx, FATAL, "Tried to read a subforms form input as entry");
+  case ENTRY:
+    if (ctx->cur_container->data.entry.next) {
+      ctx->cur_container = ctx->cur_container->data.entry.next;
+      return 1;
+    } else {
+      ctx->cur_container = ctx->cur_container->data.entry.parent->data.subforms.parent;
+      return 0;
+    }
+  default:
+    uw_error(ctx, FATAL, "Impossible input kind");
+  }
+}
+
+void uw_set_script_header(uw_context ctx, const char *s) {
+  ctx->script_header = s;
+}
+
+const char *uw_get_url_prefix(uw_context ctx) {
+  return ctx->app->url_prefix;
+}
+
+void uw_set_needs_push(uw_context ctx, int n) {
+  ctx->needs_push = n;
+}
+
+void uw_set_needs_sig(uw_context ctx, int n) {
+  ctx->needs_sig = n;
+}
+
+void uw_set_could_write_db(uw_context ctx, int n) {
+  ctx->could_write_db = n;
+}
+
+void uw_set_at_most_one_query(uw_context ctx, int n) {
+  ctx->at_most_one_query = n;
+}
+
+
+static void uw_buffer_check_ctx(uw_context ctx, const char *kind, uw_buffer *b, size_t extra, const char *desc) {
+  if (b->back - b->front < extra) {
+    size_t desired = b->front - b->start + extra, next;
+    char *new_heap;
+
+    next = b->back - b->start;
+    if (next == 0)
+      next = 1;
+    for (; next < desired; next *= 2);
+
+    if (next > b->max) {
+      if (desired <= b->max)
+        next = desired;
+      else
+        uw_error(ctx, FATAL, "Memory limit exceeded (%s)", kind);
+    }
+
+    new_heap = realloc(b->start, next);
+    b->front = new_heap + (b->front - b->start);
+    b->back = new_heap + next;
+
+    if (new_heap != b->start) {
+      b->start = new_heap;
+      uw_error(ctx, UNLIMITED_RETRY, "Couldn't allocate new %s contiguously; increasing size to %llu", desc, (unsigned long long)next);
+    }
+
+    b->start = new_heap;
+  }
+}
+
+void uw_check_heap(uw_context ctx, size_t extra) {
+  uw_buffer_check_ctx(ctx, "heap", &ctx->heap, extra, "heap chunk");
+}
+
+char *uw_heap_front(uw_context ctx) {
+  return ctx->heap.front;
+}
+
+void uw_set_heap_front(uw_context ctx, char *fr) {
+  ctx->heap.front = fr;
+}
+
+void uw_begin_initializing(uw_context ctx) {
+  ctx->amInitializing = 1;
+}
+
+void uw_end_initializing(uw_context ctx) {
+  ctx->amInitializing = 0;
+}
+
+static void align_heap(uw_context ctx) {
+  size_t posn = ctx->heap.front - ctx->heap.start;
+
+  if (posn % sizeof(void *) != 0) {
+    size_t bump = sizeof(void *) - posn % sizeof(void *);
+    uw_check_heap(ctx, bump);
+    ctx->heap.front += bump;
+  }
+}
+
+void *uw_malloc(uw_context ctx, size_t len) {
+  // On some architectures, it's important that all word-sized memory accesses
+  // be to word-aligned addresses, so we'll do a little bit of extra work here
+  // in anticipation of a possible word-aligned access to the address we'll
+  // return.
+
+  void *result;
+
+  if (ctx->amInitializing) {
+    int error = posix_memalign(&result, sizeof(void *), len);
+
+    if (!error)
+      return result;
+    else
+      uw_error(ctx, FATAL, "uw_malloc: posix_memalign() returns %d", error);
+  } else {
+    align_heap(ctx);
+
+    uw_check_heap(ctx, len);
+
+    result = ctx->heap.front;
+    ctx->heap.front += len;
+    return result;
+  }
+}
+
+void uw_begin_region(uw_context ctx) {
+  align_heap(ctx);
+
+  regions *r = (regions *) ctx->heap.front;
+
+  uw_check_heap(ctx, sizeof(regions));
+
+  ctx->heap.front += sizeof(regions);
+
+  r->next = ctx->regions;
+  ctx->regions = r;
+}
+
+void uw_end_region(uw_context ctx) {
+  regions *r = ctx->regions;
+
+  if (r == NULL)
+    uw_error(ctx, FATAL, "Region stack underflow");
+
+  ctx->heap.front = (char *) r;
+  ctx->regions = r->next;
+}
+
+void uw_memstats(uw_context ctx) {
+  printf("Headers: %lu/%lu\n", (unsigned long)uw_buffer_used(&ctx->outHeaders), (unsigned long)uw_buffer_avail(&ctx->outHeaders));
+  printf("Script: %lu/%lu\n", (unsigned long)uw_buffer_used(&ctx->script), (unsigned long)uw_buffer_avail(&ctx->script));
+  printf("Page: %lu/%lu\n", (unsigned long)uw_buffer_used(&ctx->page), (unsigned long)uw_buffer_avail(&ctx->page));
+  printf("Heap: %lu/%lu\n", (unsigned long)uw_buffer_used(&ctx->heap), (unsigned long)uw_buffer_avail(&ctx->heap));
+}
+
+int uw_pagelen(uw_context ctx) {
+  return ctx->page.front - ctx->page.start;
+}
+
+int uw_send(uw_context ctx, int sock) {
+  size_t target_length = (ctx->outHeaders.front - ctx->outHeaders.start) + 2 + (ctx->page.front - ctx->page.start);
+
+  if (ctx->output_buffer_size < target_length) {
+    do {
+      ctx->output_buffer_size *= 2;
+    } while (ctx->output_buffer_size < target_length);
+    ctx->output_buffer = realloc(ctx->output_buffer, ctx->output_buffer_size);
+  }
+
+  memcpy(ctx->output_buffer, ctx->outHeaders.start, ctx->outHeaders.front - ctx->outHeaders.start);
+  memcpy(ctx->output_buffer + (ctx->outHeaders.front - ctx->outHeaders.start), "\r\n", 2);
+  memcpy(ctx->output_buffer + (ctx->outHeaders.front - ctx->outHeaders.start) + 2, ctx->page.start, ctx->page.front - ctx->page.start);
+
+  return uw_really_send(sock, ctx->output_buffer, target_length);
+}
+
+int uw_print(uw_context ctx, int fd) {
+  int n = uw_really_write(fd, ctx->outHeaders.start, ctx->outHeaders.front - ctx->outHeaders.start);
+
+  if (n < 0)
+    return n;
+
+  n = uw_really_write(fd, "\r\n", 2);
+
+  if (n < 0)
+    return n;
+
+  return uw_really_write(fd, ctx->page.start, ctx->page.front - ctx->page.start);
+}
+
+int uw_output(uw_context ctx, int (*output)(void *data, char *buf, size_t len), void *data) {
+  int n = output(data, ctx->outHeaders.start, ctx->outHeaders.front - ctx->outHeaders.start);
+
+  if (n < 0)
+    return n;
+
+  n = output(data, "\r\n", 2);
+
+  if (n < 0)
+    return n;
+
+  return output(data, ctx->page.start, ctx->page.front - ctx->page.start);
+}
+
+static void uw_check_headers(uw_context ctx, size_t extra) {
+  ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, extra);
+}
+
+void uw_write_header(uw_context ctx, uw_Basis_string s) {
+  int len = strlen(s);
+
+  uw_check_headers(ctx, len + 1);
+  strcpy(ctx->outHeaders.front, s);
+  ctx->outHeaders.front += len;
+}
+
+int uw_has_contentLength(uw_context ctx) {
+  return strstr(ctx->outHeaders.start, "Content-length: ") != NULL;
+}
+
+void uw_clear_headers(uw_context ctx) {
+  uw_buffer_reset(&ctx->outHeaders);
+}
+
+void uw_Basis_clear_page(uw_context ctx) {
+  uw_buffer_reset(&ctx->page);
+}
+
+static void uw_check_script(uw_context ctx, size_t extra) {
+  ctx_uw_buffer_check(ctx, "script", &ctx->script, extra);
+}
+
+void uw_write_script(uw_context ctx, uw_Basis_string s) {
+  int len = strlen(s);
+
+  uw_check_script(ctx, len + 1);
+  strcpy(ctx->script.front, s);
+  ctx->script.front += len;
+}
+
+const char *uw_get_real_script(uw_context ctx) {
+  if (strstr(ctx->outHeaders.start, "Set-Cookie: ")) {
+    uw_write_script(ctx, "sig=\"");
+    uw_write_script(ctx, ctx->app->cookie_sig(ctx));
+    uw_write_script(ctx, "\";");
+  }
+
+  return ctx->script.start;
+}
+
+uw_Basis_string uw_Basis_maybe_onload(uw_context ctx, uw_Basis_string s) {
+  if (s[0] == 0)
+    return "";
+  else {
+    char *r = uw_malloc(ctx, 11 + strlen(s));
+    sprintf(r, " onload='%s'", s);
+    return r;
+  }
+}
+
+uw_Basis_string uw_Basis_maybe_onunload(uw_context ctx, uw_Basis_string s) {
+  if (ctx->script_header[0] == 0)
+    return "";
+  else {
+    char *r = uw_malloc(ctx, 37 + strlen(s));
+    sprintf(r, " onunload='unloading=true;%s;unload()'", s);
+    return r;
+  }
+}
+
+const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) {
+  if (ctx->client == NULL) {
+    if (ctx->needs_sig) {
+      char *sig = ctx->app->cookie_sig(ctx);
+      char *r = uw_malloc(ctx, strlen(sig) + 8);
+      sprintf(r, "sig=\"%s\";", sig);
+      return r;
+    }
+    else
+      return "";
+  } else {
+    char *sig = ctx->needs_sig ? ctx->app->cookie_sig(ctx) : "";
+    char *r = uw_malloc(ctx, 59 + 3 * INTS_MAX + strlen(ctx->app->url_prefix)
+                        + (ctx->needs_sig ? strlen(sig) + 7 : 0));
+    sprintf(r, "isPost=%s;client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s%s%slistener();",
+            (ctx->isPost ? "true" : "false"),
+            ctx->client->id,
+            ctx->client->pass,
+            ctx->app->url_prefix,
+            ctx->app->timeout,
+            ctx->needs_sig ? "sig=\"" : "",
+            sig,
+            ctx->needs_sig ? "\";" : "");
+    return r;
+  }
+}
+
+uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) {
+  char *r, *s2;
+
+  uw_check_heap(ctx, strlen(s) * 4 + 3);
+
+  r = s2 = ctx->heap.front;
+  *s2++ = '"';
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    switch (c) {
+    case '"':
+      strcpy(s2, "\\\"");
+      s2 += 2;
+      break;
+    case '\'':
+      strcpy(s2, "\\047");
+      s2 += 4;
+      break;
+    case '\\':
+      strcpy(s2, "\\\\");
+      s2 += 2;
+      break;
+    case '<':
+      strcpy(s2, "\\074");
+      s2 += 4;
+      break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
+    default:
+      if (isprint((int)c) || c >= 128)
+        *s2++ = c;
+      else {
+        sprintf(s2, "\\%03o", c);
+        s2 += 4;
+      }
+    }
+  }
+
+  strcpy(s2, "\"");
+  ctx->heap.front = s2 + 2;
+  return r;
+}
+
+uw_Basis_string uw_Basis_jsifyChar(uw_context ctx, uw_Basis_char c1) {
+  unsigned char c = c1;
+  char *r, *s2;
+
+  uw_check_heap(ctx, 7);
+
+  r = s2 = ctx->heap.front;
+  *s2++ = '"';
+
+  switch (c) {
+  case '"':
+    strcpy(s2, "\\\"");
+    s2 += 2;
+    break;
+  case '\'':
+    strcpy(s2, "\\047");
+    s2 += 4;
+    break;
+  case '\\':
+    strcpy(s2, "\\\\");
+    s2 += 2;
+    break;
+  case '<':
+    strcpy(s2, "\\074");
+    s2 += 4;
+    break;
+  case '&':
+    strcpy(s2, "\\046");
+    s2 += 4;
+    break;
+  default:
+    if (isprint((int)c) || c >= 128)
+      *s2++ = c;
+    else {
+      sprintf(s2, "\\%03o", (unsigned char)c);
+      s2 += 4;
+    }
+  }
+
+  strcpy(s2, "\"");
+  ctx->heap.front = s2 + 2;
+  return r;
+}
+
+uw_Basis_string uw_Basis_jsifyString_ws(uw_context ctx, uw_Basis_string s) {
+  char *r, *s2;
+
+  uw_check_script(ctx, strlen(s) * 4 + 3);
+
+  r = s2 = ctx->script.front;
+  *s2++ = '"';
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    switch (c) {
+    case '\'':
+      strcpy(s2, "\\");
+      s2 += 2;
+      break;
+    case '\\':
+      strcpy(s2, "\\\\");
+      s2 += 2;
+      break;
+    case '<':
+      strcpy(s2, "\\074");
+      s2 += 4;
+      break;
+    case '&':
+      strcpy(s2, "\\046");
+      s2 += 4;
+      break;
+    default:
+      if (isprint((int)c) || c >= 128)
+        *s2++ = c;
+      else {
+        sprintf(s2, "\\%03o", c);
+        s2 += 4;
+      }
+    }
+  }
+
+  strcpy(s2, "\"");
+  ctx->script.front = s2 + 1;
+  return r;
+}
+
+char *uw_Basis_jsifyChannel(uw_context ctx, uw_Basis_channel chn) {
+  if (ctx->client == NULL || chn.cli != ctx->client->id)
+    return "null";
+  else {
+    int len;
+    char *r;
+
+    uw_check_heap(ctx, INTS_MAX + 1);
+    r = ctx->heap.front;
+    sprintf(r, "%u%n", chn.chn, &len);
+    ctx->heap.front += len+1;
+    return r;
+  }
+}
+
+uw_Basis_source uw_Basis_new_client_source(uw_context ctx, uw_Basis_string s) {
+  int len;
+  size_t s_len = strlen(s);
+
+  if(ctx->id < 0)
+    uw_error(ctx, FATAL, "Attempt to create client source using inappropriate context");
+
+  uw_check_script(ctx, 15 + 2 * INTS_MAX + s_len);
+  sprintf(ctx->script.front, "s%d_%llu=sc(exec(%n", ctx->id, ctx->source_count, &len);
+  ctx->script.front += len;
+  strcpy(ctx->script.front, s);
+  ctx->script.front += s_len;
+  strcpy(ctx->script.front, "));");
+  ctx->script.front += 3;
+
+  uw_Basis_source r = {ctx->id, ctx->source_count++};
+  return r;
+}
+
+uw_unit uw_Basis_set_client_source(uw_context ctx, uw_Basis_source src, uw_Basis_string s) {
+  int len;
+  size_t s_len = strlen(s);
+
+  uw_check_script(ctx, 15 + 2 * INTS_MAX + s_len);
+  sprintf(ctx->script.front, "sv(s%d_%llu,exec(%n", src.context, src.source, &len);
+  ctx->script.front += len;
+  strcpy(ctx->script.front, s);
+  ctx->script.front += s_len;
+  strcpy(ctx->script.front, "));");
+  ctx->script.front += 3;
+
+  return uw_unit_v;
+}
+
+static void uw_check(uw_context ctx, size_t extra) {
+  ctx_uw_buffer_check(ctx, "page", &ctx->page, extra);
+}
+
+static void uw_writec_unsafe(uw_context ctx, char c) {
+  *(ctx->page.front)++ = c;
+  *ctx->page.front = 0;
+}
+
+void uw_writec(uw_context ctx, char c) {
+  uw_check(ctx, 2);
+  uw_writec_unsafe(ctx, c);
+}
+
+void uw_Basis_writec(uw_context ctx, char c) {
+  uw_writec(ctx, c);
+}
+
+static void uw_write_unsafe(uw_context ctx, const char* s) {
+  int len = strlen(s);
+  memcpy(ctx->page.front, s, len);
+  ctx->page.front += len;
+}
+
+void uw_write(uw_context ctx, const char* s) {
+  uw_check(ctx, strlen(s) + 1);
+  uw_write_unsafe(ctx, s);
+  *ctx->page.front = 0;
+}
+
+void uw_recordingStart(uw_context ctx) {
+  if (ctx->numRecording == ctx->recordingCapacity) {
+    ++ctx->recordingCapacity;
+    ctx->recordingOffsets = realloc(ctx->recordingOffsets, sizeof(int) * ctx->recordingCapacity);
+    ctx->scriptRecordingOffsets = realloc(ctx->scriptRecordingOffsets, sizeof(int) * ctx->recordingCapacity);
+  }
+  ctx->recordingOffsets[ctx->numRecording] = ctx->page.front - ctx->page.start;
+  ctx->scriptRecordingOffsets[ctx->numRecording] = ctx->script.front - ctx->script.start;
+  ++ctx->numRecording;
+}
+
+char *uw_recordingRead(uw_context ctx) {
+  char *recording = ctx->page.start + ctx->recordingOffsets[ctx->numRecording-1];
+  return strdup(recording);
+}
+
+char *uw_recordingReadScript(uw_context ctx) {
+  char *recording = ctx->script.start + ctx->scriptRecordingOffsets[--ctx->numRecording];
+  return strdup(recording);
+}
+
+char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) {
+  char *result;
+  int len;
+  uw_check_heap(ctx, INTS_MAX);
+  result = ctx->heap.front;
+  sprintf(result, "%lld%n", n, &len);
+  ctx->heap.front += len+1;
+  return result;
+}
+
+char *uw_Basis_attrifyFloat(uw_context ctx, uw_Basis_float n) {
+  char *result;
+  int len;
+  uw_check_heap(ctx, FLOATS_MAX);
+  result = ctx->heap.front;
+  sprintf(result, "%.16g%n", n, &len);
+  ctx->heap.front += len+1;
+  return result;
+}
+
+char *uw_Basis_attrifyString(uw_context ctx, uw_Basis_string s) {
+  int len = strlen(s);
+  char *result, *p;
+  uw_check_heap(ctx, len * 6 + 1);
+
+  result = p = ctx->heap.front;
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    if (c == '"') {
+      strcpy(p, "&quot;");
+      p += 6;
+    } else if (c == '&') {
+      strcpy(p, "&amp;");
+      p += 5;
+    }
+    else
+      *p++ = c;
+  }
+
+  *p++ = 0;
+  ctx->heap.front = p;
+  return result;
+}
+
+char *uw_Basis_attrifyChar(uw_context ctx, uw_Basis_char c) {
+  char *result, *p;
+  uw_check_heap(ctx, 7);
+
+  result = p = ctx->heap.front;
+
+  if (c == '"') {
+    strcpy(p, "&quot;");
+    p += 6;
+  } else if (c == '&') {
+    strcpy(p, "&amp;");
+    p += 5;
+  }
+  else
+    *p++ = c;
+
+  *p++ = 0;
+  ctx->heap.front = p;
+  return result;
+}
+
+char *uw_Basis_attrifyCss_class(uw_context ctx, uw_Basis_css_class s) {
+  return s;
+}
+
+static void uw_Basis_attrifyInt_w_unsafe(uw_context ctx, uw_Basis_int n) {
+  int len;
+
+  sprintf(ctx->page.front, "%lld%n", n, &len);
+  ctx->page.front += len;
+}
+
+uw_unit uw_Basis_attrifyInt_w(uw_context ctx, uw_Basis_int n) {
+  uw_check(ctx, INTS_MAX);
+  uw_Basis_attrifyInt_w_unsafe(ctx, n);
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_attrifyFloat_w(uw_context ctx, uw_Basis_float n) {
+  int len;
+
+  uw_check(ctx, FLOATS_MAX);
+  sprintf(ctx->page.front, "%g%n", n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_attrifyString_w(uw_context ctx, uw_Basis_string s) {
+  uw_check(ctx, strlen(s) * 6);
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    if (c == '"')
+      uw_write_unsafe(ctx, "&quot;");
+    else if (c == '&')
+      uw_write_unsafe(ctx, "&amp;");
+    else
+      uw_writec_unsafe(ctx, c);
+  }
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_attrifyChar_w(uw_context ctx, uw_Basis_char c) {
+  uw_check(ctx, 6);
+
+  if (c == '"')
+    uw_write_unsafe(ctx, "&quot;");
+  else if (c == '&')
+    uw_write_unsafe(ctx, "&amp;");
+  else
+    uw_writec_unsafe(ctx, c);
+
+  return uw_unit_v;
+}
+
+
+char *uw_Basis_urlifyInt(uw_context ctx, uw_Basis_int n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_urlifyChannel(uw_context ctx, uw_Basis_channel chn) {
+  if (ctx->client == NULL || chn.cli != ctx->client->id)
+    return "";
+  else {
+    int len;
+    char *r;
+
+    uw_check_heap(ctx, INTS_MAX + 1);
+    r = ctx->heap.front;
+    sprintf(r, "%u%n", chn.chn, &len);
+    ctx->heap.front += len+1;
+    return r;
+  }
+}
+
+char *uw_Basis_urlifyFloat(uw_context ctx, uw_Basis_float n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, FLOATS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%g%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_urlifyString(uw_context ctx, uw_Basis_string s) {
+  char *r, *p;
+
+  if (s[0] == '\0')
+    return "_";
+
+  uw_check_heap(ctx, strlen(s) * 3 + 1 + !!(s[0] == '_'));
+
+  r = p = ctx->heap.front;
+  if (s[0] == '_')
+    *p++ = '_';
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    if (c == ' ')
+      *p++ = '+';
+    else if (isalnum(c))
+      *p++ = c;
+    else {
+      sprintf(p, ".%02X", c);
+      p += 3;
+    }
+  }
+
+  *p++ = 0;
+  ctx->heap.front = p;
+  return r;
+}
+
+char *uw_Basis_urlifyBool(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False)
+    return "0";
+  else
+    return "1";
+}
+
+char *uw_Basis_urlifySource(uw_context ctx, uw_Basis_source src) {
+  char *r;
+  int len;
+  uw_check_heap(ctx, 2 * INTS_MAX + 2);
+  r = ctx->heap.front;
+  sprintf(r, "%d/%llu%n", src.context, src.source, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+static void uw_Basis_urlifyInt_w_unsafe(uw_context ctx, uw_Basis_int n) {
+  int len;
+
+  sprintf(ctx->page.front, "%lld%n", n, &len);
+  ctx->page.front += len;
+}
+
+uw_unit uw_Basis_urlifyInt_w(uw_context ctx, uw_Basis_int n) {
+  uw_check(ctx, INTS_MAX);
+  uw_Basis_urlifyInt_w_unsafe(ctx, n);
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_urlifyChannel_w(uw_context ctx, uw_Basis_channel chn) {
+  if (ctx->client != NULL && chn.cli == ctx->client->id) {
+    int len;
+
+    uw_check(ctx, INTS_MAX + 1);
+    sprintf(ctx->page.front, "%u%n", chn.chn, &len);
+    ctx->page.front += len;
+  }
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_urlifyFloat_w(uw_context ctx, uw_Basis_float n) {
+  int len;
+
+  uw_check(ctx, FLOATS_MAX);
+  sprintf(ctx->page.front, "%g%n", n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+uw_Basis_string uw_Basis_urlifyTime(uw_context ctx, uw_Basis_time t) {
+  return uw_Basis_urlifyInt(ctx, (uw_Basis_int)t.seconds * 1000000 + t.microseconds);
+}
+
+uw_unit uw_Basis_urlifyTime_w(uw_context ctx, uw_Basis_time t) {
+  return uw_Basis_urlifyInt_w(ctx, (uw_Basis_int)t.seconds * 1000000 + t.microseconds);
+}
+
+uw_unit uw_Basis_urlifyString_w(uw_context ctx, uw_Basis_string s) {
+  if (s[0] == '\0') {
+    uw_check(ctx, 1);
+    uw_writec_unsafe(ctx, '_');
+    return uw_unit_v;
+  }
+
+  uw_check(ctx, strlen(s) * 3 + !!(s[0] == '_'));
+
+  if (s[0] == '_')
+    uw_writec_unsafe(ctx, '_');
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    if (c == ' ')
+      uw_writec_unsafe(ctx, '+');
+    else if (isalnum(c))
+      uw_writec_unsafe(ctx, c);
+    else {
+      sprintf(ctx->page.front, ".%02X", c);
+      ctx->page.front += 3;
+    }
+  }
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_urlifyBool_w(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False)
+    uw_writec(ctx, '0');
+  else
+    uw_writec(ctx, '1');
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_urlifySource_w(uw_context ctx, uw_Basis_source src) {
+  int len;
+
+  uw_check(ctx, 2 * INTS_MAX + 2);
+  sprintf(ctx->page.front, "%d/%llu%n", src.context, src.source, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+
+static char *uw_unurlify_advance(char *s) {
+  char *new_s = strchr(s, '/');
+
+  if (new_s)
+    *new_s++ = 0;
+  else
+    new_s = strchr(s, 0);
+
+  return new_s;
+}
+
+uw_Basis_int uw_Basis_unurlifyInt(uw_context ctx, char **s) {
+  char *new_s = uw_unurlify_advance(*s);
+  uw_Basis_int r;
+
+  r = atoll(*s);
+  *s = new_s;
+  return r;
+}
+
+uw_Basis_float uw_Basis_unurlifyFloat(uw_context ctx, char **s) {
+  char *new_s = uw_unurlify_advance(*s);
+  uw_Basis_float r;
+
+  r = atof(*s);
+  *s = new_s;
+  return r;
+}
+
+uw_Basis_time uw_Basis_unurlifyTime(uw_context ctx, char **s) {
+  uw_Basis_int n = uw_Basis_unurlifyInt(ctx, s);
+  uw_Basis_time r = {n / 1000000, n % 1000000};
+  return r;
+}
+
+static uw_Basis_string uw_unurlifyString_to(int fromClient, uw_context ctx, char *r, char *s) {
+  char *s1, *s2 = s;
+  int n;
+
+  if (!fromClient) {
+    if (*s2 == '_')
+      ++s2;
+    else if ((s2[0] == '%' || s2[0] == '.') && s2[1] == '5' && (s2[2] == 'f' || s2[2] == 'F'))
+      s2 += 3;
+  }
+
+  for (s1 = r; *s2; ++s1, ++s2) {
+    unsigned char c = *s2;
+
+    switch (c) {
+    case '+':
+      *s1 = ' ';
+      break;
+    case '%':
+      if (s2[1] == 0)
+        uw_error(ctx, FATAL, "Missing first character of escaped URL byte");
+      if (s2[2] == 0)
+        uw_error(ctx, FATAL, "Missing second character of escaped URL byte");
+      if (sscanf(s2+1, "%02X", &n) != 1)
+        uw_error(ctx, FATAL, "Invalid escaped URL byte starting at: %s", uw_Basis_htmlifyString(ctx, s2));
+      *s1 = n;
+      s2 += 2;
+      break;
+    case '.':
+      if (!fromClient) {
+        if (s2[1] == 0)
+          uw_error(ctx, FATAL, "Missing first character of escaped URL byte");
+        if (s2[2] == 0)
+          uw_error(ctx, FATAL, "Missing second character of escaped URL byte");
+        if (sscanf(s2+1, "%02X", &n) != 1)
+          uw_error(ctx, FATAL, "Invalid escaped URL byte starting at: %s", uw_Basis_htmlifyString(ctx, s2));
+        *s1 = n;
+        s2 += 2;
+        break;
+      }
+    default:
+      *s1 = c;
+    }
+  }
+  *s1++ = 0;
+  return s1;
+}
+
+uw_Basis_bool uw_Basis_unurlifyBool(uw_context ctx, char **s) {
+  char *new_s = uw_unurlify_advance(*s);
+  uw_Basis_bool r;
+
+  if (*s[0] == 0 || !strcmp(*s, "0") || !strcmp(*s, "off"))
+    r = uw_Basis_False;
+  else
+    r = uw_Basis_True;
+
+  *s = new_s;
+  return r;
+}
+
+uw_Basis_string uw_Basis_unurlifyString(uw_context ctx, char **s) {
+  char *new_s = uw_unurlify_advance(*s);
+  char *r;
+  int len;
+
+  len = strlen(*s);
+  uw_check_heap(ctx, len + 1);
+
+  r = ctx->heap.front;
+  ctx->heap.front = uw_unurlifyString_to(0, ctx, ctx->heap.front, *s);
+  *s = new_s;
+  return r;
+}
+
+uw_Basis_unit uw_Basis_unurlifyUnit(uw_context ctx, char **s) {
+  *s = uw_unurlify_advance(*s);
+  return uw_unit_v;
+}
+
+uw_Basis_string uw_Basis_unurlifyString_fromClient(uw_context ctx, char **s) {
+  char *new_s = uw_unurlify_advance(*s);
+  char *r;
+  int len;
+
+  len = strlen(*s);
+  uw_check_heap(ctx, len + 1);
+
+  r = ctx->heap.front;
+  ctx->heap.front = uw_unurlifyString_to(1, ctx, ctx->heap.front, *s);
+  *s = new_s;
+  return r;
+}
+
+
+char *uw_Basis_htmlifyInt(uw_context ctx, uw_Basis_int n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_unit uw_Basis_htmlifyInt_w(uw_context ctx, uw_Basis_int n) {
+  int len;
+
+  uw_check(ctx, INTS_MAX);
+  sprintf(ctx->page.front, "%lld%n", n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+char *uw_Basis_htmlifySpecialChar(uw_context ctx, unsigned char ch) {
+  unsigned int n = ch;
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX+3);
+  r = ctx->heap.front;
+  sprintf(r, "&#%u;%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_unit uw_Basis_htmlifySpecialChar_w(uw_context ctx, unsigned char ch) {
+  unsigned int n = ch;
+  int len;
+
+  uw_check(ctx, INTS_MAX+3);
+  sprintf(ctx->page.front, "&#%u;%n", n, &len);
+  ctx->page.front += len;
+  return uw_unit_v;
+}
+
+char *uw_Basis_htmlifyFloat(uw_context ctx, uw_Basis_float n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, FLOATS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%g%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_unit uw_Basis_htmlifyFloat_w(uw_context ctx, uw_Basis_float n) {
+  int len;
+
+  uw_check(ctx, FLOATS_MAX);
+  sprintf(ctx->page.front, "%g%n", n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+char *uw_Basis_jsifyTime(uw_context ctx, uw_Basis_time t) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", (uw_Basis_int)t.seconds * 1000000 + t.microseconds, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_unit uw_Basis_jsifyInt_w(uw_context ctx, uw_Basis_int n) {
+  int len;
+
+  uw_check(ctx, INTS_MAX);
+  sprintf(ctx->page.front, "%lld%n", (uw_Basis_int)n, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+char *uw_Basis_htmlifyString(uw_context ctx, const char *s) {
+  char *r, *s2;
+
+  uw_check_heap(ctx, strlen(s) * 5 + 1);
+
+  for (r = s2 = ctx->heap.front; *s; s++) {
+    unsigned char c = *s;
+
+    switch (c) {
+    case '<':
+      strcpy(s2, "&lt;");
+      s2 += 4;
+      break;
+    case '&':
+      strcpy(s2, "&amp;");
+      s2 += 5;
+      break;
+    default:
+      *s2++ = c;
+    }
+  }
+
+  *s2++ = 0;
+  ctx->heap.front = s2;
+  return r;
+}
+
+uw_unit uw_Basis_htmlifyString_w(uw_context ctx, uw_Basis_string s) {
+  uw_check(ctx, strlen(s) * 6);
+
+  for (; *s; s++) {
+    unsigned char c = *s;
+
+    switch (c) {
+    case '<':
+      uw_write_unsafe(ctx, "&lt;");
+      break;
+    case '&':
+      uw_write_unsafe(ctx, "&amp;");
+      break;
+    default:
+      uw_writec_unsafe(ctx, c);
+    }
+  }
+
+  return uw_unit_v;
+}
+
+uw_Basis_string uw_Basis_htmlifyBool(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False)
+    return "False";
+  else
+    return "True";
+}
+
+uw_unit uw_Basis_htmlifyBool_w(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False) {
+    uw_check(ctx, 6);
+    strcpy(ctx->page.front, "False");
+    ctx->page.front += 5;
+  } else {
+    uw_check(ctx, 5);
+    strcpy(ctx->page.front, "True");
+    ctx->page.front += 4;
+  }
+
+  return uw_unit_v;
+}
+
+#define TIME_FMT "%x %X"
+#define TIME_FMT_PG "%Y-%m-%d %T"
+#define TIME_FMT_JS "%Y/%m/%d %T"
+
+uw_Basis_string uw_Basis_timeToString(uw_context, uw_Basis_time);
+
+uw_Basis_string uw_Basis_htmlifyTime(uw_context ctx, uw_Basis_time t) {
+  return uw_Basis_htmlifyString(ctx, uw_Basis_timeToString(ctx, t));
+}
+
+uw_unit uw_Basis_htmlifyTime_w(uw_context ctx, uw_Basis_time t) {
+  return uw_Basis_htmlifyString_w(ctx, uw_Basis_timeToString(ctx, t));
+}
+
+char *uw_Basis_htmlifySource(uw_context ctx, uw_Basis_source src) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, 2 * INTS_MAX + 2);
+  r = ctx->heap.front;
+  sprintf(r, "s%d_%llu%n", src.context, src.source, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_unit uw_Basis_htmlifySource_w(uw_context ctx, uw_Basis_source src) {
+  int len;
+
+  uw_check(ctx, 2 * INTS_MAX + 1);
+  sprintf(ctx->page.front, "s%d_%llu%n", src.context, src.source, &len);
+  ctx->page.front += len;
+
+  return uw_unit_v;
+}
+
+uw_Basis_char uw_Basis_strsub(uw_context ctx, uw_Basis_string s, uw_Basis_int n) {
+  while (n >= 0) {
+    if (*s == 0)
+      uw_error(ctx, FATAL, "Out-of-bounds strsub");
+
+    if (n == 0)
+      return *s;
+
+    --n;
+    ++s;
+  }
+
+  uw_error(ctx, FATAL, "Negative strsub bound");
+}
+
+uw_Basis_string uw_Basis_strsuffix(uw_context ctx, uw_Basis_string s, uw_Basis_int n) {
+  while (n >= 0) {
+    if (*s == 0 || n == 0)
+      return s;
+
+    --n;
+    ++s;
+  }
+
+  uw_error(ctx, FATAL, "Negative strsuffix bound");
+}
+
+uw_Basis_int uw_Basis_strlen(uw_context ctx, uw_Basis_string s) {
+  return strlen(s);
+}
+
+uw_Basis_bool uw_Basis_strlenGe(uw_context ctx, uw_Basis_string s, uw_Basis_int n) {
+  while (n > 0) {
+    if (*s == 0)
+      return uw_Basis_False;
+
+    --n;
+    ++s;
+  }
+
+  return uw_Basis_True;
+}
+
+uw_Basis_string uw_Basis_strchr(uw_context ctx, uw_Basis_string s, uw_Basis_char ch) {
+  return strchr(s, ch);
+}
+
+uw_Basis_int uw_Basis_strcspn(uw_context ctx, uw_Basis_string s, uw_Basis_string chs) {
+  return strcspn(s, chs);
+}
+
+uw_Basis_int *uw_Basis_strindex(uw_context ctx, uw_Basis_string s, uw_Basis_char ch) {
+  uw_Basis_string r = strchr(s, ch);
+  if (r == NULL)
+    return NULL;
+  else {
+    uw_Basis_int *nr = uw_malloc(ctx, sizeof(uw_Basis_int));
+    *nr = r - s;
+    return nr;
+  }
+}
+
+uw_Basis_int *uw_Basis_strsindex(uw_context ctx, const char *haystack, const char *needle) {
+  uw_Basis_string r = strstr(haystack, needle);
+  if (r == NULL)
+    return NULL;
+  else {
+    uw_Basis_int *nr = uw_malloc(ctx, sizeof(uw_Basis_int));
+    *nr = r - haystack;
+    return nr;
+  }
+}
+
+uw_Basis_string uw_Basis_strcat(uw_context ctx, uw_Basis_string s1, uw_Basis_string s2) {
+  int len = uw_Basis_strlen(ctx, s1) + uw_Basis_strlen(ctx, s2) + 1;
+  char *s;
+
+  uw_check_heap(ctx, len);
+
+  s = ctx->heap.front;
+
+  strcpy(s, s1);
+  strcat(s, s2);
+  ctx->heap.front += len;
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_substring(uw_context ctx, uw_Basis_string s, uw_Basis_int start, uw_Basis_int len) {
+  size_t full_len = uw_Basis_strlen(ctx, s);
+
+  if (start < 0)
+    uw_error(ctx, FATAL, "substring: Negative start index");
+  if (len < 0)
+    uw_error(ctx, FATAL, "substring: Negative length");
+  if (start + len > full_len)
+    uw_error(ctx, FATAL, "substring: Start index plus length is too large");
+
+  if (start + len == full_len)
+    return &s[start];
+  else {
+    uw_Basis_string r = uw_malloc(ctx, len+1);
+    memcpy(r, s+start, len);
+    r[len] = 0;
+    return r;
+  }
+
+}
+
+uw_Basis_string uw_Basis_str1(uw_context ctx, uw_Basis_char ch) {
+  char *r;
+
+  uw_check_heap(ctx, 2);
+  r = ctx->heap.front;
+  r[0] = ch;
+  r[1] = 0;
+
+  ctx->heap.front += 2;
+
+  return r;
+}
+
+uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) {
+  int len = uw_Basis_strlen(ctx, s1) + 1;
+  char *s;
+
+  uw_check_heap(ctx, len);
+
+  s = ctx->heap.front;
+
+  strcpy(s, s1);
+  ctx->heap.front += len;
+
+  return s;
+}
+
+uw_Basis_string uw_dup_and_clear_error_message(uw_context ctx) {
+  if (ctx->error_message[0]) {
+    char *s = uw_strdup(ctx, ctx->error_message);
+    ctx->error_message[0] = 0;
+    return s;
+  } else
+    return NULL;
+}
+
+uw_Basis_string uw_maybe_strdup(uw_context ctx, uw_Basis_string s1) {
+  if (s1)
+    return uw_strdup(ctx, s1);
+  else
+    return NULL;
+}
+
+char *uw_memdup(uw_context ctx, const char *p, size_t len) {
+  char *r = uw_malloc(ctx, len);
+  memcpy(r, p, len);
+  return r;
+}
+
+char *uw_sqlfmtInt = "%lld::int8%n";
+
+char *uw_Basis_sqlifyInt(uw_context ctx, uw_Basis_int n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX + 6);
+  r = ctx->heap.front;
+  sprintf(r, uw_sqlfmtInt, n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_sqlifyIntN(uw_context ctx, uw_Basis_int *n) {
+  if (n == NULL)
+    return "NULL";
+  else
+    return uw_Basis_sqlifyInt(ctx, *n);
+}
+
+char *uw_sqlfmtFloat = "%.16g::float8%n";
+
+char *uw_Basis_sqlifyFloat(uw_context ctx, uw_Basis_float n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, FLOATS_MAX + 8);
+  r = ctx->heap.front;
+  sprintf(r, uw_sqlfmtFloat, n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_sqlifyFloatN(uw_context ctx, uw_Basis_float *n) {
+  if (n == NULL)
+    return "NULL";
+  else
+    return uw_Basis_sqlifyFloat(ctx, *n);
+}
+
+int uw_Estrings = 1, uw_sql_type_annotations = 1;
+char *uw_sqlsuffixString = "::text";
+char *uw_sqlsuffixChar = "::char";
+
+uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
+  char *r, *s2;
+
+  uw_check_heap(ctx, strlen(s) * 2 + 3 + uw_Estrings + strlen(uw_sqlsuffixString));
+
+  r = s2 = ctx->heap.front;
+  if (uw_Estrings)
+    *s2++ = 'E';
+  *s2++ = '\'';
+
+  for (; *s; s++) {
+    char c = *s;
+
+    switch (c) {
+    case '\'':
+      if (uw_Estrings)
+        strcpy(s2, "\\'");
+      else
+        strcpy(s2, "''");
+      s2 += 2;
+      break;
+    case '\\':
+      if (uw_Estrings) {
+        strcpy(s2, "\\\\");
+        s2 += 2;
+      } else
+        *s2++ = '\\';
+      break;
+    default:
+      if (isprint((int)c))
+        *s2++ = c;
+      else if (uw_Estrings) {
+        sprintf(s2, "\\%03o", (unsigned char)c);
+        s2 += 4;
+      }
+      else
+        *s2++ = c; // I hope this is safe to do... don't know how to support UTF-8 outside Postgres otherwise!
+    }
+  }
+
+  *s2++ = '\'';
+  strcpy(s2, uw_sqlsuffixString);
+  ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixString);
+  return r;
+}
+
+uw_Basis_string uw_Basis_sqlifyChar(uw_context ctx, uw_Basis_char c) {
+  char *r, *s2;
+
+  uw_check_heap(ctx, 5 + uw_Estrings + strlen(uw_sqlsuffixChar));
+
+  r = s2 = ctx->heap.front;
+  if (uw_Estrings)
+    *s2++ = 'E';
+  *s2++ = '\'';
+
+  switch (c) {
+  case '\'':
+    if (uw_Estrings)
+      strcpy(s2, "\\'");
+    else
+      strcpy(s2, "''");
+    s2 += 2;
+    break;
+  case '\\':
+    if (uw_Estrings) {
+      strcpy(s2, "\\\\");
+      s2 += 2;
+    } else
+      *s2++ = '\\';
+    break;
+  default:
+    if (isprint((int)c))
+      *s2++ = c;
+    else if (uw_Estrings) {
+      sprintf(s2, "\\%03o", (unsigned char)c);
+      s2 += 4;
+    }
+    else
+      uw_error(ctx, FATAL, "Non-printable character %u in char to SQLify", c);
+  }
+
+  *s2++ = '\'';
+  strcpy(s2, uw_sqlsuffixChar);
+  ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixChar);
+  return r;
+}
+
+char *uw_sqlsuffixBlob = "::bytea";
+
+uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
+  char *r, *s2;
+  size_t i;
+
+  uw_check_heap(ctx, b.size * 5 + 4 + strlen(uw_sqlsuffixBlob));
+
+  r = s2 = ctx->heap.front;
+  if (uw_Estrings)
+    *s2++ = 'E';
+  else
+    *s2++ = 'X';
+  *s2++ = '\'';
+
+  for (i = 0; i < b.size; ++i) {
+    unsigned char c = b.data[i];
+
+    if (uw_Estrings) {
+      switch (c) {
+      case '\'':
+        strcpy(s2, "\\'");
+        s2 += 2;
+        break;
+      case '\\':
+        strcpy(s2, "\\\\\\\\");
+        s2 += 4;
+        break;
+      default:
+        if (isprint((int)c))
+          *s2++ = c;
+        else {
+          sprintf(s2, "\\\\%03o", c);
+          s2 += 5;
+        }
+      }
+    } else {
+      sprintf(s2, "%02X", c);
+      s2 += 2;
+    }
+  }
+
+  *s2++ = '\'';
+  strcpy(s2, uw_sqlsuffixBlob);
+  ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixBlob);
+  return r;
+}
+
+char *uw_Basis_sqlifyChannel(uw_context ctx, uw_Basis_channel chn) {
+  int len;
+  char *r;
+  unsigned long long combo = ((unsigned long long)chn.cli << 32) | chn.chn;
+
+  uw_check_heap(ctx, INTS_MAX + 7);
+  r = ctx->heap.front;
+  sprintf(r, uw_sqlfmtInt, combo, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_attrifyChannel(uw_context ctx, uw_Basis_channel chn) {
+  int len;
+  char *r;
+  unsigned long long combo = ((unsigned long long)chn.cli << 32) | chn.chn;
+
+  uw_check_heap(ctx, INTS_MAX + 1);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", combo, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_sqlfmtUint4 = "%u::int4%n";
+
+char *uw_Basis_sqlifyClient(uw_context ctx, uw_Basis_client cli) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX + 7);
+  r = ctx->heap.front;
+  sprintf(r, uw_sqlfmtUint4, cli, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+char *uw_Basis_attrifyClient(uw_context ctx, uw_Basis_client cli) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX + 1);
+  r = ctx->heap.front;
+  sprintf(r, "%u%n", cli, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_Basis_string uw_Basis_sqlifyStringN(uw_context ctx, uw_Basis_string s) {
+  if (s == NULL)
+    return "NULL";
+  else
+    return uw_Basis_sqlifyString(ctx, s);
+}
+
+char *uw_Basis_sqlifyBool(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False)
+    return "FALSE";
+  else
+    return "TRUE";
+}
+
+char *uw_Basis_sqlifyBoolN(uw_context ctx, uw_Basis_bool *b) {
+  if (b == NULL)
+    return "NULL";
+  else
+    return uw_Basis_sqlifyBool(ctx, *b);
+}
+
+char *uw_Basis_sqlifyTime(uw_context ctx, uw_Basis_time t) {
+  size_t len;
+  char *r, *s;
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (localtime_r(&t.seconds, &stm)) {
+    s = uw_malloc(ctx, TIMES_MAX);
+    len = strftime(s, TIMES_MAX, TIME_FMT_PG, &stm);
+    if (uw_sql_type_annotations) {
+      if (t.microseconds) {
+        r = uw_malloc(ctx, len + 21);
+        sprintf(r, "'%s.%06u'::timestamp", s, t.microseconds);
+      } else {
+        r = uw_malloc(ctx, len + 14);
+        sprintf(r, "'%s'::timestamp", s);
+      }
+    } else {
+      r = uw_malloc(ctx, len + 3);
+      sprintf(r, "'%s'", s);
+    }
+    return r;
+  } else
+    return "<Invalid time>";
+}
+
+char *uw_Basis_attrifyTime(uw_context ctx, uw_Basis_time t) {
+  size_t len;
+  char *r;
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (localtime_r(&t.seconds, &stm)) {
+    uw_check_heap(ctx, TIMES_MAX);
+    r = ctx->heap.front;
+    len = strftime(r, TIMES_MAX, TIME_FMT, &stm);
+    ctx->heap.front += len+1;
+    return r;
+  } else
+    return "<Invalid time>";
+}
+
+char *uw_Basis_ensqlTime(uw_context ctx, uw_Basis_time t) {
+  size_t len;
+  char *r;
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (localtime_r(&t.seconds, &stm)) {
+    uw_check_heap(ctx, TIMES_MAX);
+    r = ctx->heap.front;
+    len = strftime(r, TIMES_MAX-7, TIME_FMT_PG, &stm);
+    ctx->heap.front += len;
+    sprintf(ctx->heap.front, ".%06u", t.microseconds);
+    ctx->heap.front += 8;
+    return r;
+  } else
+    return "<Invalid time>";
+}
+
+char *uw_Basis_sqlifyTimeN(uw_context ctx, uw_Basis_time *t) {
+  if (t == NULL)
+    return "NULL";
+  else
+    return uw_Basis_sqlifyTime(ctx, *t);
+}
+
+char *uw_Basis_ensqlBool(uw_Basis_bool b) {
+  static uw_Basis_int true = 1;
+  static uw_Basis_int false = 0;
+
+  if (b == uw_Basis_False)
+    return (char *)&false;
+  else
+    return (char *)&true;
+}
+
+uw_Basis_string uw_Basis_intToString(uw_context ctx, uw_Basis_int n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%lld%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_Basis_string uw_Basis_floatToString(uw_context ctx, uw_Basis_float n) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, FLOATS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "%g%n", n, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_Basis_string uw_Basis_charToString(uw_context ctx, uw_Basis_char ch) {
+  char *r = uw_malloc(ctx, 2);
+  r[0] = ch;
+  r[1] = 0;
+  return r;
+}
+
+uw_Basis_string uw_Basis_boolToString(uw_context ctx, uw_Basis_bool b) {
+  if (b == uw_Basis_False)
+    return "False";
+  else
+    return "True";
+}
+
+uw_Basis_string uw_Basis_timef(uw_context ctx, const char *fmt, uw_Basis_time t) {
+  size_t len;
+  char *r;
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (localtime_r(&t.seconds, &stm)) {
+    uw_check_heap(ctx, TIMES_MAX);
+    r = ctx->heap.front;
+    len = strftime(r, TIMES_MAX, fmt, &stm);
+    ctx->heap.front += len+1;
+    return r;
+  } else
+    return "<Invalid time>";
+}
+
+uw_Basis_string uw_Basis_timeToString(uw_context ctx, uw_Basis_time t) {
+  return uw_Basis_timef(ctx, ctx->app->time_format, t);
+}
+
+uw_Basis_int *uw_Basis_stringToInt(uw_context ctx, uw_Basis_string s) {
+  char *endptr;
+  uw_Basis_int n = strtoll(s, &endptr, 10);
+
+  if (*s != '\0' && *endptr == '\0') {
+    uw_Basis_int *r = uw_malloc(ctx, sizeof(uw_Basis_int));
+    *r = n;
+    return r;
+  } else
+    return NULL;
+}
+
+uw_Basis_float *uw_Basis_stringToFloat(uw_context ctx, uw_Basis_string s) {
+  char *endptr;
+  uw_Basis_float n = strtod(s, &endptr);
+
+  if (*s != '\0' && *endptr == '\0') {
+    uw_Basis_float *r = uw_malloc(ctx, sizeof(uw_Basis_float));
+    *r = n;
+    return r;
+  } else
+    return NULL;
+}
+
+uw_Basis_char *uw_Basis_stringToChar(uw_context ctx, uw_Basis_string s) {
+  if (s[0] == 0) {
+    uw_Basis_char *r = uw_malloc(ctx, 1);
+    r[0] = 0;
+    return r;
+  } else if (s[1] != 0)
+    return NULL;
+  else {
+    uw_Basis_char *r = uw_malloc(ctx, 1);
+    r[0] = s[0];
+    return r;
+  }
+}
+
+uw_Basis_bool *uw_Basis_stringToBool(uw_context ctx, uw_Basis_string s) {
+  static uw_Basis_bool true = uw_Basis_True;
+  static uw_Basis_bool false = uw_Basis_False;
+
+  if (!strcasecmp (s, "True"))
+    return &true;
+  else if (!strcasecmp (s, "False"))
+    return &false;
+  else
+    return NULL;
+}
+
+uw_Basis_time *uw_Basis_stringToTime(uw_context ctx, uw_Basis_string s) {
+  char *dot = strchr(s, '.'), *end = strchr(s, 0);
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (dot) {
+    *dot = 0;
+    if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      *dot = '.';
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      r->seconds = mktime(&stm);
+      r->microseconds = 0;
+      return r;
+    }
+    else {
+      *dot = '.';
+      return NULL;
+    }
+  }
+  else {
+    if (strptime(s, ctx->app->time_format, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      r->seconds = mktime(&stm);
+      r->microseconds = 0;
+      return r;
+    } else if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      r->seconds = mktime(&stm);
+      r->microseconds = 0;
+      return r;
+    } else if (strptime(s, TIME_FMT, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      r->seconds = mktime(&stm);
+      r->microseconds = 0;
+      return r;
+    } else if (strptime(s, TIME_FMT_JS, &stm) == end) {
+      uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+      r->seconds = mktime(&stm);
+      r->microseconds = 0;
+      return r;
+    }
+    else
+      return NULL;
+  }
+}
+
+uw_Basis_time *uw_Basis_stringToTimef(uw_context ctx, const char *fmt, uw_Basis_string s) {
+  char *end = strchr(s, 0);
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (strptime(s, fmt, &stm) == end) {
+    uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+    r->seconds = mktime(&stm);
+    r->microseconds = 0;
+    return r;
+  }
+  else
+    return NULL;
+}
+
+uw_Basis_int uw_Basis_stringToInt_error(uw_context ctx, uw_Basis_string s) {
+  char *endptr;
+  uw_Basis_int n = strtoll(s, &endptr, 10);
+
+  if (*s != '\0' && *endptr == '\0')
+    return n;
+  else
+    uw_error(ctx, FATAL, "Can't parse int: %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+#include <errno.h>
+
+uw_Basis_channel uw_Basis_stringToChannel_error(uw_context ctx, uw_Basis_string s) {
+  unsigned long long n;
+
+  if (sscanf(s, "%llu", &n) < 1)
+    uw_error(ctx, FATAL, "Can't parse channel: %s", uw_Basis_htmlifyString(ctx, s));
+  else {
+    uw_Basis_channel ch = {n >> 32, n & ((1ull << 32) - 1)};
+    return ch;
+  }
+}
+
+uw_Basis_client uw_Basis_stringToClient_error(uw_context ctx, uw_Basis_string s) {
+  char *endptr;
+  unsigned long n = strtoul(s, &endptr, 10);
+
+  if (*s != '\0' && *endptr == '\0')
+    return n;
+  else
+    uw_error(ctx, FATAL, "Can't parse client: %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_float uw_Basis_stringToFloat_error(uw_context ctx, uw_Basis_string s) {
+  char *endptr;
+  uw_Basis_float n = strtod(s, &endptr);
+
+  if (*s != '\0' && *endptr == '\0')
+    return n;
+  else
+    uw_error(ctx, FATAL, "Can't parse float: %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_char uw_Basis_stringToChar_error(uw_context ctx, uw_Basis_string s) {
+  if (s[0] == 0)
+    return 0;
+  else if (s[1] != 0)
+    uw_error(ctx, FATAL, "Can't parse char: %s", uw_Basis_htmlifyString(ctx, s));
+  else
+    return s[0];
+}
+
+uw_Basis_bool uw_Basis_stringToBool_error(uw_context ctx, uw_Basis_string s) {
+  if (!strcasecmp(s, "T") || !strcasecmp (s, "True"))
+    return uw_Basis_True;
+  else if (!strcasecmp(s, "F") || !strcasecmp (s, "False"))
+    return uw_Basis_False;
+  else
+    uw_error(ctx, FATAL, "Can't parse bool: %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_time uw_Basis_unsqlTime(uw_context ctx, uw_Basis_string s) {
+  char *dot = strchr(s, '.'), *end = strchr(s, 0);
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (dot) {
+    *dot = 0;
+    if (strptime(s, TIME_FMT_PG, &stm)) {
+      *dot = '.';
+      char usec[] = "000000";
+      int len = strlen(dot+1);
+      memcpy(usec, dot+1, len < 6 ? len : 6);
+      uw_Basis_time r = { mktime(&stm), atoi(usec) };
+      return r;
+    }
+    else {
+      *dot = '.';
+      uw_error(ctx, FATAL, "Can't parse time: %s", uw_Basis_htmlifyString(ctx, s));
+    }
+  }
+  else {
+    if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else if (strptime(s, TIME_FMT, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else
+      uw_error(ctx, FATAL, "Can't parse time: %s", uw_Basis_htmlifyString(ctx, s));
+  }
+}
+
+uw_Basis_time uw_Basis_stringToTime_error(uw_context ctx, uw_Basis_string s) {
+  char *dot = strchr(s, '.'), *end = strchr(s, 0);
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (dot) {
+    *dot = 0;
+    if (strptime(s, TIME_FMT_PG, &stm)) {
+      *dot = '.';
+      {
+        uw_Basis_time r = { mktime(&stm) };
+        return r;
+      }
+    }
+    else {
+      *dot = '.';
+      uw_error(ctx, FATAL, "Can't parse time: %s", uw_Basis_htmlifyString(ctx, s));
+    }
+  }
+  else {
+    if (strptime(s, ctx->app->time_format, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else if (strptime(s, TIME_FMT_PG, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else if (strptime(s, TIME_FMT, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else if (strptime(s, TIME_FMT_JS, &stm) == end) {
+      uw_Basis_time r = { mktime(&stm) };
+      return r;
+    } else
+      uw_error(ctx, FATAL, "Can't parse time: %s", uw_Basis_htmlifyString(ctx, s));
+  }
+}
+
+uw_Basis_time uw_Basis_stringToTimef_error(uw_context ctx, const char *fmt, uw_Basis_string s) {
+  char *end = strchr(s, 0);
+  struct tm stm = {};
+  stm.tm_isdst = -1;
+
+  if (strptime(s, fmt, &stm) == end) {
+    uw_Basis_time r = { mktime(&stm) };
+    return r;
+  } else
+    uw_error(ctx, FATAL, "Can't parse time: %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_blob uw_Basis_stringToBlob_error(uw_context ctx, uw_Basis_string s, size_t len) {
+  char *r = ctx->heap.front;
+  uw_Basis_blob b = {len, r};
+
+  uw_check_heap(ctx, len);
+
+  if (s[0] == '\\' && s[1] == 'x') {
+    s += 2;
+
+    while (*s) {
+      int n;
+      sscanf(s, "%02x", &n);
+      *r++ = n;
+      s += 2;
+    }
+  } else {
+    while (*s) {
+      if (s[0] == '\\') {
+        if (s[1] == '\\') {
+          *r++ = '\\';
+          s += 2;
+        } else if (isdigit((int)s[1]) && isdigit((int)s[2]) && isdigit((int)s[3])) {
+          *r++ = (s[1] - '0') * 8 * 8 + ((s[2] - '0') * 8) + (s[3] - '0');
+          s += 4;
+        }
+        else {
+          *r++ = '\\';
+          ++s;
+        }
+      } else {
+        *r++ = s[0];
+        ++s;
+      }
+    }
+  }
+
+  b.size = r - ctx->heap.front;
+  ctx->heap.front = r;
+
+  return b;
+}
+
+#define THE_PAST "expires=Sat, 01-Jan-2011 00:00:00 GMT"
+
+uw_Basis_string uw_Basis_get_cookie(uw_context ctx, uw_Basis_string c) {
+  int len = strlen(c);
+  char *p = ctx->outHeaders.start;
+
+  while ((p = strstr(p, "\nSet-Cookie: "))) {
+    char *p2;
+    p += 13;
+    p2 = strchr(p, '=');
+
+    if (p2) {
+      size_t sz = strcspn(p2+1, ";\r\n");
+
+      if (!strncasecmp(p, c, p2 - p)) {
+        if (sz == 0 && strstr(p2+2, THE_PAST))
+          return NULL;
+        else {
+          char *ret = uw_malloc(ctx, sz + 1);
+          memcpy(ret, p2+1, sz);
+          ret[sz] = 0;
+          return ret;
+        }
+      }
+    }
+  }
+
+  if ((p = uw_Basis_requestHeader(ctx, "Cookie"))) {
+    char *p2;
+
+    while (1) {
+      if (!strncmp(p, c, len) && p[len] == '=') {
+        if ((p2 = strchr(p, ';'))) {
+          size_t n = p2 - (p + len);
+          char *r = uw_malloc(ctx, n);
+          memcpy(r, p + 1 + len, n-1);
+          r[n-1] = 0;
+          return r;
+        } else
+          return p + 1 + len;
+      } else if ((p = strchr(p, ';')))
+        p += 2;
+      else
+        return NULL;
+    }
+  }
+
+  return NULL;
+}
+
+static void set_cookie(uw_context ctx) {
+  if (ctx->usedSig)
+    ctx->needsResig = 1;
+}
+
+uw_unit uw_Basis_set_cookie(uw_context ctx, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure) {
+  uw_write_header(ctx, "Set-Cookie: ");
+  uw_write_header(ctx, c);
+  uw_write_header(ctx, "=");
+  uw_write_header(ctx, v);
+  uw_write_header(ctx, "; path=");
+  uw_write_header(ctx, prefix);
+  if (expires) {
+    char formatted[30];
+    struct tm tm = {};
+    tm.tm_isdst = -1;
+
+    gmtime_r(&expires->seconds, &tm);
+
+    strftime(formatted, sizeof formatted, "%a, %d-%b-%Y %T GMT", &tm);
+
+    uw_write_header(ctx, "; expires=");
+    uw_write_header(ctx, formatted);
+  }
+  if (secure)
+    uw_write_header(ctx, "; secure");
+  uw_write_header(ctx, "\r\n");
+  set_cookie(ctx);
+
+  return uw_unit_v;
+}
+
+uw_unit uw_Basis_clear_cookie(uw_context ctx, uw_Basis_string prefix, uw_Basis_string c) {
+  uw_write_header(ctx, "Set-Cookie: ");
+  uw_write_header(ctx, c);
+  uw_write_header(ctx, "=; path=");
+  uw_write_header(ctx, prefix);
+  uw_write_header(ctx, "; " THE_PAST "\r\n");
+  set_cookie(ctx);
+
+  return uw_unit_v;
+}
+
+size_t uw_deltas_max = SIZE_MAX;
+
+static delta *allocate_delta(uw_context ctx, unsigned client) {
+  unsigned i;
+  delta *d;
+
+  for (i = 0; i < ctx->used_deltas; ++i)
+    if (ctx->deltas[i].client == client)
+      return &ctx->deltas[i];
+
+  if (ctx->used_deltas >= ctx->n_deltas) {
+    if (ctx->n_deltas + 1 > uw_deltas_max)
+      uw_error(ctx, FATAL, "Exceeded limit on number of deltas");
+
+    ctx->deltas = realloc(ctx->deltas, sizeof(delta) * ++ctx->n_deltas);
+    uw_buffer_init(uw_messages_max, &ctx->deltas[ctx->n_deltas-1].msgs, 0);
+  }
+
+  d = &ctx->deltas[ctx->used_deltas++];
+  d->client = client;
+  uw_buffer_reset(&d->msgs);
+  return d;
+}
+
+uw_Basis_channel uw_Basis_new_channel(uw_context ctx, uw_unit u) {
+  if (ctx->client == NULL)
+    uw_error(ctx, FATAL, "Attempt to create channel on request not associated with a persistent connection");
+
+  return new_channel(ctx->client);
+}
+
+uw_unit uw_Basis_send(uw_context ctx, uw_Basis_channel chn, uw_Basis_string msg) {
+  delta *d = allocate_delta(ctx, chn.cli);
+  size_t len;
+  int preLen;
+  char pre[INTS_MAX + 2];
+
+  len = strlen(msg);
+
+  sprintf(pre, "%u\n%n", chn.chn, &preLen);
+
+  ctx_uw_buffer_append(ctx, "messages", &d->msgs, pre, preLen);
+  ctx_uw_buffer_append(ctx, "messages", &d->msgs, msg, len);
+  ctx_uw_buffer_append(ctx, "messages", &d->msgs, "\n", 1);
+
+  return uw_unit_v;
+}
+
+int uw_rollback(uw_context ctx, int will_retry) {
+  int i;
+  cleanup *cl;
+
+  if (ctx->client)
+    release_client(ctx->client);
+
+  for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+    cl->func(cl->arg);
+
+  ctx->cleanup_front = ctx->cleanup;
+
+  for (i = ctx->used_transactionals-1; i >= 0; --i)
+    if (ctx->transactionals[i].rollback != NULL)
+      ctx->transactionals[i].rollback(ctx->transactionals[i].data);
+
+  for (i = ctx->used_transactionals-1; i >= 0; --i)
+    if (ctx->transactionals[i].free)
+      ctx->transactionals[i].free(ctx->transactionals[i].data, will_retry);
+
+  if (ctx->app && ctx->transaction_started) {
+    ctx->transaction_started = 0;
+    return ctx->app->db_rollback(ctx);
+  } else
+    return 0;
+}
+
+const char uw_begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
+const char uw_begin_html5[] = "<!DOCTYPE html><html>";
+
+extern int uw_hash_blocksize;
+
+static const char sig_intro[] = "<input type=\"hidden\" name=\"Sig\" value=\"";
+
+static char *find_sig(char *haystack) {
+  int i;
+  char *s = strstr(haystack, sig_intro);
+
+  if (!s || strlen(haystack) - (s - haystack) - (sizeof sig_intro - 1) < uw_hash_blocksize*2+1)
+    return NULL;
+
+  s += sizeof sig_intro - 1;
+
+  for (i = 0; i < uw_hash_blocksize*2; ++i)
+    if (!isxdigit((int)s[i]))
+      return NULL;
+
+  if (s[i] != '"')
+    return NULL;
+
+  return s;
+}
+
+static pthread_mutex_t message_send_mutex = PTHREAD_MUTEX_INITIALIZER;
+
+int uw_commit(uw_context ctx) {
+  int i;
+  char *sig;
+
+  if (uw_has_error(ctx)) {
+    uw_rollback(ctx, 0);
+    return 0;
+  }
+
+  for (i = ctx->used_transactionals-1; i >= 0; --i)
+    if (ctx->transactionals[i].rollback != NULL)
+      if (ctx->transactionals[i].commit) {
+        ctx->transactionals[i].commit(ctx->transactionals[i].data);
+        if (uw_has_error(ctx)) {
+          uw_rollback(ctx, 0);
+          return 0;
+        }
+      }
+
+  // Here's an important lock to provide the abstraction that all messages from one transaction are sent as an atomic unit.
+  if (ctx->used_deltas > 0)
+    pthread_mutex_lock(&message_send_mutex);
+
+  if (ctx->transaction_started) {
+    int code = ctx->app->db_commit(ctx);
+
+    if (code) {
+      if (ctx->used_deltas > 0)
+        pthread_mutex_unlock(&message_send_mutex);
+
+      if (ctx->client)
+        release_client(ctx->client);
+
+      if (code == -1) {
+        // This case is for a serialization failure, which is not really an "error."
+        // The transaction will restart, so we should rollback any transactionals
+        // that triggered above.
+
+        for (i = ctx->used_transactionals-1; i >= 0; --i)
+          if (ctx->transactionals[i].rollback != NULL)
+            ctx->transactionals[i].rollback(ctx->transactionals[i].data);
+
+        for (i = ctx->used_transactionals-1; i >= 0; --i)
+          if (ctx->transactionals[i].free)
+            ctx->transactionals[i].free(ctx->transactionals[i].data, 1);
+
+        return 1;
+      }
+
+      for (i = ctx->used_transactionals-1; i >= 0; --i)
+        if (ctx->transactionals[i].free)
+          ctx->transactionals[i].free(ctx->transactionals[i].data, 0);
+
+      uw_set_error_message(ctx, "Error running SQL COMMIT");
+      return 0;
+    }
+  }
+
+  for (i = ctx->used_transactionals-1; i >= 0; --i)
+    if (ctx->transactionals[i].rollback == NULL)
+      if (ctx->transactionals[i].commit) {
+        ctx->transactionals[i].commit(ctx->transactionals[i].data);
+        if (uw_has_error(ctx)) {
+          if (ctx->used_deltas > 0)
+            pthread_mutex_unlock(&message_send_mutex);
+
+          if (ctx->client)
+            release_client(ctx->client);
+
+          for (i = ctx->used_transactionals-1; i >= 0; --i)
+            if (ctx->transactionals[i].rollback != NULL)
+              ctx->transactionals[i].rollback(ctx->transactionals[i].data);
+
+          for (i = ctx->used_transactionals-1; i >= 0; --i)
+            if (ctx->transactionals[i].free)
+              ctx->transactionals[i].free(ctx->transactionals[i].data, 0);
+
+          return 0;
+        }
+      }
+
+  for (i = 0; i < ctx->used_deltas; ++i) {
+    delta *d = &ctx->deltas[i];
+    client *c = find_client(d->client);
+
+    assert (c != NULL);
+    assert(c->mode == USED);
+
+    client_send(c, &d->msgs, ctx->script.start, uw_buffer_used(&ctx->script));
+  }
+
+  if (ctx->used_deltas > 0)
+    pthread_mutex_unlock(&message_send_mutex);
+
+  if (ctx->client)
+    release_client(ctx->client);
+
+  for (i = ctx->used_transactionals-1; i >= 0; --i)
+    if (ctx->transactionals[i].free)
+      ctx->transactionals[i].free(ctx->transactionals[i].data, 0);
+
+  uw_check(ctx, 1);
+  *ctx->page.front = 0;
+
+  if (!ctx->returning_indirectly
+      && (ctx->app->is_html5
+          ? !strncmp(ctx->page.start, uw_begin_html5, sizeof uw_begin_html5 - 1)
+          : !strncmp(ctx->page.start, uw_begin_xhtml, sizeof uw_begin_xhtml - 1))) {
+    char *s;
+
+    // Splice script data into appropriate part of page, also adding <head> if needed.
+    s = ctx->page.start + (ctx->app->is_html5 ? sizeof uw_begin_html5 - 1 : sizeof uw_begin_xhtml - 1);
+    s = strchr(s, '<');
+    if (s == NULL) {
+      // Weird.  Document has no tags!
+
+      uw_write(ctx, "<head></head><body></body>");
+      uw_check(ctx, 1);
+      *ctx->page.front = 0;
+    } else if (!strncmp(s, "<head>", 6)) {
+      // <head> is present.  Let's add the <script> tags immediately after it.
+
+      // Any freeform JavaScript to include?
+      if (uw_buffer_used(&ctx->script) > 0) {
+        size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+        size_t lenP = lenH + 40 + len;
+        char *start = s + 6, *oldPage = ctx->page.start;
+
+        ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+        start += ctx->page.start - oldPage;
+        memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+        ctx->page.front += lenP;
+        memcpy(start, ctx->script_header, lenH);
+        memcpy(start + lenH, "<script type=\"text/javascript\">", 31);
+        memcpy(start + lenH + 31, ctx->script.start, len);
+        memcpy(start + lenH + 31 + len, "</script>", 9);
+      } else {
+        size_t lenH = strlen(ctx->script_header);
+        char *start = s + 6, *oldPage = ctx->page.start;
+
+        ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenH);
+        start += ctx->page.start - oldPage;
+        memmove(start + lenH, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+        ctx->page.front += lenH;
+        memcpy(start, ctx->script_header, lenH);
+      }
+    } else {
+      // No <head>.  At this point, add it, with <script> tags inside.
+
+      if (uw_buffer_used(&ctx->script) > 0) {
+        size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+        size_t lenP = lenH + 53 + len;
+        char *start = s, *oldPage = ctx->page.start;
+
+        ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+        start += ctx->page.start - oldPage;
+        memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+        ctx->page.front += lenP;
+        memcpy(start, "<head>", 6);
+        memcpy(start + 6, ctx->script_header, lenH);
+        memcpy(start + 6 + lenH, "<script type=\"text/javascript\">", 31);
+        memcpy(start + 6 + lenH + 31, ctx->script.start, len);
+        memcpy(start + 6 + lenH + 31 + len, "</script></head>", 16);
+      } else {
+        size_t lenH = strlen(ctx->script_header);
+        size_t lenP = lenH + 13;
+        char *start = s, *oldPage = ctx->page.start;
+
+        ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+        start += ctx->page.start - oldPage;
+        memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+        ctx->page.front += lenP;
+        memcpy(start, "<head>", 6);
+        memcpy(start + 6, ctx->script_header, lenH);
+        memcpy(start + 6 + lenH, "</head>", 7);
+      }
+    }
+  }
+
+  if (ctx->needsResig) {
+    sig = find_sig(ctx->page.start);
+    if (sig) {
+      char *realsig = ctx->app->cookie_sig(ctx);
+
+      do {
+        memcpy(sig, realsig, 2*uw_hash_blocksize);
+        sig = find_sig(sig);
+      } while (sig);
+    }
+  }
+
+  return 0;
+}
+
+
+size_t uw_transactionals_max = SIZE_MAX;
+
+int uw_register_transactional(uw_context ctx, void *data, uw_callback commit, uw_callback rollback,
+                               uw_callback_with_retry free) {
+  if (ctx->used_transactionals >= ctx->n_transactionals) {
+    if (ctx->used_transactionals+1 > uw_transactionals_max)
+      // Exceeded limit on number of transactionals.
+      return -1;
+    ctx->transactionals = realloc(ctx->transactionals, sizeof(transactional) * (ctx->used_transactionals+1));
+    ++ctx->n_transactionals;
+  }
+
+  ctx->transactionals[ctx->used_transactionals].data = data;
+  ctx->transactionals[ctx->used_transactionals].commit = commit;
+  ctx->transactionals[ctx->used_transactionals].rollback = rollback;
+  ctx->transactionals[ctx->used_transactionals++].free = free;
+
+  return 0;
+}
+
+
+// "Garbage collection"
+
+void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data);
+void uw_post_expunge(uw_context ctx, void *data);
+
+static failure_kind uw_expunge(uw_context ctx, uw_Basis_client cli, void *data) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0)
+    uw_do_expunge(ctx, cli, data);
+  else
+    ctx->app->db_rollback(ctx);
+
+  uw_post_expunge(ctx, data);
+
+  return r;
+}
+
+void uw_prune_clients(uw_context ctx) {
+  client *c, *next, *prev = NULL;
+  time_t cutoff;
+
+  cutoff = time(NULL) - ctx->app->timeout;
+
+  pthread_mutex_lock(&clients_mutex);
+  pruning_thread = pthread_self();
+  pruning_thread_initialized = 1;
+
+  for (c = clients_used; c; c = next) {
+    next = c->next;
+    pthread_mutex_lock(&c->lock);
+    if (c->last_contact < cutoff && c->refcount == 0) {
+      failure_kind fk = UNLIMITED_RETRY;
+      if (prev)
+        prev->next = next;
+      else
+        clients_used = next;
+      while (fk == UNLIMITED_RETRY) {
+        uw_reset(ctx);
+        fk = uw_expunge(ctx, c->id, c->data);
+        if (fk == UNLIMITED_RETRY)
+          printf("Unlimited retry during expunge: %s\n", uw_error_message(ctx));
+      }
+      if (fk == SUCCESS)
+        free_client(c);
+      else
+        fprintf(stderr, "Expunge blocked by error: %s\n", uw_error_message(ctx));
+    }
+    else
+      prev = c;
+    pthread_mutex_unlock(&c->lock);
+  }
+
+  pthread_mutex_unlock(&clients_mutex);
+}
+
+failure_kind uw_initialize(uw_context ctx) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0) {
+    uw_ensure_transaction(ctx);
+    ctx->app->initializer(ctx);
+    if (uw_commit(ctx))
+      uw_error(ctx, FATAL, "Error running SQL COMMIT");
+  }
+
+  return r;
+}
+
+static int url_bad(uw_Basis_string s) {
+  for (; *s; ++s)
+    if (!isgraph((int)*s))
+      return 1;
+
+  return 0;
+}
+
+uw_Basis_string uw_Basis_bless(uw_context ctx, uw_Basis_string s) {
+  if (url_bad(s))
+    uw_error(ctx, FATAL, "Invalid URL %s", uw_Basis_htmlifyString(ctx, s));
+  if (ctx->app->check_url(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed URL %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkUrl(uw_context ctx, uw_Basis_string s) {
+  if (url_bad(s))
+    return NULL;
+  if (ctx->app->check_url(s))
+    return s;
+  else
+    return NULL;
+}
+
+static int mime_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalnum((int)*s) && *s != '/' && *s != '-' && *s != '.' && *s != '+')
+      return 0;
+
+  return 1;
+}
+
+uw_Basis_string uw_Basis_blessMime(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    uw_error(ctx, FATAL, "MIME type \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_mime(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed MIME type %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkMime(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    return NULL;
+
+  if (ctx->app->check_mime(s))
+    return s;
+  else
+    return NULL;
+}
+
+uw_Basis_string uw_Basis_blessRequestHeader(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    uw_error(ctx, FATAL, "Request header \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_requestHeader(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed request header %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkRequestHeader(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    return NULL;
+
+  if (ctx->app->check_requestHeader(s))
+    return s;
+  else
+    return NULL;
+}
+
+uw_Basis_string uw_Basis_blessResponseHeader(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    uw_error(ctx, FATAL, "Response header \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_responseHeader(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed response header %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+static int envVar_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalnum((int)*s) && *s != '_' && *s != '.')
+      return 0;
+
+  return 1;
+}
+
+uw_Basis_string uw_Basis_checkResponseHeader(uw_context ctx, uw_Basis_string s) {
+  if (!envVar_format(s))
+    return NULL;
+
+  if (ctx->app->check_responseHeader(s))
+    return s;
+  else
+    return NULL;
+}
+
+uw_Basis_string uw_Basis_blessEnvVar(uw_context ctx, uw_Basis_string s) {
+  if (!envVar_format(s))
+    uw_error(ctx, FATAL, "Environment variable \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_envVar(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed environment variable %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkEnvVar(uw_context ctx, uw_Basis_string s) {
+  if (!mime_format(s))
+    return NULL;
+
+  if (ctx->app->check_envVar(s))
+    return s;
+  else
+    return NULL;
+}
+
+static int meta_format(const char *s) {
+  for (; *s; ++s)
+    if (!isalpha((int)*s) && *s != '-')
+      return 0;
+
+  return 1;
+}
+
+uw_Basis_string uw_Basis_blessMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    uw_error(ctx, FATAL, "Meta name \"%s\" contains invalid character", uw_Basis_htmlifyString(ctx, s));
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    uw_error(ctx, FATAL, "Disallowed meta name %s", uw_Basis_htmlifyString(ctx, s));
+}
+
+uw_Basis_string uw_Basis_checkMeta(uw_context ctx, uw_Basis_string s) {
+  if (!meta_format(s))
+    return NULL;
+
+  if (ctx->app->check_meta(s))
+    return s;
+  else
+    return NULL;
+}
+
+uw_Basis_string uw_Basis_getHeader(uw_context ctx, uw_Basis_string name) {
+  return uw_Basis_requestHeader(ctx, name);
+}
+
+static int mime_value_format(const char *s) {
+  for (; *s; ++s)
+    if (*s == '\r' || *s == '\n')
+      return 0;
+
+  return 1;
+}
+
+uw_unit uw_Basis_setHeader(uw_context ctx, uw_Basis_string name, uw_Basis_string value) {
+  if (!mime_value_format(value))
+    uw_error(ctx, FATAL, "Invalid value for HTTP response header");
+
+  uw_write_header(ctx, name);
+  uw_write_header(ctx, ": ");
+  uw_write_header(ctx, value);
+  uw_write_header(ctx, "\r\n");
+
+  return uw_unit_v;
+}
+
+uw_Basis_string uw_Basis_getenv(uw_context ctx, uw_Basis_string name) {
+  if (ctx->get_env)
+    return ctx->get_env(ctx->get_env_data, name);
+  else
+    return getenv(name);
+}
+
+uw_Basis_string uw_unnull(uw_Basis_string s) {
+  return s ? s : "";
+}
+
+uw_Basis_string uw_Basis_makeSigString(uw_context ctx, uw_Basis_string sig) {
+  uw_Basis_string r = uw_malloc(ctx, 2 * uw_hash_blocksize + 1);
+  int i;
+
+  for (i = 0; i < uw_hash_blocksize; ++i)
+    sprintf(&r[2*i], "%.02X", ((unsigned char *)sig)[i]);
+
+  return r;
+}
+
+/* This bit of crafty code is intended to prevent GCC from performing
+ * optimizations that would enable timing attacks.  See:
+ *   http://www.impredicative.com/pipermail/ur/2011-July/000659.html
+ */
+int uw_streq(uw_Basis_string s1, uw_Basis_string s2) {
+  int i, x = 0, len1 = strlen(s1);
+
+  if (len1 != strlen(s2)) return 0;
+
+  for (i = 0; i < len1; ++i) {
+        __asm__ __volatile__ ("");
+        x |= s1[i] ^ s2[i];
+  }
+
+  return x == 0;
+}
+
+uw_Basis_string uw_Basis_sigString(uw_context ctx, uw_unit u) {
+  ctx->usedSig = 1;
+  return ctx->app->cookie_sig(ctx);
+}
+
+uw_Basis_string uw_Basis_fileName(uw_context ctx, uw_Basis_file f) {
+  return f.name;
+}
+
+uw_Basis_string uw_Basis_fileMimeType(uw_context ctx, uw_Basis_file f) {
+  return f.type;
+}
+
+uw_Basis_int uw_Basis_blobSize(uw_context ctx, uw_Basis_blob b) {
+  return b.size;
+}
+
+uw_Basis_blob uw_Basis_textBlob(uw_context ctx, uw_Basis_string s) {
+  uw_Basis_blob b = {strlen(s), s};
+
+  return b;
+}
+
+uw_Basis_blob uw_Basis_fileData(uw_context ctx, uw_Basis_file f) {
+  return f.data;
+}
+
+uw_Basis_string uw_Basis_postType(uw_context ctx, uw_Basis_postBody pb) {
+  return pb.type;
+}
+
+uw_Basis_string uw_Basis_postData(uw_context ctx, uw_Basis_postBody pb) {
+  return pb.data;
+}
+
+static char *old_headers(uw_context ctx) {
+  if (uw_buffer_used(&ctx->outHeaders) == 0)
+    return NULL;
+  else {
+    char *s;
+    int is_good;
+
+    if (strncasecmp(ctx->outHeaders.start, "Content-type: ", 14)) {
+      s = strchr(ctx->outHeaders.start, '\n');
+      is_good = !strncasecmp(s+1, "Content-type: ", 14);
+    } else {
+      s = ctx->outHeaders.start;
+      is_good = 1;
+    }
+
+    if (!is_good)
+      return NULL;
+    else {
+      s = strchr(s+15, '\n');
+      if (s == NULL)
+        return NULL;
+      else
+        return uw_strdup(ctx, s+1);
+    }
+  }
+}
+
+__attribute__((noreturn)) void uw_return_blob(uw_context ctx, uw_Basis_blob b, uw_Basis_string mimeType) {
+  cleanup *cl;
+  int len;
+  char *oldh;
+
+  if (!ctx->allowed_to_return_indirectly)
+    uw_error(ctx, FATAL, "Tried to return a blob from an RPC");
+
+  ctx->returning_indirectly = 1;
+  oldh = old_headers(ctx);
+  uw_buffer_reset(&ctx->outHeaders);
+  uw_buffer_reset(&ctx->page);
+
+  uw_write_header(ctx, on_success);
+  uw_write_header(ctx, "Content-Type: ");
+  uw_write_header(ctx, mimeType);
+  uw_write_header(ctx, "\r\nContent-length: ");
+  ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, INTS_MAX);
+  sprintf(ctx->outHeaders.front, "%lu%n", (unsigned long)b.size, &len);
+  ctx->outHeaders.front += len;
+  uw_write_header(ctx, "\r\n");
+  if (oldh) uw_write_header(ctx, oldh);
+
+  ctx_uw_buffer_append(ctx, "page", &ctx->page, b.data, b.size);
+
+  for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+    cl->func(cl->arg);
+
+  ctx->cleanup_front = ctx->cleanup;
+
+  longjmp(ctx->jmp_buf, RETURN_INDIRECTLY);
+}
+
+void uw_replace_page(uw_context ctx, const char *data, size_t size) {
+  uw_buffer_reset(&ctx->page);
+  ctx_uw_buffer_append(ctx, "page", &ctx->page, data, size);
+}
+
+__attribute__((noreturn)) void uw_return_blob_from_page(uw_context ctx, uw_Basis_string mimeType) {
+  cleanup *cl;
+  int len;
+  char *oldh;
+
+  if (!ctx->allowed_to_return_indirectly)
+    uw_error(ctx, FATAL, "Tried to return a blob from an RPC");
+
+  ctx->returning_indirectly = 1;
+  oldh = old_headers(ctx);
+  uw_buffer_reset(&ctx->outHeaders);
+
+  uw_write_header(ctx, on_success);
+  uw_write_header(ctx, "Content-Type: ");
+  uw_write_header(ctx, mimeType);
+  uw_write_header(ctx, "\r\nContent-length: ");
+  ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, INTS_MAX);
+  sprintf(ctx->outHeaders.front, "%lu%n", (unsigned long)uw_buffer_used(&ctx->page), &len);
+  ctx->outHeaders.front += len;
+  uw_write_header(ctx, "\r\n");
+  if (oldh) uw_write_header(ctx, oldh);
+
+  for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+    cl->func(cl->arg);
+
+  ctx->cleanup_front = ctx->cleanup;
+
+  longjmp(ctx->jmp_buf, RETURN_INDIRECTLY);
+}
+
+__attribute__((noreturn)) void uw_redirect(uw_context ctx, uw_Basis_string url) {
+  cleanup *cl;
+  char *s;
+  char *oldh;
+
+  if (!ctx->allowed_to_return_indirectly)
+    uw_error(ctx, FATAL, "Tried to redirect from an RPC");
+
+  ctx->returning_indirectly = 1;
+  oldh = old_headers(ctx);
+  uw_buffer_reset(&ctx->page);
+  ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->outHeaders)+1);
+  memcpy(ctx->page.start, ctx->outHeaders.start, uw_buffer_used(&ctx->outHeaders));
+  ctx->page.start[uw_buffer_used(&ctx->outHeaders)] = 0;
+  uw_buffer_reset(&ctx->outHeaders);
+
+  if (on_success[0])
+    uw_write_header(ctx, on_redirect);
+  else
+    uw_write_header(ctx, "Status: 303 See Other\r\n");
+  s = on_success[0] ? strchr(ctx->page.start, '\n') : ctx->page.start;
+  if (s) {
+    char *s2;
+    if (s[0] == '\n') ++s;
+    for (; (s2 = strchr(s, '\n')); s = s2+1) {
+      *s2 = 0;
+      if (!strncmp(s, "Set-Cookie: ", 12)) {
+        uw_write_header(ctx, s);
+        uw_write_header(ctx, "\n");
+      }
+    }
+  }
+
+  uw_write_header(ctx, "Location: ");
+  uw_write_header(ctx, url);
+  uw_write_header(ctx, "\r\n\r\n");
+  if (oldh) uw_write_header(ctx, oldh);
+
+  for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+    cl->func(cl->arg);
+
+  ctx->cleanup_front = ctx->cleanup;
+
+  longjmp(ctx->jmp_buf, RETURN_INDIRECTLY);
+}
+
+uw_Basis_string uw_Basis_unAs(uw_context ctx, uw_Basis_string s) {
+  uw_Basis_string ret = uw_malloc(ctx, strlen(s) + 1), r = ret;
+
+  for (; *s; ++s) {
+    if (s[0] == '\'') {
+      *r++ = '\'';
+      for (++s; *s; ++s) {
+        if (s[0] == '\'') {
+          *r++ = '\'';
+          break;
+        } else if (s[0] == '\\') {
+          *r++ = '\\';
+          *r++ = s[1];
+          ++s;
+        } else
+          *r++ = s[0];
+      }
+      if (*s == 0) break;
+    } else if (s[0] == 'T' && s[1] == '_' && s[2] == 'T' && s[3] == '.')
+      s += 3;
+    else
+      *r++ = s[0];
+  }
+
+  *r = 0;
+  return ret;
+}
+
+uw_Basis_string uw_Basis_mstrcat(uw_context ctx, ...) {
+  va_list ap;
+  size_t len = 1;
+  char *s, *r, *s2;
+
+  va_start(ap, ctx);
+  for (s = va_arg(ap, char*); s; s = va_arg(ap, char*))
+    len += strlen(s);
+  va_end(ap);
+
+  r = uw_malloc(ctx, len);
+  va_start(ap, ctx);
+  for (s2 = r, s = va_arg(ap, char*); s; s = va_arg(ap, char*))
+    while (*s)
+      *s2++ = *s++;
+  va_end(ap);
+  *s2 = 0;
+
+  return r;
+}
+
+const uw_Basis_time uw_Basis_minTime = {};
+
+uw_Basis_time uw_Basis_now(uw_context ctx) {
+  uw_Basis_time r = { time(NULL) };
+  return r;
+}
+
+uw_Basis_time uw_Basis_addSeconds(uw_context ctx, uw_Basis_time tm, uw_Basis_int n) {
+  tm.seconds += n;
+  return tm;
+}
+
+uw_Basis_int uw_Basis_diffInSeconds(uw_context ctx, uw_Basis_time tm1, uw_Basis_time tm2) {
+  return difftime(tm2.seconds, tm1.seconds);
+}
+
+uw_Basis_int uw_Basis_toMilliseconds(uw_context ctx, uw_Basis_time tm) {
+  return tm.seconds * 1000 + tm.microseconds / 1000;
+}
+
+uw_Basis_time uw_Basis_fromMilliseconds(uw_context ctx, uw_Basis_int n) {
+  uw_Basis_time tm = {n / 1000, n % 1000 * 1000};
+  return tm;
+}
+
+uw_Basis_int uw_Basis_diffInMilliseconds(uw_context ctx, uw_Basis_time tm1, uw_Basis_time tm2) {
+  return uw_Basis_toMilliseconds(ctx, tm2) - uw_Basis_toMilliseconds(ctx, tm1);
+}
+
+uw_Basis_int uw_Basis_toSeconds(uw_context ctx, uw_Basis_time tm) {
+  return tm.seconds;
+}
+
+uw_Basis_time uw_Basis_fromDatetime(uw_context ctx, uw_Basis_int year, uw_Basis_int month, uw_Basis_int day, uw_Basis_int hour, uw_Basis_int minute, uw_Basis_int second) {
+  struct tm tm = { .tm_year = year - 1900, .tm_mon = month, .tm_mday = day,
+                   .tm_hour = hour, .tm_min = minute, .tm_sec = second,
+                   .tm_isdst = -1 };
+  uw_Basis_time r = { timelocal(&tm) };
+  return r;
+}
+
+uw_Basis_int uw_Basis_datetimeYear(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_year + 1900;
+}
+
+uw_Basis_int uw_Basis_datetimeMonth(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_mon;
+}
+
+uw_Basis_int uw_Basis_datetimeDay(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_mday;
+}
+
+uw_Basis_int uw_Basis_datetimeHour(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_hour;
+}
+
+uw_Basis_int uw_Basis_datetimeMinute(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_min;
+}
+
+uw_Basis_int uw_Basis_datetimeSecond(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_sec;
+}
+
+uw_Basis_int uw_Basis_datetimeDayOfWeek(uw_context ctx, uw_Basis_time time) {
+  struct tm tm;
+  localtime_r(&time.seconds, &tm);
+  return tm.tm_wday;
+}
+
+
+void *uw_get_global(uw_context ctx, char *name) {
+  int i;
+
+  for (i = 0; i < ctx->n_globals; ++i)
+    if (!strcmp(name, ctx->globals[i].name))
+      return ctx->globals[i].data;
+
+  return NULL;
+}
+
+size_t uw_globals_max = SIZE_MAX;
+
+void uw_set_global(uw_context ctx, char *name, void *data, void (*free)(void*)) {
+  int i;
+
+  for (i = 0; i < ctx->n_globals; ++i)
+    if (!strcmp(name, ctx->globals[i].name)) {
+      if (ctx->globals[i].free)
+        ctx->globals[i].free(ctx->globals[i].data);
+      ctx->globals[i].data = data;
+      ctx->globals[i].free = free;
+      return;
+    }
+
+  if (ctx->n_globals+1 > uw_globals_max)
+    uw_error(ctx, FATAL, "Exceeded limit on number of globals");
+
+  ++ctx->n_globals;
+  ctx->globals = realloc(ctx->globals, ctx->n_globals * sizeof(global));
+  ctx->globals[ctx->n_globals-1].name = name;
+  ctx->globals[ctx->n_globals-1].data = data;
+  ctx->globals[ctx->n_globals-1].free = free;
+}
+
+uw_Basis_bool uw_Basis_isalnum(uw_context ctx, uw_Basis_char c) {
+  return !!isalnum((int)c);
+}
+
+uw_Basis_bool uw_Basis_isalpha(uw_context ctx, uw_Basis_char c) {
+  return !!isalpha((int)c);
+}
+
+uw_Basis_bool uw_Basis_isblank(uw_context ctx, uw_Basis_char c) {
+  return !!isblank((int)c);
+}
+
+uw_Basis_bool uw_Basis_iscntrl(uw_context ctx, uw_Basis_char c) {
+  return !!iscntrl((int)c);
+}
+
+uw_Basis_bool uw_Basis_isdigit(uw_context ctx, uw_Basis_char c) {
+  return !!isdigit((int)c);
+}
+
+uw_Basis_bool uw_Basis_isgraph(uw_context ctx, uw_Basis_char c) {
+  return !!isgraph((int)c);
+}
+
+uw_Basis_bool uw_Basis_islower(uw_context ctx, uw_Basis_char c) {
+  return !!islower((int)c);
+}
+
+uw_Basis_bool uw_Basis_isprint(uw_context ctx, uw_Basis_char c) {
+  return !!isprint((int)c);
+}
+
+uw_Basis_bool uw_Basis_ispunct(uw_context ctx, uw_Basis_char c) {
+  return !!ispunct((int)c);
+}
+
+uw_Basis_bool uw_Basis_isspace(uw_context ctx, uw_Basis_char c) {
+  return !!isspace((int)c);
+}
+
+uw_Basis_bool uw_Basis_isupper(uw_context ctx, uw_Basis_char c) {
+  return !!isupper((int)c);
+}
+
+uw_Basis_bool uw_Basis_isxdigit(uw_context ctx, uw_Basis_char c) {
+  return !!isxdigit((int)c);
+}
+
+uw_Basis_char uw_Basis_tolower(uw_context ctx, uw_Basis_char c) {
+  return tolower((int)c);
+}
+
+uw_Basis_char uw_Basis_toupper(uw_context ctx, uw_Basis_char c) {
+  return toupper((int)c);
+}
+
+uw_Basis_int uw_Basis_ord(uw_context ctx, uw_Basis_char c) {
+  return (unsigned char)c;
+}
+
+uw_Basis_char uw_Basis_chr(uw_context ctx, uw_Basis_int n) {
+  return n;
+}
+
+uw_Basis_string uw_Basis_currentUrl(uw_context ctx) {
+  return ctx->current_url;
+}
+
+void uw_set_currentUrl(uw_context ctx, char *s) {
+  ctx->current_url = s;
+}
+
+void uw_set_deadline(uw_context ctx, int n) {
+  ctx->deadline = n;
+}
+
+void uw_check_deadline(uw_context ctx) {
+  if (uw_time > ctx->deadline)
+    uw_error(ctx, FATAL, "Maximum running time exceeded");
+}
+
+size_t uw_database_max = SIZE_MAX;
+
+uw_Basis_int uw_Basis_naughtyDebug(uw_context ctx, uw_Basis_string s) {
+  if (ctx->loggers->log_debug)
+    ctx->loggers->log_debug(ctx->loggers->logger_data, "%s\n", s);
+  else
+    fprintf(stderr, "%s\n", s);
+  return 0;
+}
+
+uw_Basis_unit uw_Basis_debug(uw_context ctx, uw_Basis_string s) {
+  if (ctx->loggers->log_debug)
+    ctx->loggers->log_debug(ctx->loggers->logger_data, "%s\n", s);
+  else
+    fprintf(stderr, "%s\n", s);
+  return uw_unit_v;
+}
+
+uw_Basis_int uw_Basis_rand(uw_context ctx) {
+  int r = my_rand();
+
+  if (r >= 0)
+    return r;
+  else
+    uw_error(ctx, FATAL, "Random number generation failed");
+}
+
+void uw_noPostBody(uw_context ctx) {
+  ctx->hasPostBody = 0;
+}
+
+void uw_postBody(uw_context ctx, uw_Basis_postBody pb) {
+  ctx->hasPostBody = 1;
+  ctx->postBody = pb;
+}
+
+int uw_hasPostBody(uw_context ctx) {
+  return ctx->hasPostBody;
+}
+
+void uw_isPost(uw_context ctx) {
+  ctx->isPost = 1;
+}
+
+uw_Basis_bool uw_Basis_currentUrlHasPost(uw_context ctx) {
+  return ctx->isPost;
+}
+
+uw_Basis_bool uw_Basis_currentUrlHasQueryString(uw_context ctx) {
+  return ctx->queryString != NULL && ctx->queryString[0] != 0;
+}
+
+void uw_setQueryString(uw_context ctx, uw_Basis_string s) {
+  ctx->queryString = s;
+}
+
+uw_Basis_string uw_queryString(uw_context ctx) {
+  return ctx->queryString;
+}
+
+uw_Basis_postBody uw_getPostBody(uw_context ctx) {
+  if (ctx->hasPostBody)
+    return ctx->postBody;
+  else
+    uw_error(ctx, FATAL, "Asked for POST body when none exists");
+}
+
+failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (r == 0) {
+    uw_ensure_transaction(ctx);
+
+    callback(ctx);
+  }
+
+  return r;
+}
+
+uw_Basis_string uw_Basis_crypt(uw_context ctx, uw_Basis_string key, uw_Basis_string salt) {
+  char buf[14];
+  return uw_strdup(ctx, DES_fcrypt(key, salt, buf));
+}
+
+uw_Basis_bool uw_Basis_eq_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) {
+  return !!(t1.seconds == t2.seconds && t1.microseconds == t2.microseconds);
+}
+
+uw_Basis_bool uw_Basis_lt_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) {
+  return !!(t1.seconds < t2.seconds || (t1.seconds == t2.seconds && t1.microseconds < t2.microseconds));
+}
+
+uw_Basis_bool uw_Basis_le_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) {
+  return !!(uw_Basis_eq_time(ctx, t1, t2) || uw_Basis_lt_time(ctx, t1, t2));
+}
+
+uw_Basis_time *uw_Basis_readUtc(uw_context ctx, uw_Basis_string s) {
+  struct tm stm = {};
+  char *end = strchr(s, 0);
+  stm.tm_isdst = -1;
+
+  if (strptime(s, TIME_FMT_PG, &stm) == end || strptime(s, TIME_FMT, &stm) == end || strptime(s, TIME_FMT_JS, &stm) == end) {
+    uw_Basis_time *r = uw_malloc(ctx, sizeof(uw_Basis_time));
+
+    r->seconds = timegm(&stm);
+    r->microseconds = 0;
+
+    return r;
+  }
+  else
+    return NULL;
+}
+
+failure_kind uw_begin_onError(uw_context ctx, char *msg) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (ctx->app->on_error) {
+    if (r == 0) {
+      uw_ensure_transaction(ctx);
+
+      uw_buffer_reset(&ctx->outHeaders);
+      if (on_success[0])
+        uw_write_header(ctx, "HTTP/1.1 ");
+      else
+        uw_write_header(ctx, "Status: ");
+      uw_write_header(ctx, "500 Internal Server Error\r\n");
+      uw_write_header(ctx, "Content-type: text/html\r\n");
+      uw_write(ctx, ctx->app->is_html5 ? uw_begin_html5 : uw_begin_xhtml);
+      ctx->app->on_error(ctx, msg);
+      uw_write(ctx, "</html>");
+    }
+
+    return r;
+  } else
+    uw_error(ctx, FATAL, "Tried to run nonexistent onError handler");
+}
+
+void uw_mayReturnIndirectly(uw_context ctx) {
+  ctx->allowed_to_return_indirectly = 1;
+}
+
+uw_Basis_string uw_Basis_fresh(uw_context ctx) {
+  int len;
+  char *r;
+
+  uw_check_heap(ctx, 2+INTS_MAX);
+  r = ctx->heap.front;
+  sprintf(r, "uw%u%n", ctx->nextId++, &len);
+  ctx->heap.front += len+1;
+  return r;
+}
+
+uw_Basis_float uw_Basis_floatFromInt(uw_context ctx, uw_Basis_int n) {
+  return n;
+}
+
+uw_Basis_int uw_Basis_ceil(uw_context ctx, uw_Basis_float n) {
+  return ceil(n);
+}
+
+uw_Basis_int uw_Basis_trunc(uw_context ctx, uw_Basis_float n) {
+  return trunc(n);
+}
+
+uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) {
+  return round(n);
+}
+
+uw_Basis_int uw_Basis_floor(uw_context ctx, uw_Basis_float n) {
+  return floor(n);
+}
+
+uw_Basis_float uw_Basis_pow(uw_context ctx, uw_Basis_float n, uw_Basis_float m) {
+  return pow(n,m);
+}
+
+uw_Basis_float uw_Basis_sqrt(uw_context ctx, uw_Basis_float n) {
+  return sqrt(n);
+}
+
+uw_Basis_float uw_Basis_sin(uw_context ctx, uw_Basis_float n) {
+  return sin(n);
+}
+
+uw_Basis_float uw_Basis_cos(uw_context ctx, uw_Basis_float n) {
+  return cos(n);
+}
+
+uw_Basis_float uw_Basis_log(uw_context ctx, uw_Basis_float n) {
+  return log(n);
+}
+
+uw_Basis_float uw_Basis_exp(uw_context ctx, uw_Basis_float n) {
+  return exp(n);
+}
+
+uw_Basis_float uw_Basis_asin(uw_context ctx, uw_Basis_float n) {
+  return asin(n);
+}
+
+uw_Basis_float uw_Basis_acos(uw_context ctx, uw_Basis_float n) {
+  return acos(n);
+}
+
+uw_Basis_float uw_Basis_atan(uw_context ctx, uw_Basis_float n) {
+  return atan(n);
+}
+
+uw_Basis_float uw_Basis_atan2(uw_context ctx, uw_Basis_float n, uw_Basis_float m) {
+  return atan2(n, m);
+}
+
+uw_Basis_float uw_Basis_abs(uw_context ctx, uw_Basis_float n) {
+  return fabs(n);
+}
+
+uw_Basis_string uw_Basis_atom(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!isalnum((int)c) && c != '+' && c != '-' && c != '.' && c != '%' && c != '#')
+      uw_error(ctx, FATAL, "Disallowed character in CSS atom");
+  }
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_css_url(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!isalnum((int)c) && c != ':' && c != '/' && c != '.' && c != '_' && c != '+'
+        && c != '-' && c != '%' && c != '?' && c != '&' && c != '=' && c != '#')
+      uw_error(ctx, FATAL, "Disallowed character in CSS URL");
+  }
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) {
+  char *p;
+
+  if (!*s)
+    uw_error(ctx, FATAL, "Empty CSS property");
+
+  if (!islower((int)s[0]) && s[0] != '_')
+    uw_error(ctx, FATAL, "Bad initial character in CSS property");
+
+  for (p = s; *p; ++p) {
+    char c = *p;
+    if (!islower((int)c) && !isdigit((int)c) && c != '_' && c != '-')
+      uw_error(ctx, FATAL, "Disallowed character in CSS property");
+  }
+
+  return s;
+}
+
+uw_Basis_string uw_Basis_fieldName(uw_context ctx, uw_Basis_postField f) {
+  return f.name;
+}
+
+uw_Basis_string uw_Basis_fieldValue(uw_context ctx, uw_Basis_postField f) {
+  return f.value;
+}
+
+uw_Basis_string uw_Basis_remainingFields(uw_context ctx, uw_Basis_postField f) {
+  return f.remaining;
+}
+
+uw_Basis_postField *uw_Basis_firstFormField(uw_context ctx, uw_Basis_string s) {
+  char *unurl;
+  uw_Basis_postField *f;
+
+  if (!ctx->hasPostBody)
+    uw_error(ctx, FATAL, "firstFormField called when there is no POST body");
+
+  if (s < ctx->postBody.data || s >= ctx->postBody.data + ctx->postBody.len)
+    return NULL;
+
+  f = uw_malloc(ctx, sizeof(uw_Basis_postField));
+  unurl = s;
+  f->name = uw_Basis_unurlifyString(ctx, &unurl);
+  s = strchr(s, 0);
+  if (!s)
+    uw_error(ctx, FATAL, "firstFormField: Missing null terminator");
+  ++s;
+  unurl = s;
+  f->value = uw_Basis_unurlifyString(ctx, &unurl);
+  s = strchr(s, 0);
+  if (!s)
+    uw_error(ctx, FATAL, "firstFormField: Missing null terminator");
+  f->remaining = s+1;
+
+  return f;
+}
+
+uw_Basis_string uw_Basis_blessData(uw_context ctx, uw_Basis_string s) {
+  char *p = s;
+
+  for (; *p; ++p)
+    if (!isalnum(*p) && *p != '-' && *p != '_')
+      uw_error(ctx, FATAL, "Illegal HTML5 data-* attribute: %s", s);
+
+  return s;
+}
+
+int uw_remoteSock(uw_context ctx) {
+  return ctx->remoteSock;
+}
+
+void uw_set_remoteSock(uw_context ctx, int sock) {
+  ctx->remoteSock = sock;
+}
+
+
+// Sqlcache
+
+static void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) {
+  if (value) {
+    free(value->result);
+    free(value->output);
+    free(value->scriptOutput);
+    free(value);
+  }
+}
+
+static void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) {
+  if (entry) {
+    free(entry->key);
+    uw_Sqlcache_freeValue(entry->value);
+    free(entry);
+  }
+}
+
+// TODO: pick a number.
+static unsigned int uw_Sqlcache_maxSize = 1234567890;
+
+static void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry) {
+  if (entry) {
+    HASH_DEL(cache->table, entry);
+    uw_Sqlcache_freeEntry(entry);
+  }
+}
+
+static uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t len, int bump) {
+  uw_Sqlcache_Entry *entry = NULL;
+  HASH_FIND(hh, cache->table, key, len, entry);
+  if (entry && bump) {
+    // Bump for LRU purposes.
+    HASH_DEL(cache->table, entry);
+    // Important that we use [entry->key], because [key] might be ephemeral.
+    HASH_ADD_KEYPTR(hh, cache->table, entry->key, len, entry);
+  }
+  return entry;
+}
+
+static void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, size_t len) {
+  HASH_ADD_KEYPTR(hh, cache->table, entry->key, len, entry);
+  if (HASH_COUNT(cache->table) > uw_Sqlcache_maxSize) {
+    // Deletes the first element of the cache.
+    uw_Sqlcache_delete(cache, cache->table);
+  }
+}
+
+static unsigned long uw_Sqlcache_getTimeNow(uw_Sqlcache_Cache *cache) {
+  // TODO: verify that this makes time comparisons do the Right Thing.
+  return cache->timeNow++;
+}
+
+static unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) {
+  return x > y ? x : y;
+}
+
+static char uw_Sqlcache_keySep = '_';
+
+static char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) {
+  size_t len = 0;
+  while (numKeys-- > 0) {
+    char* k = keys[numKeys];
+    if (!k) {
+      // Can only happen when flushing, in which case we don't need anything past the null key.
+      break;
+    }
+    // Leave room for separator.
+    len += 1 + strlen(k);
+  }
+  char *buf = malloc(len+1);
+  // If nothing is copied into the buffer, it should look like it has length 0.
+  buf[0] = 0;
+  return buf;
+}
+
+static char *uw_Sqlcache_keyCopy(char *buf, char *key) {
+  *buf++ = uw_Sqlcache_keySep;
+  return stpcpy(buf, key);
+}
+
+// The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn".
+
+uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) {
+  int doBump = random() % 1024 == 0;
+  if (doBump) {
+    pthread_rwlock_wrlock(&cache->lockIn);
+  } else {
+    pthread_rwlock_rdlock(&cache->lockIn);
+  }
+  size_t numKeys = cache->numKeys;
+  char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys);
+  char *buf = key;
+  time_t timeInvalid = cache->timeInvalid;
+  uw_Sqlcache_Entry *entry = NULL;
+  if (numKeys == 0) {
+    entry = cache->table;
+    if (!entry) {
+      free(key);
+      pthread_rwlock_unlock(&cache->lockIn);
+      return NULL;
+    }
+  } else {
+    while (numKeys-- > 0) {
+      buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]);
+      size_t len = buf - key;
+      entry = uw_Sqlcache_find(cache, key, len, doBump);
+      if (!entry) {
+        free(key);
+        pthread_rwlock_unlock(&cache->lockIn);
+        return NULL;
+      }
+      timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid);
+    }
+    free(key);
+  }
+  uw_Sqlcache_Value *value = entry->value;
+  pthread_rwlock_unlock(&cache->lockIn);
+  // ASK: though the argument isn't trivial, this is safe, right?
+  // Returning outside the lock is safe because updates happen at commit time.
+  // Those are the only times the returned value or its strings can get freed.
+  // Handler output is a new string, so it's safe to free this at commit time.
+  return value && timeInvalid < value->timeValid ? value : NULL;
+}
+
+static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) {
+  pthread_rwlock_wrlock(&cache->lockIn);
+  size_t numKeys = cache->numKeys;
+  time_t timeNow = uw_Sqlcache_getTimeNow(cache);
+  uw_Sqlcache_Entry *entry = NULL;
+  if (numKeys == 0) {
+    entry = cache->table;
+    if (!entry) {
+      entry = calloc(1, sizeof(uw_Sqlcache_Entry));
+      entry->key = NULL;
+      entry->value = NULL;
+      entry->timeInvalid = 0;
+      cache->table = entry;
+    }
+  } else {
+    char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys);
+    char *buf = key;
+    while (numKeys-- > 0) {
+      buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]);
+      size_t len = buf - key;
+
+      entry = uw_Sqlcache_find(cache, key, len, 1);
+      if (!entry) {
+        entry = calloc(1, sizeof(uw_Sqlcache_Entry));
+        entry->key = strdup(key);
+        entry->value = NULL;
+        entry->timeInvalid = 0;
+        uw_Sqlcache_add(cache, entry, len);
+      }
+    }
+    free(key);
+  }
+  if (!entry->value || entry->value->timeValid < value->timeValid) {
+    uw_Sqlcache_freeValue(entry->value);
+    entry->value = value;
+    entry->value->timeValid = timeNow;
+  }
+  pthread_rwlock_unlock(&cache->lockIn);
+}
+
+static void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) {
+}
+
+static void uw_Sqlcache_commit(void *data) {
+  uw_context ctx = (uw_context)data;
+  uw_Sqlcache_Update *update = ctx->cacheUpdate;
+  while (update) {
+    uw_Sqlcache_Cache *cache = update->cache;
+    char **keys = update->keys;
+    if (update->value) {
+      uw_Sqlcache_storeCommitOne(cache, keys, update->value);
+    } else {
+      uw_Sqlcache_flushCommitOne(cache, keys);
+    }
+    update = update->next;
+  }
+}
+
+static void uw_Sqlcache_free(void *data, int dontCare) {
+  uw_context ctx = (uw_context)data;
+  uw_Sqlcache_Update *update = ctx->cacheUpdate;
+  while (update) {
+    char** keys = update->keys;
+    size_t numKeys = update->cache->numKeys;
+    while (numKeys-- > 0) {
+      free(keys[numKeys]);
+    }
+    free(keys);
+    // Don't free [update->value]: it's in the cache now!
+    uw_Sqlcache_Update *nextUpdate = update->next;
+    free(update);
+    update = nextUpdate;
+  }
+  ctx->cacheUpdate = NULL;
+  ctx->cacheUpdateTail = NULL;
+  uw_Sqlcache_Unlock *unlock = ctx->cacheUnlock;
+  while (unlock) {
+    pthread_rwlock_unlock(unlock->lock);
+    uw_Sqlcache_Unlock *nextUnlock = unlock->next;
+    free(unlock);
+    unlock = nextUnlock;
+  }
+  ctx->cacheUnlock = NULL;
+}
+
+static void uw_Sqlcache_pushUnlock(uw_context ctx, pthread_rwlock_t *lock) {
+  if (!ctx->cacheUnlock) {
+    // Just need one registered commit for both updating and unlocking.
+    uw_register_transactional(ctx, ctx, uw_Sqlcache_commit, NULL, uw_Sqlcache_free);
+  }
+  uw_Sqlcache_Unlock *unlock = malloc(sizeof(uw_Sqlcache_Unlock));
+  unlock->lock = lock;
+  unlock->next = ctx->cacheUnlock;
+  ctx->cacheUnlock = unlock;
+}
+
+void uw_Sqlcache_rlock(uw_context ctx, uw_Sqlcache_Cache *cache) {
+  pthread_rwlock_rdlock(&cache->lockOut);
+  uw_Sqlcache_pushUnlock(ctx, &cache->lockOut);
+}
+
+void uw_Sqlcache_wlock(uw_context ctx, uw_Sqlcache_Cache *cache) {
+  pthread_rwlock_wrlock(&cache->lockOut);
+  uw_Sqlcache_pushUnlock(ctx, &cache->lockOut);
+}
+
+static char **uw_Sqlcache_copyKeys(char **keys, size_t numKeys) {
+  char **copy = malloc(sizeof(char *) * numKeys);
+  while (numKeys-- > 0) {
+    char *k = keys[numKeys];
+    copy[numKeys] = k ? strdup(k) : NULL;
+  }
+  return copy;
+}
+
+void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) {
+  uw_Sqlcache_Update *update = malloc(sizeof(uw_Sqlcache_Update));
+  update->cache = cache;
+  update->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys);
+  update->value = value;
+  update->next = NULL;
+  // Can't use [uw_Sqlcache_getTimeNow] because it modifies state and we don't have the lock.
+  pthread_rwlock_rdlock(&cache->lockIn);
+  value->timeValid = cache->timeNow;
+  pthread_rwlock_unlock(&cache->lockIn);
+  if (ctx->cacheUpdateTail) {
+    ctx->cacheUpdateTail->next = update;
+  } else {
+    ctx->cacheUpdate = update;
+  }
+  ctx->cacheUpdateTail = update;
+}
+
+void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) {
+  // A flush has to happen immediately so that subsequent stores in the same transaction fail.
+  // This is safe to do because we will always call [uw_Sqlcache_wlock] earlier.
+  // If the transaction fails, the only harm done is a few extra cache misses.
+  pthread_rwlock_wrlock(&cache->lockIn);
+  size_t numKeys = cache->numKeys;
+  if (numKeys == 0) {
+    uw_Sqlcache_Entry *entry = cache->table;
+    if (entry) {
+      uw_Sqlcache_freeValue(entry->value);
+      entry->value = NULL;
+    }
+  } else {
+    char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys);
+    char *buf = key;
+    time_t timeNow = uw_Sqlcache_getTimeNow(cache);
+    while (numKeys-- > 0) {
+      char *k = keys[numKeys];
+      if (!k) {
+        size_t len = buf - key;
+        if (len == 0) {
+          // The first key was null.
+          cache->timeInvalid = timeNow;
+        } else {
+          uw_Sqlcache_Entry *entry = uw_Sqlcache_find(cache, key, len, 0);
+          if (entry) {
+            entry->timeInvalid = timeNow;
+          }
+        }
+        free(key);
+        pthread_rwlock_unlock(&cache->lockIn);
+        return;
+      }
+      buf = uw_Sqlcache_keyCopy(buf, k);
+    }
+    // All the keys were non-null, so we delete the pointed-to entry.
+    size_t len = buf - key;
+    uw_Sqlcache_Entry *entry = uw_Sqlcache_find(cache, key, len, 0);
+    free(key);
+    uw_Sqlcache_delete(cache, entry);
+  }
+  pthread_rwlock_unlock(&cache->lockIn);
+}
+
+int strcmp_nullsafe(const char *str1, const char *str2) {
+  if (str1)
+    return strcmp(str1, str2);
+  else
+    return 1;
+}
diff --git a/src/cache.sml b/src/cache.sml
new file mode 100644
index 0000000..015c3ff
--- /dev/null
+++ b/src/cache.sml
@@ -0,0 +1,17 @@
+structure Cache = struct
+
+type cache =
+     {(* Takes a query ID and parameters (and, for store, the value to
+         store) and gives an FFI call that checks, stores, or flushes the
+         relevant entry. The parameters are strings for check and store and
+         optional strings for flush because some parameters might not be
+         fixed. *)
+      check : int * Mono.exp list -> Mono.exp',
+      store : int * Mono.exp list * Mono.exp -> Mono.exp',
+      flush : int * Mono.exp list -> Mono.exp',
+      lock : int * bool (* true = write, false = read *) -> Mono.exp',
+      (* Generates C needed for FFI calls in check, store, and flush. *)
+      setupGlobal : Print.PD.pp_desc,
+      setupQuery : {index : int, params : int} -> Print.PD.pp_desc}
+
+end
diff --git a/src/cgi.sig b/src/cgi.sig
new file mode 100644
index 0000000..ae6549a
--- /dev/null
+++ b/src/cgi.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CGI = sig
+
+end
diff --git a/src/cgi.sml b/src/cgi.sml
new file mode 100644
index 0000000..7ee8142
--- /dev/null
+++ b/src/cgi.sml
@@ -0,0 +1,52 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Cgi :> CGI = struct
+
+open Settings
+open Print.PD Print
+
+val () = addProtocol {name = "cgi",
+                      compile = "",
+                      linkStatic = "liburweb_cgi.a",
+                      linkDynamic = "-lurweb_cgi",
+                      persistent = false,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "uw_setup_limits();",
+                                           newline,
+                                           string "}",
+                                           newline]}
+
+end
diff --git a/src/checknest.sig b/src/checknest.sig
new file mode 100644
index 0000000..f8273b4
--- /dev/null
+++ b/src/checknest.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CHECKNEST = sig
+
+    val annotate : Cjr.file -> Cjr.file
+
+end
diff --git a/src/checknest.sml b/src/checknest.sml
new file mode 100644
index 0000000..fa418d8
--- /dev/null
+++ b/src/checknest.sml
@@ -0,0 +1,187 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Checknest :> CHECKNEST = struct
+
+open Cjr
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+fun expUses globals =
+    let
+        fun eu (e, _) =
+            case e of
+                EPrim _ => IS.empty
+              | ERel _ => IS.empty
+              | ENamed n => Option.getOpt (IM.find (globals, n), IS.empty)
+              | ECon (_, _, NONE) => IS.empty
+              | ECon (_, _, SOME e) => eu e
+              | ENone _ => IS.empty
+              | ESome (_, e) => eu e
+              | EFfi _ => IS.empty
+              | EFfiApp (_, _, es) => foldl IS.union IS.empty (map (eu o #1) es)
+              | EApp (e, es) => foldl IS.union (eu e) (map eu es)
+
+              | EUnop (_, e) => eu e
+              | EBinop (_, e1, e2) => IS.union (eu e1, eu e2)
+
+              | ERecord (_, xes) => foldl (fn ((_, e), s) => IS.union (eu e, s)) IS.empty xes
+              | EField (e, _) => eu e
+
+              | ECase (e, pes, _) => foldl (fn ((_, e), s) => IS.union (eu e, s)) (eu e) pes
+
+              | EError (e, _) => eu e
+              | EReturnBlob {blob = NONE, mimeType, ...} => eu mimeType
+              | EReturnBlob {blob = SOME blob, mimeType, ...} => IS.union (eu blob, eu mimeType)
+              | ERedirect (e, _) => eu e
+
+              | EWrite e => eu e
+              | ESeq (e1, e2) => IS.union (eu e1, eu e2)
+              | ELet (_, _, e1, e2) => IS.union (eu e1, eu e2)
+
+              | EQuery {query, body, initial, prepared, ...} =>
+                let
+                    val s = IS.union (eu query, IS.union (eu body, eu initial))
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+              | EDml {dml, prepared, ...} =>
+                let
+                    val s = eu dml
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+              | ENextval {seq, prepared, ...} =>
+                let
+                    val s = eu seq
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+              | ESetval {seq, count} => IS.union (eu seq, eu count)
+
+              | EUnurlify (e, _, _) => eu e
+    in
+        eu
+    end
+
+fun annotateExp globals =
+    let
+        fun ae (e as (_, loc)) =
+            case #1 e of
+                EPrim _ => e
+              | ERel _ => e
+              | ENamed n => e
+              | ECon (_, _, NONE) => e
+              | ECon (dk, pc, SOME e) => (ECon (dk, pc, SOME (ae e)), loc)
+              | ENone _ => e
+              | ESome (t, e) => (ESome (t, ae e), loc)
+              | EFfi _ => e
+              | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (ae e, t)) es), loc)
+              | EApp (e, es) => (EApp (ae e, map ae es), loc)
+
+              | EUnop (uo, e) => (EUnop (uo, ae e), loc)
+              | EBinop (bo, e1, e2) => (EBinop (bo, ae e1, ae e2), loc)
+
+              | ERecord (n, xes) => (ERecord (n, map (fn (x, e) => (x, ae e)) xes), loc)
+              | EField (e, f) => (EField (ae e, f), loc)
+
+              | ECase (e, pes, ts) => (ECase (ae e, map (fn (p, e) => (p, ae e)) pes, ts), loc)
+
+              | EError (e, t) => (EError (ae e, t), loc)
+              | EReturnBlob {blob = NONE, mimeType, t} => (EReturnBlob {blob = NONE, mimeType = ae mimeType, t = t}, loc)
+              | EReturnBlob {blob = SOME blob, mimeType, t} => (EReturnBlob {blob = SOME (ae blob), mimeType = ae mimeType, t = t}, loc)
+              | ERedirect (e, t) => (ERedirect (ae e, t), loc)
+
+              | EWrite e => (EWrite (ae e), loc)
+              | ESeq (e1, e2) => (ESeq (ae e1, ae e2), loc)
+              | ELet (x, t, e1, e2) => (ELet (x, t, ae e1, ae e2), loc)
+
+              | EQuery {exps, tables, rnum, state, query, body, initial, prepared} =>
+                (EQuery {exps = exps,
+                         tables = tables,
+                         rnum = rnum,
+                         state = state,
+                         query = ae query,
+                         body = ae body,
+                         initial = ae initial,
+                         prepared = case prepared of
+                                        NONE => NONE
+                                      | SOME {id, query, ...} => SOME {id = id, query = query,
+                                                                       nested = IS.member (expUses globals body, id)}},
+                 loc)
+              | EDml {dml, prepared, mode} =>
+                (EDml {dml = ae dml,
+                       prepared = prepared,
+                       mode = mode}, loc)
+
+              | ENextval {seq, prepared} =>
+                (ENextval {seq = ae seq,
+                           prepared = prepared}, loc)
+              | ESetval {seq, count} =>
+                (ESetval {seq = ae seq,
+                          count = ae count}, loc)
+
+              | EUnurlify (e, t, b) => (EUnurlify (ae e, t, b), loc)
+    in
+        ae
+    end
+
+fun annotate (ds, syms) =
+    let
+        val globals =
+            foldl (fn ((d, _), globals) =>
+                      case d of
+                          DVal (_, n, _, e) => IM.insert (globals, n, expUses globals e)
+                        | DFun (_, n, _, _, e) => IM.insert (globals, n, expUses globals e)
+                        | DFunRec fs =>
+                          let
+                              val s = foldl (fn ((_, _, _, _, e), s) => IS.union (expUses globals e, s)) IS.empty fs
+                          in
+                              foldl (fn ((_, n, _, _, _), globals) => IM.insert (globals, n, s)) globals fs
+                          end
+                        | _ => globals) IM.empty ds
+
+        val ds =
+            map (fn d as (_, loc) =>
+                    case #1 d of
+                        DVal (x, n, t, e) => (DVal (x, n, t, annotateExp globals e), loc)
+                      | DFun (x, n, ts, t, e) => (DFun (x, n, ts, t, annotateExp globals e), loc)
+                      | DFunRec fs => (DFunRec
+                                           (map (fn (x, n, ts, t, e) => (x, n, ts, t, annotateExp globals e)) fs), loc)
+                      | _ => d) ds
+    in
+        (ds, syms)
+    end
+
+end
diff --git a/src/cjr.sml b/src/cjr.sml
new file mode 100644
index 0000000..e582e6a
--- /dev/null
+++ b/src/cjr.sml
@@ -0,0 +1,138 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Cjr = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype datatype_kind = datatype DatatypeKind.datatype_kind
+
+datatype typ' =
+         TFun of typ * typ
+       | TRecord of int
+       | TDatatype of datatype_kind * int * (string * int * typ option) list ref
+       | TFfi of string * string
+       | TOption of typ
+       | TList of typ * int
+
+withtype typ = typ' located
+
+datatype patCon =
+         PConVar of int
+       | PConFfi of {mod : string, datatyp : string, con : string, arg : typ option}
+
+datatype pat' =
+         PVar of string * typ
+       | PPrim of Prim.t
+       | PCon of datatype_kind * patCon * pat option
+       | PRecord of (string * pat * typ) list
+       | PNone of typ
+       | PSome of typ * pat
+
+withtype pat = pat' located
+
+datatype failure_mode = datatype Settings.failure_mode
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | ECon of datatype_kind * patCon * exp option
+       | ENone of typ
+       | ESome of typ * exp
+       | EFfi of string * string
+       | EFfiApp of string * string * (exp * typ) list
+       | EApp of exp * exp list
+
+       | EUnop of string * exp
+       | EBinop of string * exp * exp
+
+       | ERecord of int * (string * exp) list
+       | EField of exp * string
+
+       | ECase of exp * (pat * exp) list * { disc : typ, result : typ }
+
+       | EError of exp * typ
+       | EReturnBlob of {blob : exp option, mimeType : exp, t : typ}
+       | ERedirect of exp * typ
+
+       | EWrite of exp
+       | ESeq of exp * exp
+       | ELet of string * typ * exp * exp
+
+       | EQuery of { exps : (string * typ) list,
+                     tables : (string * (string * typ) list) list,
+                     rnum : int,
+                     state : typ,
+                     query : exp,
+                     body : exp,
+                     initial : exp,
+                     prepared : {id : int, query : string, nested : bool} option }
+       | EDml of { dml : exp,
+                   prepared : {id : int, dml : string} option,
+                   mode : failure_mode }
+       | ENextval of { seq : exp,
+                       prepared : {id : int, query : string} option }
+       | ESetval of { seq : exp, count : exp }
+       | EUnurlify of exp * typ * bool
+
+withtype exp = exp' located
+
+datatype task = Initialize | ClientLeaves | Periodic of Int64.int
+
+datatype decl' =
+         DStruct of int * (string * typ) list
+       | DDatatype of (datatype_kind * string * int * (string * int * typ option) list) list
+       | DDatatypeForward of datatype_kind * string * int
+       | DVal of string * int * typ * exp
+       | DFun of string * int * (string * typ) list * typ * exp
+       | DFunRec of (string * int * (string * typ) list * typ * exp) list
+
+       | DTable of string * (string * typ) list * string * (string * string) list
+       | DSequence of string
+       | DView of string * (string * typ) list * string
+       | DDatabase of {name : string, expunge : int, initialize : int}
+       | DPreparedStatements of (string * int) list
+
+       | DJavaScript of string
+       | DCookie of string
+       | DStyle of string
+
+       | DTask of task * string (* first arg name *) * string * exp
+       | DOnError of int
+
+withtype decl = decl' located
+
+datatype sidedness = datatype Mono.sidedness
+datatype dbmode = datatype Mono.dbmode
+
+datatype effect = datatype Export.effect
+datatype export_kind = datatype Export.export_kind
+
+type file = decl list * (export_kind * string * int * typ list * typ * sidedness * dbmode * bool) list
+
+end
diff --git a/src/cjr_env.sig b/src/cjr_env.sig
new file mode 100644
index 0000000..0254f15
--- /dev/null
+++ b/src/cjr_env.sig
@@ -0,0 +1,59 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CJR_ENV = sig
+
+    type env
+
+    val empty : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+    exception UnboundF of int
+    exception UnboundStruct of int
+
+    val pushDatatype : env -> string -> int -> (string * int * Cjr.typ option) list -> env
+    val lookupDatatype : env -> int -> string * (string * int * Cjr.typ option) list
+
+    val lookupConstructor : env -> int -> string * Cjr.typ option * int
+
+    val pushERel : env -> string -> Cjr.typ -> env
+    val lookupERel : env -> int -> string * Cjr.typ
+    val listERels : env -> (string * Cjr.typ) list
+    val countERels : env -> int
+
+    val pushENamed : env -> string -> int -> Cjr.typ -> env
+    val lookupENamed : env -> int -> string * Cjr.typ
+
+    val pushStruct : env -> int -> (string * Cjr.typ) list -> env
+    val lookupStruct : env -> int -> (string * Cjr.typ) list
+
+    val declBinds : env -> Cjr.decl -> env
+
+    val classifyDatatype : (string * int * Cjr.typ option) list -> Cjr.datatype_kind
+                                                 
+end
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
new file mode 100644
index 0000000..21188b5
--- /dev/null
+++ b/src/cjr_env.sml
@@ -0,0 +1,177 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure CjrEnv :> CJR_ENV = struct
+
+open Cjr
+
+structure IM = IntBinaryMap
+
+
+exception UnboundRel of int
+exception UnboundNamed of int
+exception UnboundF of int
+exception UnboundStruct of int
+
+type env = {
+     datatypes : (string * (string * int * typ option) list) IM.map,
+     constructors : (string * typ option * int) IM.map,
+
+     numRelE : int,
+     relE : (string * typ) list,
+     namedE : (string * typ) IM.map,
+
+     structs : (string * typ) list IM.map
+}
+
+val empty : env = {
+    datatypes = IM.empty,
+    constructors = IM.empty,
+
+    numRelE = 0,
+    relE = [],
+    namedE = IM.empty,
+
+    structs = IM.insert (IM.empty, 0, [])
+}
+
+fun pushDatatype (env : env) x n xncs =
+    {datatypes = IM.insert (#datatypes env, n, (x, xncs)),
+     constructors = foldl (fn ((x, n', to), constructors) =>
+                              IM.insert (constructors, n', (x, to, n)))
+                          (#constructors env) xncs,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     structs = #structs env}
+
+fun lookupDatatype (env : env) n =
+    case IM.find (#datatypes env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupConstructor (env : env) n =
+    case IM.find (#constructors env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushERel (env : env) x t =
+    {datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     numRelE = #numRelE env + 1,
+     relE = (x, t) :: #relE env,
+     namedE = #namedE env,
+
+     structs = #structs env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun countERels (env : env) = #numRelE env
+
+fun listERels (env : env) = #relE env
+
+fun pushENamed (env : env) x n t =
+    {datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t)),
+
+     structs = #structs env}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushStruct (env : env) n xts =
+    {datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     structs = IM.insert (#structs env, n, xts)}
+
+fun lookupStruct (env : env) n =
+    case IM.find (#structs env, n) of
+        NONE => raise UnboundStruct n
+      | SOME x => x
+
+fun classifyDatatype xncs =
+    if List.all (fn (_, _, NONE) => true | _ => false) xncs then
+        Enum
+    else
+        Default
+
+fun declBinds env (d, loc) =
+    case d of
+        DDatatype dts =>
+        foldl (fn ((_, x, n, xncs), env) =>
+                  let
+                      val env = pushDatatype env x n xncs
+                      val dt = (TDatatype (classifyDatatype xncs, n, ref xncs), loc)
+                  in
+                      foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt
+                              | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc))
+                            env xncs
+                  end) env dts
+      | DDatatypeForward (_, x, n) => pushDatatype env x n []
+      | DStruct (n, xts) => pushStruct env n xts
+      | DVal (x, n, t, _) => pushENamed env x n t
+      | DFun (fx, n, args, ran, _) =>
+        let
+            val t = foldl (fn ((_, arg), t) => (TFun (arg, t), loc)) ran args
+        in
+            pushENamed env fx n t
+        end
+      | DFunRec vis =>
+        foldl (fn ((fx, n, args, ran, _), env) =>
+                  let
+                      val t = foldl (fn ((_, arg), t) => (TFun (arg, t), loc)) ran args
+                  in
+                      pushENamed env fx n t
+                  end) env vis
+      | DTable _ => env
+      | DSequence _ => env
+      | DView _ => env
+      | DDatabase _ => env
+      | DPreparedStatements _ => env
+      | DJavaScript _ => env
+      | DCookie _ => env
+      | DStyle _ => env
+      | DTask _ => env
+      | DOnError _ => env
+
+end
diff --git a/src/cjr_print.sig b/src/cjr_print.sig
new file mode 100644
index 0000000..baef005
--- /dev/null
+++ b/src/cjr_print.sig
@@ -0,0 +1,39 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web C jr. language *)
+
+signature CJR_PRINT = sig
+    val p_typ : CjrEnv.env -> Cjr.typ Print.printer
+    val p_exp : CjrEnv.env -> Cjr.exp Print.printer
+    val p_decl : CjrEnv.env -> Cjr.decl Print.printer
+    val p_file : CjrEnv.env -> Cjr.file Print.printer
+
+    val p_sql : CjrEnv.env -> Cjr.file Print.printer
+
+    val debug : bool ref
+end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
new file mode 100644
index 0000000..53587ff
--- /dev/null
+++ b/src/cjr_print.sml
@@ -0,0 +1,3749 @@
+(* Copyright (c) 2008-2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing C jr. *)
+
+structure CjrPrint :> CJR_PRINT = struct
+
+open Print.PD
+open Print
+
+open Cjr
+
+val dummyt = (TRecord 0, ErrorMsg.dummySpan)
+
+structure E = CjrEnv
+structure EM = ErrorMsg
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+structure IS = IntBinarySet
+
+structure CM = BinaryMapFn(struct
+                           type ord_key = char
+                           val compare = Char.compare
+                           end)
+
+val debug = ref false
+
+val app_js = ref ""
+
+val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
+
+val ident = String.translate (fn #"'" => "PRIME"
+                               | ch => str ch)
+
+val p_ident = string o ident
+
+fun isUnboxable (t : typ) =
+    case #1 t of
+        TDatatype (Default, _, _) => true
+      | TFfi ("Basis", "string") => true
+      | TFfi ("Basis", "queryString") => true
+      | _ => false
+
+fun p_typ' par env (t, loc) =
+    case t of
+        TFun (t1, t2) => (EM.errorAt loc "Function type remains";
+                          string "<FUNCTION>")
+      | TRecord 0 => string "uw_unit"
+      | TRecord i => box [string "struct",
+                          space,
+                          string "__uws_",
+                          string (Int.toString i)]
+      | TDatatype (Enum, n, _) =>
+        (box [string "enum",
+              space,
+              string ("__uwe_" ^ ident (#1 (E.lookupDatatype env n)) ^ "_" ^ Int.toString n)]
+         handle CjrEnv.UnboundNamed _ => string ("__uwd_UNBOUND__" ^ Int.toString n))
+      | TDatatype (Option, n, xncs) =>
+        (case ListUtil.search #3 (!xncs) of
+             NONE => raise Fail "CjrPrint: TDatatype marked Option has no constructor with an argument"
+           | SOME t =>
+             if isUnboxable t then
+                 p_typ' par env t
+             else
+                 box [p_typ' par env t,
+                      string "*"])
+      | TDatatype (Default, n, _) =>
+        (box [string "struct",
+              space,
+              string ("__uwd_" ^ ident (#1 (E.lookupDatatype env n)) ^ "_" ^ Int.toString n ^ "*")]
+         handle CjrEnv.UnboundNamed _ => string ("__uwd_UNBOUND__" ^ Int.toString n))
+      | TFfi (m, x) => box [string "uw_", p_ident m, string "_", p_ident x]
+      | TOption t =>
+        if isUnboxable t then
+            p_typ' par env t
+        else
+            box [p_typ' par env t,
+                 string "*"]
+      | TList (_, i) => box [string "struct",
+                             space,
+                             string "__uws_",
+                             string (Int.toString i),
+                             string "*"]
+
+and p_typ env = p_typ' false env
+
+fun p_htyp' par env (t, loc) =
+    case t of
+        TFun (t1, t2) => parenIf par (box [p_htyp' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_htyp' true env t2])
+      | TRecord i =>
+        let
+            val xts = E.lookupStruct env i
+        in
+            box [string "{",
+                 p_list (fn (x, t) =>
+                            box [string x,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_htyp env t]) xts,
+                 string "}"]
+        end
+      | TDatatype (_, n, _) =>
+        let
+            val (name, _) = E.lookupDatatype env n
+        in
+            string name
+        end
+      | TFfi (m, x) => string (m ^ "." ^ x)
+      | TOption t => parenIf par (box [string "option",
+                                       space,
+                                       p_htyp' true env t])
+      | TList (t, _) => parenIf par (box [string "list",
+                                          space,
+                                          p_htyp' true env t])
+
+and p_htyp env = p_htyp' false env
+
+fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1))
+    handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1))
+
+fun p_enamed' env n =
+    "__uwn_" ^ ident (#1 (E.lookupENamed env n)) ^ "_" ^ Int.toString n
+    handle CjrEnv.UnboundNamed _ => "__uwn_UNBOUND_" ^ Int.toString n
+
+fun p_enamed env n = string (p_enamed' env n)
+
+fun p_con_named env n =
+    string ("__uwc_" ^ ident (#1 (E.lookupConstructor env n)) ^ "_" ^ Int.toString n)
+    handle CjrEnv.UnboundNamed _ => string ("__uwc_UNBOUND_" ^ Int.toString n)
+
+fun p_pat_preamble env (p, _) =
+    case p of
+        PVar (x, t) => (box [p_typ env t,
+                             space,
+                             string "__uwr_",
+                             p_ident x,
+                             string "_",
+                             string (Int.toString (E.countERels env)),
+                             string ";",
+                             newline],
+                        E.pushERel env x t)
+      | PPrim _ => (box [], env)
+      | PCon (_, _, NONE) => (box [], env)
+      | PCon (_, _, SOME p) => p_pat_preamble env p
+      | PRecord xps =>
+        foldl (fn ((_, p, _), (pp, env)) =>
+                  let
+                      val (pp', env) = p_pat_preamble env p
+                  in
+                      (box [pp', pp], env)
+                  end) (box [], env) xps
+      | PNone _ => (box [], env)
+      | PSome (_, p) => p_pat_preamble env p
+
+fun p_patCon env pc =
+    case pc of
+        PConVar n => p_con_named env n
+      | PConFfi {mod = m, con, ...} => string ("uw_" ^ ident m ^ "_" ^ ident con)
+
+fun p_patMatch (env, disc) (p, loc) =
+    case p of
+        PVar _ => string "1"
+      | PPrim (Prim.Int n) => box [string ("(" ^ disc),
+                                   space,
+                                   string "==",
+                                   space,
+                                   Prim.p_t_GCC (Prim.Int n),
+                                   string ")"]
+      | PPrim (Prim.String s) => box [string ("!strcmp(" ^ disc),
+                                           string ",",
+                                           space,
+                                           Prim.p_t_GCC (Prim.String s),
+                                           string ")"]
+      | PPrim (Prim.Char ch) => box [string ("(" ^ disc),
+                                     space,
+                                     string "==",
+                                     space,
+                                     Prim.p_t_GCC (Prim.Char ch),
+                                     string ")"]
+      | PPrim _ => raise Fail "CjrPrint: Disallowed PPrim primitive"
+
+      | PCon (dk, pc, po) =>
+        let
+            val p =
+                case po of
+                    NONE => box []
+                  | SOME p =>
+                    let
+                        val (x, to) = case pc of
+                                          PConVar n =>
+                                          let
+                                              val (x, to, _) = E.lookupConstructor env n
+                                          in
+                                              ("uw_" ^ ident x, to)
+                                          end
+                                        | PConFfi {mod = m, con, arg, ...} =>
+                                          ("uw_" ^ ident m ^ "_" ^ ident con, arg)
+
+                        val t = case to of
+                                    NONE => raise Fail "CjrPrint: Constructor mismatch"
+                                  | SOME t => t
+
+                        val x = case pc of
+                                    PConVar n =>
+                                    let
+                                        val (x, _, _) = E.lookupConstructor env n
+                                    in
+                                        "uw_" ^ ident x
+                                    end
+                                  | PConFfi {mod = m, con, ...} =>
+                                    "uw_" ^ ident m ^ "_" ^ ident con
+
+                        val disc' = case dk of
+                                        Enum => raise Fail "CjrPrint: Looking at argument of no-argument constructor"
+                                      | Default => disc ^ "->data." ^ x
+                                      | Option =>
+                                        if isUnboxable t then
+                                            disc
+                                        else
+                                            "(*" ^ disc ^ ")"
+
+                        val p = p_patMatch (env, disc') p
+                    in
+                        box [space,
+                             string "&&",
+                             space,
+                             p]
+                    end
+        in
+            box [string disc,
+                 case (dk, po) of
+                     (Enum, _) => box [space,
+                                       string "==",
+                                       space,
+                                       p_patCon env pc]
+                   | (Default, _) => box [string "->tag",
+                                          space,
+                                          string "==",
+                                          space,
+                                          p_patCon env pc]
+                   | (Option, NONE) => box [space,
+                                            string "==",
+                                            space,
+                                            string "NULL"]
+                   | (Option, SOME _) => box [space,
+                                              string "!=",
+                                              space,
+                                              string "NULL"],
+                 p]
+        end
+
+      | PRecord [] => string "1"
+      | PRecord xps =>
+        p_list_sep (box [space, string "&&", space]) (fn (x, p, _) => p_patMatch (env, disc ^ ".__uwf_" ^ ident x) p) xps
+
+      | PNone _ =>
+        box [string disc,
+             space,
+             string "==",
+             space,
+             string "NULL"]
+
+      | PSome (t, p) =>
+        let
+            val disc' = if isUnboxable t then
+                            disc
+                        else
+                            "(*" ^ disc ^ ")"
+
+            val p = p_patMatch (env, disc') p
+        in
+            box [string disc,
+                 space,
+                 string "!=",
+                 space,
+                 string "NULL",
+                 space,
+                 string "&&",
+                 space,
+                 p]
+        end
+
+fun p_patBind (env, disc) (p, loc) =
+    case p of
+        PVar (x, t) =>
+        (box [p_typ env t,
+              space,
+              string "__uwr_",
+              p_ident x,
+              string "_",
+              string (Int.toString (E.countERels env)),
+              space,
+              string "=",
+              space,
+              string disc,
+              string ";",
+              newline],
+         E.pushERel env x t)
+      | PPrim _ => (box [], env)
+
+      | PCon (_, _, NONE) => (box [], env)
+
+      | PCon (dk, pc, SOME p) =>
+        let
+            val (x, to) = case pc of
+                              PConVar n =>
+                              let
+                                  val (x, to, _) = E.lookupConstructor env n
+                              in
+                                  ("uw_" ^ ident x, to)
+                              end
+                            | PConFfi {mod = m, con, arg, ...} =>
+                              ("uw_" ^ ident m ^ "_" ^ ident con, arg)
+
+            val t = case to of
+                        NONE => raise Fail "CjrPrint: Constructor mismatch"
+                      | SOME t => t
+
+            val disc' = case dk of
+                            Enum => raise Fail "CjrPrint: Looking at argument of no-argument constructor"
+                          | Default => disc ^  "->data." ^ x
+                          | Option =>
+                            if isUnboxable t then
+                                disc
+                            else
+                                "(*" ^ disc ^ ")"
+        in
+            p_patBind (env, disc') p
+        end
+
+      | PRecord xps =>
+        let
+            val (xps, env) =
+                ListUtil.foldlMap (fn ((x, p, t), env) => p_patBind (env, disc ^ ".__uwf_" ^ ident x) p)
+                                  env xps
+        in
+            (p_list_sep (box []) (fn x => x) xps,
+             env)
+        end
+
+      | PNone _ => (box [], env)
+
+      | PSome (t, p) =>
+        let
+            val disc' = if isUnboxable t then
+                            disc
+                        else
+                            "(*" ^ disc ^ ")"
+        in
+            p_patBind (env, disc') p
+        end
+
+fun patConInfo env pc =
+    case pc of
+        PConVar n =>
+        let
+            val (x, _, dn) = E.lookupConstructor env n
+            val (dx, _) = E.lookupDatatype env dn
+        in
+            ("__uwd_" ^ ident dx ^ "_" ^ Int.toString dn,
+             "__uwc_" ^ ident x ^ "_" ^ Int.toString n,
+             "uw_" ^ ident x)
+        end
+      | PConFfi {mod = m, datatyp, con, ...} =>
+        ("uw_" ^ ident m ^ "_" ^ ident datatyp,
+         "uw_" ^ ident m ^ "_" ^ ident con,
+         "uw_" ^ ident con)
+
+fun p_unsql wontLeakStrings env (tAll as (t, loc)) e eLen =
+    case t of
+        TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "string") =>
+        if wontLeakStrings then
+            e
+        else
+            box [string "uw_strdup(ctx, ", e, string ")"]
+      | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, ",
+                                       e,
+                                       string ", ",
+                                       eLen,
+                                       string ")"]
+      | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
+
+      | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
+              Print.eprefaces' [("Type", p_htyp env tAll)];
+              string "ERROR")
+
+fun p_getcol wontLeakStrings env (tAll as (t, loc)) i =
+    case t of
+        TOption t =>
+        box [string "(PQgetisnull(res, i, ",
+             string (Int.toString i),
+             string ") ? NULL : ",
+             case t of
+                 (TFfi ("Basis", "string"), _) => p_getcol wontLeakStrings env t i
+               | _ => box [string "({",
+                           newline,
+                           p_typ env t,
+                           space,
+                           string "*tmp = uw_malloc(ctx, sizeof(",
+                           p_typ env t,
+                           string "));",
+                           newline,
+                           string "*tmp = ",
+                           p_getcol wontLeakStrings env t i,
+                           string ";",
+                           newline,
+                           string "tmp;",
+                           newline,
+                           string "})"],
+             string ")"]
+      | _ =>
+        box [string "(PQgetisnull(res, i, ",
+             string (Int.toString i),
+             string ") ? ",
+             box [string "({",
+                  p_typ env tAll,
+                  space,
+                  string "tmp;",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
+                  string (Int.toString i),
+                  string "\");",
+                  newline,
+                  string "tmp;",
+                  newline,
+                  string "})"],
+             string " : ",
+             p_unsql wontLeakStrings env tAll
+                     (box [string "PQgetvalue(res, i, ",
+                           string (Int.toString i),
+                           string ")"])
+                     (box [string "PQgetlength(res, i, ",
+                           string (Int.toString i),
+                           string ")"]),
+             string ")"]
+
+datatype sql_type = datatype Settings.sql_type
+val isBlob = Settings.isBlob
+
+fun isFile (t : typ) =
+    case #1 t of
+        TFfi ("Basis", "file") => true
+      | _ => false
+
+fun p_sql_type t = string (Settings.p_sql_ctype t)
+
+fun getPargs (e, _) =
+    case e of
+        EPrim (Prim.String _) => []
+      | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => getPargs e1 @ getPargs e2
+
+      | EFfiApp ("Basis", "sqlifyInt", [(e, _)]) => [(e, Int)]
+      | EFfiApp ("Basis", "sqlifyFloat", [(e, _)]) => [(e, Float)]
+      | EFfiApp ("Basis", "sqlifyString", [(e, _)]) => [(e, String)]
+      | EFfiApp ("Basis", "sqlifyBool", [(e, _)]) => [(e, Bool)]
+      | EFfiApp ("Basis", "sqlifyTime", [(e, _)]) => [(e, Time)]
+      | EFfiApp ("Basis", "sqlifyBlob", [(e, _)]) => [(e, Blob)]
+      | EFfiApp ("Basis", "sqlifyChannel", [(e, _)]) => [(e, Channel)]
+      | EFfiApp ("Basis", "sqlifyClient", [(e, _)]) => [(e, Client)]
+
+      | ECase (e,
+               [((PNone _, _),
+                 (EPrim (Prim.String (_, "NULL")), _)),
+                ((PSome (_, (PVar _, _)), _),
+                 (EFfiApp (m, x, [((ERel 0, _), _)]), _))],
+               {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e))
+
+      | ECase (e,
+               [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
+                 (EPrim (Prim.String (_, "TRUE")), _)),
+                ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
+                 (EPrim (Prim.String (_, "FALSE")), _))],
+               _) => [(e, Bool)]
+
+      | _ => raise Fail "CjrPrint: getPargs"
+
+val notLeakies = SS.fromList ["int", "float", "char", "time", "bool", "unit", "client", "channel",
+                              "xhtml", "page", "xbody", "css_class"]
+val notLeakies' = SS.fromList ["blob"]
+
+fun notLeaky env allowHeapAllocated =
+    let
+        fun nl ok (t, _) =
+            case t of
+                TFun _ => false
+              | TRecord n =>
+                let
+                    val xts = E.lookupStruct env n
+                in
+                    List.all (fn (_, t) => nl ok t) xts
+                end
+              | TDatatype (dk, n, ref cons) =>
+                IS.member (ok, n)
+                orelse
+                ((allowHeapAllocated orelse dk = Enum)
+                 andalso
+                 let
+                     val ok' = IS.add (ok, n)
+                 in
+                     List.all (fn (_, _, to) => case to of
+                                                    NONE => true
+                                                  | SOME t => nl ok' t) cons
+                 end)
+              | TFfi ("Basis", t) => SS.member (notLeakies, t)
+                                     orelse (allowHeapAllocated andalso SS.member (notLeakies', t))
+              | TFfi _ => false
+              | TOption t => allowHeapAllocated andalso nl ok t
+              | TList (t, _) => allowHeapAllocated andalso nl ok t
+    in
+        nl IS.empty
+    end
+
+fun capitalize s =
+    if s = "" then
+        ""
+    else
+        str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+local
+    val urlHandlers = ref ([] : (pp_desc * pp_desc) list)
+in
+
+fun addUrlHandler v = urlHandlers := v :: !urlHandlers
+
+fun latestUrlHandlers () =
+    !urlHandlers
+    before urlHandlers := []
+
+fun clearUrlHandlers () = urlHandlers := []
+
+end
+
+val unurlifies = ref IS.empty
+
+fun unurlify fromClient env (t, loc) =
+    let
+        fun deStar request =
+            case request of
+                "(*request)" => "request"
+              | _ => "&" ^ request
+
+        fun unurlify' request t =
+            case t of
+                TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
+              | TFfi ("Basis", "string") => string (if fromClient then
+                                                        "uw_Basis_unurlifyString_fromClient(ctx, " ^ deStar request ^ ")"
+                                                    else
+                                                        "uw_Basis_unurlifyString(ctx, " ^ deStar request ^ ")")
+              | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, " ^ deStar request ^ ")")
+
+              | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
+              | TRecord i =>
+                let
+                    val xts = E.lookupStruct env i
+                in
+                    box [string "({",
+                         newline,
+                         box (map (fn (x, t) =>
+                                      box [p_typ env t,
+                                           space,
+                                           string "uwr_",
+                                           string x,
+                                           space,
+                                           string "=",
+                                           space,
+                                           unurlify' request (#1 t),
+                                           string ";",
+                                           newline]) xts),
+                         string "struct",
+                         space,
+                         string "__uws_",
+                         string (Int.toString i),
+                         space,
+                         string "tmp",
+                         space,
+                         string "=",
+                         space,
+                         string "{",
+                         space,
+                         p_list_sep (box [string ",", space]) (fn (x, _) => box [string "uwr_",
+                                                                                 string x]) xts,
+                         space,
+                         string "};",
+                         newline,
+                         string "tmp;",
+                         newline,
+                         string "})"]
+                end
+
+              | TDatatype (Enum, i, _) =>
+                let
+                    val (x, xncs) = E.lookupDatatype env i
+
+                    fun doEm xncs =
+                        case xncs of
+                            [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
+                                          ^ x ^ "\"), (enum __uwe_"
+                                          ^ x ^ "_" ^ Int.toString i ^ ")0)")
+                          | (x', n, to) :: rest =>
+                            box [string ("((!strncmp(" ^ request ^ ", \""),
+                                 string x',
+                                 string "\", ",
+                                 string (Int.toString (size x')),
+                                 string (") && (" ^ request ^ "["),
+                                 string (Int.toString (size x')),
+                                 string ("] == 0 || " ^ request ^ "["),
+                                 string (Int.toString (size x')),
+                                 string ("] == '/')) ? (" ^ request ^ " += "),
+                                 string (Int.toString (size x')),
+                                 string (", (" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : NULL), __uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ")"),
+                                 space,
+                                 string ":",
+                                 space,
+                                 doEm rest,
+                                 string ")"]
+                in
+                    doEm xncs
+                end
+
+              | TDatatype (Option, i, xncs) =>
+                if IS.member (!unurlifies, i) then
+                    box [string "unurlify_",
+                         string (Int.toString i),
+                         string ("(ctx, " ^ deStar request ^ ")")]
+                else
+                    let
+                        val (x, _) = E.lookupDatatype env i
+
+                        val (no_arg, has_arg, t) =
+                            case !xncs of
+                                [(no_arg, _, NONE), (has_arg, _, SOME t)] =>
+                                (no_arg, has_arg, t)
+                              | [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
+                                (no_arg, has_arg, t)
+                              | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype"
+
+                        val unboxable = isUnboxable t
+                    in
+                        unurlifies := IS.add (!unurlifies, i);
+                        addUrlHandler (box [string "static",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            if unboxable then
+                                                box []
+                                            else
+                                                string "*",
+                                            string "unurlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context, char **);",
+                                            newline],
+                                       box [string "static",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            if unboxable then
+                                                box []
+                                            else
+                                                string "*",
+                                            string "unurlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context ctx, char **request) {",
+                                            newline,
+                                            box [string "return ((*request)[0] == '/' ? ++*request : *request,",
+                                                 newline,
+                                                 string "((!strncmp(*request, \"",
+                                                 string no_arg,
+                                                 string "\", ",
+                                                 string (Int.toString (size no_arg)),
+                                                 string ") && ((*request)[",
+                                                 string (Int.toString (size no_arg)),
+                                                 string "] == 0 || (*request)[",
+                                                 string (Int.toString (size no_arg)),
+                                                 string "] == '/')) ? (*request",
+                                                 space,
+                                                 string "+=",
+                                                 space,
+                                                 string (Int.toString (size no_arg)),
+                                                 string ", NULL) : ((!strncmp(*request, \"",
+                                                 string has_arg,
+                                                 string "\", ",
+                                                 string (Int.toString (size has_arg)),
+                                                 string ") && ((*request)[",
+                                                 string (Int.toString (size has_arg)),
+                                                 string "] == 0 || (*request)[",
+                                                 string (Int.toString (size has_arg)),
+                                                 string "] == '/')) ? (*request",
+                                                 space,
+                                                 string "+=",
+                                                 space,
+                                                 string (Int.toString (size has_arg)),
+                                                 string ", ((*request)[0] == '/' ? ++*request : NULL), ",
+                                                 newline,
+
+                                                 if unboxable then
+                                                     unurlify' "(*request)" (#1 t)
+                                                 else
+                                                     box [string "({",
+                                                          newline,
+                                                          p_typ env t,
+                                                          space,
+                                                          string "*tmp",
+                                                          space,
+                                                          string "=",
+                                                          space,
+                                                          string "uw_malloc(ctx, sizeof(",
+                                                          p_typ env t,
+                                                          string "));",
+                                                          newline,
+                                                          string "*tmp",
+                                                          space,
+                                                          string "=",
+                                                          space,
+                                                          unurlify' "(*request)" (#1 t),
+                                                          string ";",
+                                                          newline,
+                                                          string "tmp;",
+                                                          newline,
+                                                          string "})"],
+                                                 string ")",
+                                                 newline,
+                                                 string ":",
+                                                 space,
+                                                 string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
+                                                         ^ "\"), NULL))));"),
+                                                 newline],
+                                            string "}",
+                                            newline,
+                                            newline]);
+
+                             box [string "unurlify_",
+                                  string (Int.toString i),
+                                  string ("(ctx, &" ^ request ^ ")")]
+                    end
+
+              | TDatatype (Default, i, _) =>
+                if IS.member (!unurlifies, i) then
+                    box [string "unurlify_",
+                         string (Int.toString i),
+                         string ("(ctx, " ^ deStar request ^ ")")]
+                else
+                    let
+                        val (x, xncs) = E.lookupDatatype env i
+
+                        val () = unurlifies := IS.add (!unurlifies, i)
+
+                        fun doEm xncs =
+                            case xncs of
+                                [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
+                                              ^ x ^ "\"), NULL)")
+                              | (x', n, to) :: rest =>
+                                box [string "((!strncmp(*request, \"",
+                                     string x',
+                                     string "\", ",
+                                     string (Int.toString (size x')),
+                                     string ") && ((*request)[",
+                                     string (Int.toString (size x')),
+                                     string "] == 0 || (*request)[",
+                                     string (Int.toString (size x')),
+                                     string "] == '/')) ? ({",
+                                     newline,
+                                     string "struct",
+                                     space,
+                                     string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
+                                     space,
+                                     string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
+                                     string x,
+                                     string "_",
+                                     string (Int.toString i),
+                                     string "));",
+                                     newline,
+                                     string "tmp->tag",
+                                     space,
+                                     string "=",
+                                     space,
+                                     string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
+                                     string ";",
+                                     newline,
+                                     string "*request",
+                                     space,
+                                     string "+=",
+                                     space,
+                                     string (Int.toString (size x')),
+                                     string ";",
+                                     newline,
+                                     string "if ((*request)[0] == '/') ++*request;",
+                                     newline,
+                                     case to of
+                                         NONE => box []
+                                       | SOME (t, _) => box [string "tmp->data.uw_",
+                                                             p_ident x',
+                                                             space,
+                                                             string "=",
+                                                             space,
+                                                             unurlify' "(*request)" t,
+                                                             string ";",
+                                                             newline],
+                                     string "tmp;",
+                                     newline,
+                                     string "})",
+                                     space,
+                                     string ":",
+                                     space,
+                                     doEm rest,
+                                     string ")"]
+                    in
+                        addUrlHandler (box [string "static",
+                                            space,
+                                            p_typ env (t, ErrorMsg.dummySpan),
+                                            space,
+                                            string "unurlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context, char **);",
+                                            newline],
+                                       box [string "static",
+                                            space,
+                                            p_typ env (t, ErrorMsg.dummySpan),
+                                            space,
+                                            string "unurlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context ctx, char **request) {",
+                                            newline,
+                                            box [string "return",
+                                                 space,
+                                                 doEm xncs,
+                                                 string ";",
+                                                 newline],
+                                            string "}",
+                                            newline,
+                                            newline]);
+
+                        box [string "unurlify_",
+                             string (Int.toString i),
+                             string ("(ctx, " ^ deStar request ^ ")")]
+                    end
+
+              | TList (t', i) =>
+                if IS.member (!unurlifies, i) then
+                    box [string "unurlify_list_",
+                         string (Int.toString i),
+                         string ("(ctx, " ^ deStar request ^ ")")]
+                else
+                    (unurlifies := IS.add (!unurlifies, i);
+                     addUrlHandler (box [string "static",
+                                         space,
+                                         p_typ env (t, loc),
+                                         space,
+                                         string "unurlify_list_",
+                                         string (Int.toString i),
+                                         string "(uw_context, char **);",
+                                         newline],
+                                    box [string "static",
+                                         space,
+                                         p_typ env (t, loc),
+                                         space,
+                                         string "unurlify_list_",
+                                         string (Int.toString i),
+                                         string "(uw_context ctx, char **request) {",
+                                         newline,
+                                         box [string "return ((*request)[0] == '/' ? ++*request : *request,",
+                                              newline,
+                                              string "((!strncmp(*request, \"Nil\", 3) && ((*request)[3] == 0 ",
+                                              string "|| (*request)[3] == '/')) ? (*request",
+                                              space,
+                                              string "+=",
+                                              space,
+                                              string "3, ((*request)[0] == '/' ? ((*request)[0] = 0, ++*request) : NULL), NULL) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ",
+                                              string "|| (*request)[4] == '/')) ? (*request",
+                                              space,
+                                              string "+=",
+                                              space,
+                                              string "4, ((*request)[0] == '/' ? ++*request : NULL), ",
+                                              newline,
+
+                                              string "({",
+                                              newline,
+                                              p_typ env (t, loc),
+                                              space,
+                                              string "tmp",
+                                              space,
+                                              string "=",
+                                              space,
+                                              string "uw_malloc(ctx, sizeof(struct __uws_",
+                                              string (Int.toString i),
+                                              string "));",
+                                              newline,
+                                              string "*tmp",
+                                              space,
+                                              string "=",
+                                              space,
+                                              unurlify' "(*request)" (TRecord i),
+                                              string ";",
+                                              newline,
+                                              string "tmp;",
+                                              newline,
+                                              string "})",
+                                              string ")",
+                                              newline,
+                                              string ":",
+                                              space,
+                                              string ("(uw_error(ctx, FATAL, \"Error unurlifying list: %s\", request), NULL))));"),
+                                              newline],
+                                         string "}",
+                                         newline,
+                                         newline]);
+
+                     box [string "unurlify_list_",
+                          string (Int.toString i),
+                          string ("(ctx, " ^ deStar request ^ ")")])
+
+              | TOption t =>
+                box [string ("(" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : " ^ request ^ ", "),
+                     string ("((!strncmp(" ^ request ^ ", \"None\", 4) "),
+                     string ("&& (" ^ request ^ "[4] == 0 || " ^ request ^ "[4] == '/')) "),
+                     string ("? (" ^ request ^ " += (" ^ request ^ "[4] == 0 ? 4 : 5), NULL) "),
+                     string (": ((!strncmp(" ^ request ^ ", \"Some\", 4) "),
+                     string ("&& " ^ request ^ "[4] == '/') "),
+                     string ("? (" ^ request ^ " += 5, "),
+                     if isUnboxable  t then
+                         unurlify' request (#1 t)
+                     else
+                         box [string "({",
+                              newline,
+                              p_typ env t,
+                              space,
+                              string "*tmp",
+                              space,
+                              string "=",
+                              space,
+                              string "uw_malloc(ctx, sizeof(",
+                              p_typ env t,
+                              string "));",
+                              newline,
+                              string "*tmp",
+                              space,
+                              string "=",
+                              space,
+                              unurlify' request (#1 t),
+                              string ";",
+                              newline,
+                              string "tmp;",
+                              newline,
+                              string "})"],
+                     string ") :",
+                     space,
+                     string "(uw_error(ctx, FATAL, \"Error unurlifying option type\"), NULL))))"]
+
+              | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
+                      space)
+    in
+        unurlify' "request" t
+    end
+
+val urlify1 = ref 0
+
+val urlifies = ref IS.empty
+val urlifiesL = ref IS.empty
+
+fun urlify env t =
+    let
+        fun urlify' level (t as (_, loc)) =
+            case #1 t of
+                TFfi ("Basis", "unit") => box []
+              | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
+                                            ^ "_w(ctx, it" ^ Int.toString level ^ ");"),
+                                    newline]
+
+              | TRecord 0 => box []
+              | TRecord i =>
+                let
+                    fun empty (t, _) =
+                        case t of
+                            TFfi ("Basis", "unit") => true
+                          | TRecord 0 => true
+                          | TRecord j =>
+                            List.all (fn (_, t) => empty t) (E.lookupStruct env j)
+                          | _ => false
+
+                    val xts = E.lookupStruct env i
+
+                    val (blocks, _) = foldl
+                                      (fn ((x, t), (blocks, printingSinceLastSlash)) =>
+                                          let
+                                              val thisEmpty = empty t
+                                          in
+                                              if thisEmpty then
+                                                  (blocks, printingSinceLastSlash)
+                                              else
+                                                  (box [string "{",
+                                                        newline,
+                                                        p_typ env t,
+                                                        space,
+                                                        string ("it" ^ Int.toString (level + 1)),
+                                                        space,
+                                                        string "=",
+                                                        space,
+                                                        string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
+                                                        newline,
+                                                        box (if printingSinceLastSlash then
+                                                                 [string "uw_write(ctx, \"/\");",
+                                                                  newline]
+                                                             else
+                                                                 []),
+                                                        urlify' (level + 1) t,
+                                                        string "}",
+                                                        newline] :: blocks,
+                                                   true)
+                                          end)
+                                      ([], false) xts
+                in
+                    box (rev blocks)
+                end
+
+              | TDatatype (Enum, i, _) =>
+                let
+                    val (x, xncs) = E.lookupDatatype env i
+
+                    fun doEm xncs =
+                        case xncs of
+                            [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
+                                               ^ x ^ "\");"),
+                                       newline]
+                          | (x', n, to) :: rest =>
+                            box [string ("if (it" ^ Int.toString level
+                                         ^ "==__uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ") {"),
+                                 newline,
+                                 box [string ("uw_write(ctx, \"" ^ x' ^ "\");"),
+                                      newline],
+                                 string "} else {",
+                                 newline,
+                                 box [doEm rest,
+                                      newline],
+                                 string "}"]
+                in
+                    doEm xncs
+                end
+
+              | TDatatype (Option, i, xncs) =>
+                if IS.member (!urlifies, i) then
+                    box [string "urlify_",
+                         string (Int.toString i),
+                         string "(ctx,",
+                         space,
+                         string "it",
+                         string (Int.toString level),
+                         string ");",
+                         newline]
+                else
+                    let
+                        val (x, _) = E.lookupDatatype env i
+
+                        val (no_arg, has_arg, t) =
+                            case !xncs of
+                                [(no_arg, _, NONE), (has_arg, _, SOME t)] =>
+                                (no_arg, has_arg, t)
+                              | [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
+                                (no_arg, has_arg, t)
+                              | _ => raise Fail "CjrPrint: urlify misclassified Option datatype"
+                    in
+                        urlifies := IS.add (!urlifies, i);
+                        addUrlHandler (box [string "static",
+                                            space,
+                                            string "void",
+                                            space,
+                                            string "urlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context,",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            if isUnboxable t then
+                                                box []
+                                            else
+                                                string "*",
+                                            string ");",
+                                            newline],
+                                       box [string "static",
+                                            space,
+                                            string "void",
+                                            space,
+                                            string "urlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context ctx,",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            if isUnboxable t then
+                                                box []
+                                            else
+                                                string "*",
+                                            string "it0) {",
+                                            newline,
+                                            box [string "if (it0) {",
+                                                 newline,
+                                                 if isUnboxable t then
+                                                     box [string "uw_write(ctx, \"",
+                                                          string has_arg,
+                                                          string "/\");",
+                                                          newline,
+                                                          urlify' 0 t,
+                                                          string ";",
+                                                          newline]
+                                                 else
+                                                     box [p_typ env t,
+                                                          space,
+                                                          string "it1",
+                                                          space,
+                                                          string "=",
+                                                          space,
+                                                          string "*it0;",
+                                                          newline,
+                                                          string "uw_write(ctx, \"",
+                                                          string has_arg,
+                                                          string "/\");",
+                                                          newline,
+                                                          urlify' 1 t,
+                                                          string ";",
+                                                          newline],
+                                                 string "} else {",
+                                                 box [newline,
+                                                      string "uw_write(ctx, \"",
+                                                      string no_arg,
+                                                      string "\");",
+                                                      newline],
+                                                 string "}",
+                                                 newline],
+                                            string "}",
+                                            newline,
+                                            newline]);
+
+                        box [string "urlify_",
+                             string (Int.toString i),
+                             string "(ctx,",
+                             space,
+                             string "it",
+                             string (Int.toString level),
+                             string ");",
+                             newline]
+                    end
+
+              | TDatatype (Default, i, _) =>
+                if IS.member (!urlifies, i) then
+                    box [string "urlify_",
+                         string (Int.toString i),
+                         string "(ctx,",
+                         space,
+                         string "it",
+                         string (Int.toString level),
+                         string ");",
+                         newline]
+                else
+                    let
+                        val (x, xncs) = E.lookupDatatype env i
+
+                        val () = urlifies := IS.add (!urlifies, i)
+
+                        fun doEm xncs =
+                            case xncs of
+                                [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
+                                                   ^ x ^ " (%d)\", it0->data);"),
+                                           newline]
+                              | (x', n, to) :: rest =>
+                                box [string "if",
+                                     space,
+                                     string "(it0->tag==__uwc_",
+                                     string (ident x'),
+                                     string "_",
+                                     string (Int.toString n),
+                                     string ") {",
+                                     newline,
+                                     case to of
+                                         NONE => box [string "uw_write(ctx, \"",
+                                                      string x',
+                                                      string "\");",
+                                                      newline]
+                                       | SOME t => box [string "uw_write(ctx, \"",
+                                                        string x',
+                                                        string "/\");",
+                                                        newline,
+                                                        p_typ env t,
+                                                        space,
+                                                        string "it1",
+                                                        space,
+                                                        string "=",
+                                                        space,
+                                                        string "it0->data.uw_",
+                                                        string x',
+                                                        string ";",
+                                                        newline,
+                                                        urlify' 1 t,
+                                                        newline],
+                                     string "} else {",
+                                     newline,
+                                     box [doEm rest,
+                                          newline],
+                                     string "}",
+                                     newline]
+                    in
+                        addUrlHandler (box [string "static",
+                                            space,
+                                            string "void",
+                                            space,
+                                            string "urlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context,",
+                                            space,
+                                            p_typ env t,
+                                            string ");",
+                                            newline],
+                                       box [string "static",
+                                            space,
+                                            string "void",
+                                            space,
+                                            string "urlify_",
+                                            string (Int.toString i),
+                                            string "(uw_context ctx,",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            string "it0) {",
+                                            newline,
+                                            box [doEm xncs,
+                                                 newline],
+                                            newline,
+                                            string "}",
+                                            newline,
+                                            newline]);
+
+                        box [string "urlify_",
+                             string (Int.toString i),
+                             string "(ctx,",
+                             space,
+                             string "it",
+                             string (Int.toString level),
+                             string ");",
+                             newline]
+                    end
+
+              | TOption t =>
+                box [string "if (it",
+                     string (Int.toString level),
+                     string ") {",
+                     if isUnboxable t then
+                         box [string "uw_write(ctx, \"Some/\");",
+                              newline,
+                              urlify' level t]
+                     else
+                         box [p_typ env t,
+                              space,
+                              string "it",
+                              string (Int.toString (level + 1)),
+                              space,
+                              string "=",
+                              space,
+                              string "*it",
+                              string (Int.toString level),
+                              string ";",
+                              newline,
+                              string "uw_write(ctx, \"Some/\");",
+                              newline,
+                              urlify' (level + 1) t,
+                              string ";",
+                              newline],
+                     string "} else {",
+                     box [newline,
+                          string "uw_write(ctx, \"None\");",
+                          newline],
+                     string "}",
+                     newline]
+
+              | TList (t, i) =>
+                if IS.member (!urlifiesL, i) then
+                    box [string "urlifyl_",
+                         string (Int.toString i),
+                         string "(ctx,",
+                         space,
+                         string "it",
+                         string (Int.toString level),
+                         string ");",
+                         newline]
+                else
+                    (urlifiesL := IS.add (!urlifiesL, i);
+                     addUrlHandler (box [string "static",
+                                         space,
+                                         string "void",
+                                         space,
+                                         string "urlifyl_",
+                                         string (Int.toString i),
+                                         string "(uw_context,",
+                                         space,
+                                         string "struct __uws_",
+                                         string (Int.toString i),
+                                         space,
+                                         string "*);",
+                                         newline],
+                                    box [string "static",
+                                         space,
+                                         string "void",
+                                         space,
+                                         string "urlifyl_",
+                                         string (Int.toString i),
+                                         string "(uw_context ctx,",
+                                         space,
+                                         string "struct __uws_",
+                                         string (Int.toString i),
+                                         space,
+                                         string "*it0) {",
+                                         newline,
+                                         box [string "if (it0) {",
+                                              newline,
+                                              p_typ env t,
+                                              space,
+                                              string "it1",
+                                              space,
+                                              string "=",
+                                              space,
+                                              string "it0->__uwf_1;",
+                                              newline,
+                                              string "uw_write(ctx, \"Cons/\");",
+                                              newline,
+                                              urlify' 1 t,
+                                              string ";",
+                                              newline,
+                                              string "uw_write(ctx, \"/\");",
+                                              newline,
+                                              string "urlifyl_",
+                                              string (Int.toString i),
+                                              string "(ctx, it0->__uwf_2);",
+                                              newline,
+                                              string "} else {",
+                                              newline,
+                                              box [string "uw_write(ctx, \"Nil\");",
+                                                   newline],
+                                              string "}",
+                                              newline],
+                                         string "}",
+                                         newline,
+                                         newline]);
+
+                     box [string "urlifyl_",
+                          string (Int.toString i),
+                          string "(ctx,",
+                          space,
+                          string "it",
+                          string (Int.toString level),
+                          string ");",
+                          newline])
+
+              | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function";
+                      space)
+    in
+        urlify' 0 t
+    end
+
+fun sql_type_in env (tAll as (t, loc)) =
+    case t of
+        TFfi ("Basis", "int") => Int
+      | TFfi ("Basis", "float") => Float
+      | TFfi ("Basis", "string") => String
+      | TFfi ("Basis", "char") => Char
+      | TFfi ("Basis", "bool") => Bool
+      | TFfi ("Basis", "time") => Time
+      | TFfi ("Basis", "blob") => Blob
+      | TFfi ("Basis", "channel") => Channel
+      | TFfi ("Basis", "client") => Client
+      | TOption t' => Nullable (sql_type_in env t')
+      | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
+              Print.eprefaces' [("Type", p_htyp env tAll)];
+              Int)
+
+fun potentiallyFancy (e, _) =
+    case e of
+        EPrim _ => false
+      | ERel _ => false
+      | ENamed _ => false
+      | ECon (_, _, NONE) => false
+      | ECon (_, _, SOME e) => potentiallyFancy e
+      | ENone _ => false
+      | ESome (_, e) => potentiallyFancy e
+      | EFfi _ => false
+      | EFfiApp _ => true
+      | EApp _ => true
+      | EUnop (_, e) => potentiallyFancy e
+      | EBinop (_, e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2
+      | ERecord (_, xes) => List.exists (potentiallyFancy o #2) xes
+      | EField (e, _) => potentiallyFancy e
+      | ECase (e, pes, _) => potentiallyFancy e orelse List.exists (potentiallyFancy o #2) pes
+      | EError _ => false
+      | EReturnBlob _ => false
+      | ERedirect _ => false
+      | EWrite e => potentiallyFancy e
+      | ESeq (e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2
+      | ELet (_, _, e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2
+      | EQuery _ => true
+      | EDml {dml = e, ...} => potentiallyFancy e
+      | ENextval {seq = e, ...} => potentiallyFancy e
+      | ESetval {seq = e1, count = e2} => potentiallyFancy e1 orelse potentiallyFancy e2
+      | EUnurlify _ => true
+
+val self = ref (NONE : int option)
+
+(* The crucial thing to do here is assign arguments to local variables, to enforce order of evaluation.
+ * Otherwise, we are at the mercy of C's undefined order of function argument evaluation. *)
+fun pFuncall env (m, x, es, extra) =
+    case es of
+        [] => box [string "uw_",
+                   p_ident m,
+                   string "_",
+                   p_ident x,
+                   string "(ctx",
+                   case extra of
+                       NONE => box []
+                     | SOME extra => box [string ",",
+                                          space,
+                                          string extra],
+                   string ")"]
+      | [(e, _)] => box [string "uw_",
+                         p_ident m,
+                         string "_",
+                         p_ident x,
+                         string "(ctx,",
+                         space,
+                         p_exp' false false env e,
+                         case extra of
+                             NONE => box []
+                           | SOME extra => box [string ",",
+                                                space,
+                                                string extra],
+                         string ")"]
+      | _ => box [string "({",
+                  newline,
+                  p_list_sepi (box []) (fn i => fn (e, t) =>
+                                                   box [p_typ env t,
+                                                        space,
+                                                        string "arg",
+                                                        string (Int.toString i),
+                                                        space,
+                                                        string "=",
+                                                        space,
+                                                        p_exp' false false env e,
+                                                        string ";",
+                                                        newline]) es,
+                  string "uw_",
+                  p_ident m,
+                  string "_",
+                  p_ident x,
+                  string "(ctx, ",
+                  p_list_sepi (box [string ",", space]) (fn i => fn _ => box [string "arg", string (Int.toString i)]) es,
+                  case extra of
+                      NONE => box []
+                    | SOME extra => box [string ",",
+                                         space,
+                                         string extra],
+                  string ");",
+                  newline,
+                  string "})"]
+
+and p_exp' par tail env (e, loc) =
+    case e of
+        EPrim p => Prim.p_t_GCC p
+      | ERel n => p_rel env n
+      | ENamed n => p_enamed env n
+      | ECon (Enum, pc, _) => p_patCon env pc
+      | ECon (Option, pc, NONE) => string "NULL"
+      | ECon (Option, pc, SOME e) =>
+        let
+            val to = case pc of
+                         PConVar n => #2 (E.lookupConstructor env n)
+                       | PConFfi {arg, ...} => arg
+
+            val t = case to of
+                        NONE => raise Fail "CjrPrint: ECon argument status mismatch"
+                      | SOME t => t
+        in
+            if isUnboxable t then
+                p_exp' par tail env e
+            else
+                box [string "({",
+                     newline,
+                     p_typ env t,
+                     space,
+                     string "*tmp",
+                     space,
+                     string "=",
+                     space,
+                     string "uw_malloc(ctx, sizeof(",
+                     p_typ env t,
+                     string "));",
+                     newline,
+                     string "*tmp",
+                     space,
+                     string "=",
+                     space,
+                     p_exp' par false env e,
+                     string ";",
+                     newline,
+                     string "tmp;",
+                     newline,
+                     string "})"]
+        end
+      | ECon (Default, pc, eo) =>
+        let
+            val (xd, xc, xn) = patConInfo env pc
+        in
+            box [string "({",
+                 newline,
+                 string "struct",
+                 space,
+                 string xd,
+                 space,
+                 string "*tmp",
+                 space,
+                 string "=",
+                 space,
+                 string "uw_malloc(ctx, sizeof(struct ",
+                 string xd,
+                 string "));",
+                 newline,
+                 string "tmp->tag",
+                 space,
+                 string "=",
+                 space,
+                 string xc,
+                 string ";",
+                 newline,
+                 case eo of
+                     NONE => box []
+                   | SOME e => box [string "tmp->data.",
+                                    string xn,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp' false false env e,
+                                    string ";",
+                                    newline],
+                 string "tmp;",
+                 newline,
+                 string "})"]
+        end
+      | ENone _ => string "NULL"
+      | ESome (t, e) =>
+        if isUnboxable t then
+            p_exp' par tail env e
+        else
+            box [string "({",
+                 newline,
+                 p_typ env t,
+                 space,
+                 string "*tmp",
+                 space,
+                 string "=",
+                 space,
+                 string "uw_malloc(ctx, sizeof(",
+                 p_typ env t,
+                 string "));",
+                 newline,
+                 string "*tmp",
+                 space,
+                 string "=",
+                 space,
+                 p_exp' par false env e,
+                 string ";",
+                 newline,
+                 string "tmp;",
+                 newline,
+                 string "})"]
+
+      | EFfi (m, x) => box [string "uw_", p_ident m, string "_", p_ident x]
+      | EError (e, t) =>
+        box [string "({",
+             newline,
+             p_typ env t,
+             space,
+             string "tmp;",
+             newline,
+             string "uw_error(ctx, FATAL, \"",
+             string (if Settings.getDebug () then
+                         ErrorMsg.spanToString loc ^ ": "
+                     else
+                         ""),
+             string "%s\", ",
+             p_exp' false false env e,
+             string ");",
+             newline,
+             string "tmp;",
+             newline,
+             string "})"]
+      | EReturnBlob {blob = SOME blob, mimeType, t} =>
+        box [string "({",
+             newline,
+             string "uw_Basis_blob",
+             space,
+             string "blob",
+             space,
+             string "=",
+             space,
+             p_exp' false false env blob,
+             string ";",
+             newline,
+             string "uw_Basis_string",
+             space,
+             string "mimeType",
+             space,
+             string "=",
+             space,
+             p_exp' false false env mimeType,
+             string ";",
+             newline,
+             p_typ env t,
+             space,
+             string "tmp;",
+             newline,
+             string "uw_return_blob(ctx, blob, mimeType);",
+             newline,
+             string "tmp;",
+             newline,
+             string "})"]
+      | EReturnBlob {blob = NONE, mimeType, t} =>
+        box [string "({",
+             newline,
+             string "uw_Basis_string",
+             space,
+             string "mimeType",
+             space,
+             string "=",
+             space,
+             p_exp' false false env mimeType,
+             string ";",
+             newline,
+             p_typ env t,
+             space,
+             string "tmp;",
+             newline,
+             string "uw_return_blob_from_page(ctx, mimeType);",
+             newline,
+             string "tmp;",
+             newline,
+             string "})"]
+      | ERedirect (e, t) =>
+        box [string "({",
+             newline,
+             p_typ env t,
+             space,
+             string "tmp;",
+             newline,
+             string "uw_redirect(ctx, ",
+             p_exp' false false env e,
+             string ");",
+             newline,
+             string "tmp;",
+             newline,
+             string "})"]
+      | EApp ((EError (e, (TFun (_, ran), _)), loc), _) =>
+        p_exp' false false env (EError (e, ran), loc)
+      | EApp ((EReturnBlob {blob, mimeType, t = (TFun (_, ran), _)}, loc), _) =>
+        p_exp' false false env (EReturnBlob {blob = blob, mimeType = mimeType, t = ran}, loc)
+
+      | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) =>
+        let
+            fun flatten e =
+                case #1 e of
+                    EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => flatten e1 @ flatten e2
+                  | _ => [e]
+
+            val es = flatten e1 @ flatten e2
+            val t = (TFfi ("Basis", "string"), loc)
+            val es = map (fn e => (e, t)) es
+        in
+            case es of
+                [_, _] => pFuncall env ("Basis", "strcat", es, NONE)
+              | _ => pFuncall env ("Basis", "mstrcat", es, SOME "NULL")
+        end
+
+      | EFfiApp (m, x, es) => pFuncall env (m, x, es, NONE)
+      | EApp (f, args) =>
+        let
+            fun getSig n =
+                let
+                    val (_, t) = E.lookupENamed env n
+
+                    fun getSig (t, args) =
+                        case #1 t of
+                            TFun (dom, t) => getSig (t, dom :: args)
+                          | _ => (args, t)
+                in
+                    getSig (t, [])
+                end
+
+            fun default () =
+                case (#1 f, args) of
+                    (ENamed n, _ :: _ :: _) =>
+                    let
+                        val (args', ret) = getSig n
+                        val args = ListPair.zip (args, args')
+                    in
+                        parenIf par (box [string "({",
+                                          newline,
+                                          p_list_sepi newline
+                                                      (fn i => fn (e, t) =>
+                                                                  box [p_typ env t,
+                                                                       space,
+                                                                       string ("arg" ^ Int.toString i),
+                                                                       space,
+                                                                       string "=",
+                                                                       space,
+                                                                       p_exp' false false env e,
+                                                                       string ";"])
+                                                      args,
+                                          newline,
+                                          p_exp' false false env f,
+                                          string "(ctx,",
+                                          space,
+                                          p_list_sepi (box [string ",", space])
+                                                      (fn i => fn _ =>
+                                                                  string ("arg" ^ Int.toString i)) args,
+                                          string ");",
+                                          newline,
+                                          string "})"])
+                    end
+                  | _ =>
+                    parenIf par (box [p_exp' true false env f,
+                                      string "(ctx,",
+                                      space,
+                                      p_list_sep (box [string ",", space]) (p_exp' false false env) args,
+                                      string ")"])
+
+            fun isSelf n =
+                let
+                    val (argts, ret) = getSig n
+                in
+                    parenIf par (box [string "({",
+                                      newline,
+                                      p_list_sepi newline
+                                      (fn i => fn (e, t) =>
+                                          box [p_typ env t,
+                                               space,
+                                               string ("rearg" ^ Int.toString i),
+                                               space,
+                                               string "=",
+                                               space,
+                                               p_exp' false false env e,
+                                               string ";"])
+                                      (ListPair.zip (args, argts)),
+                                      newline,
+                                      p_typ env ret,
+                                      space,
+                                      string "tmp;",
+                                      newline,
+                                      p_list_sepi newline
+                                      (fn i => fn _ =>
+                                          box [p_rel env (E.countERels env - 1 - i),
+                                               space,
+                                               string "=",
+                                               space,
+                                               string ("rearg" ^ Int.toString i ^ ";")]) args,
+                                      newline,
+                                      string "goto restart;",
+                                      newline,
+                                      string "tmp;",
+                                      newline,
+                                      string "})"])
+                end
+        in
+            case #1 f of
+                ENamed n => if SOME n = !self andalso tail then
+                                isSelf n
+                            else
+                                default ()
+              | _ => default ()
+        end
+
+      | EUnop (s, e1) =>
+        parenIf par (box [string s,
+                          space,
+                          p_exp' true false env e1])
+
+      | EBinop (s, e1, e2) =>
+        if s <> "fdiv" andalso Char.isAlpha (String.sub (s, size s - 1)) then
+            box [string s,
+                 string "(",
+                 p_exp' false false env e1,
+                 string ",",
+                 space,
+                 p_exp' false false env e2,
+                 string ")"]
+        else if s = "/" orelse s = "%" then
+            box [string "({",
+                 newline,
+                 string "uw_Basis_int",
+                 space,
+                 string "dividend",
+                 space,
+                 string "=",
+                 space,
+                 p_exp env e1,
+                 string ",",
+                 space,
+                 string "divisor",
+                 space,
+                 string "=",
+                 space,
+                 p_exp env e2,
+                 string ";",
+                 newline,
+                 string "if",
+                 space,
+                 string "(divisor",
+                 space,
+                 string "==",
+                 space,
+                 string "0)",
+                 newline,
+                 box [string "uw_error(ctx, FATAL, \"",
+                      string (ErrorMsg.spanToString loc),
+                      string ": division by zero\");",
+                      newline],
+                 string "dividend",
+                 space,
+                 string s,
+                 space,
+                 string "divisor;",
+                 newline,
+                 string "})"]
+        else
+            parenIf par (box [p_exp' true false env e1,
+                              space,
+                              string (if s = "fdiv" then "/" else s),
+                              space,
+                              p_exp' true false env e2])
+
+      | ERecord (0, _) => string "0"
+
+      | ERecord (i, xes) => box [string "({",
+                                 space,
+                                 string "struct",
+                                 space,
+                                 string ("__uws_" ^ Int.toString i),
+                                 space,
+                                 string "tmp",
+                                 space,
+                                 string "=",
+                                 space,
+                                 string "{",
+                                 p_list (fn (_, e) =>
+                                            p_exp' false false env e) xes,
+                                 string "};",
+                                 space,
+                                 string "tmp;",
+                                 space,
+                                 string "})" ]
+      | EField (e, x) =>
+        box [p_exp' true false env e,
+             string ".__uwf_",
+             p_ident x]
+
+      | ECase (e, pes, {disc, result}) =>
+        box [string "({",
+             newline,
+             p_typ env disc,
+             space,
+             string "disc",
+             space,
+             string "=",
+             space,
+             p_exp' false false env e,
+             string ";",
+             newline,
+             newline,
+             foldr (fn ((p, e), body) =>
+                       let
+                           val pm = p_patMatch (env, "disc") p
+                           val (pb, env') = p_patBind (env, "disc") p
+                       in
+                           box [pm,
+                                space,
+                                string "?",
+                                space,
+                                if E.countERels env' = E.countERels env then
+                                    p_exp' false tail env e
+                                else
+                                    box [string "({",
+                                         pb,
+                                         p_exp' false tail env' e,
+                                         string ";",
+                                         newline,
+                                         string "})"],
+                                newline,
+                                space,
+                                string ":",
+                                space,
+                                body]
+                       end) (box [string "({",
+                                  newline,
+                                  p_typ env result,
+                                  space,
+                                  string "tmp;",
+                                  newline,
+                                  string "uw_error(ctx, FATAL, \"",
+                                  string (ErrorMsg.spanToString loc),
+                                  string ": pattern match failure\");",
+                                  newline,
+                                  string "tmp;",
+                                  newline,
+                                  string "})"]) pes,
+             string ";",
+             newline,
+             string "})"]
+
+      | EWrite e => box [string "(uw_write(ctx, ",
+                         p_exp' false false env e,
+                         string "), 0)"]
+
+      | ESeq (e1, e2) =>
+        let
+            val useRegion = potentiallyFancy e1
+        in
+            box [string "(",
+                 if useRegion then
+                     box [string "uw_begin_region(ctx),",
+                          space]
+                 else
+                     box [],
+                 p_exp' false false env e1,
+                 string ",",
+                 space,
+                 if useRegion then
+                     box [string "uw_end_region(ctx),",
+                          space]
+                 else
+                     box [],
+                 p_exp' false tail env e2,
+                 string ")"]
+        end
+      | ELet (x, t, e1, e2) =>
+        let
+            val useRegion = notLeaky env false t andalso potentiallyFancy e1
+        in
+            box [string "({",
+                 newline,
+                 p_typ env t,
+                 space,
+                 string "__uwr_",
+                 p_ident x,
+                 string "_",
+                 string (Int.toString (E.countERels env)),
+                 space,
+                 string "=",
+                 space,
+                 if useRegion then
+                     box [string "(uw_begin_region(ctx),",
+                          space]
+                 else
+                     box [],
+                 p_exp' false false env e1,
+                 if useRegion then
+                     string ")"
+                 else
+                     box [],
+                 string ";",
+                 newline,
+                 if useRegion then
+                     box [string "uw_end_region(ctx);",
+                          newline]
+                 else
+                     box [],
+                 p_exp' false tail (E.pushERel env x t) e2,
+                 string ";",
+                 newline,
+                 string "})"]
+        end
+
+      | EQuery {exps, tables, rnum, state, query, body, initial, prepared} =>
+        let
+            val exps = map (fn (x, t) => ("__uwf_" ^ ident x, t)) exps
+            val tables = ListUtil.mapConcat (fn (x, xts) =>
+                                                map (fn (x', t) => ("__uwf_" ^ ident x ^ ".__uwf_" ^ ident x', t)) xts)
+                                            tables
+
+            val sort = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER)
+            val outputs = sort exps @ sort tables
+
+            val wontLeakStrings = notLeaky env true state
+            val wontLeakAnything = notLeaky env false state
+
+            val inputs =
+                case prepared of
+                    NONE => []
+                  | SOME _ => getPargs query
+
+            fun doCols p_getcol =
+                box [string "struct __uws_",
+                     string (Int.toString rnum),
+                     string " __uwr_r_",
+                     string (Int.toString (E.countERels env)),
+                     string ";",
+                     newline,
+                     p_typ env state,
+                     space,
+                     string "__uwr_acc_",
+                     string (Int.toString (E.countERels env + 1)),
+                     space,
+                     string "=",
+                     space,
+                     string "acc;",
+                     newline,
+                     newline,
+
+                     if Settings.getDeadlines () then
+                         box [string "uw_check_deadline(ctx);",
+                              newline]
+                     else
+                         box [],
+
+                     p_list_sepi (box []) (fn i =>
+                                           fn (proj, t) =>
+                                              box [string "__uwr_r_",
+                                                   string (Int.toString (E.countERels env)),
+                                                   string ".",
+                                                   string proj,
+                                                   space,
+                                                   string "=",
+                                                   space,
+                                                   p_getcol {loc = loc,
+                                                             wontLeakStrings = wontLeakStrings,
+                                                             col = i,
+                                                             typ = sql_type_in env t},
+                                                   string ";",
+                                                   newline]) outputs,
+                     newline,
+                     newline,
+
+                     string "acc",
+                     space,
+                     string "=",
+                     space,
+                     p_exp' false false (E.pushERel
+                                             (E.pushERel env "r" (TRecord rnum, loc))
+                                             "acc" state)
+                            body,
+                     string ";",
+                     newline]
+        in
+            box [if wontLeakAnything then
+                     string "(uw_begin_region(ctx), "
+                 else
+                     box [],
+                 string "({",
+                 newline,
+                 p_typ env state,
+                 space,
+                 string "acc",
+                 space,
+                 string "=",
+                 space,
+                 p_exp' false false env initial,
+                 string ";",
+                 newline,
+                 string "int dummy = (uw_begin_region(ctx), 0);",
+                 newline,
+                 string "uw_ensure_transaction(ctx);",
+                 newline,
+
+                 case prepared of
+                     NONE =>
+                     box [string "char *query = ",
+                          p_exp' false false env query,
+                          string ";",
+                          newline,
+                          newline,
+
+                          #query (Settings.currentDbms ())
+                                 {loc = loc,
+                                  cols = map (fn (_, t) => sql_type_in env t) outputs,
+                                  doCols = doCols}]
+                   | SOME {id, query, nested} =>
+                     box [p_list_sepi newline
+                                      (fn i => fn (e, t) =>
+                                                  box [p_sql_type t,
+                                                       space,
+                                                       string "arg",
+                                                       string (Int.toString (i + 1)),
+                                                       space,
+                                                       string "=",
+                                                       space,
+                                                       p_exp' false false env e,
+                                                       string ";"])
+                                      inputs,
+                          newline,
+                          newline,
+
+                          #queryPrepared (Settings.currentDbms ())
+                                         {loc = loc,
+                                          id = id,
+                                          query = query,
+                                          inputs = map #2 inputs,
+                                          cols = map (fn (_, t) => sql_type_in env t) outputs,
+                                          doCols = doCols,
+                                          nested = nested}],
+                 newline,
+
+                 if wontLeakAnything then
+                     box [string "uw_end_region(ctx);",
+                          newline]
+                 else
+                     box [],
+                 string "acc;",
+                 newline,
+                 string "})",
+                 if wontLeakAnything then
+                     string ")"
+                 else
+                     box []]
+        end
+
+      | EDml {dml, prepared, mode} =>
+        box [string "(uw_begin_region(ctx), ({",
+             newline,
+             case prepared of
+                 NONE => box [string "char *dml = ",
+                              p_exp' false false env dml,
+                              string ";",
+                              newline,
+                              string "uw_ensure_transaction(ctx);",
+                              newline,
+                              newline,
+                              #dml (Settings.currentDbms ()) (loc, mode)]
+               | SOME {id, dml = dml'} =>
+                 let
+                     val inputs = getPargs dml
+                 in
+                     box [p_list_sepi newline
+                                      (fn i => fn (e, t) =>
+                                                  box [p_sql_type t,
+                                                       space,
+                                                       string "arg",
+                                                       string (Int.toString (i + 1)),
+                                                       space,
+                                                       string "=",
+                                                       space,
+                                                       p_exp' false false env e,
+                                                       string ";"])
+                                      inputs,
+                          newline,
+                          string "uw_ensure_transaction(ctx);",
+                          newline,
+                          newline,
+
+                          #dmlPrepared (Settings.currentDbms ()) {loc = loc,
+                                                                  id = id,
+                                                                  dml = dml',
+                                                                  inputs = map #2 inputs,
+                                                                  mode = mode}]
+                 end,
+             newline,
+             newline,
+             string "uw_end_region(ctx);",
+             newline,
+
+             case mode of
+                 Settings.Error => string "0;"
+               | Settings.None => string "uw_dup_and_clear_error_message(ctx);",
+
+             newline,
+             string "}))"]
+
+      | ENextval {seq, prepared} =>
+        box [string "({",
+             newline,
+             string "uw_Basis_int n;",
+             newline,
+             string "uw_ensure_transaction(ctx);",
+             newline,
+
+             case prepared of
+                 NONE => #nextval (Settings.currentDbms ()) {loc = loc,
+                                                             seqE = p_exp' false false env seq,
+                                                             seqName = case #1 seq of
+                                                                           EPrim (Prim.String (_, s)) => SOME s
+                                                                         | _ => NONE}
+               | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
+                                                                                 id = id,
+                                                                                 query = query},
+             newline,
+             newline,
+
+             string "n;",
+             newline,
+             string "})"]
+
+      | ESetval {seq, count} =>
+        box [string "({",
+             newline,
+             string "uw_ensure_transaction(ctx);",
+             newline,
+
+             #setval (Settings.currentDbms ()) {loc = loc,
+                                                seqE = p_exp' false false env seq,
+                                                count = p_exp' false false env count},
+             newline,
+             newline,
+
+             string "0;",
+             newline,
+             string "})"]
+
+      | EUnurlify (e, t, true) =>
+        let
+            fun getIt () =
+                if isUnboxable t then
+                    unurlify false env t
+                else
+                    box [string "({",
+                         newline,
+                         p_typ env t,
+                         string " *tmp = uw_malloc(ctx, sizeof(",
+                         p_typ env t,
+                         string "));",
+                         newline,
+                         string "*tmp = ",
+                         unurlify false env t,
+                         string ";",
+                         newline,
+                         string "tmp;",
+                         newline,
+                         string "})"]
+        in
+            box [string "({",
+                 newline,
+                 string "uw_Basis_string request = uw_maybe_strdup(ctx, ",
+                 p_exp' false false env e,
+                 string ");",
+                 newline,
+                 newline,
+                 string "(request ? ",
+                 getIt (),
+                 string " : NULL);",
+                 newline,
+                 string "})"]
+        end
+
+      | EUnurlify (e, t, false) =>
+        let
+            fun getIt () =
+                if isUnboxable t then
+                    unurlify false env t
+                else
+                    box [string "({",
+                         newline,
+                         p_typ env t,
+                         string " *tmp = uw_malloc(ctx, sizeof(",
+                         p_typ env t,
+                         string "));",
+                         newline,
+                         string "*tmp = ",
+                         unurlify false env t,
+                         string ";",
+                         newline,
+                         string "tmp;",
+                         newline,
+                         string "})"]
+        in
+            box [string "({",
+                 newline,
+                 string "uw_Basis_string request = uw_maybe_strdup(ctx, ",
+                 p_exp' false false env e,
+                 string ");",
+                 newline,
+                 newline,
+                 unurlify false env t,
+                 string ";",
+                 newline,
+                 string "})"]
+        end
+
+and p_exp env = p_exp' false true env
+
+fun p_fun isRec env (fx, n, args, ran, e) =
+    let
+        val nargs = length args
+        val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
+    in
+        box [string "static",
+             space,
+             p_typ env ran,
+             space,
+             string ("__uwn_" ^ ident fx ^ "_" ^ Int.toString n),
+             string "(",
+             p_list_sep (box [string ",", space]) (fn x => x)
+                        (string "uw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
+                                                                      box [p_typ env dom,
+                                                                           space,
+                                                                           p_rel env' (nargs - i - 1)]) args),
+             string ")",
+             space,
+             string "{",
+             if isRec then
+                 box [string "restart:",
+                      newline]
+             else
+                 box [],
+             newline,
+             if isRec andalso Settings.getDeadlines () then
+                 box [string "uw_check_deadline(ctx);",
+                      newline]
+             else
+                 box [],
+             box [string "return(",
+                  p_exp env' e,
+                  string ");"],
+             newline,
+             string "}"]
+    end
+
+val global_initializers : Print.PD.pp_desc list ref = ref []
+
+fun p_decl env (dAll as (d, loc) : decl) =
+    case d of
+        DStruct (n, xts) =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "struct",
+                 space,
+                 string ("__uws_" ^ Int.toString n),
+                 space,
+                 string "{",
+                 newline,
+                 p_list_sep (box []) (fn (x, t) => box [p_typ env t,
+                                                        space,
+                                                        string "__uwf_",
+                                                        p_ident x,
+                                                        string ";",
+                                                        newline]) xts,
+                 string "};"]
+        end
+      | DDatatype dts =>
+        let
+            fun p_one (Enum, x, n, xncs) =
+                box [string "enum",
+                     space,
+                     string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
+                     space,
+                     string "{",
+                     space,
+                     case xncs of
+                         [] => string ("__uwec_" ^ ident x ^ "_" ^ Int.toString n)
+                       | _ =>
+                         p_list_sep (box [string ",", space]) (fn (x, n, _) =>
+                                                                  string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs,
+                     space,
+                     string "};"]
+              | p_one (Option, _, _, _) = box []
+              | p_one (Default, x, n, xncs) =
+                let
+                    val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE
+                                                     | (x, n, SOME t) => SOME (x, n, t)) xncs
+                in
+                    box [string "enum",
+                         space,
+                         string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
+                         space,
+                         string "{",
+                         space,
+                         p_list_sep (box [string ",", space]) (fn (x, n, _) =>
+                                                                  string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n))
+                                    xncs,
+                         space,
+                         string "};",
+                         newline,
+                         newline,
+                         string "struct",
+                         space,
+                         string ("__uwd_" ^ ident x ^ "_" ^ Int.toString n),
+                         space,
+                         string "{",
+                         newline,
+                         string "enum",
+                         space,
+                         string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
+                         space,
+                         string "tag;",
+                         newline,
+                         box (case xncsArgs of
+                                  [] => []
+                                | _ => [string "union",
+                                        space,
+                                        string "{",
+                                        newline,
+                                        p_list_sep newline (fn (x, n, t) => box [p_typ env t,
+                                                                                 space,
+                                                                                 string ("uw_" ^ ident x),
+                                                                                 string ";"]) xncsArgs,
+                                        newline,
+                                        string "}",
+                                        space,
+                                        string "data;",
+                                        newline]),
+                         string "};"]
+                end
+        in
+            p_list_sep (box []) p_one dts
+        end
+
+      | DDatatypeForward _ => box []
+
+      | DVal (x, n, t, e) =>
+        (global_initializers := box [string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n),
+                                     space,
+                                     string "=",
+                                     space,
+                                     p_exp env e,
+                                     string ";"] :: !global_initializers;
+         box [p_typ env t,
+              space,
+              string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n ^ ";")])
+      | DFun vi => p_fun false env vi
+      | DFunRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [p_list_sep newline (fn (fx, n, args, ran, _) =>
+                                        box [string "static",
+                                             space,
+                                             p_typ env ran,
+                                             space,
+                                             string ("__uwn_" ^ ident fx ^ "_" ^ Int.toString n),
+                                             string "(uw_context,",
+                                             space,
+                                             p_list_sep (box [string ",", space])
+                                                        (fn (_, dom) => p_typ env dom) args,
+                                             string ");"]) vis,
+                 newline,
+                 p_list_sep newline (fn vi as (_, n, _, _, _) =>
+                                        (self := SOME n;
+                                         p_fun true env vi
+                                         before self := NONE)) vis,
+                 newline]
+        end
+      | DTable (x, _, pk, csts) => box [string "/* SQL table ",
+                                        string x,
+                                        space,
+                                        case pk of
+                                            "" => box []
+                                          | _ => box [string "keys",
+                                                      space,
+                                                      string pk,
+                                                      space],
+                                        string "constraints",
+                                        space,
+                                        p_list (fn (x, v) => box [string x,
+                                                                  space,
+                                                                  string ":",
+                                                                  space,
+                                                                  string v]) csts,
+                                        space,
+                                        string " */",
+                                        newline]
+      | DSequence x => box [string "/* SQL sequence ",
+                            string x,
+                            string " */",
+                            newline]
+      | DView (x, _, s) => box [string "/* SQL view ",
+                                string x,
+                                space,
+                                string "AS",
+                                space,
+                                string s,
+                                space,
+                                string " */",
+                                newline]
+      | DDatabase _ => box []
+      | DPreparedStatements _ => box []
+
+      | DJavaScript s =>
+        let
+	    val name =
+		(case Settings.getOutputJsFile () of
+		    NONE => "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"
+		  | SOME s => s)
+            val () = app_js := OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
+                                                    file = name}
+        in
+            box [string "static char jslib[] = \"",
+                 string (Prim.toCString s),
+                 string "\";"]
+        end
+      | DCookie s => box [string "/*",
+                          space,
+                          string "cookie",
+                          space,
+                          string s,
+                          space,
+                          string "*/"]
+      | DStyle s => box [string "/*",
+                         space,
+                         string "style",
+                         space,
+                         string s,
+                         space,
+                         string "*/"]
+
+      | DTask _ => box []
+      | DOnError _ => box []
+
+datatype 'a search =
+         Found of 'a
+       | NotFound
+       | Error
+
+fun p_sqltype'' env (tAll as (t, loc)) =
+    case t of
+        TFfi ("Basis", "int") => "int8"
+      | TFfi ("Basis", "float") => "float8"
+      | TFfi ("Basis", "string") => "text"
+      | TFfi ("Basis", "bool") => "bool"
+      | TFfi ("Basis", "time") => "timestamp"
+      | TFfi ("Basis", "blob") => "bytea"
+      | TFfi ("Basis", "channel") => "int8"
+      | TFfi ("Basis", "client") => "int4"
+      | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
+              Print.eprefaces' [("Type", p_htyp env tAll)];
+              "ERROR")
+
+fun p_sqltype' env (tAll as (t, loc)) =
+    case t of
+        (TOption t, _) => p_sqltype'' env t
+      | _ => p_sqltype'' env t ^ " NOT NULL"
+
+fun p_sqltype env t = string (p_sqltype' env t)
+
+fun p_sqltype_base' env t =
+    case t of
+        (TOption t, _) => p_sqltype'' env t
+      | _ => p_sqltype'' env t
+
+fun p_sqltype_base env t = string (p_sqltype_base' env t)
+
+fun is_not_null t =
+    case t of
+        (TOption _, _) => false
+      | _ => true
+
+fun sigName fields =
+    let
+        fun inFields s = List.exists (fn (s', _) => s' = s) fields
+
+        fun getSigName n =
+            let
+                val s = "Sig" ^ Int.toString n
+            in
+                if inFields s then
+                    getSigName (n + 1)
+                else
+                    s
+            end
+    in
+        if inFields "Sig" then
+            getSigName 0
+        else
+            "Sig"
+    end
+
+fun p_file env (ds, ps) =
+    let
+        val () = (clearUrlHandlers ();
+                  unurlifies := IS.empty;
+                  urlifies := IS.empty;
+                  urlifiesL := IS.empty;
+                  self := NONE;
+                  global_initializers := [])
+
+        (* First, pull out all of the enumerated types, to be declared first. *)
+        val (ds, enums) = ListUtil.foldlMapPartial (fn (d, enums) =>
+                                                       case #1 d of
+                                                           DDatatype dts =>
+                                                           let
+                                                               val (enum, other) = List.partition (fn (Enum, _, _, _) => true
+                                                                                                  | _ => false) dts
+                                                           in
+                                                               (SOME (DDatatype other, #2 d),
+                                                                List.revAppend (enum, enums))
+                                                           end
+                                                         | DDatatypeForward (Enum, _, _) => (NONE, enums)
+                                                         | _ => (SOME d, enums))
+                                                   [] ds
+
+        val ds = (DDatatype enums, ErrorMsg.dummySpan) :: ds
+
+        val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
+                                               let
+                                                   val d' = p_decl env d
+                                                   val hs = latestUrlHandlers ()
+                                                   val (protos, defs) = ListPair.unzip hs
+                                               in
+                                                   (box (List.revAppend (protos, (List.revAppend (defs, [d'])))),
+                                                    E.declBinds env d)
+                                               end)
+                             env ds
+
+        fun flatFields always (t : typ) =
+            case #1 t of
+                TRecord i =>
+                let
+                    val xts = E.lookupStruct env i
+                in
+                    SOME ((always @ map #1 xts) :: List.concat (List.mapPartial (flatFields [] o #2) xts))
+                end
+              | TList (_, i) =>
+                let
+                    val ts = E.lookupStruct env i
+                in
+                    case ts of
+                        [("1", t'), ("2", _)] => flatFields [] t'
+                      | _ => raise Fail "CjrPrint: Bad struct for TList"
+                end
+              | _ => NONE
+
+        val fields = foldl (fn ((ek, _, _, ts, _, _, _, _), fields) =>
+                               case ek of
+                                   Action eff =>
+                                   (case List.nth (ts, length ts - 2) of
+                                        (TRecord i, loc) =>
+                                        let
+                                            val xts = E.lookupStruct env i
+                                            val extra = case eff of
+                                                            ReadCookieWrite => [sigName xts]
+                                                          | _ => []
+                                        in
+                                            case flatFields extra (TRecord i, loc) of
+                                                NONE => raise Fail "CjrPrint: flatFields impossible"
+                                              | SOME fields' => List.revAppend (fields', fields)
+                                        end
+                                      | _ => raise Fail "CjrPrint: Last argument of action isn't record")
+                                 | _ => fields)
+                           [] ps
+
+        val fields = foldl (fn (xts, fields) =>
+                               let
+                                   val xtsSet = SS.addList (SS.empty, xts)
+                               in
+                                   foldl (fn (x, fields) =>
+                                             let
+                                                 val xtsSet' = Option.getOpt (SM.find (fields, x), SS.empty)
+                                             in
+                                                 SM.insert (fields, x, SS.union (SS.delete (xtsSet, x),
+                                                                                 xtsSet'))
+                                             end) fields xts
+                               end)
+                           SM.empty fields
+
+        val fnums = SM.foldli (fn (x, xs, fnums) =>
+                                  let
+                                      val unusable = SS.foldl (fn (x', unusable) =>
+                                                                  case SM.find (fnums, x') of
+                                                                      NONE => unusable
+                                                                    | SOME n => IS.add (unusable, n))
+                                                     IS.empty xs
+
+                                      fun findAvailable n =
+                                          if IS.member (unusable, n) then
+                                              findAvailable (n + 1)
+                                          else
+                                              n
+                                  in
+                                      SM.insert (fnums, x, findAvailable 0)
+                                  end)
+                    SM.empty fields
+
+        val cookies = List.mapPartial (fn (DCookie s, _) => SOME s | _ => NONE) ds
+
+        fun makeSwitch (fnums, i) =
+            case SM.foldl (fn (n, NotFound) => Found n
+                            | (n, Error) => Error
+                            | (n, Found n') => if n = n' then
+                                                  Found n'
+                                               else
+                                                   Error) NotFound fnums of
+                NotFound => box [string "return",
+                                 space,
+                                 string "-1;"]
+              | Found n => box [string "return",
+                                space,
+                                string (Int.toString n),
+                                string ";"]
+              | Error =>
+                let
+                    val cmap = SM.foldli (fn (x, n, cmap) =>
+                                             let
+                                                 val ch = if i < size x then
+                                                              String.sub (x, i)
+                                                          else
+                                                              chr 0
+
+                                                 val fnums = case CM.find (cmap, ch) of
+                                                                 NONE => SM.empty
+                                                               | SOME fnums => fnums
+                                                 val fnums = SM.insert (fnums, x, n)
+                                             in
+                                                 CM.insert (cmap, ch, fnums)
+                                             end)
+                               CM.empty fnums
+
+                    val cmap = CM.listItemsi cmap
+                in
+                    case cmap of
+                        [(_, fnums)] =>
+                        box [string "if",
+                             space,
+                             string "(name[",
+                             string (Int.toString i),
+                             string "]",
+                             space,
+                             string "==",
+                             space,
+                             string "0)",
+                             space,
+                             string "return",
+                             space,
+                             string "-1;",
+                             newline,
+                             makeSwitch (fnums, i+1)]
+                      | _ =>
+                        box [string "switch",
+                             space,
+                             string "(name[",
+                             string (Int.toString i),
+                             string "])",
+                             space,
+                             string "{",
+                             newline,
+                             box (map (fn (ch, fnums) =>
+                                          box [string "case",
+                                               space,
+                                               if ch = chr 0 then
+                                                   string "0:"
+                                               else
+                                                   box [string "'",
+                                                        string (Char.toString ch),
+                                                        string "':"],
+                                               newline,
+                                               makeSwitch (fnums, i+1),
+                                               newline]) cmap),
+                             string "default:",
+                             newline,
+                             string "return",
+                             space,
+                             string "-1;",
+                             newline,
+                             string "}"]
+                end
+
+        fun getInput (x, t) =
+            let
+                val n = case SM.find (fnums, x) of
+                            NONE => raise Fail ("CjrPrint: Can't find " ^ x ^ " in fnums")
+                          | SOME n => n
+
+                val f = case t of
+                            (TFfi ("Basis", "bool"), _) => "optional_"
+                          | _ => ""
+            in
+                if isFile t then
+                    box [string "uw_input_",
+                         p_ident x,
+                         space,
+                         string "=",
+                         space,
+                         string "uw_get_file_input(ctx, ",
+                         string (Int.toString n),
+                         string ");",
+                         newline]
+                else case #1 t of
+                         TRecord i =>
+                         let
+                             val xts = E.lookupStruct env i
+                         in
+                             box [string "uw_enter_subform(ctx, ",
+                                  string (Int.toString n),
+                                  string ");",
+                                  newline,
+                                  string "uw_input_",
+                                  p_ident x,
+                                  space,
+                                  string "=",
+                                  space,
+                                  string "({",
+                                  box [p_typ env t,
+                                       space,
+                                       string "result;",
+                                       newline,
+                                       p_list_sep (box [])
+                                                  (fn (x, t) =>
+                                                      box [p_typ env t,
+                                                           space,
+                                                           string "uw_input_",
+                                                           string x,
+                                                           string ";",
+                                                           newline])
+                                                  xts,
+                                       newline,
+                                       p_list_sep (box []) (fn (x, t) =>
+                                                               box [getInput (x, t),
+                                                                    string "result.__uwf_",
+                                                                    string x,
+                                                                    space,
+                                                                    string "=",
+                                                                    space,
+                                                                    string "uw_input_",
+                                                                    string x,
+                                                                    string ";",
+                                                                    newline])
+                                                  xts,
+                                       newline,
+                                       string "result;",
+                                       newline],
+                                  string "});",
+                                  newline,
+                                  string "uw_leave_subform(ctx);"]
+                         end
+                       | TList (t', i) =>
+                         let
+                             val xts = E.lookupStruct env i
+                             val i' = case xts of
+                                          [("1", (TRecord i', loc)), ("2", _)] => i'
+                                        | _ => raise Fail "CjrPrint: Bad TList record [2]"
+                             val xts = E.lookupStruct env i'
+                         in
+                             box [string "{",
+                                  newline,
+                                  string "int status;",
+                                  newline,
+                                  string "uw_input_",
+                                  p_ident x,
+                                  space,
+                                  string "=",
+                                  space,
+                                  string "NULL;",
+                                  newline,
+                                  string "for (status = uw_enter_subforms(ctx, ",
+                                  string (Int.toString n),
+                                  string "); status; status = uw_next_entry(ctx)) {",
+                                  newline,
+                                  box [p_typ env t,
+                                       space,
+                                       string "result",
+                                       space,
+                                       string "=",
+                                       space,
+                                       string "uw_malloc(ctx, sizeof(struct __uws_",
+                                       string (Int.toString i),
+                                       string "));",
+                                       newline,
+                                       box [string "{",
+                                            p_list_sep (box [])
+                                                       (fn (x, t) =>
+                                                           box [p_typ env t,
+                                                                space,
+                                                                string "uw_input_",
+                                                                string x,
+                                                                string ";",
+                                                                newline])
+                                                       xts,
+                                            newline,
+                                            p_list_sep (box []) (fn (x, t) =>
+                                                                    box [getInput (x, t),
+                                                                         string "result->__uwf_1.__uwf_",
+                                                                         string x,
+                                                                         space,
+                                                                         string "=",
+                                                                         space,
+                                                                         string "uw_input_",
+                                                                         string x,
+                                                                         string ";",
+                                                                         newline])
+                                                       xts,
+                                            string "}",
+                                            newline],
+                                       newline,
+                                       string "result->__uwf_2 = uw_input_",
+                                       p_ident x,
+                                       string ";",
+                                       newline,
+                                       string "uw_input_",
+                                       p_ident x,
+                                       string " = result;",
+                                       newline],
+                                  string "}}",
+                                  newline]
+                         end
+                       | TOption _ =>
+                         box [string "uw_input_",
+                              p_ident x,
+                              space,
+                              string "=",
+                              space,
+                              string "uw_get_input(ctx, ",
+                              string (Int.toString n),
+                              string ");",
+                              newline]
+                       | _ =>
+                         box [string "request = uw_get_",
+                              string f,
+                              string "input(ctx, ",
+                              string (Int.toString n),
+                              string ");",
+                              newline,
+                              string "if (request == NULL)",
+                              newline,
+                              box [string "uw_error(ctx, FATAL, \"Missing input ",
+                                   string x,
+                                   string "\");"],
+                              newline,
+                              string "uw_input_",
+                              p_ident x,
+                              space,
+                              string "=",
+                              space,
+                              unurlify true env t,
+                              string ";",
+                              newline]
+            end
+
+        fun allScripts () =
+            foldl (fn (x, scripts) =>
+                      scripts
+                      ^ "<script type=\\\"text/javascript\\\" src=\\\"" ^ x ^ "\\\"></script>\\n")
+                  "" (Settings.getScripts () @ [!app_js])
+
+        fun p_page (ek, s, n, ts, ran, side, dbmode, tellSig) =
+            let
+                val (ts, defInputs, inputsVar, fields) =
+                    case ek of
+                        Core.Action _ =>
+                        (case List.nth (ts, length ts - 2) of
+                             (TRecord i, _) =>
+                             let
+                                 val xts = E.lookupStruct env i
+                             in
+                                 (List.take (ts, length ts - 2),
+                                  box [box (map (fn (x, t) => box [p_typ env t,
+                                                                   space,
+                                                                   string "uw_input_",
+                                                                   p_ident x,
+                                                                   string ";",
+                                                                   newline]) xts),
+                                       newline,
+                                       box (map getInput xts),
+                                       case i of
+                                           0 => string "uw_unit uw_inputs;"
+                                         | _ => box [string "struct __uws_",
+                                                     string (Int.toString i),
+                                                     space,
+                                                     string "uw_inputs",
+                                                     space,
+                                                     string "= {",
+                                                     newline,
+                                                     box (map (fn (x, _) => box [string "uw_input_",
+                                                                                 p_ident x,
+                                                                                 string ",",
+                                                                                 newline]) xts),
+                                                     string "};"],
+                                       newline],
+                                  box [string ",",
+                                       space,
+                                       string "uw_inputs"],
+                                  SOME xts)
+                             end
+
+                           | _ => raise Fail "CjrPrint: Last argument to an action isn't a record")
+                      | _ => (List.take (ts, length ts - 1), string "", string "", NONE)
+
+                fun couldWrite ek =
+                    case ek of
+                        Link _ => false
+                      | Action ef => ef = ReadCookieWrite
+                      | Rpc ef => ef = ReadCookieWrite
+                      | Extern _ => false
+
+                fun couldWriteDb ek =
+                    case ek of
+                        Link ef => ef <> ReadOnly
+                      | Action ef => ef <> ReadOnly
+                      | Rpc ef => ef <> ReadOnly
+                      | Extern ef => ef <> ReadOnly
+
+                val s =
+                    case Settings.getUrlPrefix () of
+                        "" => s
+                      | "/" => s
+                      | prefix =>
+                        if size s > 0 andalso String.sub (s, 0) = #"/" then
+                            prefix ^ String.extract (s, 1, NONE)
+                        else
+                            prefix ^ s
+            in
+                box [string "if (!strncmp(request, \"",
+                     string (Prim.toCString s),
+                     string "\", ",
+                     string (Int.toString (size s)),
+                     string ") && (request[",
+                     string (Int.toString (size s)),
+                     string "] == 0 || request[",
+                     string (Int.toString (size s)),
+                     string "] == '/')) {",
+                     newline,
+                     string "request += ",
+                     string (Int.toString (size s)),
+                     string ";",
+                     newline,
+                     string "if (*request == '/') ++request;",
+                     newline,
+                     case ek of
+                         Rpc _ => box [string "if (uw_hasPostBody(ctx)) {",
+                                       newline,
+                                       box [string "uw_Basis_postBody pb = uw_getPostBody(ctx);",
+                                            newline,
+                                            string "if (pb.data[0])",
+                                            newline,
+                                            box [string "request = uw_Basis_strcat(ctx, request, pb.data);"],
+                                            newline],
+                                       string "}",
+                                       newline]
+                       | _ => box [],
+                     if couldWrite ek andalso not (Settings.checkNoXsrfProtection s) then
+                         box [string "{",
+                              newline,
+                              string "uw_Basis_string sig = ",
+                              case fields of
+                                  NONE => string "uw_Basis_requestHeader(ctx, \"UrWeb-Sig\")"
+                                | SOME fields =>
+                                  case SM.find (fnums, sigName fields) of
+                                      NONE => raise Fail "CjrPrint: sig name wasn't assigned a number"
+                                    | SOME inum =>
+                                      string ("uw_get_input(ctx, " ^ Int.toString inum ^ ")"),
+                              string ";",
+                              newline,
+                              string "if (sig == NULL) uw_error(ctx, FATAL, \"Missing cookie signature\");",
+                              newline,
+                              string "if (!uw_streq(sig, uw_cookie_sig(ctx)))",
+                              newline,
+                              box [string "uw_error(ctx, FATAL, \"Wrong cookie signature\");",
+                                   newline],
+                              string "}",
+                              newline]
+                     else
+                         box [],
+                     box (case ek of
+                              Core.Rpc _ => [string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");",
+                                             newline]
+                            | _ => [string "uw_write_header(ctx, \"Content-type: text/html; charset=utf-8\\r\\n\");",
+                                    newline,
+                                    case side of
+                                        ServerOnly => box []
+                                      | _ => box [string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");",
+                                                  newline],
+                                    string ("uw_write(ctx, uw_begin_" ^
+                                            (if Settings.getIsHtml5 () then
+                                                 "html5"
+                                             else
+                                                 "xhtml") ^ ");"),
+                                    newline,
+                                    string "uw_mayReturnIndirectly(ctx);",
+                                    newline,
+                                    string "uw_set_script_header(ctx, \"",
+                                    let
+                                        val scripts =
+                                            case side of
+                                                ServerOnly => ""
+                                              | _ => allScripts ()
+                                    in
+                                        string scripts
+                                    end,
+                                    string "\");",
+                                    newline]),
+                     string "uw_set_could_write_db(ctx, ",
+                     string (if couldWriteDb ek then "1" else "0"),
+                     string ");",
+                     newline,
+                     string "uw_set_at_most_one_query(ctx, ",
+                     string (case dbmode of OneQuery => "1" | _ => "0"),
+                     string ");",
+                     newline,
+                     string "uw_set_needs_push(ctx, ",
+                     string (case side of
+                                 ServerAndPullAndPush => "1"
+                               | _ => "0"),
+                     string ");",
+                     newline,
+                     string "uw_set_needs_sig(ctx, ",
+                     string (if tellSig then
+                                 "1"
+                             else
+                                 "0"),
+                     string ");",
+                     newline,
+                     string "uw_login(ctx);",
+                     newline,
+                     box [string "{",
+                          newline,
+                          box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
+                                                                space,
+                                                                string "arg",
+                                                                string (Int.toString i),
+                                                                space,
+                                                                string "=",
+                                                                space,
+                                                                case #1 t of
+                                                                    TFfi ("Basis", "postBody") => string "uw_getPostBody(ctx)"
+                                                                  | TOption (TFfi ("Basis", "queryString"), _) => string "uw_queryString(ctx)"
+                                                                  | _ => unurlify false env t,
+                                                                string ";",
+                                                                newline]) ts),
+                          defInputs,
+                          box (case ek of
+                                   Core.Rpc _ => [p_typ env ran,
+                                                  space,
+                                                  string "it0",
+                                                  space,
+                                                  string "=",
+                                                  space]
+                                 | _ => []),
+                          p_enamed env n,
+                          string "(",
+                          p_list_sep (box [string ",", space])
+                                     (fn x => x)
+                                     (string "ctx"
+                                      :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
+                          inputsVar,
+                          string ", 0);",
+                          newline,
+                          box (case ek of
+                                   Core.Rpc _ => [string "uw_write(ctx, uw_get_real_script(ctx));",
+                                                  newline,
+                                                  string "uw_write(ctx, \"\\n\");",
+                                                  newline,
+                                                  urlify env ran]
+                                 | _ => [string "uw_write(ctx, \"</html>\");",
+                                         newline]),
+                          string "return;",
+                          newline,
+                          string "}",
+                          newline,
+                          string "}"]
+                    ]
+            end
+
+        val (pds', handlers) = ListUtil.foldlMap (fn (p, handlers) =>
+                                                     let
+                                                         val p' = p_page p
+                                                     in
+                                                         (p', latestUrlHandlers () @ handlers)
+                                                     end) [] ps
+        val (protos, defs) = ListPair.unzip handlers
+
+        val hasDb = ref false
+        val tables = ref []
+        val views = ref []
+        val sequences = ref []
+        val dbstring = ref ""
+        val expunge = ref 0
+        val initialize = ref 0
+        val prepped = ref []
+        val hasJs = ref false
+
+        val _ = foldl (fn (d, env) =>
+                          ((case #1 d of
+                                DDatabase {name = x, expunge = y, initialize = z} => (hasDb := true;
+                                                                                      dbstring := x;
+                                                                                      expunge := y;
+                                                                                      initialize := z)
+                              | DJavaScript _ => hasJs := true
+                              | DTable (s, xts, _, _) => tables := (s, map (fn (x, t) =>
+                                                                               (x, sql_type_in env t)) xts) :: !tables
+                              | DView (s, xts, _) => views := (s, map (fn (x, t) =>
+                                                                          (x, sql_type_in env t)) xts) :: !views
+                              | DSequence s => sequences := s :: !sequences
+                              | DPreparedStatements ss => prepped := ss
+                              | _ => ());
+                           E.declBinds env d)) E.empty ds
+
+        val hasDb = !hasDb
+
+        fun expDb (e, _) =
+            case e of
+                ECon (_, _, SOME e) => expDb e
+              | ESome (_, e) => expDb e
+              | EFfiApp (_, _, es) => List.exists (expDb o #1) es
+              | EApp (e, es) => expDb e orelse List.exists expDb es
+              | EUnop (_, e) => expDb e
+              | EBinop (_, e1, e2) => expDb e1 orelse expDb e2
+              | ERecord (_, xes) => List.exists (expDb o #2) xes
+              | EField (e, _) => expDb e
+              | ECase (e, pes, _) => expDb e orelse List.exists (expDb o #2) pes
+              | EError (e, _) => expDb e
+              | EReturnBlob {blob = NONE, mimeType = e2, ...} => expDb e2
+              | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => expDb e1 orelse expDb e2
+              | ERedirect (e, _) => expDb e
+              | EWrite e => expDb e
+              | ESeq (e1, e2) => expDb e1 orelse expDb e2
+              | ELet (_, _, e1, e2) => expDb e1 orelse expDb e2
+              | EQuery _ => true
+              | EDml _ => true
+              | ENextval _ => true
+              | ESetval _ => true
+              | EUnurlify (e, _, _) => expDb e
+              | _ => false
+
+        fun declDb (d, _) =
+            case d of
+                DVal (_, _, _, e) => expDb e
+              | DFun (_, _, _, _, e) => expDb e
+              | DFunRec vis => List.exists (expDb o #5) vis
+              | DTask (_, _, _, e) => expDb e
+              | _ => false
+
+        val () = if not hasDb andalso List.exists declDb ds then
+                     ErrorMsg.error "Application uses a database but has none configured with 'database' in .urp file."
+                 else
+                     ()
+
+        val cookies = List.mapPartial (fn (DCookie s, _) => SOME s | _ => NONE) ds
+
+        val cookieCode = foldl (fn (cookie, acc) =>
+                                   SOME (case acc of
+                                             NONE => string ("uw_unnull(uw_Basis_get_cookie(ctx, \""
+                                                             ^ cookie ^ "\"))")
+                                           | SOME acc => box [string ("uw_Basis_strcat(ctx, uw_unnull(uw_Basis_get_cookie(ctx, \""
+                                                                      ^ cookie ^ "\")), uw_Basis_strcat(ctx, \"/\", "),
+                                                              acc,
+                                                              string "))"]))
+                         NONE cookies
+
+        val cookieCode = foldl (fn (evar, acc) =>
+                                   SOME (case acc of
+                                             NONE => string ("uw_unnull(uw_Basis_getenv(ctx, \""
+                                                             ^ Prim.toCString evar ^ "\"))")
+                                           | SOME acc => box [string ("uw_Basis_strcat(ctx, uw_unnull(uw_Basis_getenv(ctx, \""
+                                                                      ^ Prim.toCString evar ^ "\")), uw_Basis_strcat(ctx, \"/\", "),
+                                                              acc,
+                                                              string "))"]))
+                         cookieCode (SideCheck.readEnvVars ())
+
+        fun makeChecker (name, rules : Settings.rule list) =
+            box [string "static int ",
+                 string name,
+                 string "(const char *s) {",
+                 newline,
+                 box [p_list_sep (box [])
+                      (fn rule =>
+                          box [string "if (!str",
+                               case #kind rule of
+                                   Settings.Exact => box [string "cmp(s, \"",
+                                                          string (Prim.toCString (#pattern rule)),
+                                                          string "\"))"]
+                                 | Settings.Prefix => box [string "ncmp(s, \"",
+                                                           string (Prim.toCString (#pattern rule)),
+                                                           string "\", ",
+                                                           string (Int.toString (size (#pattern rule))),
+                                                           string "))"],
+                               string " return ",
+                               string (case #action rule of
+                                           Settings.Allow => "1"
+                                         | Settings.Deny => "0"),
+                               string ";",
+                               newline]) rules,
+                      string "return 0;",
+                      newline],
+                 string "}",
+                 newline]
+
+        val initializers = List.mapPartial (fn (DTask (Initialize, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
+        val expungers = List.mapPartial (fn (DTask (ClientLeaves, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
+        val periodics = List.mapPartial (fn (DTask (Periodic n, x1, x2, e), _) => SOME (n, x1, x2, e) | _ => NONE) ds
+
+        val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
+
+        val lastMod = Date.fromTimeUniv (FileIO.mostRecentModTime ())
+        val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
+
+        fun hexifyByte (b : Word8.word) : string =
+            let
+                val s = Int.fmt StringCvt.HEX (Word8.toInt b)
+            in
+                "\\x" ^ (if size s < 2 then "0" else "") ^ s
+            end
+
+        fun hexify (v : Word8Vector.vector) : string =
+            String.concat (Word8Vector.foldr (fn (b, ls) =>
+                                                 hexifyByte b :: ls) [] v)
+    in
+        box [string "#include \"",
+             string (OS.Path.joinDirFile {dir = !Settings.configInclude,
+                                          file = "config.h"}),
+             string "\"",
+             newline,
+             string "#include <stdio.h>",
+             newline,
+             string "#include <stdlib.h>",
+             newline,
+             string "#include <string.h>",
+             newline,
+             string "#include <math.h>",
+             newline,
+             string "#include <time.h>",
+             newline,
+             if hasDb then
+                 box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"),
+                      newline]
+             else
+                 box [],
+             p_list_sep (box []) (fn s => box [string "#include \"",
+                                               string s,
+                                               string "\"",
+                                               newline]) (Settings.getHeaders ()),
+             string "#include \"",
+             string (OS.Path.joinDirFile {dir = !Settings.configInclude,
+                                          file = "urweb.h"}),
+             string "\"",
+             newline,
+             newline,
+
+             box [string "static void uw_setup_limits() {",
+                  newline,
+                  case Settings.getMinHeap () of
+                      0 => box []
+                    | n => box [string "uw_min_heap",
+                                space,
+                                string "=",
+                                space,
+                                string (Int.toString n),
+                                string ";",
+                                newline,
+                                newline],
+                  box [p_list_sep (box []) (fn (class, num) =>
+                                               let
+                                                   val num = case class of
+                                                                 "page" => Int.max (2048, num)
+                                                               | _ => num
+                                               in
+                                                   box [string ("uw_" ^ class ^ "_max"),
+                                                        space,
+                                                        string "=",
+                                                        space,
+                                                        string (Int.toString num),
+                                                        string ";",
+                                                        newline]
+                                               end) (Settings.limits ())],
+                  string "}",
+                  newline,
+                  newline],
+
+             #code (Settings.currentProtocol ()) (),
+
+             if hasDb then
+                 #init (Settings.currentDbms ()) {dbstring = !dbstring,
+                                                  prepared = !prepped,
+                                                  tables = !tables,
+                                                  views = !views,
+                                                  sequences = !sequences}
+             else
+                 box [string "static void uw_client_init(void) { };",
+                      newline,
+                      string "static void uw_db_init(uw_context ctx) { };",
+                      newline,
+                      string "static int uw_db_begin(uw_context ctx, int could_write) { return 0; };",
+                      newline,
+                      string "static void uw_db_close(uw_context ctx) { };",
+                      newline,
+                      string "static int uw_db_commit(uw_context ctx) { return 0; };",
+                      newline,
+                      string "static int uw_db_rollback(uw_context ctx) { return 0; };"],
+             newline,
+             newline,
+
+             (* For sqlcache. *)
+             let
+                 val {setupGlobal, setupQuery, ...} = Sqlcache.getCache ()
+             in
+                 box (setupGlobal :: newline :: List.map setupQuery (Sqlcache.getFfiInfo ()))
+             end,
+             newline,
+
+             p_list_sep newline (fn x => x) pds,
+             newline,
+             newline,
+             string "static int uw_input_num(const char *name) {",
+             newline,
+             makeSwitch (fnums, 0),
+             string "}",
+             newline,
+             newline,
+
+             box (ListUtil.mapi (fn (i, (_, x1, x2, e)) =>
+                                    box [string "static void uw_periodic",
+                                         string (Int.toString i),
+                                         string "(uw_context ctx) {",
+                                         newline,
+                                         box [string "uw_unit __uwr_",
+                                              string x1,
+                                              string "_0 = 0, __uwr_",
+                                              string x2,
+                                              string "_1 = 0;",
+                                              newline,
+                                              p_exp (E.pushERel (E.pushERel env x1 dummyt) x2 dummyt) e,
+                                              string ";",
+                                              newline],
+                                         string "}",
+                                         newline,
+                                         newline]) periodics),
+
+             string "static uw_periodic my_periodics[] = {",
+             box (ListUtil.mapi (fn (i, (n, _, _, _)) =>
+                                    box [string "{uw_periodic",
+                                         string (Int.toString i),
+                                         string ",",
+                                         space,
+                                         string (Int64.toString n),
+                                         string "},"]) periodics),
+             string "{NULL}};",
+             newline,
+             newline,
+
+             makeChecker ("uw_check_url", Settings.getUrlRules ()),
+             newline,
+
+             makeChecker ("uw_check_mime", Settings.getMimeRules ()),
+             newline,
+
+             makeChecker ("uw_check_requestHeader", Settings.getRequestHeaderRules ()),
+             newline,
+
+             makeChecker ("uw_check_responseHeader", Settings.getResponseHeaderRules ()),
+             newline,
+
+             makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()),
+             newline,
+
+             makeChecker ("uw_check_meta", Settings.getMetaRules ()),
+             newline,
+
+             string "extern void uw_sign(const char *in, char *out);",
+             newline,
+             string "extern int uw_hash_blocksize;",
+             newline,
+             string "static uw_Basis_string uw_cookie_sig(uw_context ctx) {",
+             newline,
+             box [string "uw_Basis_string r = uw_malloc(ctx, uw_hash_blocksize);",
+                  newline,
+                  string "uw_sign(",
+                  case cookieCode of
+                      NONE => string "\"\""
+                    | SOME code => code,
+                  string ", r);",
+                  newline,
+                  string "return uw_Basis_makeSigString(ctx, r);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             box (rev protos),
+             box (rev defs),
+
+             string "static void uw_handle(uw_context ctx, char *request) {",
+             newline,
+             string "uw_Basis_string ims = uw_Basis_requestHeader(ctx, \"If-modified-since\");",
+             newline,
+             string ("if (ims && !strcmp(ims, \"" ^ Date.fmt rfcFmt lastMod ^ "\")) {"),
+             newline,
+             box [string "uw_clear_headers(ctx);",
+                  newline,
+                  string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 304 Not Modified\\r\\n\" : \"Status: 304 Not Modified\\r\\n\");",
+                  newline,
+                  string "return;",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (!strcmp(request, \"",
+             string (!app_js),
+             string "\")) {",
+             newline,
+             box [string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
+                  newline,
+                  string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
+                  newline,
+                  string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
+                  newline,
+                  string "uw_write(ctx, jslib);",
+                  newline,
+                  string "return;",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             p_list_sep newline (fn r =>
+                                    box [string "if (!strcmp(request, \"",
+                                         string (String.toCString (#Uri r)),
+                                         string "\")) {",
+                                         newline,
+                                         box [(case #ContentType r of
+                                                   NONE => box []
+                                                 | SOME ct => box [string "uw_write_header(ctx, \"Content-Type: ",
+                                                                   string (String.toCString ct),
+                                                                   string "\\r\\n\");",
+                                                                   newline]),
+                                              string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt lastMod ^ "\\r\\n\");"),
+                                              newline,
+                                              string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
+                                              newline,
+                                              string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
+                                              newline,
+                                              string "uw_replace_page(ctx, \"",
+                                              string (hexify (#Bytes r)),
+                                              string "\", ",
+                                              string (Int.toString (Word8Vector.length (#Bytes r))),
+                                              string ");",
+                                              newline,
+                                              string "return;",
+                                              newline],
+                                         string "};",
+                                         newline]) (Settings.listFiles ()),
+
+             newline,
+             p_list_sep newline (fn x => x) pds',
+             newline,
+             string "uw_clear_headers(ctx);",
+             newline,
+             string "uw_write_header(ctx, uw_supports_direct_status ? \"HTTP/1.1 404 Not Found\\r\\n\" : \"Status: 404 Not Found\\r\\n\");",
+             newline,
+             string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");",
+             newline,
+             string "uw_write(ctx, \"Not Found\");",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
+                  newline,
+
+                  p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
+                                                              newline,
+                                                              string "uw_Basis_client __uwr_",
+                                                              string x1,
+                                                              string "_0 = cli;",
+                                                              newline,
+                                                              string "uw_unit __uwr_",
+                                                              string x2,
+                                                              string "_1 = 0;",
+                                                              newline,
+                                                              p_exp (E.pushERel (E.pushERel env x1 (TFfi ("Basis", "client"), ErrorMsg.dummySpan))
+                                                                                x2 dummyt) e,
+                                                              string ";",
+                                                              newline,
+                                                              string "});",
+                                                              newline]) expungers,
+
+                  if hasDb then
+                      box [p_enamed env (!expunge),
+                           string "(ctx, cli);",
+                           newline]
+                  else
+                      box [],
+                  string "}"],
+
+             newline,
+             string "static void uw_initializer(uw_context ctx) {",
+             newline,
+             box [string "uw_begin_initializing(ctx);",
+                  newline,
+                  p_list_sep newline (fn x => x) (rev (!global_initializers)),
+                  string "uw_end_initializing(ctx);",
+                  newline,
+                  p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
+                                                              newline,
+                                                              string "uw_unit __uwr_",
+                                                              string x1,
+                                                              string "_0 = 0, __uwr_",
+                                                              string x2,
+                                                              string "_1 = 0;",
+                                                              newline,
+                                                              p_exp (E.pushERel (E.pushERel env x1 dummyt) x2 dummyt) e,
+                                                              string ";",
+                                                              newline,
+                                                              string "});",
+                                                              newline]) initializers,
+                  if hasDb then
+                      box [p_enamed env (!initialize),
+                           string "(ctx, 0);",
+                           newline]
+                  else
+                      box []],
+             string "}",
+             newline,
+
+             case onError of
+                 NONE => box []
+               | SOME n => box [string "static void uw_onError(uw_context ctx, char *msg) {",
+                                newline,
+                                if !hasJs then
+                                    box [string "uw_set_script_header(ctx, \"",
+                                         string (allScripts ()),
+                                         string "\");",
+                                         newline]
+                                else
+                                    box [],
+                                box [string "uw_write(ctx, ",
+                                     p_enamed env n,
+                                     string "(ctx, msg, 0));",
+                                     newline],
+                                string "}",
+                                newline,
+                                newline],
+
+             string "uw_app uw_application = {",
+             p_list_sep (box [string ",", newline]) string
+                        [Int.toString (SM.foldl Int.max 0 fnums + 1),
+                         Int.toString (Settings.getTimeout ()),
+                         "\"" ^ Settings.getUrlPrefix () ^ "\"",
+                         "uw_client_init", "uw_initializer", "uw_expunger",
+                         "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close",
+                         "uw_handle",
+                         "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar", "uw_check_meta",
+                         case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics",
+                         "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\"",
+                         if Settings.getIsHtml5 () then "1" else "0"],
+             string "};",
+             newline]
+    end
+
+fun p_sql env (ds, _) =
+    let
+        val (pps, _) = ListUtil.foldlMap
+                       (fn (dAll as (d, _), env) =>
+                           let
+                               val pp = case d of
+                                            DTable (s, xts, pk, csts) =>
+                                            box [string "CREATE TABLE ",
+                                                 string s,
+                                                 string "(",
+                                                 p_list (fn (x, t) =>
+                                                            let
+                                                                val t = sql_type_in env t
+                                                            in
+                                                                box [string (Settings.mangleSql (CharVector.map Char.toLower x)),
+                                                                     space,
+                                                                     string (#p_sql_type (Settings.currentDbms ()) t),
+                                                                     case t of
+                                                                         Nullable _ => box []
+                                                                       | _ => string " NOT NULL"]
+                                                            end) xts,
+                                                 case (pk, csts) of
+                                                     ("", []) => box []
+                                                   | _ => string ",",
+                                                 cut,
+                                                 case pk of
+                                                     "" => box []
+                                                   | _ => box [string "PRIMARY",
+                                                               space,
+                                                               string "KEY",
+                                                               space,
+                                                               string "(",
+                                                               string pk,
+                                                               string ")",
+                                                               case csts of
+                                                                   [] => box []
+                                                                 | _ => string ",",
+                                                               newline],
+                                                 p_list_sep (box [string ",", newline])
+                                                            (fn (x, c) =>
+                                                                box [string "CONSTRAINT",
+                                                                     space,
+                                                                     string s,
+                                                                     string "_",
+                                                                     string x,
+                                                                     space,
+                                                                     string c]) csts,
+                                                 newline,
+                                                 string ");",
+                                                 newline,
+                                                 newline]
+                                          | DSequence s =>
+                                            box [string (#createSequence (Settings.currentDbms ()) s),
+                                                 string ";",
+                                                 newline,
+                                                 newline]
+                                          | DView (s, xts, q) =>
+                                            box [string "CREATE VIEW",
+                                                 space,
+                                                 string s,
+                                                 space,
+                                                 string "AS",
+                                                 space,
+                                                 string q,
+                                                 string ";",
+                                                 newline,
+                                                 newline]
+                                          | _ => box []
+                           in
+                               (pp, E.declBinds env dAll)
+                           end)
+                       env ds
+    in
+        box (string (#sqlPrefix (Settings.currentDbms ())) :: pps)
+    end
+
+end
diff --git a/src/cjrize.sig b/src/cjrize.sig
new file mode 100644
index 0000000..fb8d37f
--- /dev/null
+++ b/src/cjrize.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CJRIZE = sig
+
+    val cjrize : Mono.file -> Cjr.file
+
+end
diff --git a/src/cjrize.sml b/src/cjrize.sml
new file mode 100644
index 0000000..fbc7eba
--- /dev/null
+++ b/src/cjrize.sml
@@ -0,0 +1,745 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Cjrize :> CJRIZE = struct
+
+structure L = Mono
+structure L' = Cjr
+
+structure IM = IntBinaryMap
+
+structure Sm :> sig
+    type t
+
+    val empty : t
+    val find : t * (string * L.typ) list * (string * L'.typ) list -> t * int
+    val findList : t * L.typ * L'.typ -> t * int
+
+    val declares : t -> (int * (string * L'.typ) list) list
+    val clearDeclares : t -> t
+end = struct
+
+structure FM = BinaryMapFn(struct
+                           type ord_key = L.typ
+                           val compare = MonoUtil.Typ.compare
+                           end)
+
+type t = {
+     count : int,
+     normal : int FM.map,
+     lists : int FM.map,
+     decls : (int * (string * L'.typ) list) list
+}
+
+val empty : t = {
+    count = 1,
+    normal = FM.insert (FM.empty, (L.TRecord [], ErrorMsg.dummySpan), 0),
+    lists = FM.empty,
+    decls = []
+}
+
+fun find (v as {count, normal, decls, lists}, xts, xts') =
+    let
+        val t = (L.TRecord xts, ErrorMsg.dummySpan)
+    in
+        case FM.find (normal, t) of
+            SOME i => (v, i)
+          | NONE => ({count = count+1,
+                      normal = FM.insert (normal, t, count),
+                      lists = lists,
+                      decls = (count, xts') :: decls},
+                     count)
+    end
+
+fun findList (v as {count, normal, decls, lists}, t, t') =
+    case FM.find (lists, t) of
+        SOME i => (v, i)
+      | NONE =>
+        let
+            val xts = [("1", t), ("2", (L.TList t, #2 t))]
+            val xts' = [("1", t'), ("2", (L'.TList (t', count), #2 t'))]
+        in
+            ({count = count+1,
+              normal = FM.insert (normal, (L.TRecord xts, ErrorMsg.dummySpan), count),
+              lists = FM.insert (lists, t, count),
+              decls = (count, xts') :: decls},
+             count)
+    end
+
+fun declares (v : t) = #decls v
+
+fun clearDeclares (v : t) = {count = #count v,
+                             normal = #normal v,
+                             lists = #lists v,
+                             decls = []}
+
+end
+
+fun cifyTyp x =
+    let
+        fun cify dtmap ((t, loc), sm) =
+            case t of
+                L.TFun (t1, t2) =>
+                let
+                    val (t1, sm) = cify dtmap (t1, sm)
+                    val (t2, sm) = cify dtmap (t2, sm)
+                in
+                    ((L'.TFun (t1, t2), loc), sm)
+                end
+              | L.TRecord xts =>
+                let
+                    val xts = MonoUtil.Typ.sortFields xts
+                    val old_xts = xts
+                    val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                          let
+                                                              val (t, sm) = cify dtmap (t, sm)
+                                                          in
+                                                              ((x, t), sm)
+                                                          end)
+                                                      sm xts
+                    val (sm, si) = Sm.find (sm, old_xts, xts)
+                in
+                    ((L'.TRecord si, loc), sm)
+                end
+              | L.TDatatype (n, ref (dk, xncs)) =>
+                (case IM.find (dtmap, n) of
+                     SOME r => ((L'.TDatatype (dk, n, r), loc), sm)
+                   | NONE =>
+                     let
+                         val r = ref []
+                         val dtmap = IM.insert (dtmap, n, r)
+
+                         val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) =>
+                                                                case to of
+                                                                    NONE => ((x, n, NONE), sm)
+                                                                  | SOME t =>
+                                                                    let
+                                                                        val (t, sm) = cify dtmap (t, sm)
+                                                                    in
+                                                                        ((x, n, SOME t), sm)
+                                                                    end)
+                                                            sm xncs
+                     in
+                         r := xncs;
+                         ((L'.TDatatype (dk, n, r), loc), sm)
+                     end)
+              | L.TFfi mx => ((L'.TFfi mx, loc), sm)
+              | L.TOption t =>
+                let
+                    val (t, sm) = cify dtmap (t, sm)
+                in
+                    ((L'.TOption t, loc), sm)
+                end
+              | L.TList t =>
+                let
+                    val (t', sm) = cify dtmap (t, sm)
+                    val (sm, si) = Sm.findList (sm, t, t')
+                in
+                    ((L'.TList (t', si), loc), sm)
+                end
+              | L.TSource => ((L'.TFfi ("Basis", "source"), loc), sm)
+              | L.TSignal _ => (ErrorMsg.errorAt loc "TSignal remains";
+                                Print.epreface ("Full type", MonoPrint.p_typ MonoEnv.empty (#1 x));
+                                ((L'.TFfi ("Basis", "bogus"), loc), sm))
+    in
+        cify IM.empty x
+    end
+
+val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan)
+
+fun cifyPatCon (pc, sm) =
+    case pc of
+        L.PConVar n => (L'.PConVar n, sm)
+      | L.PConFfi {mod = m, datatyp, con, arg} =>
+        let
+            val (arg, sm) =
+                case arg of
+                    NONE => (NONE, sm)
+                  | SOME t =>
+                    let
+                        val (t, sm) = cifyTyp (t, sm)
+                    in
+                        (SOME t, sm)
+                    end
+        in
+            (L'.PConFfi {mod = m, datatyp = datatyp, con = con, arg = arg}, sm)
+        end
+
+fun cifyPat ((p, loc), sm) =
+    case p of
+        L.PVar (x, t) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            ((L'.PVar (x, t), loc), sm)
+        end
+      | L.PPrim p => ((L'.PPrim p, loc), sm)
+      | L.PCon (dk, pc, NONE) =>
+        let
+            val (pc, sm) = cifyPatCon (pc, sm)
+        in
+            ((L'.PCon (dk, pc, NONE), loc), sm)
+        end
+      | L.PCon (dk, pc, SOME p) =>
+        let
+            val (pc, sm) = cifyPatCon (pc, sm)
+            val (p, sm) = cifyPat (p, sm)
+        in
+            ((L'.PCon (dk, pc, SOME p), loc), sm)
+        end
+      | L.PRecord xps =>
+        let
+            val (xps, sm) = ListUtil.foldlMap (fn ((x, p, t), sm) =>
+                                                  let
+                                                      val (p, sm) = cifyPat (p, sm)
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, p, t), sm)
+                                                  end) sm xps
+        in
+            ((L'.PRecord xps, loc), sm)
+        end
+      | L.PNone t =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            ((L'.PNone t, loc), sm)
+        end
+      | L.PSome (t, p) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+            val (p, sm) = cifyPat (p, sm)
+        in
+            ((L'.PSome (t, p), loc), sm)
+        end
+
+fun cifyExp (eAll as (e, loc), sm) =
+    let
+        fun fail msg =
+            (ErrorMsg.errorAt loc msg;
+             ((L'.EPrim (Prim.String (Prim.Normal, "")), loc), sm))
+    in
+        case e of
+            L.EPrim p => ((L'.EPrim p, loc), sm)
+          | L.ERel n => ((L'.ERel n, loc), sm)
+          | L.ENamed n => ((L'.ENamed n, loc), sm)
+          | L.ECon (dk, pc, eo) =>
+            let
+                val (eo, sm) =
+                    case eo of
+                        NONE => (NONE, sm)
+                      | SOME e =>
+                        let
+                            val (e, sm) = cifyExp (e, sm)
+                        in
+                            (SOME e, sm)
+                        end
+                val (pc, sm) = cifyPatCon (pc, sm)
+            in
+                ((L'.ECon (dk, pc, eo), loc), sm)
+            end
+          | L.ENone t =>
+            let
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.ENone t, loc), sm)
+            end
+          | L.ESome (t, e) =>
+            let
+                val (t, sm) = cifyTyp (t, sm)
+                val (e, sm) = cifyExp (e, sm)
+            in
+                ((L'.ESome (t, e), loc), sm)
+            end
+          | L.EFfi mx => ((L'.EFfi mx, loc), sm)
+          | L.EFfiApp (m, x, es) =>
+            let
+                val (es, sm) = ListUtil.foldlMap (fn ((e, t), sm) =>
+                                                     let
+                                                         val (t, sm) = cifyTyp (t, sm)
+                                                         val (e, sm) = cifyExp (e, sm)
+                                                     in
+                                                         ((e, t), sm)
+                                                     end) sm es
+            in
+                ((L'.EFfiApp (m, x, es), loc), sm)
+            end
+          | L.EApp (e1, e2) =>
+            let
+                fun unravel (e, args) =
+                    case e of
+                        (L.EApp (e1, e2), _) => unravel (e1, e2 :: args)
+                      | _ => (e, args)
+
+                val (f, es) = unravel (e1, [e2])
+
+                val (f, sm) = cifyExp (f, sm)
+                val (es, sm) = ListUtil.foldlMap cifyExp sm es
+            in
+                ((L'.EApp (f, es), loc), sm)
+            end
+          | L.EAbs _ => (ErrorMsg.errorAt loc "Anonymous function remains at code generation";
+                         Print.prefaces' [("Function", MonoPrint.p_exp MonoEnv.empty eAll)];
+                         (dummye, sm))
+
+          | L.EUnop (s, e1) =>
+            let
+                val (e1, sm) = cifyExp (e1, sm)
+            in
+                ((L'.EUnop (s, e1), loc), sm)
+            end
+          | L.EBinop (_, s, e1, e2) =>
+            let
+                val (e1, sm) = cifyExp (e1, sm)
+                val (e2, sm) = cifyExp (e2, sm)
+            in
+                ((L'.EBinop (s, e1, e2), loc), sm)
+            end
+
+          | L.ERecord xes =>
+            let
+                val old_xts = map (fn (x, _, t) => (x, t)) xes
+
+                val (xets, sm) = ListUtil.foldlMap (fn ((x, e, t), sm) =>
+                                                       let
+                                                           val (e, sm) = cifyExp (e, sm)
+                                                           val (t, sm) = cifyTyp (t, sm)
+                                                       in
+                                                           ((x, e, t), sm)
+                                                       end)
+                                                   sm xes
+
+                val (sm, si) = Sm.find (sm, old_xts, map (fn (x, _, t) => (x, t)) xets)
+
+                val xes = map (fn (x, e, _) => (x, e)) xets
+                val xes = ListMergeSort.sort (fn ((x1, _), (x2, _)) => String.compare (x1, x2) = GREATER) xes
+            in
+                ((L'.ERecord (si, xes), loc), sm)
+            end
+          | L.EField (e, x) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+            in
+                ((L'.EField (e, x), loc), sm)
+            end
+
+          | L.ECase (e, pes, {disc, result}) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+                val (pes, sm) = ListUtil.foldlMap
+                                    (fn ((p, e), sm) =>
+                                        let
+                                            val (e, sm) = cifyExp (e, sm)
+                                            val (p, sm) = cifyPat (p, sm)
+                                        in
+                                            ((p, e), sm)
+                                        end) sm pes
+                val (disc, sm) = cifyTyp (disc, sm)
+                val (result, sm) = cifyTyp (result, sm)
+            in
+                ((L'.ECase (e, pes, {disc = disc, result = result}), loc), sm)
+            end
+
+          | L.EError (e, t) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.EError (e, t), loc), sm)
+            end
+          | L.EReturnBlob {blob = NONE, mimeType, t} =>
+            let
+                val (mimeType, sm) = cifyExp (mimeType, sm)
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.EReturnBlob {blob = NONE, mimeType = mimeType, t = t}, loc), sm)
+            end
+          | L.EReturnBlob {blob = SOME blob, mimeType, t} =>
+            let
+                val (blob, sm) = cifyExp (blob, sm)
+                val (mimeType, sm) = cifyExp (mimeType, sm)
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.EReturnBlob {blob = SOME blob, mimeType = mimeType, t = t}, loc), sm)
+            end
+          | L.ERedirect (e, t) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.ERedirect (e, t), loc), sm)
+            end
+
+          | L.EStrcat (e1, e2) =>
+            let
+                val (e1, sm) = cifyExp (e1, sm)
+                val (e2, sm) = cifyExp (e2, sm)
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EFfiApp ("Basis", "strcat", [(e1, s), (e2, s)]), loc), sm)
+            end
+
+          | L.EWrite e =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+            in
+                ((L'.EWrite e, loc), sm)
+            end
+
+          | L.ESeq (e1, e2) =>
+            let
+                val (e1, sm) = cifyExp (e1, sm)
+                val (e2, sm) = cifyExp (e2, sm)
+            in
+                ((L'.ESeq (e1, e2), loc), sm)
+            end
+
+          | L.ELet (x, t, e1, e2) =>
+            let
+                val (t, sm) = cifyTyp (t, sm)
+                val (e1, sm) = cifyExp (e1, sm)
+                val (e2, sm) = cifyExp (e2, sm)
+            in
+                ((L'.ELet (x, t, e1, e2), loc), sm)
+            end
+
+          | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation";
+                             (dummye, sm))
+
+          | L.EQuery {exps, tables, state, query, body, initial} =>
+            let
+                val (exps', sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                        let
+                                                            val (t, sm) = cifyTyp (t, sm)
+                                                        in
+                                                            ((x, t), sm)
+                                                        end) sm exps
+                val (tables', sm) = ListUtil.foldlMap (fn ((x, xts), sm) =>
+                                                          let
+                                                              val (xts, sm) = ListUtil.foldlMap
+                                                                                  (fn ((x, t), sm) =>
+                                                                                      let
+                                                                                          val (t, sm) = cifyTyp (t, sm)
+                                                                                      in
+                                                                                          ((x, t), sm)
+                                                                                      end) sm xts
+                                                          in
+                                                              ((x, xts), sm)
+                                                          end) sm tables
+
+                val row = exps @ map (fn (x, xts) => (x, (L.TRecord xts, loc))) tables
+                val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row
+
+                val (tableRows, sm) = ListUtil.foldlMap (fn (((x, xts), (_, xts')), sm) =>
+                                                            let
+                                                                val (sm, rnum) = Sm.find (sm, xts, xts')
+                                                            in
+                                                                ((x, rnum), sm)
+                                                            end)
+                                                        sm (ListPair.zip (tables, tables'))
+                val row' = exps' @ map (fn (x, n) => (x, (L'.TRecord n, loc))) tableRows
+                val row' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row'
+
+                val (sm, rnum) = Sm.find (sm, row, row')
+
+                val (state, sm) = cifyTyp (state, sm)
+                val (query, sm) = cifyExp (query, sm)
+                val (body, sm) = cifyExp (body, sm)
+                val (initial, sm) = cifyExp (initial, sm)
+            in
+                ((L'.EQuery {exps = exps', tables = tables', rnum = rnum, state = state,
+                             query = query, body = body, initial = initial, prepared = NONE}, loc), sm)
+            end
+
+          | L.EDml (e, mode) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+            in
+                ((L'.EDml {dml = e, prepared = NONE, mode = mode}, loc), sm)
+            end
+
+          | L.ENextval e =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+            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, b) =>
+            let
+                val (e, sm) = cifyExp (e, sm)
+                val (t, sm) = cifyTyp (t, sm)
+            in
+                ((L'.EUnurlify (e, t, b), loc), sm)
+            end
+
+          | L.EJavaScript _ => fail "Uncompilable JavaScript remains"
+
+          | L.ESignalReturn _ => fail "Signal monad 'return' remains in server-side code"
+          | L.ESignalBind _ => fail "Signal monad 'bind' remains in server-side code"
+          | L.ESignalSource _ => fail "Signal monad 'source' remains in server-side code"
+
+          | L.EServerCall _ => fail "RPC in server-side code"
+          | L.ERecv _ => fail "Message receive in server-side code"
+          | L.ESleep _ => fail "Sleep in server-side code"
+          | L.ESpawn _ => fail "Thread spawn in server-side code"
+    end
+
+fun cifyDecl ((d, loc), sm) =
+    case d of
+        L.DDatatype dts =>
+        let
+            val (dts, sm) = ListUtil.foldlMap
+                                (fn ((x, n, xncs), sm) =>
+                                    let
+                                        val dk = ElabUtil.classifyDatatype xncs
+                                        val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) =>
+                                                                               case to of
+                                                                                   NONE => ((x, n, NONE), sm)
+                                                                                 | SOME t =>
+                                                                                   let
+                                                                                       val (t, sm) = cifyTyp (t, sm)
+                                                                                   in
+                                                                                       ((x, n, SOME t), sm)
+                                                                                   end) sm xncs
+                                    in
+                                        ((dk, x, n, xncs), sm)
+                                    end)
+                                sm dts
+        in
+            (SOME (L'.DDatatype dts, loc), NONE, sm)
+        end
+
+      | L.DVal (x, n, t, e, _) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+
+            val (d, sm) = case #1 t of
+                              L'.TFun _ =>
+                              let
+                                  fun unravel (tAll as (t, _), eAll as (e, _)) =
+                                      case (t, e) of
+                                          (L'.TFun (dom, ran), L.EAbs (ax, _, _, e)) =>
+                                          let
+                                              val (args, t, e) = unravel (ran, e)
+                                          in
+                                              ((ax, dom) :: args, t, e)
+                                          end
+                                        | (L'.TFun (dom, ran), _) =>
+                                          let
+                                              val e = MonoEnv.liftExpInExp 0 eAll
+                                              val e = (L.EApp (e, (L.ERel 0, loc)), loc)
+                                              val (args, t, e) = unravel (ran, e)
+                                          in
+                                              (("x", dom) :: args, t, e)
+                                          end
+                                        | _ => ([], tAll, eAll)
+
+                                  val (args, ran, e) = unravel (t, e)
+                                  val (e, sm) = cifyExp (e, sm)
+                              in
+                                  (L'.DFun (x, n, args, ran, e), sm)
+                              end
+
+                            | _ =>
+                              let
+                                  val (e, sm) = cifyExp (e, sm)
+                              in
+                                  (L'.DVal (x, n, t, e), sm)
+                              end
+        in
+            (SOME (d, loc), NONE, sm)
+        end
+      | L.DValRec vis =>
+        let
+            val (vis, sm) = ListUtil.foldlMap
+                            (fn ((x, n, t, e, _), sm) =>
+                                let
+                                    val (t, sm) = cifyTyp (t, sm)
+
+                                    fun unravel (tAll as (t, _), eAll as (e, _)) =
+                                        case (t, e) of
+                                            (L'.TFun (dom, ran), L.EAbs (ax, _, _, e)) =>
+                                            let
+                                                val (args, t, e) = unravel (ran, e)
+                                            in
+                                                ((ax, dom) :: args, t, e)
+                                            end
+                                          | (L'.TFun _, _) =>
+                                            (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
+                                             ([], tAll, eAll))
+                                          | _ => ([], tAll, eAll)
+
+                                    val (args, ran, e) = unravel (t, e)
+                                    val (e, sm) = cifyExp (e, sm)
+                              in
+                                  ((x, n, args, ran, e), sm)
+                              end)
+                            sm vis
+        in
+            (SOME (L'.DFunRec vis, loc), NONE, sm)
+        end
+
+      | L.DExport (ek, s, n, ts, t, b) =>
+        let
+            val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndPullAndPush, b), sm)
+        end
+
+      | L.DTable (s, xts, pe, ce) =>
+        let
+            val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                  let
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, t), sm)
+                                                  end) sm xts
+
+            fun flatten e =
+                case #1 e of
+                    L.ERecord [] => []
+                  | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)]
+                  | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
+                  | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
+                          Print.prefaces "Undetermined constraint"
+                                         [("e", MonoPrint.p_exp MonoEnv.empty e)];
+                          [])
+
+            val pe = case #1 pe of
+                         L.EPrim (Prim.String (_, s)) => s
+                       | _ => (ErrorMsg.errorAt loc "Primary key has not been fully determined";
+                               Print.prefaces "Undetermined constraint"
+                                              [("e", MonoPrint.p_exp MonoEnv.empty pe)];
+                               "")
+        in
+            (SOME (L'.DTable (s, xts, pe, flatten ce), loc), NONE, sm)
+        end
+      | L.DSequence s =>
+        (SOME (L'.DSequence s, loc), NONE, sm)
+      | L.DView (s, xts, e) =>
+        let
+            val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                  let
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, t), sm)
+                                                  end) sm xts
+
+            fun flatten e =
+                case #1 e of
+                    L.ERecord [] => []
+                  | L.ERecord [(x, (L.EPrim (Prim.String (_, v)), _), _)] => [(x, v)]
+                  | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
+                  | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
+                          Print.prefaces "Undetermined constraint"
+                                         [("e", MonoPrint.p_exp MonoEnv.empty e)];
+                          [])
+
+            val e = case #1 e of
+                        L.EPrim (Prim.String (_, s)) => s
+                      | _ => (ErrorMsg.errorAt loc "VIEW query has not been fully determined";
+                              Print.prefaces "Undetermined VIEW query"
+                                             [("e", MonoPrint.p_exp MonoEnv.empty e)];
+                              "")
+        in
+            (SOME (L'.DView (s, xts, e), loc), NONE, sm)
+        end
+      | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm)
+      | 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.DTask (e1, e2) =>
+        (case #1 e2 of
+             L.EAbs (x1, _, _, (L.EAbs (x2, _, _, e), _)) =>
+             let
+                 val tk = case #1 e1 of
+                              L.EFfi ("Basis", "initialize") => L'.Initialize
+                            | L.EFfi ("Basis", "clientLeaves") => L'.ClientLeaves
+                            | L.EFfiApp ("Basis", "periodic", [((L.EPrim (Prim.Int n), _), _)]) => L'.Periodic n
+                            | _ => (ErrorMsg.errorAt loc "Task kind not fully determined";
+                                    L'.Initialize)
+                 val (e, sm) = cifyExp (e, sm)
+             in
+                 (SOME (L'.DTask (tk, x1, x2, e), loc), NONE, sm)
+             end
+           | _ => (ErrorMsg.errorAt loc "Initializer has not been fully determined";
+                   (NONE, NONE, sm)))
+      | L.DPolicy _ => (NONE, NONE, sm)
+      | L.DOnError n => (SOME (L'.DOnError n, loc), NONE, sm)
+
+fun cjrize (ds, sideInfo) =
+    let
+        val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) =>
+                                          let
+                                              val (dop, pop, sm) = cifyDecl (d, sm)
+
+                                              val dsF = case dop of
+                                                            SOME (L'.DDatatype dts, loc) =>
+                                                            map (fn (dk, x, n, _) =>
+                                                                    (L'.DDatatypeForward (dk, x, n), loc)) dts @ dsF
+                                                          | _ => dsF
+
+                                              val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
+                                                        @ dsF
+
+                                              val (dsF, ds) = case dop of
+                                                                  NONE => (dsF, ds)
+                                                                | SOME (d as (L'.DDatatype _, loc)) =>
+                                                                  (d :: dsF, ds)
+                                                                | SOME d => (dsF, d :: ds)
+
+                                              val ps = case pop of
+                                                           NONE => ps
+                                                         | SOME p => p :: ps
+                                          in
+                                              (dsF, ds, ps, Sm.clearDeclares sm)
+                                          end)
+                                      ([], [], [], Sm.empty) ds
+
+        val sideInfo = foldl (fn ((n, mode, dbmode), mp) => IM.insert (mp, n, (mode, dbmode))) IM.empty sideInfo
+
+        val ps = map (fn (ek, s, n, ts, t, _, b) =>
+                         let
+                             val (side, db) = getOpt (IM.find (sideInfo, n), (L'.ServerOnly, L'.AnyDb))
+                         in
+                             (ek, s, n, ts, t, side, db, b)
+                         end) ps
+    in
+        (List.revAppend (dsF, rev ds),
+         ps)
+    end
+
+end
diff --git a/src/compiler.mlb b/src/compiler.mlb
new file mode 100644
index 0000000..04a5871
--- /dev/null
+++ b/src/compiler.mlb
@@ -0,0 +1,6 @@
+$(SML_LIB)/basis/basis.mlb
+$(SML_LIB)/basis/mlton.mlb
+
+$(BUILD)/urweb.mlb
+
+main.mlton.sml
diff --git a/src/compiler.sig b/src/compiler.sig
new file mode 100644
index 0000000..952c707
--- /dev/null
+++ b/src/compiler.sig
@@ -0,0 +1,213 @@
+(* Copyright (c) 2008-2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Ur/Web main compiler interface *)
+
+signature COMPILER = sig
+
+    type job = {
+         prefix : string,
+         database : string option,
+         sources : string list,
+         exe : string,
+         sql : string option,
+         debug : bool,
+         profile : bool,
+         timeout : int,
+         ffi : string list,
+         link : string list,
+         linker : string option,
+         headers : string list,
+         scripts : string list,
+         clientToServer : Settings.ffi list,
+         effectful : Settings.ffi list,
+         benignEffectful : Settings.ffi list,
+         clientOnly : Settings.ffi list,
+         serverOnly : Settings.ffi list,
+         jsModule : string option,
+         jsFuncs : (Settings.ffi * string) list,
+         rewrites : Settings.rewrite list,
+         filterUrl : Settings.rule list,
+         filterMime : Settings.rule list,
+         filterRequest : Settings.rule list,
+         filterResponse : Settings.rule list,
+         filterEnv : Settings.rule list,
+         filterMeta : Settings.rule list,
+         protocol : string option,
+         dbms : string option,
+         sigFile : string option,
+         safeGets : string list,
+         onError : (string * string list * string) option,
+         minHeap : int
+    }
+    val compile : string -> bool
+    val compiler : string -> unit
+    val compileC : {cname : string, oname : string, ename : string, libs : string,
+                    profile : bool, debug : bool, linker : string option, link : string list} -> bool
+
+    val beforeC : (unit -> unit) ref
+    (* This function is called before beginning C compilation.
+     * The current use is for MLton to compact its heap here, to avoid hogging
+     * space after all the interesting ML code is done. *)
+
+    type ('src, 'dst) phase
+    type ('src, 'dst) transform
+
+    val transform : ('src, 'dst) phase -> string -> ('src, 'dst) transform
+    val o : ('b, 'c) transform * ('a, 'b) transform -> ('a, 'c) transform
+
+    val check : ('src, 'dst) transform -> 'src -> unit
+    val run : ('src, 'dst) transform -> 'src -> 'dst option
+    val runPrint : ('src, 'dst) transform -> 'src -> unit
+    val runPrintToFile : ('src, 'dst) transform -> 'src -> string -> unit
+    val time : ('src, 'dst) transform -> 'src -> unit
+    val timePrint : ('src, 'dst) transform -> 'src -> unit
+
+    val runPrintCoreFuncs : ('src, Core.file) transform -> 'src -> unit
+
+    val parseUr : (string, Source.file) phase
+    val parseUrs : (string, Source.sgn_item list) phase
+    val parseUrp : (string, job) phase
+    val parseUrp' : (string, {Job : job, Libs : string list}) phase
+
+    val parse : (job, Source.file) phase
+    val elaborate : (Source.file, Elab.file) phase
+    val unnest : (Elab.file, Elab.file) phase
+    val termination : (Elab.file, Elab.file) phase
+    val explify : (Elab.file, Expl.file) phase
+    val corify : (Expl.file, Core.file) phase
+    val core_untangle : (Core.file, Core.file) phase
+    val shake : (Core.file, Core.file) phase
+    val rpcify : (Core.file, Core.file) phase
+    val tag : (Core.file, Core.file) phase
+    val reduce : (Core.file, Core.file) phase
+    val unpoly : (Core.file, Core.file) phase
+    val especialize : (Core.file, Core.file) phase
+    val specialize : (Core.file, Core.file) phase
+    val marshalcheck : (Core.file, Core.file) phase
+    val effectize : (Core.file, Core.file) phase
+    val css : (Core.file, Css.report) phase
+    val monoize : (Core.file, Mono.file) phase
+    val mono_opt : (Mono.file, Mono.file) phase
+    val untangle : (Mono.file, Mono.file) phase
+    val mono_reduce : (Mono.file, Mono.file) phase
+    val mono_shake : (Mono.file, Mono.file) phase
+    val iflow : (Mono.file, Mono.file) phase
+    val namejs : (Mono.file, Mono.file) phase
+    val scriptcheck : (Mono.file, Mono.file) phase
+    val jscomp : (Mono.file, Mono.file) phase
+    val fuse : (Mono.file, Mono.file) phase
+    val pathcheck : (Mono.file, Mono.file) phase
+    val sidecheck : (Mono.file, Mono.file) phase
+    val sigcheck : (Mono.file, Mono.file) phase
+    val sqlcache : (Mono.file, Mono.file) phase
+    val cjrize : (Mono.file, Cjr.file) phase
+    val prepare : (Cjr.file, Cjr.file) phase
+    val checknest : (Cjr.file, Cjr.file) phase
+    val sqlify : (Mono.file, Cjr.file) phase
+
+    val toParseJob : (string, job) transform
+    val toParseJob' : (string, {Job : job, Libs : string list}) transform
+    val toParse : (string, Source.file) transform
+    val toElaborate : (string, Elab.file) transform
+    val toUnnest : (string, Elab.file) transform
+    val toTermination : (string, Elab.file) transform
+    val toExplify : (string, Expl.file) transform
+    val toCorify : (string, Core.file) transform
+    val toCore_untangle : (string, Core.file) transform
+    val toShake1 : (string, Core.file) transform
+    val toEspecialize1' : (string, Core.file) transform
+    val toShake1' : (string, Core.file) transform
+    val toRpcify : (string, Core.file) transform
+    val toCore_untangle2 : (string, Core.file) transform
+    val toShake2 : (string, Core.file) transform
+    val toEspecialize1 : (string, Core.file) transform
+    val toCore_untangle3 : (string, Core.file) transform
+    val toShake3 : (string, Core.file) transform
+    val toTag : (string, Core.file) transform
+    val toReduce : (string, Core.file) transform
+    val toShakey : (string, Core.file) transform
+    val toUnpoly : (string, Core.file) transform
+    val toSpecialize : (string, Core.file) transform
+    val toShake4 : (string, Core.file) transform
+    val toEspecialize2 : (string, Core.file) transform
+    val toShake4' : (string, Core.file) transform
+    val toSpecialize2 : (string, Core.file) transform
+    val toUnpoly2 : (string, Core.file) transform
+    val toShake4'' : (string, Core.file) transform
+    val toEspecialize3 : (string, Core.file) transform
+    val toReduce2 : (string, Core.file) transform
+    val toShake5 : (string, Core.file) transform
+    val toMarshalcheck : (string, Core.file) transform
+    val toEffectize : (string, Core.file) transform
+    val toCss : (string, Css.report) transform
+    val toMonoize : (string, Mono.file) transform
+    val toMono_opt1 : (string, Mono.file) transform
+    val toUntangle : (string, Mono.file) transform
+    val toMono_reduce : (string, Mono.file) transform
+    val toMono_shake : (string, Mono.file) transform
+    val toMono_opt2 : (string, Mono.file) transform
+    val toIflow : (string, Mono.file) transform
+    val toNamejs : (string, Mono.file) transform
+    val toNamejs_untangle : (string, Mono.file) transform
+    val toScriptcheck : (string, Mono.file) transform
+    val toDbmodecheck : (string, Mono.file) transform
+    val toJscomp : (string, Mono.file) transform
+    val toMono_opt3 : (string, Mono.file) transform
+    val toFuse : (string, Mono.file) transform
+    val toUntangle2 : (string, Mono.file) transform
+    val toMono_reduce2 : (string, Mono.file) transform
+    val toMono_shake2 : (string, Mono.file) transform
+    val toMono_opt4 : (string, Mono.file) transform
+    val toMono_reduce3 : (string, Mono.file) transform
+    val toFuse2 : (string, Mono.file) transform
+    val toUntangle3 : (string, Mono.file) transform
+    val toMono_shake3 : (string, Mono.file) transform
+    val toPathcheck : (string, Mono.file) transform
+    val toSidecheck : (string, Mono.file) transform
+    val toSigcheck : (string, Mono.file) transform
+    val toSqlcache : (string, Mono.file) transform
+    val toCjrize : (string, Cjr.file) transform
+    val toPrepare : (string, Cjr.file) transform
+    val toChecknest : (string, Cjr.file) transform
+    val toSqlify : (string, Cjr.file) transform
+
+    val debug : bool ref
+    val dumpSource : bool ref
+    val enableBoot : unit -> unit
+
+    val doIflow : bool ref
+
+    val addPath : string * string -> unit
+    val addModuleRoot : string * string -> unit
+
+    val moduleOf : string -> string
+
+    val setStop : string -> unit
+    (* Stop compilation after this phase. *)
+
+end
diff --git a/src/compiler.sml b/src/compiler.sml
new file mode 100644
index 0000000..c13de30
--- /dev/null
+++ b/src/compiler.sml
@@ -0,0 +1,1716 @@
+(* Copyright (c) 2008-2012, 2014, 2016, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Compiler :> COMPILER = struct
+
+structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
+structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens)
+structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData
+                         structure Lex = Lex
+                         structure LrParser = LrParser)
+
+type job = {
+     prefix : string,
+     database : string option,
+     sources : string list,
+     exe : string,
+     sql : string option,
+     debug : bool,
+     profile : bool,
+     timeout : int,
+     ffi : string list,
+     link : string list,
+     linker : string option,
+     headers : string list,
+     scripts : string list,
+     clientToServer : Settings.ffi list,
+     effectful : Settings.ffi list,
+     benignEffectful : Settings.ffi list,
+     clientOnly : Settings.ffi list,
+     serverOnly : Settings.ffi list,
+     jsModule : string option,
+     jsFuncs : (Settings.ffi * string) list,
+     rewrites : Settings.rewrite list,
+     filterUrl : Settings.rule list,
+     filterMime : Settings.rule list,
+     filterRequest : Settings.rule list,
+     filterResponse : Settings.rule list,
+     filterEnv : Settings.rule list,
+     filterMeta : Settings.rule list,
+     protocol : string option,
+     dbms : string option,
+     sigFile : string option,
+     safeGets : string list,
+     onError : (string * string list * string) option,
+     minHeap : int
+}
+
+type ('src, 'dst) phase = {
+     func : 'src -> 'dst,
+     print : 'dst -> Print.PD.pp_desc
+}
+
+type pmap = (string * Time.time) list
+
+type ('src, 'dst) transform = {
+     func : 'src -> 'dst option,
+     print : 'dst -> Print.PD.pp_desc,
+     time : 'src * pmap -> 'dst option * pmap
+}
+
+val debug = ref false
+val dumpSource = ref false
+val doIflow = ref false
+
+val doDumpSource = ref (fn () => ())
+
+val stop = ref (NONE : string option)
+fun setStop s = stop := SOME s
+
+fun transform (ph : ('src, 'dst) phase) name = {
+    func = fn input => let
+                  val () = if !debug then
+                               print ("Starting " ^ name ^ "....\n")
+                           else
+                               ()
+                  val v = #func ph input
+              in
+                  if !debug then
+                      print ("Finished " ^ name ^ ".\n")
+                  else
+                      ();
+                  if ErrorMsg.anyErrors () then
+                      (!doDumpSource ();
+                       doDumpSource := (fn () => ());
+                       NONE)
+                  else if !stop = SOME name then
+                      (Print.eprint (#print ph v);
+                       ErrorMsg.error ("Stopped compilation after phase " ^ name);
+                       NONE)
+                  else
+                      (if !dumpSource then
+                           doDumpSource := (fn () => Print.eprint (#print ph v))
+                       else
+                           ();
+                       SOME v)
+              end,
+    print = #print ph,
+    time = fn (input, pmap) => let
+                  val () = if !debug then
+                               print ("Starting " ^ name ^ "....\n")
+                           else
+                               ()
+                  val befor = Time.now ()
+                  val v = #func ph input
+                  val elapsed = Time.- (Time.now (), befor)
+              in
+                  if !debug then
+                      print ("Finished " ^ name ^ ".\n")
+                  else
+                      ();
+                  (if ErrorMsg.anyErrors () then
+                       NONE
+                   else
+                       SOME v,
+                   (name, elapsed) :: pmap)
+              end
+}
+
+fun check (tr : ('src, 'dst) transform) x = (ErrorMsg.resetErrors ();
+                                             ignore (#func tr x))
+
+fun run (tr : ('src, 'dst) transform) x = (ErrorMsg.resetErrors ();
+                                           #func tr x)
+
+fun runPrint (tr : ('src, 'dst) transform) input =
+    (ErrorMsg.resetErrors ();
+     case #func tr input of
+         NONE => print "Failure\n"
+       | SOME v =>
+         (print "Success\n";
+          Print.print (#print tr v);
+          print "\n"))
+
+fun runPrintToFile (tr : ('src, 'dst) transform) input fname =
+    (ErrorMsg.resetErrors ();
+     case #func tr input of
+         NONE => print "Failure\n"
+       | SOME v =>
+         let
+             val outf = TextIO.openOut fname
+             val str = Print.openOut {dst = outf, wid = 80}
+         in
+             print "Success\n";
+             Print.fprint str (#print tr v);
+             Print.PD.PPS.closeStream str;
+             TextIO.closeOut outf
+         end)
+
+fun time (tr : ('src, 'dst) transform) input =
+    let
+        val (_, pmap) = #time tr (input, [])
+    in
+        app (fn (name, time) =>
+                print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
+        print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
+        print "\n"
+    end
+
+fun timePrint (tr : ('src, 'dst) transform) input =
+    let
+        val (ro, pmap) = #time tr (input, [])
+    in
+        app (fn (name, time) =>
+                print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
+        print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
+        print "\n";
+        case ro of
+            NONE => print "Failure\n"
+          | SOME v =>
+            (print "Success\n";
+             Print.print (#print tr v);
+             print "\n")
+    end
+
+fun runPrintCoreFuncs (tr : ('src, Core.file) transform) input =
+    (ErrorMsg.resetErrors ();
+     case #func tr input of
+         NONE => print "Failure\n"
+       | SOME file =>
+         (print "Success\n";
+          app (fn (d, _) =>
+                  case d of
+                      Core.DVal (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t)
+                    | Core.DValRec xts => app (fn (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t)) xts
+                    | _ => ()) file))
+
+val parseUrs =
+    {func = fn filename => let
+                   val fname = OS.FileSys.tmpName ()
+                   val outf = TextIO.openOut fname
+                   val () = TextIO.output (outf, "sig\n")
+                   val inf = FileIO.txtOpenIn filename
+                   fun loop () =
+                       case TextIO.inputLine inf of
+                           NONE => ()
+                         | SOME line => (TextIO.output (outf, line);
+                                         loop ())
+                   val () = loop ()
+                   val () = TextIO.closeIn inf
+                   val () = TextIO.closeOut outf
+
+                   val () = (ErrorMsg.resetErrors ();
+                             ErrorMsg.resetPositioning filename;
+                             Lex.UserDeclarations.initialize ())
+	           val file = FileIO.txtOpenIn fname
+	           fun get _ = TextIO.input file
+	           fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
+	           val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+	           val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
+               in
+                   TextIO.closeIn file;
+                   case absyn of
+                       [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis
+                     | _ => (ErrorMsg.errorAt {file = filename,
+                                               first = {line = 0,
+                                                        char = 0},
+                                               last = {line = 0,
+                                                       char = 0}} "Not a signature";
+                             [])
+               end
+               handle LrParser.ParseError => [],
+     print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
+
+(* The main parsing routine *)
+val parseUr = {
+    func = fn filename =>
+              let
+                  val () = (ErrorMsg.resetErrors ();
+                            ErrorMsg.resetPositioning filename;
+                            Lex.UserDeclarations.initialize ())
+	          val file = FileIO.txtOpenIn filename
+	          fun get _ = TextIO.input file
+	          fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
+	          val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+	          val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
+              in
+                  TextIO.closeIn file;
+                  case absyn of
+                      [(Source.DSgn ("?", _), _)] =>
+                      (ErrorMsg.errorAt {file = filename,
+                                         first = {line = 0,
+                                                  char = 0},
+                                         last = {line = 0,
+                                                 char = 0}} "File starts with 'sig'";
+                       [])
+                    | _ => absyn
+              end
+              handle LrParser.ParseError => [],
+     print = SourcePrint.p_file}
+
+fun p_job ({prefix, database, exe, sql, sources, debug, profile,
+            timeout, ffi, link, headers, scripts,
+            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsModule, jsFuncs, ...} : job) =
+    let
+        open Print.PD
+        open Print
+
+        fun p_ffi name = p_list_sep (box []) (fn (m, s) =>
+                                                 box [string name, space, string m, string ".", string s, newline])
+    in
+        box [if debug then
+                 box [string "DEBUG", newline]
+             else
+                 box [],
+             if profile then
+                 box [string "PROFILE", newline]
+             else
+                 box [],
+             case database of
+                 NONE => string "No database."
+               | SOME db => string ("Database: " ^ db),
+             newline,
+             string "Exe: ",
+             string exe,
+             newline,
+             case sql of
+                 NONE => string "No SQL file."
+               | SOME sql => string ("SQL fle: " ^ sql),
+             newline,
+             string "Timeout: ",
+             string (Int.toString timeout),
+             newline,
+             p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi,
+             p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers,
+             p_list_sep (box []) (fn s => box [string "Script", space, string s, newline]) scripts,
+             p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link,
+             p_ffi "ClientToServer" clientToServer,
+             p_ffi "Effectful" effectful,
+             p_ffi "BenignEffectful" benignEffectful,
+             p_ffi "ClientOnly" clientOnly,
+             p_ffi "ServerOnly" serverOnly,
+             case jsModule of
+                 NONE => string "No JavaScript FFI module"
+               | SOME m => string ("JavaScript FFI module: " ^ m),
+             p_list_sep (box []) (fn ((m, s), s') =>
+                                     box [string "JsFunc", space, string m, string ".", string s,
+                                          space, string "=", space, string s', newline]) jsFuncs,
+             string "Sources:",
+             p_list string sources,
+             newline]
+    end
+
+fun trim s =
+    let
+        val (_, s) = Substring.splitl Char.isSpace s
+        val (s, _) = Substring.splitr Char.isSpace s
+    in
+        s
+    end
+
+val trimS = Substring.string o trim o Substring.full
+
+structure M = BinaryMapFn(struct
+                          type ord_key = string
+                          val compare = String.compare
+                          end)
+
+(* XXX ezyang: pathmap gets initialized /really early/, before
+ * we do any options parsing.  So libUr will always point to the
+ * default. We override it explicitly in enableBoot *)
+val pathmap = ref (M.insert (M.empty, "", Settings.libUr ()))
+
+fun addPath (k, v) = pathmap := M.insert (!pathmap, k, v)
+
+(* XXX ezyang: this is not right; it probably doesn't work in
+ * the case of separate build and src trees *)
+fun enableBoot () =
+ (Settings.configBin := OS.Path.joinDirFile {dir = Config.builddir, file = "bin"};
+  Settings.configSrcLib := OS.Path.joinDirFile {dir = Config.builddir, file = "lib"};
+  (* joinDirFile is annoying... (ArcError; it doesn't like
+   * slashes in file) *)
+  Settings.configLib := Config.builddir ^ "/src/c/.libs";
+  Settings.configInclude := OS.Path.joinDirFile {dir = Config.builddir ^ "/include", file = "urweb"};
+  Settings.configSitelisp := Config.builddir ^ "/src/elisp";
+  addPath ("", Settings.libUr ()))
+
+fun capitalize "" = ""
+  | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+fun institutionalizeJob (job : job) =
+    (Settings.setDebug (#debug job);
+     Settings.setUrlPrefix (#prefix job);
+     Settings.setTimeout (#timeout job);
+     Settings.setHeaders (#headers job);
+     Settings.setScripts (#scripts job);
+     Settings.setClientToServer (#clientToServer job);
+     Settings.setEffectful (#effectful job);
+     Settings.setBenignEffectful (#benignEffectful job);
+     Settings.setClientOnly (#clientOnly job);
+     Settings.setServerOnly (#serverOnly job);
+     Settings.setJsModule (#jsModule job);
+     Settings.setJsFuncs (#jsFuncs job);
+     Settings.setRewriteRules (#rewrites job);
+     Settings.setUrlRules (#filterUrl job);
+     Settings.setMimeRules (#filterMime job);
+     Settings.setRequestHeaderRules (#filterRequest job);
+     Settings.setResponseHeaderRules (#filterResponse job);
+     Settings.setEnvVarRules (#filterEnv job);
+     Settings.setMetaRules (#filterMeta job);
+     Option.app Settings.setProtocol (#protocol job);
+     Option.app Settings.setDbms (#dbms job);
+     Settings.setSafeGets (#safeGets job);
+     Settings.setOnError (#onError job);
+     Settings.setMinHeap (#minHeap job);
+     Settings.setSigFile (#sigFile job))
+
+datatype commentableLine =
+         EndOfFile
+       | OnlyComment
+       | Content of string
+
+fun inputCommentableLine inf =
+    case TextIO.inputLine inf of
+        NONE => EndOfFile
+      | SOME s =>
+        let
+            val (befor, after) = Substring.splitl (fn ch => ch <> #"#") (Substring.full s)
+        in
+            if not (Substring.isEmpty after)
+               andalso Substring.foldl (fn (ch, b) => b andalso Char.isSpace ch) true befor then
+                OnlyComment
+            else
+                let
+                    val s = #1 (Substring.splitr (not o Char.isSpace) befor)
+                in
+                    Content (Substring.string (if Substring.size s > 0 andalso Char.isSpace (Substring.sub (s, Substring.size s - 1)) then
+                                                   if Substring.size s > 1 andalso Char.isSpace (Substring.sub (s, Substring.size s - 2)) then
+                                                       Substring.trimr 2 s
+                                                   else
+                                                       Substring.trimr 1 s
+                                               else
+                                                   s))
+                end
+        end
+
+val lastUrp = ref ""
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+
+fun parseUrp' accLibs fname =
+    (lastUrp := fname;
+     if not (Posix.FileSys.access (fname ^ ".urp", []) orelse Posix.FileSys.access (fname ^ "/lib.urp", []))
+        andalso Posix.FileSys.access (fname ^ ".ur", []) then
+         let
+             val job = {prefix = "/",
+                        database = NONE,
+                        sources = [fname],
+                        exe = fname ^ ".exe",
+                        sql = NONE,
+                        debug = Settings.getDebug (),
+                        profile = false,
+                        timeout = 120,
+                        ffi = [],
+                        link = [],
+                        linker = NONE,
+                        headers = [],
+                        scripts = [],
+                        clientToServer = [],
+                        effectful = [],
+                        benignEffectful = [],
+                        clientOnly = [],
+                        serverOnly = [],
+                        jsModule = NONE,
+                        jsFuncs = [],
+                        rewrites = [{pkind = Settings.Any,
+                                     kind = Settings.Prefix,
+                                     from = capitalize (OS.Path.file fname) ^ "/", to = "",
+                                     hyphenate = false}],
+                        filterUrl = [],
+                        filterMime = [],
+                        filterRequest = [],
+                        filterResponse = [],
+                        filterEnv = [],
+                        filterMeta = [],
+                        protocol = NONE,
+                        dbms = NONE,
+                        sigFile = NONE,
+                        safeGets = [],
+                        onError = NONE,
+                        minHeap = 0}
+         in
+             institutionalizeJob job;
+             {Job = job, Libs = []}
+         end
+     else
+         let
+             val pathmap = ref (!pathmap)
+             val bigLibs = ref []
+             val libSet = ref SS.empty
+
+             fun pu filename =
+                 let
+                     val filename = OS.Path.mkAbsolute {path = filename, relativeTo = OS.FileSys.getDir ()}
+                     val thisPath = OS.Path.dir filename
+
+                     val dir = OS.Path.dir filename
+                     fun opener () = FileIO.txtOpenIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+
+                     val inf = opener ()
+
+                     fun hasSpaceLine () =
+                         case inputCommentableLine inf of
+                             Content s => s = "debug" orelse s = "profile"
+                                          orelse s = "html5" orelse s = "xhtml"
+                                          orelse s = "noMangleSql" orelse s = "lessSafeFfi"
+                                          orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
+                           | EndOfFile => false
+                           | OnlyComment => hasSpaceLine ()
+
+                     val hasBlankLine = hasSpaceLine ()
+
+                     val inf = (TextIO.closeIn inf; opener ())
+
+                     fun pathify fname =
+                         if size fname > 0 andalso String.sub (fname, 0) = #"$" then
+                             let
+                                 val fname' = Substring.extract (fname, 1, NONE)
+                                 val (befor, after) = Substring.splitl (fn ch => ch <> #"/") fname'
+                             in
+                                 case M.find (!pathmap, Substring.string befor) of
+                                     NONE => fname
+                                   | SOME rep => rep ^ Substring.string after
+                             end
+                         else
+                             fname
+
+                     fun relify fname =
+                         let
+                             val fname = pathify fname
+                         in
+                             OS.Path.concat (dir, fname)
+                             handle OS.Path.Path => fname
+                         end
+
+                     fun libify path =
+                         (if Posix.FileSys.access (path ^ ".urp", []) then
+                              path
+                          else
+                              path ^ "/lib")
+                         handle SysErr => path
+
+                     fun libify' path =
+                         (if Posix.FileSys.access (relify path ^ ".urp", []) then
+                              path
+                          else
+                              path ^ "/lib")
+                         handle SysErr => path
+
+                     val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
+
+                     fun relifyA fname =
+                         OS.Path.mkAbsolute {path = pathify fname, relativeTo = absDir}
+
+                     fun readSources acc =
+                         case inputCommentableLine inf of
+                             Content line =>
+                             let
+                                 val acc = if CharVector.all Char.isSpace line then
+                                               acc
+                                           else
+                                               let
+                                                   fun trim s =
+                                                       let
+                                                           val s = Substring.full s
+                                                           val (_, s) = Substring.splitl Char.isSpace s
+                                                           val (s, _) = Substring.splitr Char.isSpace s
+                                                       in
+                                                           Substring.string s
+                                                       end
+
+                                                   val fname = relifyA (trim line)
+                                               in
+                                                   fname :: acc
+                                               end
+                             in
+                                 readSources acc
+                             end
+                           | OnlyComment => readSources acc
+                           | EndOfFile => rev acc
+
+                     val prefix = ref (case Settings.getUrlPrefixFull () of "/" => NONE | s => SOME s)
+                     val database = ref (Settings.getDbstring ())
+                     val exe = ref (Settings.getExe ())
+                     val sql = ref (Settings.getSql ())
+                     val debug = ref (Settings.getDebug ())
+                     val profile = ref false
+                     val timeout = ref NONE
+                     val ffi = ref []
+                     val link = ref []
+                     val linker = ref NONE
+                     val headers = ref []
+                     val scripts = ref []
+                     val clientToServer = ref []
+                     val effectful = ref []
+                     val benignEffectful = ref []
+                     val clientOnly = ref []
+                     val serverOnly = ref []
+                     val jsModule = ref NONE
+                     val jsFuncs = ref []
+                     val rewrites = ref []
+                     val url = ref []
+                     val mime = ref []
+                     val request = ref []
+                     val response = ref []
+                     val env = ref []
+                     val meta = ref []
+                     val libs = ref []
+                     val protocol = ref NONE
+                     val dbms = ref NONE
+                     val sigFile = ref (Settings.getSigFile ())
+                     val safeGets = ref []
+                     val onError = ref NONE
+                     val minHeap = ref 0
+
+                     fun finish sources =
+                         let
+                             val job = {
+                                 prefix = Option.getOpt (!prefix, "/"),
+                                 database = !database,
+                                 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
+                                                                                 ext = SOME "exe"}),
+                                 sql = !sql,
+                                 debug = !debug,
+                                 profile = !profile,
+                                 timeout = Option.getOpt (!timeout, 60),
+                                 ffi = rev (!ffi),
+                                 link = rev (!link),
+                                 linker = !linker,
+                                 headers = rev (!headers),
+                                 scripts = rev (!scripts),
+                                 clientToServer = rev (!clientToServer),
+                                 effectful = rev (!effectful),
+                                 benignEffectful = rev (!benignEffectful),
+                                 clientOnly = rev (!clientOnly),
+                                 serverOnly = rev (!serverOnly),
+                                 jsModule = !jsModule,
+                                 jsFuncs = rev (!jsFuncs),
+                                 rewrites = rev (!rewrites),
+                                 filterUrl = rev (!url),
+                                 filterMime = rev (!mime),
+                                 filterRequest = rev (!request),
+                                 filterResponse = rev (!response),
+                                 filterEnv = rev (!env),
+                                 filterMeta = rev (!meta),
+                                 sources = sources,
+                                 protocol = !protocol,
+                                 dbms = !dbms,
+                                 sigFile = !sigFile,
+                                 safeGets = rev (!safeGets),
+                                 onError = !onError,
+                                 minHeap = !minHeap
+                             }
+
+                             fun mergeO f (old, new) =
+                                 case (old, new) of
+                                     (NONE, _) => new
+                                   | (_, NONE) => old
+                                   | (SOME v1, SOME v2) => SOME (f (v1, v2))
+
+                             fun same desc = mergeO (fn (x : string, y) =>
+                                                        (if x = y then
+                                                             ()
+                                                         else
+                                                             ErrorMsg.error ("Multiple "
+                                                                             ^ desc ^ " values that don't agree");
+                                                         x))
+
+                             fun merge (old : job, new : job) = {
+                                 prefix = case #prefix old of
+                                              "/" => #prefix new
+                                            | pold => case #prefix new of
+                                                          "/" => pold
+                                                        | pnew => (if pold = pnew then
+                                                                       ()
+                                                                   else
+                                                                       ErrorMsg.error ("Multiple prefix values that don't agree: "
+                                                                                       ^ pold ^ ", " ^ pnew);
+                                                                   pold),
+                                 database = mergeO (fn (old, _) => old) (#database old, #database new),
+                                 exe = #exe old,
+                                 sql = #sql old,
+                                 debug = #debug old orelse #debug new,
+                                 profile = #profile old orelse #profile new,
+                                 timeout = #timeout old,
+                                 ffi = #ffi old @ #ffi new,
+                                 link = #link old @ #link new,
+                                 linker = mergeO (fn (_, new) => new) (#linker old, #linker new),
+                                 headers = #headers old @ #headers new,
+                                 scripts = #scripts old @ #scripts new,
+                                 clientToServer = #clientToServer old @ #clientToServer new,
+                                 effectful = #effectful old @ #effectful new,
+                                 benignEffectful = #benignEffectful old @ #benignEffectful new,
+                                 clientOnly = #clientOnly old @ #clientOnly new,
+                                 serverOnly = #serverOnly old @ #serverOnly new,
+                                 jsModule = #jsModule old,
+                                 jsFuncs = #jsFuncs old @ #jsFuncs new,
+                                 rewrites = #rewrites old @ #rewrites new,
+                                 filterUrl = #filterUrl old @ #filterUrl new,
+                                 filterMime = #filterMime old @ #filterMime new,
+                                 filterRequest = #filterRequest old @ #filterRequest new,
+                                 filterResponse = #filterResponse old @ #filterResponse new,
+                                 filterEnv = #filterEnv old @ #filterEnv new,
+                                 filterMeta = #filterMeta old @ #filterMeta new,
+                                 sources = #sources new
+                                           @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
+                                                         (#sources old),
+                                 protocol = mergeO #2 (#protocol old, #protocol new),
+                                 dbms = mergeO #2 (#dbms old, #dbms new),
+                                 sigFile = mergeO #2 (#sigFile old, #sigFile new),
+                                 safeGets = #safeGets old @ #safeGets new,
+                                 onError = mergeO #2 (#onError old, #onError new),
+                                 minHeap = Int.max (#minHeap old, #minHeap new)
+                             }
+                         in
+                             if accLibs then
+                                 foldl (fn (job', job) => merge (job, job')) job (!libs)
+                             else
+                                 job
+                         end
+
+                     fun parsePkind s =
+                         case s of
+                             "all" => Settings.Any
+                           | "url" => Settings.Url
+                           | "table" => Settings.Table
+                           | "sequence" => Settings.Sequence
+                           | "view" => Settings.View
+                           | "relation" => Settings.Relation
+                           | "cookie" => Settings.Cookie
+                           | "style" => Settings.Style
+                           | _ => (ErrorMsg.error "Bad path kind spec";
+                                   Settings.Any)
+
+                     fun parsePattern s =
+                         if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
+                             (Settings.Prefix, String.substring (s, 0, size s - 1))
+                         else
+                             (Settings.Exact, s)
+
+                     fun parseFkind s =
+                         case s of
+                             "url" => url
+                           | "mime" => mime
+                           | "requestHeader" => request
+                           | "responseHeader" => response
+                           | "env" => env
+                           | "meta" => meta
+                           | _ => (ErrorMsg.error "Bad filter kind";
+                                   url)
+
+                     fun read () =
+                         case inputCommentableLine inf of
+                             EndOfFile => finish []
+                           | OnlyComment => read ()
+                           | Content "" => finish (readSources [])
+                           | Content line =>
+                             let
+                                 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
+                                 val cmd = Substring.string (trim cmd)
+                                 val arg = Substring.string (trim arg)
+
+                                 fun ffiS () =
+                                     case String.fields (fn ch => ch = #".") arg of
+                                         [m, x] => (m, x)
+                                       | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
+                                               ("", ""))
+
+                                 fun ffiM () =
+                                     case String.fields (fn ch => ch = #"=") arg of
+                                         [f, s] =>
+                                         let
+                                             val f = trimS f
+                                             val s = trimS s
+                                         in
+                                             case String.fields (fn ch => ch = #".") f of
+                                                 [m, x] => ((m, x), s)
+                                               | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                                       (("", ""), ""))
+                                         end
+                                       | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                               (("", ""), ""))
+                             in
+                                 case cmd of
+                                     "prefix" => prefix := SOME arg
+                                   | "database" =>
+                                     (case !database of
+                                          NONE => database := SOME arg
+                                        | SOME _ => ())
+                                   | "dbms" =>
+                                     (case !dbms of
+                                          NONE => dbms := SOME arg
+                                        | SOME _ => ())
+                                   | "sigfile" =>
+                                     (case !sigFile of
+                                          NONE => sigFile := SOME arg
+                                        | SOME _ => ())
+                                   | "exe" =>
+                                     (case !exe of
+                                          NONE => exe := SOME (relify arg)
+                                        | SOME _ => ())
+                                   | "sql" =>
+                                     (case !sql of
+                                          NONE => sql := SOME (relify arg)
+                                        | SOME _ => ())
+                                   | "debug" => debug := true
+                                   | "profile" => profile := true
+                                   | "timeout" =>
+                                     (case !timeout of
+                                          NONE => ()
+                                        | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
+                                      timeout := SOME (valOf (Int.fromString arg)))
+                                   | "ffi" => ffi := relify arg :: !ffi
+                                   | "link" => let
+                                         val arg = if size arg >= 1
+                                                      andalso String.sub (arg, 0) = #"-" then
+                                                       arg
+                                                   else
+                                                       relifyA arg
+                                     in
+                                         link := arg :: !link
+                                     end
+                                   | "linker" => linker := SOME arg
+                                   | "include" => headers := relifyA arg :: !headers
+                                   | "script" => scripts := arg :: !scripts
+                                   | "clientToServer" => clientToServer := ffiS () :: !clientToServer
+                                   | "safeGet" => safeGets := arg :: !safeGets
+                                   | "effectful" => effectful := ffiS () :: !effectful
+                                   | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
+                                   | "clientOnly" => clientOnly := ffiS () :: !clientOnly
+                                   | "serverOnly" => serverOnly := ffiS () :: !serverOnly
+                                   | "jsModule" =>
+                                     (case !jsModule of
+                                          NONE => jsModule := SOME arg
+                                        | SOME _ => ())
+                                   | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
+                                   | "rewrite" =>
+                                     let
+                                         fun doit (pkind, from, to, hyph) =
+                                             let
+                                                 val pkind = parsePkind pkind
+                                                 val (kind, from) = parsePattern from
+                                             in
+                                                 rewrites := {pkind = pkind, kind = kind, from = from, to = to, hyphenate = hyph} :: !rewrites
+                                             end
+                                     in
+                                         case String.tokens Char.isSpace arg of
+                                             [pkind, from, to, "[-]"] => doit (pkind, from, to, true)
+                                           | [pkind, from, "[-]"] => doit (pkind, from, "", true)
+                                           | [pkind, from, to] => doit (pkind, from, to, false)
+                                           | [pkind, from] => doit (pkind, from, "", false)
+                                           | _ => ErrorMsg.error "Bad 'rewrite' syntax"
+                                     end
+                                   | "allow" =>
+                                     (case String.tokens Char.isSpace arg of
+                                          [fkind, pattern] =>
+                                          let
+                                              val fkind = parseFkind fkind
+                                              val (kind, pattern) = parsePattern pattern
+                                          in
+                                              fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
+                                          end
+                                        | _ => ErrorMsg.error "Bad 'allow' syntax")
+                                   | "deny" =>
+                                     (case String.tokens Char.isSpace arg of
+                                          [fkind, pattern] =>
+                                          let
+                                              val fkind = parseFkind fkind
+                                              val (kind, pattern) = parsePattern pattern
+                                          in
+                                              fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
+                                          end
+                                        | _ => ErrorMsg.error "Bad 'deny' syntax")
+                                   | "library" =>
+                                     if accLibs then
+                                         let
+                                             val arg = libify (relify arg)
+                                         in
+                                             if SS.member (!libSet, arg) then
+                                                 ()
+                                             else
+                                                 (libs := pu arg :: !libs;
+                                                  libSet := SS.add (!libSet, arg))
+                                         end
+                                     else
+                                         bigLibs := libify' arg :: !bigLibs
+                                   | "path" =>
+                                     (case String.fields (fn ch => ch = #"=") arg of
+                                          [n, v] => ((pathmap := M.insert (!pathmap, n, OS.Path.mkAbsolute {path = v, relativeTo = dir}))
+                                                     handle OS.Path.Path => ErrorMsg.error "Invalid 'path' directory argument")
+                                        | _ => ErrorMsg.error "path argument not of the form name=value'")
+                                   | "onError" =>
+                                     (case String.fields (fn ch => ch = #".") arg of
+                                          m1 :: (fs as _ :: _) =>
+                                          onError := SOME (m1, List.take (fs, length fs - 1), List.last fs)
+                                        | _ => ErrorMsg.error "invalid 'onError' argument")
+                                   | "limit" =>
+                                     (case String.fields Char.isSpace arg of
+                                          [class, num] =>
+                                          (case Int.fromString num of
+                                               NONE => ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
+                                             | SOME n =>
+                                               if n < 0 then
+                                                   ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
+                                               else
+                                                   Settings.addLimit (class, n))
+                                        | _ => ErrorMsg.error "invalid 'limit' arguments")
+                                   | "minHeap" =>
+                                     (case Int.fromString arg of
+                                          NONE => ErrorMsg.error ("invalid min heap '" ^ arg ^ "'")
+                                        | SOME n => minHeap := n)
+                                   | "coreInline" =>
+                                     (case Int.fromString arg of
+                                          NONE => ErrorMsg.error ("invalid core inline level '" ^ arg ^ "'")
+                                        | SOME n => Settings.setCoreInline n)
+                                   | "monoInline" =>
+                                     (case Int.fromString arg of
+                                          NONE => ErrorMsg.error ("invalid mono inline level '" ^ arg ^ "'")
+                                        | SOME n => Settings.setMonoInline n)
+                                   | "alwaysInline" => Settings.addAlwaysInline arg
+                                   | "neverInline" => Settings.addNeverInline arg
+                                   | "noXsrfProtection" => Settings.addNoXsrfProtection arg
+                                   | "timeFormat" => Settings.setTimeFormat arg
+                                   | "noMangleSql" => Settings.setMangleSql false
+                                   | "html5" => Settings.setIsHtml5 true
+                                   | "xhtml" => Settings.setIsHtml5 false
+                                   | "lessSafeFfi" => Settings.setLessSafeFfi true
+
+                                   | "file" =>
+                                     (case String.fields Char.isSpace arg of
+                                          [uri, fname] => (Settings.setFilePath thisPath;
+                                                           Settings.addFile {Uri = uri,
+                                                                             LoadFromFilename = fname};
+                                                           url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url)
+                                        | _ => ErrorMsg.error "Bad 'file' arguments")
+
+                                   | "jsFile" =>
+                                     (Settings.setFilePath thisPath;
+                                      Settings.addJsFile arg)
+
+                                   | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
+                                 read ()
+                             end
+
+                     val job = if hasBlankLine then
+                                   read ()
+                               else
+                                   finish (readSources [])
+                 in
+                     TextIO.closeIn inf;
+                     institutionalizeJob job;
+                     job
+                 end
+         in
+             {Job = pu fname, Libs = !bigLibs}
+         end)
+
+fun p_job' {Job = j, Libs = _ : string list} = p_job j
+
+val parseUrp = {
+    func = #Job o parseUrp' true,
+    print = p_job
+}
+
+val parseUrp' = {
+    func = parseUrp' false,
+    print = p_job'
+}
+
+val toParseJob = transform parseUrp "parseJob"
+val toParseJob' = transform parseUrp' "parseJob'"
+
+fun op o (tr2 : ('b, 'c) transform, tr1 : ('a, 'b) transform) = {
+    func = fn input => case #func tr1 input of
+                           NONE => NONE
+                         | SOME v => #func tr2 v,
+    print = #print tr2,
+    time = fn (input, pmap) => let
+                  val (ro, pmap) = #time tr1 (input, pmap)
+              in
+                  case ro of
+                      NONE => (NONE, pmap)
+                    | SOME v => #time tr2 (v, pmap)
+              end
+}
+
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val moduleRoots = ref ([] : (string * string) list)
+fun addModuleRoot (k, v) = moduleRoots :=
+                           (OS.Path.mkAbsolute {path = k,
+                                                relativeTo = OS.FileSys.getDir ()},
+                            v) :: !moduleRoots
+
+exception MissingFile of string
+
+val parse = {
+    func = fn {database, sources = fnames, ffi, onError, ...} : job =>
+              let
+                  val mrs = !moduleRoots
+
+                  val anyErrors = ref false
+                  fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ())
+                  fun nameOf fname =
+                      let
+                          val fname = OS.Path.file fname
+                          val fst = if size fname = 0 then #"!" else String.sub (fname, 0)
+                      in
+                          if not (Char.isAlpha fst) then
+                              ErrorMsg.error ("Filename doesn't start with letter: " ^ fname)
+                          else if CharVector.exists (fn ch => not (Char.isAlphaNum ch) andalso ch <> #"_") fname then
+                              ErrorMsg.error ("Filename contains a character that isn't alphanumeric or underscore: " ^ fname)
+                          else
+                              ();
+                          capitalize fname
+                      end
+
+                  fun parseFfi fname =
+                      let
+                          val mname = nameOf fname
+                          val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
+
+                          val loc = {file = urs,
+                                     first = ErrorMsg.dummyPos,
+                                     last = ErrorMsg.dummyPos}
+
+                          val sgn = (Source.SgnConst (#func parseUrs urs), loc)
+                      in
+                          checkErrors ();
+                          (Source.DFfiStr (mname, sgn, if !Elaborate.incremental then SOME (OS.FileSys.modTime urs) else NONE), loc)
+                      end
+
+                  val defed = ref SS.empty
+                  val fulls = ref SS.empty
+
+                  val caughtOneThatIsn'tAFile = ref false
+
+                  fun parseOne fname =
+                      let
+                          val mname = nameOf fname
+                          val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"}
+                          val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
+
+                          val () = if Posix.FileSys.access (ur, []) then
+                                       ()
+                                   else
+                                       raise MissingFile ur
+
+                          val sgnO =
+                              if Posix.FileSys.access (urs, []) then
+                                  SOME (Source.SgnConst (#func parseUrs urs),
+                                        {file = urs,
+                                         first = ErrorMsg.dummyPos,
+                                         last = ErrorMsg.dummyPos})
+                                  before checkErrors ()
+                              else
+                                  NONE
+
+                          val loc = {file = ur,
+                                     first = ErrorMsg.dummyPos,
+                                     last = ErrorMsg.dummyPos}
+
+                          val urt = OS.FileSys.modTime ur
+                          val urst = (OS.FileSys.modTime urs) handle _ => urt
+
+                          val ds = #func parseUr ur
+                          val d = (Source.DStr (mname, sgnO, if !Elaborate.incremental then SOME (if Time.> (urt, urst) then urt else urst) else NONE,
+                                                (Source.StrConst ds, loc), false), loc)
+
+                          val fname = OS.Path.mkCanonical fname
+                          val d = case List.find (fn (root, name) =>
+                                                     String.isPrefix (root ^ "/") fname) mrs of
+                                      NONE => d
+                                    | SOME (root, name) =>
+                                      let
+                                          val fname = String.extract (fname, size root + 1, NONE)
+                                          val pieces = name :: String.tokens (fn ch => ch = #"/") fname
+                                          val pieces = List.filter (fn s => size s > 0
+                                                                            andalso Char.isAlpha (String.sub (s, 0)))
+                                                                   pieces
+                                          val pieces = map capitalize pieces
+                                          val full = String.concatWith "." pieces
+
+                                          fun makeD first prefix pieces =
+                                              case pieces of
+                                                  [] => (ErrorMsg.error "Empty module path";
+                                                         (Source.DStyle "Boo", loc))
+                                                | [_] => d
+                                                | piece :: pieces =>
+                                                  let
+                                                      val this = case prefix of
+                                                                     "" => piece
+                                                                   | _ => prefix ^ "." ^ piece
+                                                      val old = SS.member (!defed, this)
+
+                                                      fun notThere (ch, s) =
+                                                          Substring.isEmpty (#2 (Substring.splitl
+                                                                                     (fn ch' => ch' <> ch) s))
+
+                                                      fun simOpen () =
+                                                          SS.foldl (fn (full, ds) =>
+                                                                       if String.isPrefix (this ^ ".") full
+                                                                          andalso notThere (#".",
+                                                                                            Substring.extract (full,
+                                                                                                               size
+                                                                                                                   this + 1,
+                                                                                                               NONE)) then
+                                                                           let
+                                                                               val parts = String.tokens
+                                                                                           (fn ch => ch = #".") full
+
+                                                                               val part = List.last parts
+
+                                                                               val imp = if length parts >= 2 then
+                                                                                             (Source.StrProj
+                                                                                                  ((Source.StrVar
+                                                                                                        (List.nth (parts,
+                                                                                                                   length
+                                                                                                                       parts
+                                                                                                                       - 2)),
+                                                                                                    loc),
+                                                                                                   part), loc)
+                                                                                         else
+                                                                                             (Source.StrVar part, loc)
+                                                                           in
+                                                                               (Source.DStr (part, NONE, NONE, imp, false),
+                                                                                loc) :: ds
+                                                                           end
+                                                                       else
+                                                                           ds) [] (!fulls)
+                                                  in
+                                                      defed := SS.add (!defed, this);
+                                                      (Source.DStr (piece, NONE, NONE,
+                                                                    (Source.StrConst (if old then
+                                                                                          simOpen ()
+                                                                                          @ [makeD false this pieces]
+                                                                                      else
+                                                                                          [makeD false this pieces]),
+                                                                     loc), first andalso old),
+                                                       loc)
+                                                  end
+                                      in
+                                          if SS.member (!fulls, full) then
+                                              ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.")
+                                          else
+                                              ();
+
+                                          makeD true "" pieces
+                                          before ignore (foldl (fn (new, path) =>
+                                                                   let
+                                                                       val new' = case path of
+                                                                                      "" => new
+                                                                                    | _ => path ^ "." ^ new
+                                                                   in
+                                                                       fulls := SS.add (!fulls, new');
+                                                                       new'
+                                                                   end) "" pieces)
+                                      end
+                      in
+                          checkErrors ();
+                          d
+                      end handle MissingFile fname => (if not (!caughtOneThatIsn'tAFile)
+                                                          andalso CharVector.exists Char.isSpace fname then
+                                                           (caughtOneThatIsn'tAFile := true;
+                                                            ErrorMsg.error ("In .urp files, all configuration directives must come before any blank lines.\n"
+                                                                            ^ "However, this .urp file contains at least one suspicious line in a position\n"
+                                                                            ^ "where filenames belong (after the first blank line) but containing a space\n"
+                                                                            ^ "character."))
+                                                       else
+                                                           ();
+                                                       ErrorMsg.error ("Missing source file: " ^ fname);
+                                                       (Source.DSequence "", ErrorMsg.dummySpan))
+
+                  val dsFfi = map parseFfi ffi
+                  val ds = map parseOne fnames
+                  val loc = ErrorMsg.dummySpan
+              in
+                  if !anyErrors then
+                      ErrorMsg.error "Parse failure"
+                  else
+                      ();
+
+                  let
+                      val final = List.last fnames
+                      val final = case List.find (fn (root, name) =>
+                                                     String.isPrefix (root ^ "/") final) mrs of
+                                      NONE => (Source.StrVar (nameOf final), loc)
+                                    | SOME (root, name) =>
+                                      let
+                                          val m = (Source.StrVar name, loc)
+                                          val final = String.extract (final, size root + 1, NONE)
+                                          val fields = String.fields (fn ch => ch = #"/") final
+                                          val fields = List.filter (fn s => size s = 0
+                                                                            orelse not (Char.isDigit (String.sub (s, 0))))
+                                                                   fields
+                                      in
+                                          foldl (fn (x, m) => (Source.StrProj (m, capitalize x), loc))
+                                                m fields
+                                      end
+
+                      val ds = dsFfi @ ds
+                               @ [(Source.DExport final, loc)]
+
+                      val ds = case database of
+                                   NONE => ds
+                                 | SOME s => (Source.DDatabase s, loc) :: ds
+
+                      val ds = case onError of
+                                   NONE => ds
+                                 | SOME v => ds @ [(Source.DOnError v, loc)]
+
+                      fun dummy fname = {file = Settings.libFile fname,
+                                         first = ErrorMsg.dummyPos,
+                                         last = ErrorMsg.dummyPos}
+
+                      val used = SM.insert (SM.empty, "Basis", dummy "basis.urs")
+                      val used = SM.insert (used, "Top", dummy "top.urs")
+                  in
+                      ignore (List.foldl (fn (d, used) =>
+                                             case #1 d of
+                                                 Source.DStr (x, _, _, _, false) =>
+                                                 (case SM.find (used, x) of
+                                                      SOME loc =>
+                                                      (ErrorMsg.error ("Duplicate top-level module name " ^ x);
+                                                       Print.prefaces "Files" [("Previous", Print.PD.string (ErrorMsg.spanToString loc)),
+                                                                               ("Current", Print.PD.string (ErrorMsg.spanToString (#2 d)))];
+                                                       used)
+                                                    | NONE =>
+                                                      SM.insert (used, x, #2 d))
+                                               | _ => used) used ds);
+                      ds
+                  end handle Empty => ds
+              end,
+    print = SourcePrint.p_file
+}
+
+val toParse = transform parse "parse" o toParseJob
+
+val elaborate = {
+    func = fn file => let
+                  val basisF = Settings.libFile "basis.urs"
+                  val topF = Settings.libFile "top.urs"
+                  val topF' = Settings.libFile "top.ur"
+
+                  val basis = #func parseUrs basisF
+                  val topSgn = #func parseUrs topF
+                  val topStr = #func parseUr topF'
+
+                  val tm1 = OS.FileSys.modTime topF
+                  val tm2 = OS.FileSys.modTime topF'
+              in
+                  Elaborate.elabFile basis (OS.FileSys.modTime basisF)
+                                     topStr topSgn (if Time.< (tm1, tm2) then tm2 else tm1)
+                                     ElabEnv.empty file
+              end,
+    print = ElabPrint.p_file ElabEnv.empty
+}
+
+val toElaborate = transform elaborate "elaborate" o toParse
+
+val unnest = {
+    func = Unnest.unnest,
+    print = ElabPrint.p_file ElabEnv.empty
+}
+
+val toUnnest = transform unnest "unnest" o toElaborate
+
+val termination = {
+    func = (fn file => (Termination.check file; file)),
+    print = ElabPrint.p_file ElabEnv.empty
+}
+
+val toTermination = transform termination "termination" o toUnnest
+
+val explify = {
+    func = Explify.explify,
+    print = ExplPrint.p_file ExplEnv.empty
+}
+
+val toExplify = transform explify "explify" o toUnnest
+
+val corify = {
+    func = Corify.corify,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toCorify = transform corify "corify" o toExplify
+
+(*val reduce_local = {
+    func = ReduceLocal.reduce,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toReduce_local = transform reduce_local "reduce_local" o toCorify*)
+
+val especialize = {
+    func = ESpecialize.specialize,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val core_untangle = {
+    func = CoreUntangle.untangle,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toCore_untangle = transform core_untangle "core_untangle" o toCorify
+
+val shake = {
+    func = Shake.shake,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toShake1 = transform shake "shake1" o toCore_untangle
+
+val toEspecialize1' = transform especialize "especialize1'" o toShake1
+val toShake1' = transform shake "shake1'" o toEspecialize1'
+
+val rpcify = {
+    func = Rpcify.frob,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toRpcify = transform rpcify "rpcify" o toShake1'
+
+val toCore_untangle2 = transform core_untangle "core_untangle2" o toRpcify
+val toShake2 = transform shake "shake2" o toCore_untangle2
+
+val toEspecialize1 = transform especialize "especialize1" o toShake2
+
+val toCore_untangle3 = transform core_untangle "core_untangle3" o toEspecialize1
+val toShake3 = transform shake "shake3" o toCore_untangle3
+
+val tag = {
+    func = Tag.tag,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toTag = transform tag "tag" o toShake3
+
+val reduce = {
+    func = Reduce.reduce,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toReduce = transform reduce "reduce" o toTag
+
+val toShakey = transform shake "shakey" o toReduce
+
+val unpoly = {
+    func = Unpoly.unpoly,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toUnpoly = transform unpoly "unpoly" o toShakey
+
+val specialize = {
+    func = Specialize.specialize,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toSpecialize = transform specialize "specialize" o toUnpoly
+
+val toShake4 = transform shake "shake4" o toSpecialize
+
+val toEspecialize2 = transform especialize "especialize2" o toShake4
+val toShake4' = transform shake "shake4'" o toEspecialize2
+val toUnpoly2 = transform unpoly "unpoly2" o toShake4'
+val toSpecialize2 = transform specialize "specialize2" o toUnpoly2
+val toShake4'' = transform shake "shake4'" o toSpecialize2
+val toEspecialize3 = transform especialize "especialize3" o toShake4''
+
+val toReduce2 = transform reduce "reduce2" o toEspecialize3
+
+val toShake5 = transform shake "shake5" o toReduce2
+
+val marshalcheck = {
+    func = (fn file => (MarshalCheck.check file; file)),
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake5
+
+val effectize = {
+    func = Effective.effectize,
+    print = CorePrint.p_file CoreEnv.empty
+}
+
+val toEffectize = transform effectize "effectize" o toMarshalcheck
+
+val css = {
+    func = Css.summarize,
+    print = fn _ => Print.box []
+}
+
+val toCss = transform css "css" o toShake5
+
+val monoize = {
+    func = Monoize.monoize CoreEnv.empty,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toMonoize = transform monoize "monoize" o toEffectize
+
+val mono_opt = {
+    func = MonoOpt.optimize,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
+
+val untangle = {
+    func = Untangle.untangle,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toUntangle = transform untangle "untangle" o toMono_opt1
+
+val mono_reduce = {
+    func = MonoReduce.reduce,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toMono_reduce = transform mono_reduce "mono_reduce" o toUntangle
+
+val mono_shake = {
+    func = MonoShake.shake,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toMono_shake = transform mono_shake "mono_shake1" o toMono_reduce
+
+val toMono_opt2 = transform mono_opt "mono_opt2" o toMono_shake
+
+val iflow = {
+    func = (fn file => (if !doIflow then Iflow.check file else (); file)),
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toIflow = transform iflow "iflow" o toMono_opt2
+
+val namejs = {
+    func = NameJS.rewrite,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toNamejs = transform namejs "namejs" o toIflow
+
+val toNamejs_untangle = transform untangle "namejs_untangle" o toNamejs
+
+val scriptcheck = {
+    func = ScriptCheck.classify,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toScriptcheck = transform scriptcheck "scriptcheck" o toNamejs_untangle
+
+val dbmodecheck = {
+    func = DbModeCheck.classify,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toDbmodecheck = transform dbmodecheck "dbmodecheck" o toScriptcheck
+
+val jscomp = {
+    func = JsComp.process,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toJscomp = transform jscomp "jscomp" o toDbmodecheck
+
+val toMono_opt3 = transform mono_opt "mono_opt3" o toJscomp
+
+val fuse = {
+    func = Fuse.fuse,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toFuse = transform fuse "fuse" o toMono_opt3
+
+val toUntangle2 = transform untangle "untangle2" o toFuse
+
+val toMono_reduce2 = transform mono_reduce "mono_reduce2" o toUntangle2
+val toMono_shake2 = transform mono_shake "mono_shake2" o toMono_reduce2
+val toMono_opt4 = transform mono_opt "mono_opt4" o toMono_shake2
+val toMono_reduce3 = transform mono_reduce "mono_reduce3" o toMono_opt4
+val toFuse2 = transform fuse "fuse2" o toMono_reduce3
+val toUntangle3 = transform untangle "untangle3" o toFuse2
+val toMono_shake3 = transform mono_shake "mono_shake3" o toUntangle3
+
+val pathcheck = {
+    func = (fn file => (PathCheck.check file; file)),
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toPathcheck = transform pathcheck "pathcheck" o toMono_shake3
+
+val sidecheck = {
+    func = SideCheck.check,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toSidecheck = transform sidecheck "sidecheck" o toPathcheck
+
+val sigcheck = {
+    func = SigCheck.check,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toSigcheck = transform sigcheck "sigcheck" o toSidecheck
+
+val sqlcache = {
+    func = (fn file =>
+               if Settings.getSqlcache ()
+               then let val file = MonoInline.inlineFull file in Sqlcache.go file end
+               else file),
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toSqlcache = transform sqlcache "sqlcache" o toSigcheck
+
+val cjrize = {
+    func = Cjrize.cjrize,
+    print = CjrPrint.p_file CjrEnv.empty
+}
+
+val toCjrize = transform cjrize "cjrize" o toSqlcache
+
+val prepare = {
+    func = Prepare.prepare,
+    print = CjrPrint.p_file CjrEnv.empty
+}
+
+val toPrepare = transform prepare "prepare" o toCjrize
+
+val checknest = {
+    func = fn f => if #supportsNestedPrepared (Settings.currentDbms ()) then f else Checknest.annotate f,
+    print = CjrPrint.p_file CjrEnv.empty
+}
+
+val toChecknest = transform checknest "checknest" o toPrepare
+
+val sqlify = {
+    func = Cjrize.cjrize,
+    print = CjrPrint.p_sql CjrEnv.empty
+}
+
+val toSqlify = transform sqlify "sqlify" o toMono_opt2
+
+fun escapeFilename s =
+    "\""
+    ^ String.translate (fn #"\"" => "\\\"" | #"\\" => "\\\\" | ch => str ch) s
+    ^ "\""
+
+val beforeC = ref (fn () => ())
+
+structure StringSet = BinarySetFn(struct
+                                  type ord_key = string
+                                  val compare = String.compare
+                                  end)
+
+fun compileC {cname, oname, ename, libs, profile, debug, linker, link = link'} =
+    let
+        val proto = Settings.currentProtocol ()
+
+        val lib = if Settings.getBootLinking () then
+                      !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a"
+                  else if Settings.getStaticLinking () then
+                      " -static " ^ !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a"
+                  else
+                      "-L" ^ !Settings.configLib ^ " " ^ #linkDynamic proto ^ " -lurweb"
+
+        val opt = if debug then
+                      ""
+                  else
+                      " -O3"
+
+        val compile = (Settings.getCCompiler ()) ^ " " ^ Config.ccArgs ^ " " ^ Config.pthreadCflags ^ " -Wimplicit -Werror -Wno-unused-value"
+                      ^ opt ^ " -I " ^ !Settings.configInclude
+                      ^ " " ^ #compile proto
+                      ^ " -c " ^ escapeFilename cname ^ " -o " ^ escapeFilename oname
+
+        fun concatArgs (a1, a2) =
+            if CharVector.all Char.isSpace a1 then
+                a2
+            else
+                a1 ^ " " ^ a2
+
+        val args = concatArgs (Config.ccArgs, Config.pthreadCflags)
+        val args = concatArgs (args, Config.pthreadLibs)
+
+        val linker = Option.getOpt (linker, (Settings.getCCompiler ()) ^ " -Werror" ^ opt ^ " " ^ args)
+
+        val ssl = if Settings.getStaticLinking () then
+                      Config.openssl ^ " -ldl -lz"
+                  else
+                      Config.openssl
+
+        val link = linker
+                   ^ " " ^ escapeFilename oname ^ " " ^ lib ^ " -lm " ^ ssl ^ " " ^ libs ^ " -o " ^ escapeFilename ename
+
+        val (compile, link) =
+            if profile then
+                (compile ^ " -pg", link ^ " -pg")
+            else
+                (compile, link)
+
+        val (compile, link) =
+            if debug then
+                (compile ^ " -g", link ^ " -g")
+            else
+                (compile, link)
+
+        val link = #1 (foldl
+            (fn (s, (link, set)) =>
+              if StringSet.member (set, s) then
+                (link, set)
+              else
+                ((link ^ " " ^ s), StringSet.add (set, s)))
+            (link, StringSet.empty)
+            link')
+
+        fun system s =
+            (if debug then
+                 print (s ^ "\n")
+             else
+                 ();
+             OS.Process.isSuccess (OS.Process.system s))
+    in
+        !beforeC ();
+        system compile andalso system link
+    end
+
+fun compile job =
+    case run toChecknest job of
+        NONE => false
+      | SOME file =>
+        let
+            val job = valOf (run (transform parseUrp "parseUrp") job)
+
+            val (cname, oname, cleanup) =
+                if #debug job then
+                    ("/tmp/webapp.c", "/tmp/webapp.o", fn () => ())
+                else
+                    let
+                        val dir = OS.FileSys.tmpName ()
+                        val () = if OS.FileSys.access (dir, []) then
+                                     OS.FileSys.remove dir
+                                 else
+                                     ()
+                        val cname = OS.Path.joinDirFile {dir = dir, file = "webapp.c"}
+                        val oname = OS.Path.joinDirFile {dir = dir, file = "webapp.o"}
+                    in
+                        OS.FileSys.mkDir dir;
+                        (cname, oname,
+                      fn () => (if OS.Process.isSuccess (OS.Process.system ("rm -rf " ^ dir)) then
+                                    ()
+                                else
+                                    raise Fail ("Unable to delete temporary directory " ^ dir)))
+                    end
+            val ename = #exe job
+        in
+            let
+                val outf = TextIO.openOut cname
+                val s = TextIOPP.openOut {dst = outf, wid = 80}
+
+                val hasDb = List.exists (fn (Cjr.DDatabase _, _) => true | _ => false) (#1 file)
+                val libs =
+                    if hasDb then
+                        #link (Settings.currentDbms ())
+                    else
+                        ""
+            in
+                Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
+		TextIO.output1 (outf, #"\n");
+                TextIO.closeOut outf;
+
+                if ErrorMsg.anyErrors () then
+                    false
+                else
+                    (case #sql job of
+                         NONE => ()
+                       | SOME sql =>
+                         let
+                             val outf = TextIO.openOut sql
+                             val s = TextIOPP.openOut {dst = outf, wid = 80}
+                         in
+                             Print.fprint s (CjrPrint.p_sql CjrEnv.empty file);
+                             TextIO.closeOut outf
+                         end;
+
+                     compileC {cname = cname, oname = oname, ename = ename, libs = libs,
+                               profile = #profile job, debug = #debug job, linker = #linker job, link = #link job}
+
+                     before cleanup ())
+            end
+            handle ex => (((cleanup ()) handle _ => ()); raise ex)
+        end
+
+fun compiler job =
+    if compile job then
+        ()
+    else
+        OS.Process.exit OS.Process.failure
+
+fun moduleOf fname =
+    let
+        val mrs = !moduleRoots
+        val fname = OS.Path.mkCanonical fname
+    in
+        case List.find (fn (root, _) => String.isPrefix (root ^ "/") fname) mrs of
+            NONE => capitalize (OS.Path.base (OS.Path.file fname))
+          | SOME (root, name) =>
+            let
+                val fname = OS.Path.base fname
+                val fname = String.extract (fname, size root + 1, NONE)
+                val fs = String.fields (fn ch => ch = #"/") fname
+                val fs = List.filter (CharVector.exists (fn ch => not (Char.isDigit ch))) fs
+                val fs = map capitalize fs
+            in
+                String.concatWith "." (name :: fs)
+            end
+    end
+
+end
diff --git a/src/config.sig b/src/config.sig
new file mode 100644
index 0000000..a3ad7d7
--- /dev/null
+++ b/src/config.sig
@@ -0,0 +1,23 @@
+signature CONFIG = sig
+    val builddir : string
+
+    val bin : string
+    val srclib : string
+    val lib : string
+    val includ : string
+    val sitelisp : string
+
+    val ccompiler : string
+    val ccArgs : string
+    val openssl : string
+
+    val pgheader : string
+    val msheader : string
+    val sqheader : string
+
+    val versionNumber : string
+    val versionString : string
+
+    val pthreadCflags : string
+    val pthreadLibs : string
+end
diff --git a/src/config.sml.in b/src/config.sml.in
new file mode 100644
index 0000000..ebcdb7b
--- /dev/null
+++ b/src/config.sml.in
@@ -0,0 +1,37 @@
+structure Config :> CONFIG = struct
+
+val builddir = "@abs_top_builddir@"
+
+val bin = "@BIN@"
+val srclib = "@SRCLIB@"
+val lib = "@LIB@"
+val includ = "@INCLUDE@"
+val sitelisp = "@SITELISP@"
+
+val ccompiler = "@CC@"
+val ccArgs = "@CCARGS@"
+
+val openssl = "@OPENSSL_LDFLAGS@ @OPENSSL_LIBS@"
+
+(* Something is rotten in the state of Ubuntu 11.10, so here's a manual fix that I hope doesn't break other platforms. *)
+val openssl =
+    let
+        val tokens = String.tokens Char.isSpace openssl
+    in
+        if List.exists (fn s => s = "-lssl") tokens then
+            String.concatWith " " (List.filter (fn s => s <> "-lssl") tokens @ ["-lssl"])
+        else
+            openssl
+    end
+
+val pgheader = "@PGHEADER@"
+val msheader = "@MSHEADER@"
+val sqheader = "@SQHEADER@"
+
+val versionNumber  = "@VERSION@"
+val versionString  = "The Ur/Web compiler, version " ^ versionNumber
+
+val pthreadCflags = "@PTHREAD_CFLAGS@"
+val pthreadLibs = "@PTHREAD_LIBS@"
+
+end
diff --git a/src/coq/Axioms.v b/src/coq/Axioms.v
new file mode 100644
index 0000000..0a0a84d
--- /dev/null
+++ b/src/coq/Axioms.v
@@ -0,0 +1,47 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+Set Implicit Arguments.
+
+
+Axiom ext_eq : forall dom ran (f g : forall x : dom, ran x),
+  (forall x, f x = g x)
+  -> f = g.
+
+Theorem ext_eq_forall : forall dom (f g : forall x : dom, Type),
+  (forall x, f x = g x)
+  -> (forall x, f x) = (forall x, g x).
+  intros.
+  rewrite (ext_eq _ f g H); reflexivity.
+Qed.
+
+Theorem ext_eq_forallS : forall dom (f g : forall x : dom, Set),
+  (forall x, f x = g x)
+  -> (forall x, f x) = (forall x, g x).
+  intros.
+  rewrite (ext_eq _ f g H); reflexivity.
+Qed.
diff --git a/src/coq/Makefile b/src/coq/Makefile
new file mode 100644
index 0000000..fc488d6
--- /dev/null
+++ b/src/coq/Makefile
@@ -0,0 +1,14 @@
+MODULES := Axioms Name Syntax Semantics
+VS      := $(MODULES:%=%.v)
+
+.PHONY: coq clean
+
+coq: Makefile.coq
+	make -f Makefile.coq
+
+Makefile.coq: Makefile $(VS)
+	coq_makefile -impredicative-set $(VS) -o Makefile.coq
+
+clean:: Makefile.coq
+	make -f Makefile.coq clean
+	rm -f Makefile.coq
diff --git a/src/coq/Name.v b/src/coq/Name.v
new file mode 100644
index 0000000..6dedae6
--- /dev/null
+++ b/src/coq/Name.v
@@ -0,0 +1,31 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+Require Import String.
+
+Definition name := string.
+Definition name_eq_dec : forall x y : name, {x = y} + {x <> y} := string_dec.
diff --git a/src/coq/README b/src/coq/README
new file mode 100644
index 0000000..10cb01e
--- /dev/null
+++ b/src/coq/README
@@ -0,0 +1,3 @@
+This is a Coq formalization of a simplified version of the Ur programming language.
+
+It has only been tested with Coq version 8.3pl2.
diff --git a/src/coq/Semantics.v b/src/coq/Semantics.v
new file mode 100644
index 0000000..c334a89
--- /dev/null
+++ b/src/coq/Semantics.v
@@ -0,0 +1,232 @@
+(* Copyright (c) 2009, 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+Require Import Eqdep_dec.
+
+Require Import Axioms.
+Require Import Syntax.
+
+Set Implicit Arguments.
+
+
+Definition row (A : Type) : Type := name -> option A.
+
+Definition record (r : row Set) := forall n, match r n with
+                                               | None => unit
+                                               | Some T => T
+                                             end.
+
+Fixpoint kDen (k : kind) : Type :=
+  match k with
+    | KType => Set
+    | KName => name
+    | KArrow k1 k2 => kDen k1 -> kDen k2
+    | KRecord k1 => row (kDen k1)
+  end.
+
+Definition disjoint T (r1 r2 : row T) :=
+  forall n, match r1 n, r2 n with
+              | Some _, Some _ => False
+              | _, _ => True
+            end.
+
+Fixpoint cDen k (c : con kDen k) : kDen k :=
+  match c with
+    | CVar _ x => x
+    | Arrow c1 c2 => cDen c1 -> cDen c2
+    | Poly _ c1 => forall x, cDen (c1 x)
+    | CAbs _ _ c1 => fun x => cDen (c1 x)
+    | CApp _ _ c1 c2 => (cDen c1) (cDen c2)
+    | Name n => n
+    | TRecord c1 => record (cDen c1)
+    | CEmpty _ => fun _ => None
+    | CSingle _ c1 c2 => fun n => if name_eq_dec n (cDen c1) then Some (cDen c2) else None
+    | CConcat _ c1 c2 => fun n => match (cDen c1) n with
+                                    | None => (cDen c2) n
+                                    | v => v
+                                  end
+    | CMap k1 k2 => fun f r n => match r n with
+                                   | None => None
+                                   | Some T => Some (f T)
+                                 end
+    | TGuarded _ c1 c2 t => disjoint (cDen c1) (cDen c2) -> cDen t
+  end.
+
+Theorem subs_correct : forall k1 (c1 : con kDen k1) k2 (c2 : _ -> con kDen k2) c2',
+  subs c1 c2 c2'
+  -> cDen (c2 (cDen c1)) = cDen c2'.
+  induction 1; simpl; intuition; try (apply ext_eq_forallS || apply ext_eq);
+    repeat match goal with
+             | [ H : _ |- _ ] => rewrite H
+           end; intuition.
+Qed.
+
+Definition dvar k (c1 c2 : con kDen (KRecord k)) :=
+  disjoint (cDen c1) (cDen c2).
+
+Scheme deq_mut := Minimality for deq Sort Prop
+with disj_mut := Minimality for disj Sort Prop.
+
+Ltac deq_disj_correct scm :=
+  let t := repeat progress (simpl; intuition; subst) in
+
+  let rec use_disjoint' notDone E :=
+    match goal with
+      | [ H : disjoint _ _ |- _ ] =>
+        notDone H; generalize (H E); use_disjoint'
+          ltac:(fun H' =>
+            match H' with
+              | H => fail 1
+              | _ => notDone H'
+            end) E
+      | _ => idtac
+    end in
+  let use_disjoint := use_disjoint' ltac:(fun _ => idtac) in
+
+  apply (scm _ dvar
+    (fun k (c1 c2 : con kDen k) =>
+      cDen c1 = cDen c2)
+    (fun k (c1 c2 : con kDen (KRecord k)) =>
+      disjoint (cDen c1) (cDen c2))); t;
+  repeat ((unfold row; apply ext_eq)
+    || (match goal with
+          | [ H : _ |- _ ] => rewrite H; []
+          | [ H : subs _ _ _ |- _ ] => rewrite <- (subs_correct H)
+        end); t);
+  unfold disjoint; t;
+    repeat (match goal with
+              | [ |- context[match cDen ?C ?E with Some _ => _ | None => _ end] ] =>
+                use_disjoint E; destruct (cDen C E)
+              | [ |- context[if name_eq_dec ?N1 ?N2 then _ else _] ] =>
+                use_disjoint N1; use_disjoint N2; destruct (name_eq_dec N1 N2)
+              | [ _ : context[match cDen ?C ?E with Some _ => _ | None => _ end] |- _ ] =>
+                use_disjoint E; destruct (cDen C E)
+              | [ |- context[if ?E then _ else _] ] => destruct E                  
+            end; t).
+
+Hint Unfold dvar.
+
+Theorem deq_correct : forall k (c1 c2 : con kDen k),
+  deq dvar c1 c2
+  -> cDen c1 = cDen c2.
+  deq_disj_correct deq_mut.
+Qed.
+
+Theorem disj_correct : forall k (c1 c2 : con kDen (KRecord k)),
+  disj dvar c1 c2
+  -> disjoint (cDen c1) (cDen c2).
+  deq_disj_correct disj_mut.
+Qed.
+
+Definition tDen (t : con kDen KType) : Set := cDen t.
+
+Theorem name_eq_dec_refl : forall n, name_eq_dec n n = left _ (refl_equal n).
+  intros; destruct (name_eq_dec n n); intuition; [
+    match goal with
+      | [ e : _ = _ |- _ ] => rewrite (UIP_dec name_eq_dec e (refl_equal _)); reflexivity
+    end
+    | elimtype False; tauto
+  ].
+Qed.
+
+Theorem cut_disjoint : forall n1 v r,
+  disjoint (fun n => if name_eq_dec n n1 then Some v else None) r
+  -> unit = match r n1 with
+              | Some T => T
+              | None => unit
+            end.
+  intros;
+    match goal with
+      | [ H : disjoint _ _ |- _ ] => generalize (H n1)
+    end; rewrite name_eq_dec_refl;
+    destruct (r n1); intuition.
+Qed.
+
+Implicit Arguments cut_disjoint [v r].
+
+Fixpoint eDen t (e : exp dvar tDen t) : tDen t :=
+  match e in exp _ _ t return tDen t with
+    | Var _ x => x
+    | App _ _ e1 e2 => (eDen e1) (eDen e2)
+    | Abs _ _ e1 => fun x => eDen (e1 x)
+    | ECApp _ c _ _ e1 Hsub => match subs_correct Hsub in _ = T return T with
+                                 | refl_equal => (eDen e1) (cDen c)
+                               end
+    | ECAbs _ _ e1 => fun X => eDen (e1 X)
+    | Cast _ _ Heq e1 => match deq_correct Heq in _ = T return T with
+                           | refl_equal => eDen e1
+                         end
+    | Empty => fun _ => tt
+    | Single c c' e1 => fun n => if name_eq_dec n (cDen c) as B
+      return (match (match (if B then _ else _) with Some _ => _ | None => _ end)
+                with Some _ => _ | None => unit end)
+      then eDen e1 else tt
+    | Proj c _ _ e1 =>
+      match name_eq_dec_refl (cDen c) in _ = B
+        return (match (match (if B then _ else _) with
+                         | Some _ => _
+                         | None => _ end)
+        return Set
+                  with Some _ => _ | None => _ end) with
+        | refl_equal => (eDen e1) (cDen c)
+      end
+    | Cut c _ c' Hdisj e1 => fun n =>
+      match name_eq_dec n (cDen c) as B return (match (match (if B then Some _ else None) with Some _ => _ | None => (cDen c') n end)
+                                                  with Some T => T | None => unit end
+      -> match (cDen c') n with
+           | None => unit
+           | Some T => T
+         end) with 
+        | left Heq => fun _ =>
+          match sym_eq Heq in _ = n' return match cDen c' n' return Set with Some _ => _ | None => _ end with
+            | refl_equal =>
+              match cut_disjoint _ (disj_correct Hdisj) in _ = T return T with
+                | refl_equal => tt
+              end
+          end
+        | right _ => fun x => x
+      end ((eDen e1) n)
+
+    | Concat c1 c2 e1 e2 => fun n =>
+      match (cDen c1) n as D return match D with
+                                      | None => unit
+                                      | Some T => T
+                                    end
+      -> match (match D with
+                  | None => (cDen c2) n
+                  | Some v => Some v
+                end) with
+           | None => unit
+           | Some T => T
+         end with
+        | None => fun _ => (eDen e2) n
+        | _ => fun x => x
+      end ((eDen e1) n)
+
+    | Guarded _ _ _ _ e1 => fun pf => eDen (e1 pf)
+    | GuardedApp _ _ _ _ e1 Hdisj => (eDen e1) (disj_correct Hdisj)
+  end.
diff --git a/src/coq/Syntax.v b/src/coq/Syntax.v
new file mode 100644
index 0000000..03f8d82
--- /dev/null
+++ b/src/coq/Syntax.v
@@ -0,0 +1,186 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+Require Import Name.
+Export Name.
+
+Set Implicit Arguments.
+
+
+(** Syntax of Featherweight Ur *)
+
+Inductive kind : Type :=
+| KType : kind
+| KName : kind
+| KArrow : kind -> kind -> kind
+| KRecord : kind -> kind.
+
+Section vars.
+  Variable cvar : kind -> Type.
+
+  Inductive con : kind -> Type :=
+  | CVar : forall k, cvar k -> con k
+  | Arrow : con KType -> con KType -> con KType
+  | Poly : forall k, (cvar k -> con KType) -> con KType
+  | CAbs : forall k1 k2, (cvar k1 -> con k2) -> con (KArrow k1 k2)
+  | CApp : forall k1 k2, con (KArrow k1 k2) -> con k1 -> con k2
+  | Name : name -> con KName
+  | TRecord : con (KRecord KType) -> con KType
+  | CEmpty : forall k, con (KRecord k)
+  | CSingle : forall k, con KName -> con k -> con (KRecord k)
+  | CConcat : forall k, con (KRecord k) -> con (KRecord k) -> con (KRecord k)
+  | CMap : forall k1 k2, con (KArrow (KArrow k1 k2) (KArrow (KRecord k1) (KRecord k2)))
+  | TGuarded : forall k, con (KRecord k) -> con (KRecord k) -> con KType -> con KType.
+
+  Variable dvar : forall k, con (KRecord k) -> con (KRecord k) -> Type.
+
+  Section subs.
+    Variable k1 : kind.
+    Variable c1 : con k1.
+
+    Inductive subs : forall k2, (cvar k1 -> con k2) -> con k2 -> Type :=
+    | S_Unchanged : forall k2 (c2 : con k2),
+      subs (fun _ => c2) c2
+    | S_CVar : subs (fun x => CVar x) c1
+    | S_Arrow : forall c2 c3 c2' c3',
+      subs c2 c2'
+      -> subs c3 c3'
+      -> subs (fun x => Arrow (c2 x) (c3 x)) (Arrow c2' c3')
+    | S_Poly : forall k (c2 : cvar k1 -> cvar k -> _) (c2' : cvar k -> _),
+      (forall x', subs (fun x => c2 x x') (c2' x'))
+      -> subs (fun x => Poly (c2 x)) (Poly c2')
+    | S_CAbs : forall k2 k3 (c2 : cvar k1 -> cvar k2 -> con k3) (c2' : cvar k2 -> _),
+      (forall x', subs (fun x => c2 x x') (c2' x'))
+      -> subs (fun x => CAbs (c2 x)) (CAbs c2')
+    | S_CApp : forall k1 k2 (c2 : _ -> con (KArrow k1 k2)) c3 c2' c3',
+      subs c2 c2'
+      -> subs c3 c3'
+      -> subs (fun x => CApp (c2 x) (c3 x)) (CApp c2' c3')
+    | S_TRecord : forall c2 c2',
+      subs c2 c2'
+      -> subs (fun x => TRecord (c2 x)) (TRecord c2')
+    | S_CSingle : forall k2 c2 (c3 : _ -> con k2) c2' c3',
+      subs c2 c2'
+      -> subs c3 c3'
+      -> subs (fun x => CSingle (c2 x) (c3 x)) (CSingle c2' c3')
+    | S_CConcat : forall k2 (c2 c3 : _ -> con (KRecord k2)) c2' c3',
+      subs c2 c2'
+      -> subs c3 c3'
+      -> subs (fun x => CConcat (c2 x) (c3 x)) (CConcat c2' c3')
+    | S_TGuarded : forall k2 (c2 c3 : _ -> con (KRecord k2)) c4 c2' c3' c4',
+      subs c2 c2'
+      -> subs c3 c3'
+      -> subs c4 c4'
+      -> subs (fun x => TGuarded (c2 x) (c3 x) (c4 x)) (TGuarded c2' c3' c4').
+  End subs.
+
+  Inductive disj : forall k, con (KRecord k) -> con (KRecord k) -> Prop :=
+  | DVar : forall k (c1 c2 : con (KRecord k)),
+    dvar c1 c2 -> disj c1 c2
+  | DComm : forall k (c1 c2 : con (KRecord k)),
+    disj c1 c2 -> disj c2 c1
+
+  | DEmpty : forall k c2,
+    disj (CEmpty k) c2
+  | DSingleKeys : forall k X1 X2 (c1 c2 : con k),
+    X1 <> X2
+    -> disj (CSingle (Name X1) c1) (CSingle (Name X2) c2)
+  | DSingleValues : forall k n1 n2 (c1 c2 : con k) k' (c1' c2' : con k'),
+    disj (CSingle n1 c1') (CSingle n2 c2')
+    -> disj (CSingle n1 c1) (CSingle n2 c2)
+
+  | DConcat : forall k (c1 c2 c : con (KRecord k)),
+    disj c1 c
+    -> disj c2 c
+    -> disj (CConcat c1 c2) c
+
+  | DEq : forall k (c1 c2 c1' : con (KRecord k)),
+    disj c1 c2
+    -> deq c1' c1
+    -> disj c1' c2
+
+  with deq : forall k, con k -> con k -> Prop :=
+  | Eq_Beta : forall k1 k2 (c1 : cvar k1 -> con k2) c2 c1',
+    subs c2 c1 c1'
+    -> deq (CApp (CAbs c1) c2) c1'
+  | Eq_Refl : forall k (c : con k),
+    deq c c
+  | Eq_Comm : forall k (c1 c2 : con k),
+    deq c2 c1
+    -> deq c1 c2
+  | Eq_Trans : forall k (c1 c2 c3 : con k),
+    deq c1 c2
+    -> deq c2 c3
+    -> deq c1 c3
+  | Eq_Cong : forall k1 k2 c1 c1' (c2 : cvar k1 -> con k2) c2' c2'',
+    deq c1 c1'
+    -> subs c1 c2 c2'
+    -> subs c1' c2 c2''
+    -> deq c2' c2''
+
+  | Eq_Concat_Empty : forall k c,
+    deq (CConcat (CEmpty k) c) c
+  | Eq_Concat_Comm : forall k (c1 c2 c3 : con (KRecord k)),
+    disj c1 c2
+    -> deq (CConcat c1 c2) (CConcat c2 c1)
+  | Eq_Concat_Assoc : forall k (c1 c2 c3 : con (KRecord k)),
+    deq (CConcat c1 (CConcat c2 c3)) (CConcat (CConcat c1 c2) c3)
+
+  | Eq_Map_Empty : forall k1 k2 f,
+    deq (CApp (CApp (CMap k1 k2) f) (CEmpty _)) (CEmpty _)
+  | Eq_Map_Cons : forall k1 k2 f c1 c2 c3,
+    disj (CSingle c1 c2) c3
+    -> deq (CApp (CApp (CMap k1 k2) f) (CConcat (CSingle c1 c2) c3))
+    (CConcat (CSingle c1 (CApp f c2)) (CApp (CApp (CMap k1 k2) f) c3))
+
+  | Eq_Map_Ident : forall k c,
+    deq (CApp (CApp (CMap k k) (CAbs (fun x => CVar x))) c) c
+  | Eq_Map_Dist : forall k1 k2 f c1 c2,
+    deq (CApp (CApp (CMap k1 k2) f) (CConcat c1 c2))
+    (CConcat (CApp (CApp (CMap k1 k2) f) c1) (CApp (CApp (CMap k1 k2) f) c2))
+  | Eq_Map_Fuse : forall k1 k2 k3 f f' c,
+    deq (CApp (CApp (CMap k2 k3) f')
+      (CApp (CApp (CMap k1 k2) f) c))
+    (CApp (CApp (CMap k1 k3) (CAbs (fun x => CApp f' (CApp f (CVar x))))) c).
+
+  Variable evar : con KType -> Type.
+
+  Inductive exp : con KType -> Type :=
+  | Var : forall t, evar t -> exp t
+  | App : forall dom ran, exp (Arrow dom ran) -> exp dom -> exp ran
+  | Abs : forall dom ran, (evar dom -> exp ran) -> exp (Arrow dom ran)
+  | ECApp : forall k (dom : con k) ran ran', exp (Poly ran) -> subs dom ran ran' -> exp ran'
+  | ECAbs : forall k (ran : cvar k -> _), (forall X, exp (ran X)) -> exp (Poly ran)
+  | Cast : forall t1 t2, deq t1 t2 -> exp t1 -> exp t2
+  | Empty : exp (TRecord (CEmpty _))
+  | Single : forall c t, exp t -> exp (TRecord (CConcat (CSingle c t) (CEmpty _)))
+  | Proj : forall c t c', exp (TRecord (CConcat (CSingle c t) c')) -> exp t
+  | Cut : forall c t c', disj (CSingle c t) c' -> exp (TRecord (CConcat (CSingle c t) c')) -> exp (TRecord c')
+  | Concat : forall c1 c2, exp (TRecord c1) -> exp (TRecord c2) -> exp (TRecord (CConcat c1 c2))
+  | Guarded : forall k (c1 c2 : con (KRecord k)) c, (dvar c1 c2 -> exp c) -> exp (TGuarded c1 c2 c)
+  | GuardedApp : forall k (c1 c2 : con (KRecord k)) t, exp (TGuarded c1 c2 t) -> disj c1 c2 -> exp t.
+End vars.
diff --git a/src/core.sml b/src/core.sml
new file mode 100644
index 0000000..8f57c31
--- /dev/null
+++ b/src/core.sml
@@ -0,0 +1,146 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Core = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype kind' =
+         KType
+       | KArrow of kind * kind
+       | KName
+       | KRecord of kind
+       | KUnit
+       | KTuple of kind list
+
+       | KRel of int
+       | KFun of string * kind
+
+withtype kind = kind' located
+
+datatype con' =
+         TFun of con * con
+       | TCFun of string * kind * con
+       | TRecord of con
+
+       | CRel of int
+       | CNamed of int
+       | CFfi of string * string
+       | CApp of con * con
+       | CAbs of string * kind * con
+
+       | CKAbs of string * con
+       | CKApp of con * kind
+       | TKFun of string * con
+
+       | CName of string
+
+       | CRecord of kind * (con * con) list
+       | CConcat of con * con
+       | CMap of kind * kind
+
+       | CUnit
+
+       | CTuple of con list
+       | CProj of con * int
+
+withtype con = con' located
+
+datatype datatype_kind = datatype DatatypeKind.datatype_kind
+
+datatype patCon =
+         PConVar of int
+       | PConFfi of {mod : string, datatyp : string, params : string list,
+                     con : string, arg : con option, kind : datatype_kind}
+
+datatype pat' =
+         PVar of string * con
+       | PPrim of Prim.t
+       | PCon of datatype_kind * patCon * con list * pat option
+       | PRecord of (string * pat * con) list
+
+withtype pat = pat' located
+
+datatype failure_mode = datatype Settings.failure_mode
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | ECon of datatype_kind * patCon * con list * exp option
+       | EFfi of string * string
+       | EFfiApp of string * string * (exp * con) list
+       | EApp of exp * exp
+       | EAbs of string * con * con * exp
+       | ECApp of exp * con
+       | ECAbs of string * kind * exp
+
+       | EKAbs of string * exp
+       | EKApp of exp * kind
+
+       | ERecord of (con * exp * con) list
+       | EField of exp * con * { field : con, rest : con }
+       | EConcat of exp * con * exp * con
+       | ECut of exp * con * { field : con, rest : con }
+       | ECutMulti of exp * con * { rest : con }
+
+       | ECase of exp * (pat * exp) list * { disc : con, result : con }
+
+       | EWrite of exp
+
+       | EClosure of int * exp list
+
+       | ELet of string * con * exp * exp
+
+       | EServerCall of int * exp list * con * failure_mode
+
+withtype exp = exp' located
+
+datatype effect = datatype Export.effect
+datatype export_kind = datatype Export.export_kind
+
+datatype decl' =
+         DCon of string * int * kind * con
+       | DDatatype of (string * int * string list * (string * int * con option) list) list
+       | DVal of string * int * con * exp * string
+       | DValRec of (string * int * con * exp * string) list
+       | DExport of export_kind * int * bool
+       | DTable of string * int * con * string * exp * con * exp * con
+       | DSequence of string * int * string
+       | DView of string * int * string * exp * con
+       | DDatabase of string
+       | DCookie of string * int * con * string
+       | DStyle of string * int * string
+       | DTask of exp * exp
+       | DPolicy of exp
+       | DOnError of int
+
+withtype decl = decl' located
+
+type file = decl list
+
+end
diff --git a/src/core_env.sig b/src/core_env.sig
new file mode 100644
index 0000000..9377373
--- /dev/null
+++ b/src/core_env.sig
@@ -0,0 +1,72 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CORE_ENV = sig
+
+    val liftConInCon : int -> Core.con -> Core.con
+    val subConInCon : (int * Core.con) -> Core.con -> Core.con
+
+    val liftConInExp : int -> Core.exp -> Core.exp
+    val subConInExp : (int * Core.con) -> Core.exp -> Core.exp
+
+    val liftExpInExp : int -> Core.exp -> Core.exp
+    val subExpInExp : (int * Core.exp) -> Core.exp -> Core.exp
+
+    type env
+
+    val empty : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+
+    val pushKRel : env -> string -> env
+    val lookupKRel : env -> int -> string
+
+    val pushCRel : env -> string -> Core.kind -> env
+    val lookupCRel : env -> int -> string * Core.kind
+
+    val pushCNamed : env -> string -> int -> Core.kind -> Core.con option -> env
+    val lookupCNamed : env -> int -> string * Core.kind * Core.con option
+
+    val pushDatatype : env -> string -> int -> string list -> (string * int * Core.con option) list -> env
+    val lookupDatatype : env -> int -> string * string list * (string * int * Core.con option) list
+
+    val lookupConstructor : env -> int -> string * string list * Core.con option * int
+
+    val pushERel : env -> string -> Core.con -> env
+    val lookupERel : env -> int -> string * Core.con
+
+    val pushENamed : env -> string -> int -> Core.con -> Core.exp option -> string -> env
+    val lookupENamed : env -> int -> string * Core.con * Core.exp option * string
+
+    val declBinds : env -> Core.decl -> env
+    val patBinds : env -> Core.pat -> env
+
+    val patBindsN : Core.pat -> int
+    val patBindsL : Core.pat -> (string * Core.con) list
+                                                 
+end
diff --git a/src/core_env.sml b/src/core_env.sml
new file mode 100644
index 0000000..7d78bde
--- /dev/null
+++ b/src/core_env.sml
@@ -0,0 +1,379 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure CoreEnv :> CORE_ENV = struct
+
+open Core
+
+structure U = CoreUtil
+
+structure IM = IntBinaryMap
+
+
+(* AST utility functions *)
+
+val liftKindInKind =
+    U.Kind.mapB {kind = fn bound => fn k =>
+                                       case k of
+                                           KRel xn =>
+                                           if xn < bound then
+                                               k
+                                           else
+                                               KRel (xn + 1)
+                                         | _ => k,
+                 bind = fn (bound, _) => bound + 1}
+
+val liftKindInCon =
+    U.Con.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + 1)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                bind = fn (bound, U.Con.RelK _) => bound + 1
+                        | (bound, _) => bound}
+
+val liftKindInExp =
+    U.Exp.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + 1)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelK _) => bound + 1
+                        | (bound, _) => bound}
+    
+val liftConInCon =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | _ => c,
+                bind = fn (bound, U.Con.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+val lift = liftConInCon 0
+
+val subConInCon =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn (xn, rep) => fn c =>
+                                  case c of
+                                      CRel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER => CRel (xn' - 1)
+                                         | LESS => c)
+                                    | _ => c,
+                bind = fn ((xn, rep), U.Con.RelC _) => (xn+1, liftConInCon 0 rep)
+                        | (ctx, _) => ctx}
+
+
+val liftConInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | _ => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+val subConInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn (xn, rep) => fn c =>
+                                         case c of
+                                             CRel xn' =>
+                                             (case Int.compare (xn', xn) of
+                                                  EQUAL => #1 rep
+                                                | GREATER => CRel (xn' - 1)
+                                                | LESS => c)
+                                           | _ => c,
+                exp = fn _ => fn e => e,
+                bind = fn ((xn, rep), U.Exp.RelC _) => (xn+1, liftConInCon 0 rep)
+                        | (ctx, _) => ctx}
+
+val liftExpInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+val subExpInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | ((xn, rep), U.Exp.RelC _) => (xn, liftConInExp 0 rep)
+                        | (ctx, _) => ctx}
+
+(* Back to environments *)
+
+exception UnboundRel of int
+exception UnboundNamed of int
+
+type env = {
+     relK : string list,
+
+     relC : (string * kind) list,
+     namedC : (string * kind * con option) IM.map,
+
+     datatypes : (string * string list * (string * int * con option) list) IM.map,
+     constructors : (string * string list * con option * int) IM.map,
+
+     relE : (string * con) list,
+     namedE : (string * con * exp option * string) IM.map
+}
+
+val empty = {
+    relK = [],
+
+    relC = [],
+    namedC = IM.empty,
+
+    datatypes = IM.empty,
+    constructors = IM.empty,
+
+    relE = [],
+    namedE = IM.empty
+}
+
+fun pushKRel (env : env) x =
+    {relK = x :: #relK env,
+
+     relC = map (fn (x, k) => (x, liftKindInKind 0 k)) (#relC env),
+     namedC = #namedC env,
+
+     relE = map (fn (x, c) => (x, liftKindInCon 0 c)) (#relE env),
+     namedE = #namedE env,
+
+     datatypes = #datatypes env,
+     constructors = #constructors env
+    }
+
+fun lookupKRel (env : env) n =
+    (List.nth (#relK env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushCRel (env : env) x k =
+    {relK = #relK env,
+
+     relC = (x, k) :: #relC env,
+     namedC = IM.map (fn (x, k, co) => (x, k, Option.map lift co)) (#namedC env),
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     relE = map (fn (x, c) => (x, lift c)) (#relE env),
+     namedE = IM.map (fn (x, c, eo, s) => (x, lift c, eo, s)) (#namedE env)}
+
+fun lookupCRel (env : env) n =
+    (List.nth (#relC env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushCNamed (env : env) x n k co =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = IM.insert (#namedC env, n, (x, k, co)),
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+     
+     relE = #relE env,
+     namedE = #namedE env}
+
+fun lookupCNamed (env : env) n =
+    case IM.find (#namedC env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushDatatype (env : env) x n xs xncs =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     datatypes = IM.insert (#datatypes env, n, (x, xs, xncs)),
+     constructors = foldl (fn ((x, n', to), constructors) =>
+                              IM.insert (constructors, n', (x, xs, to, n)))
+                          (#constructors env) xncs,
+     
+     relE = #relE env,
+     namedE = #namedE env}
+
+fun lookupDatatype (env : env) n =
+    case IM.find (#datatypes env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupConstructor (env : env) n =
+    case IM.find (#constructors env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushERel (env : env) x t =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     relE = (x, t) :: #relE env,
+     namedE = #namedE env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushENamed (env : env) x n t eo s =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t, eo, s))}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun declBinds env (d, loc) =
+    case d of
+        DCon (x, n, k, c) => pushCNamed env x n k (SOME c)
+      | DDatatype dts =>
+        foldl (fn ((x, n, xs, xncs), env) =>
+                  let
+                      val env = pushDatatype env x n xs xncs
+                      val env = pushCNamed env x n (KType, loc) NONE
+                  in
+                      foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (CNamed n, loc) NONE ""
+                              | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (CNamed n, loc)), loc) NONE "")
+                            env xncs
+                  end) env dts
+      | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s
+      | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis
+      | DExport _ => env
+      | DTable (x, n, c, s, _, pc, _, cc) =>
+        let
+            val ct = (CFfi ("Basis", "sql_table"), loc)
+            val ct = (CApp (ct, c), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+        in
+            pushENamed env x n ct NONE s
+        end
+      | DSequence (x, n, s) =>
+        let
+            val t = (CFfi ("Basis", "sql_sequence"), loc)
+        in
+            pushENamed env x n t NONE s
+        end
+      | DView (x, n, s, _, c) =>
+        let
+            val ct = (CFfi ("Basis", "sql_view"), loc)
+            val ct = (CApp (ct, c), loc)
+        in
+            pushENamed env x n ct NONE s
+        end
+      | DDatabase _ => env
+      | DCookie (x, n, c, s) =>
+        let
+            val t = (CApp ((CFfi ("Basis", "http_cookie"), loc), c), loc)
+        in
+            pushENamed env x n t NONE s
+        end
+      | DStyle (x, n, s) =>
+        let
+            val t = (CFfi ("Basis", "css_class"), loc)
+        in
+            pushENamed env x n t NONE s
+        end
+      | DTask _ => env
+      | DPolicy _ => env
+      | DOnError _ => env
+
+fun patBinds env (p, loc) =
+    case p of
+        PVar (x, t) => pushERel env x t
+      | PPrim _ => env
+      | PCon (_, _, _, NONE) => env
+      | PCon (_, _, _, SOME p) => patBinds env p
+      | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+
+fun patBindsN (p, loc) =
+    case p of
+        PVar _ => 1
+      | PPrim _ => 0
+      | PCon (_, _, _, NONE) => 0
+      | PCon (_, _, _, SOME p) => patBindsN p
+      | PRecord xps => foldl (fn ((_, p, _), count) => count + patBindsN p) 0 xps
+
+fun patBindsL (p, loc) =
+    case p of
+        PVar (x, t) => [(x, t)]
+      | PPrim _ => []
+      | PCon (_, _, _, NONE) => []
+      | PCon (_, _, _, SOME p) => patBindsL p
+      | PRecord xps => rev (ListUtil.mapConcat (rev o patBindsL o #2) xps)
+
+end
diff --git a/src/core_print.sig b/src/core_print.sig
new file mode 100644
index 0000000..aee3717
--- /dev/null
+++ b/src/core_print.sig
@@ -0,0 +1,41 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web internal language *)
+
+signature CORE_PRINT = sig
+    val p_kind : CoreEnv.env -> Core.kind Print.printer
+    val p_con : CoreEnv.env -> Core.con Print.printer
+    val p_patCon : CoreEnv.env -> Core.patCon Print.printer
+    val p_pat : CoreEnv.env -> Core.pat Print.printer
+    val p_exp : CoreEnv.env -> Core.exp Print.printer
+    val p_decl : CoreEnv.env -> Core.decl Print.printer
+    val p_file : CoreEnv.env -> Core.file Print.printer
+
+    val debug : bool ref
+end
+
diff --git a/src/core_print.sml b/src/core_print.sml
new file mode 100644
index 0000000..5c71e97
--- /dev/null
+++ b/src/core_print.sml
@@ -0,0 +1,643 @@
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing core Ur/Web *)
+
+structure CorePrint :> CORE_PRINT = struct
+
+open Print.PD
+open Print
+
+open Core
+
+structure E = CoreEnv
+
+val debug = ref false
+
+fun p_kind' par env (k, _) =
+    case k of
+        KType => string "Type"
+      | KArrow (k1, k2) => parenIf par (box [p_kind' true env k1,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_kind env k2])
+      | KName => string "Name"
+      | KRecord k => box [string "{", p_kind env k, string "}"]
+      | KUnit => string "Unit"
+      | KTuple ks => box [string "(",
+                          p_list_sep (box [space, string "*", space]) (p_kind env) ks,
+                          string ")"]
+
+      | KRel n => ((if !debug then
+                         string (E.lookupKRel env n ^ "_" ^ Int.toString n)
+                     else
+                         string (E.lookupKRel env n))
+                    handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | KFun (x, k) => box [string x,
+                            space,
+                            string "-->",
+                            space,
+                            p_kind (E.pushKRel env x) k]
+
+and p_kind env = p_kind' false env
+
+fun p_con' par env (c, _) =
+    case c of
+        TFun (t1, t2) => parenIf par (box [p_con' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_con env t2])
+      | TCFun (x, k, c) => parenIf par (box [string x,
+                                             space,
+                                             string "::",
+                                             space,
+                                             p_kind env k,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_con (E.pushCRel env x k) c])
+      | TRecord (CRecord (_, xcs), _) => box [string "{",
+                                              p_list (fn (x, c) =>
+                                                         box [p_name env x,
+                                                              space,
+                                                              string ":",
+                                                              space,
+                                                              p_con env c]) xcs,
+                                              string "}"]
+      | TRecord c => box [string "$",
+                          p_con' true env c]
+
+      | CRel n =>
+        ((if !debug then
+              string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCRel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
+      | CNamed n =>
+        ((if !debug then
+              string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCNamed env n)))
+        handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n))
+      | CFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+
+      | CApp (c1, c2) => parenIf par (box [p_con env c1,
+                                           space,
+                                           p_con' true env c2])
+      | CAbs (x, k, c) => parenIf par (box [string "fn",
+                                            space,
+                                            string x,
+                                            space,
+                                            string "::",
+                                            space,
+                                            p_kind env k,
+                                            space,
+                                            string "=>",
+                                            space,
+                                            p_con (E.pushCRel env x k) c])
+
+      | CName s => box [string "#", string s]
+
+      | CRecord (k, xcs) =>
+        if !debug then
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_con env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]::",
+                              p_kind env k])
+        else
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_con env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]"])
+      | CConcat (c1, c2) => parenIf par (box [p_con' true env c1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_con env c2])
+      | CMap _ => string "map"
+      | CUnit => string "()"
+
+      | CTuple cs => box [string "(",
+                          p_list (p_con env) cs,
+                          string ")"]
+      | CProj (c, n) => box [p_con env c,
+                             string ".",
+                             string (Int.toString n)]
+
+      | CKAbs (x, c) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_con (E.pushKRel env x) c]
+      | CKApp (c, k) => box [p_con env c,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+      | TKFun (x, c) => box [string x,
+                             space,
+                             string "-->",
+                             space,
+                             p_con (E.pushKRel env x) c]
+        
+and p_con env = p_con' false env
+
+and p_name env (all as (c, _)) =
+    case c of
+        CName s => string s
+      | _ => p_con env all
+
+fun p_enamed env n =
+    (if !debug then
+        string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+     else
+         string (#1 (E.lookupENamed env n)))
+    handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n)
+
+fun p_con_named env n =
+    (if !debug then
+        string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n)
+     else
+         string (#1 (E.lookupConstructor env n)))
+    handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n)
+
+fun p_patCon env pc =
+    case pc of
+        PConVar n => p_con_named env n
+      | PConFfi {mod = m, con, arg, params, ...} =>
+        if !debug then
+            box [string "FFIC[",
+                 case arg of
+                     NONE => box []
+                   | SOME t =>
+                     let
+                         val k = (KType, ErrorMsg.dummySpan)
+                         val env' = foldl (fn (x, env) => E.pushCRel env x k) env params
+                     in
+                         p_con env' t
+                     end,
+                 string "](",
+                 string m,
+                 string ".",
+                 string con,
+                 string ")"]
+        else
+            box [string "FFIC(",
+                 string m,
+                 string ".",
+                 string con,
+                 string ")"]
+
+fun p_pat' par env (p, _) =
+    case p of
+        PVar (s, _) => string s
+      | PPrim p => Prim.p_t p
+      | PCon (_, n, _, NONE) => p_patCon env n
+      | PCon (_, n, _, SOME p) => parenIf par (box [p_patCon env n,
+                                                    space,
+                                                    p_pat' true env p])
+      | PRecord xps =>
+        box [string "{",
+             p_list_sep (box [string ",", space]) (fn (x, p, t) =>
+                                                      box [string x,
+                                                           space,
+                                                           string "=",
+                                                           space,
+                                                           p_pat env p,
+                                                           if !debug then
+                                                               box [space,
+                                                                    string ":",
+                                                                    space,
+                                                                    p_con env t]
+                                                           else
+                                                               box []]) xps,
+             string "}"]
+
+and p_pat x = p_pat' false x
+
+fun p_exp' par env (e, _) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n =>
+        ((if !debug then
+              string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupERel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
+      | ENamed n => p_enamed env n
+      | ECon (_, pc, ts, NONE) => box [string "[",
+                                       p_patCon env pc,
+                                       p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
+                                       string "]"]
+      | ECon (_, pc, ts, SOME e) => box [string "[",
+                                        p_patCon env pc,
+                                        space,
+                                        p_exp' true env e,
+                                        p_list_sep (box []) (fn t => box [space, string "[", p_con env t, string "]"]) ts,
+                                        string "]"]
+      | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+      | EFfiApp (m, x, es) => box [string "FFI(",
+                                   string m,
+                                   string ".",
+                                   string x,
+                                   string "(",
+                                   p_list (p_exp env o #1) es,
+                                   string "))"]
+      | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
+                                           space,
+                                           p_exp' true env e2])
+      | EAbs (x, t, _, e) => parenIf par (box [string "(fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               string ":",
+                                               space,
+                                               p_con env t,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_exp (E.pushERel env x t) e,
+                                               string ")"])
+      | ECApp (e, c) => parenIf par (box [p_exp env e,
+                                          space,
+                                          string "[",
+                                          p_con env c,
+                                          string "]"])
+      | ECAbs (x, k, e) => parenIf par (box [string "fn",
+                                             space,
+                                             string x,
+                                             space,
+                                             string "::",
+                                             space,
+                                             p_kind env k,
+                                             space,
+                                             string "=>",
+                                             space,
+                                             p_exp (E.pushCRel env x k) e])
+
+      | ERecord xes => box [string "{",
+                            p_list (fn (x, e, _) =>
+                                       box [p_name env x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_exp env e]) xes,
+                            string "}"]
+      | EField (e, c, {field, rest}) =>
+        if !debug then
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c,
+                 space,
+                 string "[",
+                 p_con env field,
+                 space,
+                 string " in ",
+                 space,
+                 p_con env rest,
+                 string "]"]
+        else
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c]
+      | EConcat (e1, c1, e2, c2) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e1,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c1,
+                              space,
+                              string "++",
+                              space,
+                              p_exp' true env e2,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c2]
+                     else
+                         box [p_exp' true env e1,
+                              space,
+                              string "with",
+                              space,
+                              p_exp' true env e2])
+      | ECut (e, c, {field, rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env field,
+                              space,
+                              string " in ",
+                              space,
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c])
+      | ECutMulti (e, c, {rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c])
+
+      | ECase (e, pes, {disc, result}) =>
+        parenIf par (box [string "case",
+                          space,
+                          p_exp env e,
+                          space,
+                          if !debug then
+                              box [string "in",
+                                   space,
+                                   p_con env disc,
+                                   space,
+                                   string "return",
+                                   space,
+                                   p_con env result,
+                                   space]
+                          else
+                              box [],
+                          string "of",
+                          space,
+                          p_list_sep (box [space, string "|", space])
+                                     (fn (p, e) => box [p_pat env p,
+                                                        space,
+                                                        string "=>",
+                                                        space,
+                                                        p_exp (E.patBinds env p) e]) pes])
+
+      | EWrite e => box [string "write(",
+                         p_exp env e,
+                         string ")"]
+
+      | EClosure (n, es) => box [string "CLOSURE(",
+                                 p_enamed env n,
+                                 p_list_sep (string "") (fn e => box [string ", ",
+                                                                      p_exp env e]) es,
+                                 string ")"]
+
+      | ELet (x, t, e1, e2) => box [string "let",
+                                    space,
+                                    string x,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_con env t,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp env e1,
+                                    space,
+                                    string "in",
+                                    newline,
+                                    p_exp (E.pushERel env x t) e2]
+
+      | EServerCall (n, es, _, _) => box [string "Server(",
+                                          p_enamed env n,
+                                          string ",",
+                                          space,
+                                          p_list (p_exp env) es,
+                                          string ")"]
+
+      | EKAbs (x, e) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_exp (E.pushKRel env x) e]
+      | EKApp (e, k) => box [p_exp env e,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+
+and p_exp env = p_exp' false env
+
+fun p_named x n =
+    if !debug then
+        box [string x,
+             string "__",
+             string (Int.toString n)]
+    else
+        string x        
+
+fun p_vali env (x, n, t, e, s) =
+    let
+        val xp = p_named x n
+    in
+        box [xp,
+             space,
+             string "as",
+             space,
+             string s,
+             space,
+             string ":",
+             space,
+             p_con env t,
+             space,
+             string "=",
+             space,
+             p_exp env e]
+    end
+
+fun p_datatype env (x, n, xs, cons) =
+    let
+        val k = (KType, ErrorMsg.dummySpan)
+        val env = E.pushCNamed env x n (KType, ErrorMsg.dummySpan) NONE
+        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
+
+        val xp = if !debug then
+                     string (x ^ "__" ^ Int.toString n)
+                 else
+                     string x
+    in
+        box [xp,
+             p_list_sep (box []) (fn x => box [space, string x]) xs,
+             space,
+             string "=",
+             space,
+             p_list_sep (box [space, string "|", space])
+                        (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
+                                            else string x
+                          | (x, n, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
+                                                   else string x, space, string "of", space, p_con env t])
+                        cons]
+    end
+
+fun p_decl env (dAll as (d, _) : decl) =
+    case d of
+        DCon (x, n, k, c) =>
+        let
+            val xp = if !debug then
+                         box [string x,
+                              string "__",
+                              string (Int.toString n)]
+                     else
+                         string x
+        in
+            box [string "con",
+                 space,
+                 xp,
+                 space,
+                 string "::",
+                 space,
+                 p_kind env k,
+                 space,
+                 string "=",
+                 space,
+                 p_con env c]
+        end
+      | DDatatype x => box [string "datatype",
+                            space,
+                            p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
+      | DVal vi => box [string "val",
+                        space,
+                        p_vali env vi]
+      | DValRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
+        end
+      | DExport (ek, n, _) => box [string "export",
+                                   space,
+                                   Export.p_export_kind ek,
+                                   space,
+                                   p_enamed env n,
+                                   space,
+                                   string "as",
+                                   space,
+                                   (p_con env (#2 (E.lookupENamed env n))
+                                    handle E.UnboundNamed _ => string "UNBOUND")]
+      | DTable (x, n, c, s, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string "as",
+                                                  space,
+                                                  string s,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp (E.declBinds env dAll) ce]
+      | DSequence (x, n, s) => box [string "sequence",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "as",
+                                    space,
+                                    string s]
+      | DView (x, n, s, e, _) => box [string "view",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string "as",
+                                      space,
+                                      p_exp env e]
+      | DDatabase s => box [string "database",
+                            space,
+                            string s]
+      | DCookie (x, n, c, s) => box [string "cookie",
+                                     space,
+                                     p_named x n,
+                                     space,
+                                     string "as",
+                                     space,
+                                     string s,
+                                     space,
+                                     string ":",
+                                     space,
+                                     p_con env c]
+      | DStyle (x, n, s) => box [string "style",
+                                 space,
+                                 p_named x n,
+                                 space,
+                                 string "as",
+                                 space,
+                                 string s]
+      | DTask (e1, e2) => box [string "task",
+                               space,
+                               p_exp env e1,
+                               space,
+                               string "=",
+                               space,
+                               p_exp env e2]
+      | DPolicy e1 => box [string "policy",
+                           space,
+                           p_exp env e1]
+      | DOnError _ => string "ONERROR"
+
+fun p_file env file =
+    let
+        val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
+                                             (p_decl env d,
+                                              E.declBinds env d))
+                             env file
+    in
+        p_list_sep newline (fn x => x) pds
+    end
+
+end
diff --git a/src/core_untangle.sig b/src/core_untangle.sig
new file mode 100644
index 0000000..86e039e
--- /dev/null
+++ b/src/core_untangle.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CORE_UNTANGLE = sig
+
+    val untangle : Core.file -> Core.file
+
+end
diff --git a/src/core_untangle.sml b/src/core_untangle.sml
new file mode 100644
index 0000000..a3bb559
--- /dev/null
+++ b/src/core_untangle.sml
@@ -0,0 +1,237 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure CoreUntangle :> CORE_UNTANGLE = struct
+
+open Core
+
+structure U = CoreUtil
+structure E = CoreEnv
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+fun default (k, s) = s
+
+fun exp thisGroup (e, s) =
+    let
+        fun try n =
+            if IS.member (thisGroup, n) then
+                IS.add (s, n)
+            else
+                s
+    in
+        case e of
+            ENamed n => try n
+          | EClosure (n, _) => try n
+          | EServerCall (n, _, _, _) => try n
+          | _ => s
+    end
+
+fun untangle file =
+    let
+        fun expUsed thisGroup = U.Exp.fold {con = default,
+                                            kind = default,
+                                            exp = exp thisGroup} IS.empty
+
+        fun decl (dAll as (d, loc)) =
+            case d of
+                DValRec vis =>
+                let
+                    val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) =>
+                                              IS.add (thisGroup, n)) IS.empty vis
+
+                    val edefs = foldl (fn ((_, n, _, e, _), edefs) =>
+                                         IM.insert (edefs, n, expUsed thisGroup e))
+                                     IM.empty vis
+
+                    val used = edefs
+
+                    fun expand used =
+                        IS.foldl (fn (n, used) =>
+                                     case IM.find (edefs, n) of
+                                         NONE => used
+                                       | SOME usedHere =>
+                                         if IS.isEmpty (IS.difference (usedHere, used)) then
+                                             used
+                                         else
+                                             expand (IS.union (usedHere, used)))
+                        used used
+
+                    fun p_graph reachable =
+                        IM.appi (fn (n, reachableHere) =>
+                                    (print (Int.toString n);
+                                     print ":";
+                                     IS.app (fn n' => (print " ";
+                                                       print (Int.toString n'))) reachableHere;
+                                     print "\n")) reachable
+
+                    (*val () = print "used:\n"
+                    val () = p_graph used*)
+
+                    fun expand reachable =
+                        let
+                            val changed = ref false
+
+                            val reachable =
+                                IM.mapi (fn (n, reachableHere) =>
+                                            IS.foldl (fn (n', reachableHere) =>
+                                                         let
+                                                             val more = valOf (IM.find (reachable, n'))
+                                                         in
+                                                             if IS.isEmpty (IS.difference (more, reachableHere)) then
+                                                                 reachableHere
+                                                             else
+                                                                 (changed := true;
+                                                                  IS.union (more, reachableHere))
+                                                         end)
+                                                     reachableHere reachableHere) reachable
+                        in
+                            (reachable, !changed)
+                        end
+
+                    fun iterate reachable =
+                        let
+                            val (reachable, changed) = expand reachable
+                        in
+                            if changed then
+                                iterate reachable
+                            else
+                                reachable
+                        end
+
+                    val reachable = iterate used
+
+                    (*val () = print "reachable:\n"
+                    val () = p_graph reachable*)
+
+                    fun sccs (nodes, acc) =
+                        case IS.find (fn _ => true) nodes of
+                            NONE => acc
+                          | SOME rep =>
+                            let
+                                val reachableHere = valOf (IM.find (reachable, rep))
+
+                                val (nodes, scc) = IS.foldl (fn (node, (nodes, scc)) =>
+                                                                if node = rep then
+                                                                    (nodes, scc)
+                                                                else
+                                                                    let
+                                                                        val reachableThere =
+                                                                            valOf (IM.find (reachable, node))
+                                                                    in
+                                                                        if IS.member (reachableThere, rep) then
+                                                                            (IS.delete (nodes, node),
+                                                                             IS.add (scc, node))
+                                                                        else
+                                                                            (nodes, scc)
+                                                                    end)
+                                                   (IS.delete (nodes, rep), IS.singleton rep) reachableHere
+                            in
+                                sccs (nodes, scc :: acc)
+                            end
+
+                    val sccs = sccs (thisGroup, [])
+
+                    (*val () = app (fn nodes => (print "SCC:";
+                                               IS.app (fn i => (print " ";
+                                                                print (Int.toString i))) nodes;
+                                               print "\n")) sccs*)
+
+                    fun depends nodes1 nodes2 =
+                        let
+                            val node1 = valOf (IS.find (fn _ => true) nodes1)
+                            val node2 = valOf (IS.find (fn _ => true) nodes2)
+                            val reachable1 = valOf (IM.find (reachable, node1))
+                        in
+                            IS.member (reachable1, node2)
+                        end
+
+                    fun findReady (sccs, passed) =
+                        case sccs of
+                            [] => raise Fail "Untangle: Unable to topologically sort 'val rec'"
+                          | nodes :: sccs =>
+                            if List.exists (depends nodes) passed
+                               orelse List.exists (depends nodes) sccs then
+                                findReady (sccs, nodes :: passed)
+                            else
+                                (nodes, List.revAppend (passed, sccs))
+
+                    fun topo (sccs, acc) =
+                        case sccs of
+                            [] => rev acc
+                          | _ =>
+                            let
+                                val (node, sccs) = findReady (sccs, [])
+                            in
+                                topo (sccs, node :: acc)
+                            end
+
+                    val sccs = topo (sccs, [])
+
+                    (*val () = app (fn nodes => (print "SCC':";
+                                               IS.app (fn i => (print " ";
+                                                                print (Int.toString i))) nodes;
+                                               print "\n")) sccs*)
+
+                    fun isNonrec nodes =
+                        case IS.find (fn _ => true) nodes of
+                            NONE => NONE
+                          | SOME node =>
+                            let
+                                val nodes = IS.delete (nodes, node)
+                                val reachableHere = valOf (IM.find (reachable, node))
+                            in
+                                if IS.isEmpty nodes then
+                                    if IS.member (reachableHere, node) then
+                                        NONE
+                                    else
+                                        SOME node
+                                else
+                                    NONE
+                            end
+
+                    val ds = map (fn nodes =>
+                                     case isNonrec nodes of
+                                         SOME node =>
+                                         let
+                                             val vi = valOf (List.find (fn (_, n, _, _, _) => n = node) vis)
+                                         in
+                                             (DVal vi, loc)
+                                         end
+                                       | NONE =>
+                                         (DValRec (List.filter (fn (_, n, _, _, _) => IS.member (nodes, n)) vis), loc))
+                                 sccs
+                in
+                    ds
+                end
+              | _ => [dAll]
+    in
+        ListUtil.mapConcat decl file
+    end
+
+end
diff --git a/src/core_util.sig b/src/core_util.sig
new file mode 100644
index 0000000..835577a
--- /dev/null
+++ b/src/core_util.sig
@@ -0,0 +1,232 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CORE_UTIL = sig
+
+structure Kind : sig
+    val compare : Core.kind * Core.kind -> order
+
+    val mapfoldB : {kind : ('context, Core.kind', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * string -> 'context}
+                   -> ('context, Core.kind, 'state, 'abort) Search.mapfolderB
+    val mapfold : (Core.kind', 'state, 'abort) Search.mapfolder
+                  -> (Core.kind, 'state, 'abort) Search.mapfolder
+    val map : (Core.kind' -> Core.kind') -> Core.kind -> Core.kind
+    val exists : (Core.kind' -> bool) -> Core.kind -> bool
+    val mapB : {kind : 'context -> Core.kind' -> Core.kind',
+                bind : 'context * string -> 'context}
+               -> 'context -> (Core.kind -> Core.kind)
+end
+
+structure Con : sig
+    val compare : Core.con * Core.con -> order
+
+    datatype binder =
+             RelK of string
+           | RelC of string * Core.kind
+           | NamedC of string * int * Core.kind * Core.con option
+
+    val mapfoldB : {kind : ('context, Core.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Core.con', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Core.con, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Core.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Core.con', 'state, 'abort) Search.mapfolder}
+                  -> (Core.con, 'state, 'abort) Search.mapfolder
+
+    val map : {kind : Core.kind' -> Core.kind',
+               con : Core.con' -> Core.con'}
+              -> Core.con -> Core.con
+
+    val mapB : {kind : 'context -> Core.kind' -> Core.kind',
+                con : 'context -> Core.con' -> Core.con',
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Core.con -> Core.con)
+
+    val fold : {kind : Core.kind' * 'state -> 'state,
+                con : Core.con' * 'state -> 'state}
+               -> 'state -> Core.con -> 'state
+                                        
+    val exists : {kind : Core.kind' -> bool,
+                  con : Core.con' -> bool} -> Core.con -> bool
+
+    val existsB : {kind : 'context * Core.kind' -> bool,
+                   con : 'context * Core.con' -> bool,
+                   bind : 'context * binder -> 'context}
+                  -> 'context -> Core.con -> bool
+                                                          
+    val foldMap : {kind : Core.kind' * 'state -> Core.kind' * 'state,
+                   con : Core.con' * 'state -> Core.con' * 'state}
+                  -> 'state -> Core.con -> Core.con * 'state
+end
+
+structure Exp : sig
+    val compare : Core.exp * Core.exp -> order
+
+    datatype binder =
+             RelK of string
+           | RelC of string * Core.kind
+           | NamedC of string * int * Core.kind * Core.con option
+           | RelE of string * Core.con
+           | NamedE of string * int * Core.con * Core.exp option * string
+
+    val mapfoldB : {kind : ('context, Core.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Core.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Core.exp', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Core.exp, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Core.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Core.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Core.exp', 'state, 'abort) Search.mapfolder}
+                  -> (Core.exp, 'state, 'abort) Search.mapfolder
+
+    val map : {kind : Core.kind' -> Core.kind',
+               con : Core.con' -> Core.con',
+               exp : Core.exp' -> Core.exp'}
+              -> Core.exp -> Core.exp
+    val mapB : {kind : 'context -> Core.kind' -> Core.kind',
+                con : 'context -> Core.con' -> Core.con',
+                exp : 'context -> Core.exp' -> Core.exp',
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Core.exp -> Core.exp)
+
+    val fold : {kind : Core.kind' * 'state -> 'state,
+                con : Core.con' * 'state -> 'state,
+                exp : Core.exp' * 'state -> 'state}
+               -> 'state -> Core.exp -> 'state
+
+    val foldB : {kind : 'context * Core.kind' * 'state -> 'state,
+                 con : 'context * Core.con' * 'state -> 'state,
+                 exp : 'context * Core.exp' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Core.exp -> 'state
+                                        
+    val exists : {kind : Core.kind' -> bool,
+                  con : Core.con' -> bool,
+                  exp : Core.exp' -> bool} -> Core.exp -> bool
+
+    val existsB : {kind : 'context * Core.kind' -> bool,
+                   con : 'context * Core.con' -> bool,
+                   exp : 'context * Core.exp' -> bool,
+                   bind : 'context * binder -> 'context}
+                  -> 'context -> Core.exp -> bool
+
+    val foldMap : {kind : Core.kind' * 'state -> Core.kind' * 'state,
+                   con : Core.con' * 'state -> Core.con' * 'state,
+                   exp : Core.exp' * 'state -> Core.exp' * 'state}
+                  -> 'state -> Core.exp -> Core.exp * 'state
+    val foldMapB : {kind : 'context * Core.kind' * 'state -> Core.kind' * 'state,
+                    con : 'context * Core.con' * 'state -> Core.con' * 'state,
+                    exp : 'context * Core.exp' * 'state -> Core.exp' * 'state,
+                    bind : 'context * binder -> 'context}
+                   -> 'context -> 'state -> Core.exp -> Core.exp * 'state
+end
+
+structure Decl : sig
+    datatype binder = datatype Exp.binder
+
+    val mapfoldB : {kind : ('context, Core.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Core.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Core.exp', 'state, 'abort) Search.mapfolderB,
+                    decl : ('context, Core.decl', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Core.decl, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Core.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Core.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Core.exp', 'state, 'abort) Search.mapfolder,
+                   decl : (Core.decl', 'state, 'abort) Search.mapfolder}
+                  -> (Core.decl, 'state, 'abort) Search.mapfolder
+
+    val fold : {kind : Core.kind' * 'state -> 'state,
+                con : Core.con' * 'state -> 'state,
+                exp : Core.exp' * 'state -> 'state,
+                decl : Core.decl' * 'state -> 'state}
+               -> 'state -> Core.decl -> 'state
+
+    val foldMap : {kind : Core.kind' * 'state -> Core.kind' * 'state,
+                   con : Core.con' * 'state -> Core.con' * 'state,
+                   exp : Core.exp' * 'state -> Core.exp' * 'state,
+                   decl : Core.decl' * 'state -> Core.decl' * 'state}
+                  -> 'state -> Core.decl -> Core.decl * 'state
+    val foldMapB : {kind : 'context * Core.kind' * 'state -> Core.kind' * 'state,
+                    con : 'context * Core.con' * 'state -> Core.con' * 'state,
+                    exp : 'context * Core.exp' * 'state -> Core.exp' * 'state,
+                    decl : 'context * Core.decl' * 'state -> Core.decl' * 'state,
+                    bind : 'context * binder -> 'context}
+                   -> 'context -> 'state -> Core.decl -> Core.decl * 'state
+
+    val exists : {kind : Core.kind' -> bool,
+                  con : Core.con' -> bool,
+                  exp : Core.exp' -> bool,
+                  decl : Core.decl' -> bool} -> Core.decl -> bool
+end
+
+structure File : sig
+    val maxName : Core.file -> int
+
+    datatype binder = datatype Exp.binder
+
+    val mapfoldB : {kind : ('context, Core.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Core.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Core.exp', 'state, 'abort) Search.mapfolderB,
+                    decl : ('context, Core.decl', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Core.file, 'state, 'abort) Search.mapfolderB
+
+    val mapfold : {kind : (Core.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Core.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Core.exp', 'state, 'abort) Search.mapfolder,
+                   decl : (Core.decl', 'state, 'abort) Search.mapfolder}
+                  -> (Core.file, 'state, 'abort) Search.mapfolder
+
+    val mapB : {kind : 'context -> Core.kind' -> Core.kind',
+                con : 'context -> Core.con' -> Core.con',
+                exp : 'context -> Core.exp' -> Core.exp',
+                decl : 'context -> Core.decl' -> Core.decl',
+                bind : 'context * binder -> 'context}
+               -> 'context -> Core.file -> Core.file
+
+    val map : {kind : Core.kind' -> Core.kind',
+               con : Core.con' -> Core.con',
+               exp : Core.exp' -> Core.exp',
+               decl : Core.decl' -> Core.decl'}
+              -> Core.file -> Core.file
+
+    val fold : {kind : Core.kind' * 'state -> 'state,
+                con : Core.con' * 'state -> 'state,
+                exp : Core.exp' * 'state -> 'state,
+                decl : Core.decl' * 'state -> 'state}
+               -> 'state -> Core.file -> 'state
+
+    val foldMap : {kind : Core.kind' * 'state -> Core.kind' * 'state,
+                   con : Core.con' * 'state -> Core.con' * 'state,
+                   exp : Core.exp' * 'state -> Core.exp' * 'state,
+                   decl : Core.decl' * 'state -> Core.decl' * 'state}
+                  -> 'state -> Core.file -> Core.file * 'state
+end
+
+end
diff --git a/src/core_util.sml b/src/core_util.sml
new file mode 100644
index 0000000..57ef16f
--- /dev/null
+++ b/src/core_util.sml
@@ -0,0 +1,1240 @@
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure CoreUtil :> CORE_UTIL = struct
+
+open Core
+
+structure S = Search
+
+structure Kind = struct
+
+open Order
+
+fun compare ((k1, _), (k2, _)) =
+    case (k1, k2) of
+        (KType, KType) => EQUAL
+      | (KType, _) => LESS
+      | (_, KType) => GREATER
+
+      | (KArrow (d1, r1), KArrow (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
+      | (KArrow _, _) => LESS
+      | (_, KArrow _) => GREATER
+
+      | (KName, KName) => EQUAL
+      | (KName, _) => LESS
+      | (_, KName) => GREATER
+
+      | (KRecord k1, KRecord k2) => compare (k1, k2)
+      | (KRecord _, _) => LESS
+      | (_, KRecord _) => GREATER
+
+      | (KUnit, KUnit) => EQUAL
+      | (KUnit, _) => LESS
+      | (_, KUnit) => GREATER
+
+      | (KTuple ks1, KTuple ks2) => joinL compare (ks1, ks2)
+      | (KTuple _, _) => LESS
+      | (_, KTuple _) => GREATER
+
+      | (KRel n1, KRel n2) => Int.compare (n1, n2)
+      | (KRel _, _) => LESS
+      | (_, KRel _) => GREATER
+
+      | (KFun (_, k1), KFun (_, k2)) => compare (k1, k2)
+
+fun mapfoldB {kind = f, bind} =
+    let
+        fun mfk ctx k acc =
+            S.bindP (mfk' ctx k acc, f ctx)
+
+        and mfk' ctx (kAll as (k, loc)) =
+            case k of
+                KType => S.return2 kAll
+
+              | KArrow (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                      fn k1' =>
+                         S.map2 (mfk ctx k2,
+                              fn k2' =>
+                                 (KArrow (k1', k2'), loc)))
+
+              | KName => S.return2 kAll
+
+              | KRecord k =>
+                S.map2 (mfk ctx k,
+                        fn k' =>
+                           (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
+
+              | KTuple ks =>
+                S.map2 (ListUtil.mapfold (mfk ctx) ks,
+                        fn ks' =>
+                           (KTuple ks', loc))
+
+              | KRel _ => S.return2 kAll
+              | KFun (x, k) =>
+                S.map2 (mfk (bind (ctx, x)) k,
+                        fn k' =>
+                           (KFun (x, k'), loc))
+    in
+        mfk
+    end
+
+fun mapfold fk =
+    mapfoldB {kind = fn () => fk,
+              bind = fn ((), _) => ()} ()
+
+fun map f k =
+    case mapfold (fn k => fn () => S.Continue (f k, ())) k () of
+        S.Return () => raise Fail "CoreUtil.Kind.map"
+      | S.Continue (k, ()) => k
+
+fun mapB {kind, bind} ctx k =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   bind = bind} ctx k () of
+        S.Continue (k, ()) => k
+      | S.Return _ => raise Fail "CoreUtil.Kind.mapB: Impossible"
+
+fun exists f k =
+    case mapfold (fn k => fn () =>
+                             if f k then
+                                 S.Return ()
+                             else
+                                 S.Continue (k, ())) k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure Con = struct
+
+open Order
+
+fun compare ((c1, _), (c2, _)) =
+    case (c1, c2) of
+        (TFun (d1, r1), TFun (d2, r2)) => join (compare (d1, d2), fn () => compare (r1, r2))
+      | (TFun _, _) => LESS
+      | (_, TFun _) => GREATER
+
+      | (TCFun (x1, k1, r1), TCFun (x2, k2, r2)) =>
+        join (String.compare (x1, x2),
+           fn () => join (Kind.compare (k1, k2),
+                          fn () => compare (r1, r2)))
+      | (TCFun _, _) => LESS
+      | (_, TCFun _) => GREATER
+
+      | (TRecord c1, TRecord c2) => compare (c1, c2)
+      | (TRecord _, _) => LESS
+      | (_, TRecord _) => GREATER
+
+      | (CRel n1, CRel n2) => Int.compare (n1, n2)
+      | (CRel _, _) => LESS
+      | (_, CRel _) => GREATER
+
+      | (CNamed n1, CNamed n2) => Int.compare (n1, n2)
+      | (CNamed _, _) => LESS
+      | (_, CNamed _) => GREATER
+
+      | (CFfi (m1, s1), CFfi (m2, s2)) => join (String.compare (m1, m2),
+                                                fn () => String.compare (s1, s2))
+      | (CFfi _, _) => LESS
+      | (_, CFfi _) => GREATER
+
+      | (CApp (f1, x1), CApp (f2, x2)) => join (compare (f1, f2),
+                                                fn () => compare (x1, x2))
+      | (CApp _, _) => LESS
+      | (_, CApp _) => GREATER
+
+      | (CAbs (x1, k1, b1), CAbs (x2, k2, b2)) =>
+        join (String.compare (x1, x2),
+              fn () => join (Kind.compare (k1, k2),
+                             fn () => compare (b1, b2)))
+      | (CAbs _, _) => LESS
+      | (_, CAbs _) => GREATER
+
+      | (CName s1, CName s2) => String.compare (s1, s2)
+      | (CName _, _) => LESS
+      | (_, CName _) => GREATER
+
+      | (CRecord (k1, xvs1), CRecord (k2, xvs2)) =>
+        join (Kind.compare (k1, k2),
+              fn () =>
+                 let
+                     val sort = ListMergeSort.sort (fn ((x1, _), (x2, _)) =>
+                                                       compare (x1, x2) = GREATER)
+                 in
+                     joinL (fn ((x1, v1), (x2, v2)) =>
+                               join (compare (x1, x2),
+                                  fn () => compare (v1, v2))) (sort xvs1, sort xvs2)
+                 end)
+      | (CRecord _, _) => LESS
+      | (_, CRecord _) => GREATER
+
+      | (CConcat (f1, s1), CConcat (f2, s2)) =>
+        join (compare (f1, f2),
+              fn () => compare (s1, s2))
+      | (CConcat _, _) => LESS
+      | (_, CConcat _) => GREATER
+
+      | (CMap (d1, r1), CMap (d2, r2)) =>
+        join (Kind.compare (d1, d2),
+              fn () => Kind.compare (r1, r2))
+      | (CMap _, _) => LESS
+      | (_, CMap _) => GREATER
+
+      | (CUnit, CUnit) => EQUAL
+      | (CUnit, _) => LESS
+      | (_, CUnit) => GREATER
+
+      | (CTuple cs1, CTuple cs2) => joinL compare (cs1, cs2)
+      | (CTuple _, _) => LESS
+      | (_, CTuple _) => GREATER
+
+      | (CProj (c1, n1), CProj (c2, n2)) => join (Int.compare (n1, n2),
+                                                  fn () => compare (c1, c2))
+      | (CProj _, _) => LESS
+      | (_, CProj _) => GREATER
+
+      | (CKAbs (_, c1), CKAbs (_, c2)) => compare (c1, c2)
+      | (CKAbs _, _) => LESS
+      | (_, CKAbs _) => GREATER
+
+      | (CKApp (c1, k1), CKApp (c2, k2)) =>
+        join (compare (c1, c2),
+              fn () => Kind.compare (k1, k2))
+      | (CKApp _, _) => LESS
+      | (_, CKApp _) => GREATER
+
+      | (TKFun (_, c1), TKFun (_, c2)) => compare (c1, c2)
+
+datatype binder =
+         RelK of string
+       | RelC of string * kind
+       | NamedC of string * int * kind * con option
+
+fun mapfoldB {kind = fk, con = fc, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun mfc ctx c acc =
+            S.bindP (mfc' ctx c acc, fc ctx)
+
+        and mfc' ctx (cAll as (c, loc)) =
+            case c of
+                TFun (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (TFun (c1', c2'), loc)))
+              | TCFun (x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (TCFun (x, k', c'), loc)))
+              | TRecord c =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (TRecord c', loc))
+
+              | CRel _ => S.return2 cAll
+              | CNamed _ => S.return2 cAll
+              | CFfi _ => S.return2 cAll
+              | CApp (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CApp (c1', c2'), loc)))
+              | CAbs (x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (CAbs (x, k', c'), loc)))
+
+              | CName _ => S.return2 cAll
+
+              | CRecord (k, xcs) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (ListUtil.mapfold (fn (x, c) =>
+                                                      S.bind2 (mfc ctx x,
+                                                            fn x' =>
+                                                               S.map2 (mfc ctx c,
+                                                                    fn c' =>
+                                                                       (x', c'))))
+                                 xcs,
+                              fn xcs' =>
+                                 (CRecord (k', xcs'), loc)))
+              | CConcat (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CConcat (c1', c2'), loc)))
+              | CMap (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                         fn k1' =>
+                            S.map2 (mfk ctx k2,
+                                    fn k2' =>
+                                       (CMap (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
+
+              | CTuple cs =>
+                S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                        fn cs' =>
+                           (CTuple cs', loc))
+
+              | CProj (c, n) =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (CProj (c', n), loc))
+
+              | CKAbs (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (CKAbs (x, c'), loc))
+              | CKApp (c, k) =>
+                S.bind2 (mfc ctx c,
+                      fn c' =>
+                         S.map2 (mfk ctx k,
+                                 fn k' =>
+                                    (CKApp (c', k'), loc)))
+              | TKFun (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (TKFun (x, c'), loc))
+    in
+        mfc
+    end
+
+fun mapfold {kind = fk, con = fc} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              bind = fn ((), _) => ()} ()
+
+fun map {kind, con} c =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ())} c () of
+        S.Return () => raise Fail "Core_util.Con.map"
+      | S.Continue (c, ()) => c
+
+fun mapB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   bind = bind} ctx c () of
+        S.Continue (c, ()) => c
+      | S.Return _ => raise Fail "CoreUtil.Con.mapB: Impossible"
+
+fun fold {kind, con} s c =
+    case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
+                  con = fn c => fn s => S.Continue (c, con (c, s))} c s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "CoreUtil.Con.fold: Impossible"
+
+fun exists {kind, con} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun existsB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () =>
+                                               if kind (ctx, k) then
+                                                   S.Return ()
+                                               else
+                                                   S.Continue (k, ()),
+                   con = fn ctx => fn c => fn () =>
+                                              if con (ctx, c) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (c, ()),
+                   bind = bind} ctx c () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun foldMap {kind, con} s c =
+    case mapfold {kind = fn k => fn s => S.Continue (kind (k, s)),
+                  con = fn c => fn s => S.Continue (con (c, s))} c s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.Con.foldMap: Impossible"
+
+end
+
+structure Exp = struct
+
+open Order
+
+fun pcCompare (pc1, pc2) =
+    case (pc1, pc2) of
+        (PConVar n1, PConVar n2) => Int.compare (n1, n2)
+      | (PConVar _, _) => LESS
+      | (_, PConVar _) => GREATER
+
+      | (PConFfi {mod = m1, datatyp = d1, con = c1, ...},
+         PConFfi {mod = m2, datatyp = d2, con = c2, ...}) =>
+        join (String.compare (m1, m2),
+              fn () => join (String.compare (d1, d2),
+                             fn () => String.compare (c1, c2)))
+
+fun pCompare ((p1, _), (p2, _)) =
+    case (p1, p2) of
+        (PVar _, PVar _) => EQUAL
+      | (PVar _, _) => LESS
+      | (_, PVar _) => GREATER
+
+      | (PPrim p1, PPrim p2) => Prim.compare (p1, p2)
+      | (PPrim _, _) => LESS
+      | (_, PPrim _) => GREATER
+
+      | (PCon (_, pc1, _, po1), PCon (_, pc2, _, po2)) =>
+        join (pcCompare (pc1, pc2),
+              fn () => joinO pCompare (po1, po2))
+      | (PCon _, _) => LESS
+      | (_, PCon _) => GREATER
+
+      | (PRecord xps1, PRecord xps2) =>
+        joinL (fn ((x1, p1, _), (x2, p2, _)) =>
+                  join (String.compare (x1, x2),
+                        fn () => pCompare (p1, p2))) (xps1, xps2)
+
+fun fmCompare (fm1, fm2) =
+    case (fm1, fm2) of
+        (None, None) => EQUAL
+      | (None, _) => LESS
+      | (_, None) => GREATER
+
+      | (Error, Error) => EQUAL
+
+fun compare ((e1, _), (e2, _)) =
+    case (e1, e2) of
+        (EPrim p1, EPrim p2) => Prim.compare (p1, p2)
+      | (EPrim _, _) => LESS
+      | (_, EPrim _) => GREATER
+
+      | (ERel n1, ERel n2) => Int.compare (n1, n2)
+      | (ERel _, _) => LESS
+      | (_, ERel _) => GREATER
+
+      | (ENamed n1, ENamed n2) => Int.compare (n1, n2)
+      | (ENamed _, _) => LESS
+      | (_, ENamed _) => GREATER
+
+      | (ECon (_, pc1, _, eo1), ECon (_, pc2, _, eo2)) =>
+        join (pcCompare (pc1, pc2),
+              fn () => joinO compare (eo1, eo2))
+      | (ECon _, _) => LESS
+      | (_, ECon _) => GREATER
+
+      | (EFfi (f1, x1), EFfi (f2, x2)) =>
+        join (String.compare (f1, f2),
+              fn () => String.compare (x1, x2))
+      | (EFfi _, _) => LESS
+      | (_, EFfi _) => GREATER
+
+      | (EFfiApp (f1, x1, es1), EFfiApp (f2, x2, es2)) =>
+        join (String.compare (f1, f2),
+           fn () => join (String.compare (x1, x2),
+                       fn () => joinL (fn ((e1, _), (e2, _)) => compare (e1, e2))(es1, es2)))
+      | (EFfiApp _, _) => LESS
+      | (_, EFfiApp _) => GREATER
+
+      | (EApp (f1, x1), EApp (f2, x2)) =>
+        join (compare (f1, f2),
+              fn () => compare (x1, x2))
+      | (EApp _, _) => LESS
+      | (_, EApp _) => GREATER
+
+      | (EAbs (_, _, _, e1), EAbs (_, _, _, e2)) => compare (e1, e2)
+      | (EAbs _, _) => LESS
+      | (_, EAbs _) => GREATER
+
+      | (ECApp (f1, x1), ECApp (f2, x2)) =>
+        join (compare (f1, f2),
+           fn () => Con.compare (x1, x2))
+      | (ECApp _, _) => LESS
+      | (_, ECApp _) => GREATER
+
+      | (ECAbs (_, _, e1), ECAbs (_, _, e2)) => compare (e1, e2)
+      | (ECAbs _, _) => LESS
+      | (_, ECAbs _) => GREATER
+
+      | (ERecord xes1, ERecord xes2) =>
+        joinL (fn ((x1, e1, _), (x2, e2, _)) =>
+                  join (Con.compare (x1, x2),
+                        fn () => compare (e1, e2))) (xes1, xes2)
+      | (ERecord _, _) => LESS
+      | (_, ERecord _) => GREATER
+
+      | (EField (e1, c1, _), EField (e2, c2, _)) =>
+        join (compare (e1, e2),
+              fn () => Con.compare (c1, c2))
+      | (EField _, _) => LESS
+      | (_, EField _) => GREATER
+
+      | (EConcat (x1, _, y1, _), EConcat (x2, _, y2, _)) =>
+        join (compare (x1, x2),
+              fn () => compare (y1, y2))
+      | (EConcat _, _) => LESS
+      | (_, EConcat _) => GREATER
+
+      | (ECut (e1, c1, _), ECut (e2, c2, _)) =>
+        join (compare (e1, e2),
+           fn () => Con.compare (c1, c2))
+      | (ECut _, _) => LESS
+      | (_, ECut _) => GREATER
+
+      | (ECutMulti (e1, c1, _), ECutMulti (e2, c2, _)) =>
+        join (compare (e1, e2),
+           fn () => Con.compare (c1, c2))
+      | (ECutMulti _, _) => LESS
+      | (_, ECutMulti _) => GREATER
+
+      | (ECase (e1, pes1, _), ECase (e2, pes2, _)) =>
+        join (compare (e1, e2),
+              fn () => joinL (fn ((p1, e1), (p2, e2)) =>
+                                 join (pCompare (p1, p2),
+                                       fn () => compare (e1, e2))) (pes1, pes2))
+      | (ECase _, _) => LESS
+      | (_, ECase _) => GREATER
+
+      | (EWrite e1, EWrite e2) => compare (e1, e2)
+      | (EWrite _, _) => LESS
+      | (_, EWrite _) => GREATER
+
+      | (EClosure (n1, es1), EClosure (n2, es2)) =>
+        join (Int.compare (n1, n2),
+              fn () => joinL compare (es1, es2))
+      | (EClosure _, _) => LESS
+      | (_, EClosure _) => GREATER
+
+      | (ELet (_, _, x1, e1), ELet (_, _, x2, e2)) =>
+        join (compare (x1, x2),
+              fn () => compare (e1, e2))
+      | (ELet _, _) => LESS
+      | (_, ELet _) => GREATER
+
+      | (EServerCall (n1, es1, _, fm1), EServerCall (n2, es2, _, fm2)) =>
+        join (Int.compare (n1, n2),
+           fn () => join (fmCompare (fm1, fm2),
+                       fn () => joinL compare (es1, es2)))
+      | (EServerCall _, _) => LESS
+      | (_, EServerCall _) => GREATER
+
+      | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2)
+      | (EKAbs _, _) => LESS
+      | (_, EKAbs _) => GREATER
+
+      | (EKApp (e1, k1), EKApp (e2, k2)) =>
+        join (compare (e1, e2),
+              fn () => Kind.compare (k1, k2))
+
+datatype binder =
+         RelK of string
+       | RelC of string * kind
+       | NamedC of string * int * kind * con option
+       | RelE of string * con
+       | NamedE of string * int * con * exp option * string
+
+fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
+
+        fun mfe ctx e acc =
+            S.bindP (mfe' ctx e acc, fe ctx)
+
+        and mfet ctx (e, t) =
+            S.bind2 (mfe ctx e,
+                  fn e' =>
+                     S.map2 (mfc ctx t,
+                          fn t' => (e', t')))
+
+        and mfe' ctx (eAll as (e, loc)) =
+            case e of
+                EPrim _ => S.return2 eAll
+              | ERel _ => S.return2 eAll
+              | ENamed _ => S.return2 eAll
+              | ECon (dk, pc, cs, NONE) =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
+                         S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                              fn cs' =>
+                                 (ECon (dk, pc', cs', NONE), loc)))
+              | ECon (dk, pc, cs, SOME e) =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
+                         S.bind2 (mfe ctx e,
+                               fn e' =>
+                                  S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                                       fn cs' =>
+                                          (ECon (dk, pc', cs', SOME e'), loc))))
+              | EFfi _ => S.return2 eAll
+              | EFfiApp (m, x, es) =>
+                S.map2 (ListUtil.mapfold (mfet ctx) es,
+                     fn es' =>
+                        (EFfiApp (m, x, es'), loc))
+              | EApp (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EApp (e1', e2'), loc)))
+              | EAbs (x, dom, ran, e) =>
+                S.bind2 (mfc ctx dom,
+                      fn dom' =>
+                         S.bind2 (mfc ctx ran,
+                               fn ran' =>
+                                  S.map2 (mfe (bind (ctx, RelE (x, dom'))) e,
+                                       fn e' =>
+                                          (EAbs (x, dom', ran', e'), loc))))
+
+              | ECApp (e, c) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.map2 (mfc ctx c,
+                              fn c' =>
+                                 (ECApp (e', c'), loc)))
+              | ECAbs (x, k, e) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfe (bind (ctx, RelC (x, k))) e,
+                              fn e' =>
+                                 (ECAbs (x, k', e'), loc)))
+
+              | ERecord xes =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfc ctx x,
+                                                   fn x' =>
+                                                      S.bind2 (mfe ctx e,
+                                                            fn e' =>
+                                                               S.map2 (mfc ctx t,
+                                                                    fn t' =>
+                                                                       (x', e', t')))))
+                                         xes,
+                     fn xes' =>
+                        (ERecord xes', loc))
+              | EField (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (EField (e', c', {field = field', rest = rest'}), loc)))))
+              | EConcat (e1, c1, e2, c2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.bind2 (mfc ctx c1,
+                              fn c1' =>
+                                 S.bind2 (mfe ctx e2,
+                                       fn e2' =>
+                                          S.map2 (mfc ctx c2,
+                                               fn c2' =>
+                                                  (EConcat (e1', c1', e2', c2'),
+                                                   loc)))))
+              | ECut (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (ECut (e', c', {field = field', rest = rest'}), loc)))))
+              | ECutMulti (e, c, {rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.map2 (mfc ctx rest,
+                                      fn rest' =>
+                                         (ECutMulti (e', c', {rest = rest'}), loc))))
+
+              | ECase (e, pes, {disc, result}) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.bind2 (ListUtil.mapfold (fn (p, e) =>
+                                                          let
+                                                              fun pb ((p, _), ctx) =
+                                                                  case p of
+                                                                      PVar (x, t) => bind (ctx, RelE (x, t))
+                                                                    | PPrim _ => ctx
+                                                                    | PCon (_, _, _, NONE) => ctx
+                                                                    | PCon (_, _, _, SOME p) => pb (p, ctx)
+                                                                    | PRecord xps => foldl (fn ((_, p, _), ctx) =>
+                                                                                               pb (p, ctx)) ctx xps
+                                                          in
+                                                              S.bind2 (mfp ctx p,
+                                                                       fn p' =>
+                                                                          S.map2 (mfe (pb (p', ctx)) e,
+                                                                               fn e' => (p', e')))
+                                                          end) pes,
+                                    fn pes' =>
+                                       S.bind2 (mfc ctx disc,
+                                                fn disc' =>
+                                                   S.map2 (mfc ctx result,
+                                                        fn result' =>
+                                                           (ECase (e', pes', {disc = disc', result = result'}), loc)))))
+
+              | EWrite e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (EWrite e', loc))
+
+              | EClosure (n, es) =>
+                S.map2 (ListUtil.mapfold (mfe ctx) es,
+                     fn es' =>
+                        (EClosure (n, es'), loc))
+
+              | ELet (x, t, e1, e2) =>
+                S.bind2 (mfc ctx t,
+                         fn t' =>
+                            S.bind2 (mfe ctx e1,
+                                  fn e1' =>
+                                     S.map2 (mfe (bind (ctx, RelE (x, t'))) e2,
+                                          fn e2' =>
+                                             (ELet (x, t', e1', e2'), loc))))
+
+              | EServerCall (n, es, t, fm) =>
+                S.bind2 (ListUtil.mapfold (mfe ctx) es,
+                      fn es' =>
+                         S.map2 (mfc ctx t,
+                              fn t' =>
+                                 (EServerCall (n, es', t', fm), loc)))
+
+              | EKAbs (x, e) =>
+                S.map2 (mfe (bind (ctx, RelK x)) e,
+                        fn e' =>
+                           (EKAbs (x, e'), loc))
+              | EKApp (e, k) =>
+                S.bind2 (mfe ctx e,
+                        fn e' =>
+                           S.map2 (mfk ctx k,
+                                   fn k' =>
+                                      (EKApp (e', k'), loc)))
+                         
+        and mfp ctx (pAll as (p, loc)) =
+            case p of
+                PVar (x, t) =>
+                S.map2 (mfc ctx t,
+                        fn t' =>
+                           (PVar (x, t'), loc))
+              | PPrim _ => S.return2 pAll
+              | PCon (dk, pc, args, po) =>
+                S.bind2 (mfpc ctx pc,
+                         fn pc' =>
+                            S.bind2 (ListUtil.mapfold (mfc ctx) args,
+                                     fn args' =>
+                                        S.map2 ((case po of
+                                                     NONE => S.return2 NONE
+                                                   | SOME p => S.map2 (mfp ctx p, SOME)),
+                                                fn po' =>
+                                                   (PCon (dk, pc', args', po'), loc))))
+              | PRecord xps =>
+                S.map2 (ListUtil.mapfold (fn (x, p, c) =>
+                                              S.bind2 (mfp ctx p,
+                                                       fn p' =>
+                                                          S.map2 (mfc ctx c,
+                                                                  fn c' =>
+                                                                     (x, p', c')))) xps,
+                         fn xps' =>
+                            (PRecord xps', loc))
+
+        and mfpc ctx pc =
+            case pc of
+                PConVar _ => S.return2 pc
+              | PConFfi {mod = m, datatyp, params, con, arg, kind} =>
+                S.map2 ((case arg of
+                             NONE => S.return2 NONE
+                           | SOME c =>
+                             let
+                                 val k = (KType, ErrorMsg.dummySpan)
+                                 val ctx' = foldl (fn (x, ctx) => bind (ctx, RelC (x, k))) ctx params
+                             in
+                                 S.map2 (mfc ctx' c, SOME)
+                             end),
+                        fn arg' =>
+                           PConFfi {mod = m, datatyp = datatyp, params = params,
+                                    con = con, arg = arg', kind = kind})
+    in
+        mfe
+    end
+
+fun mapfold {kind = fk, con = fc, exp = fe} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              exp = fn () => fe,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, con, exp, bind} ctx e =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
+                   bind = bind} ctx e () of
+        S.Continue (e, ()) => e
+      | S.Return _ => raise Fail "CoreUtil.Exp.mapB: Impossible"
+
+fun map {kind, con, exp} e =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ()),
+                  exp = fn e => fn () => S.Continue (exp e, ())} e () of
+        S.Return () => raise Fail "Core_util.Exp.map"
+      | S.Continue (e, ()) => e
+
+fun fold {kind, con, exp} s e =
+    case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
+                  con = fn c => fn s => S.Continue (c, con (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s))} e s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "CoreUtil.Exp.fold: Impossible"
+
+fun foldB {kind, con, exp, bind} ctx s e =
+    case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (k, kind (ctx, k, s)),
+                  con = fn ctx => fn c => fn s => S.Continue (c, con (ctx, c, s)),
+                  exp = fn ctx => fn e => fn s => S.Continue (e, exp (ctx, e, s)),
+                  bind = bind} ctx e s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "CoreUtil.Exp.foldB: Impossible"
+
+fun exists {kind, con, exp} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun existsB {kind, con, exp, bind} ctx k =
+    case mapfoldB {kind = fn ctx => fn k => fn () =>
+                                               if kind (ctx, k) then
+                                                   S.Return ()
+                                               else
+                                                   S.Continue (k, ()),
+                   con = fn ctx => fn c => fn () =>
+                                              if con (ctx, c) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (c, ()),
+                   exp = fn ctx => fn e => fn () =>
+                                              if exp (ctx, e) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (e, ()),
+                   bind = bind} ctx k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun foldMap {kind, con, exp} s e =
+    case mapfold {kind = fn k => fn s => S.Continue (kind (k, s)),
+                  con = fn c => fn s => S.Continue (con (c, s)),
+                  exp = fn e => fn s => S.Continue (exp (e, s))} e s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.Exp.foldMap: Impossible"
+
+fun foldMapB {kind, con, exp, bind} ctx s e =
+    case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (kind (ctx, k, s)),
+                   con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)),
+                   exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
+                   bind = bind} ctx e s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.Exp.foldMapB: Impossible"
+
+end
+
+structure Decl = struct
+
+datatype binder = datatype Exp.binder
+
+fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
+
+        val mfe = Exp.mapfoldB {kind = fk, con = fc, exp = fe, bind = bind}
+
+        fun mfd ctx d acc =
+            S.bindP (mfd' ctx d acc, fd ctx)
+
+        and mfd' ctx (dAll as (d, loc)) =
+            case d of
+                DCon (x, n, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc ctx c,
+                              fn c' =>
+                                 (DCon (x, n, k', c'), loc)))
+              | DDatatype dts =>
+                S.map2 (ListUtil.mapfold (fn (x, n, xs, xncs) =>
+                                             let
+                                                 val k = (KType, loc)
+                                                 val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
+                                                 val ctx' = bind (ctx, NamedC (x, n, k', NONE))
+                                             in
+                                                 S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                                              case c of
+                                                                                  NONE => S.return2 (x, n, c)
+                                                                                | SOME c =>
+                                                                                  S.map2 (mfc ctx' c,
+                                                                                       fn c' => (x, n, SOME c'))) xncs,
+                                                         fn xncs' => (x, n, xs, xncs'))
+                                             end) dts,
+                     fn dts' =>
+                        (DDatatype dts', loc))
+              | DVal vi =>
+                S.map2 (mfvi ctx vi,
+                     fn vi' =>
+                        (DVal vi', loc))
+              | DValRec vis =>
+                let
+                    val ctx = foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
+                                    ctx vis
+                in
+                    S.map2 (ListUtil.mapfold (mfvi ctx) vis,
+                         fn vis' =>
+                            (DValRec vis', loc))
+                end
+              | DExport _ => S.return2 dAll
+              | DTable (x, n, c, s, pe, pc, ce, cc) =>
+                let
+                    val loc = #2 ce
+                    val ct = (CFfi ("Basis", "sql_table"), loc)
+                    val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+                    val ct = (CApp (ct, cc), loc)
+                    val ctx' = bind (ctx, NamedE (x, n, ct, NONE, s))
+                in
+                    S.bind2 (mfc ctx c,
+                          fn c' =>
+                             S.bind2 (mfe ctx' pe,
+                                   fn pe' =>
+                                      S.bind2 (mfc ctx pc,
+                                            fn pc' =>
+                                               S.bind2 (mfe ctx' ce,
+                                                     fn ce' =>
+                                                        S.map2 (mfc ctx cc,
+                                                             fn cc' =>
+                                                                (DTable (x, n, c', s, pe', pc', ce', cc'), loc))))))
+                end
+              | DSequence _ => S.return2 dAll
+              | DView (x, n, s, e, c) =>
+                S.bind2 (mfe ctx e,
+                     fn e' =>
+                        S.map2 (mfc ctx c,
+                             fn c' =>
+                                (DView (x, n, s, e', c'), loc)))
+              | DDatabase _ => S.return2 dAll
+              | DCookie (x, n, c, s) =>
+                S.map2 (mfc ctx c,
+                     fn c' =>
+                        (DCookie (x, n, c', s), loc))
+              | DStyle _ => S.return2 dAll
+              | DTask (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                     fn e1' =>
+                        S.map2 (mfe ctx e2,
+                             fn e2' =>
+                                (DTask (e1', e2'), loc)))
+              | DPolicy e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (DPolicy e', loc))
+
+              | DOnError _ => S.return2 dAll
+
+        and mfvi ctx (x, n, t, e, s) =
+            S.bind2 (mfc ctx t,
+                  fn t' =>
+                     S.map2 (mfe ctx e,
+                          fn e' =>
+                             (x, n, t', e', s)))
+    in
+        mfd
+    end    
+
+fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              exp = fn () => fe,
+              decl = fn () => fd,
+              bind = fn ((), _) => ()} ()
+
+fun fold {kind, con, exp, decl} s d =
+    case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
+                  con = fn c => fn s => S.Continue (c, con (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s)),
+                  decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "CoreUtil.Decl.fold: Impossible"
+
+fun foldMap {kind, con, exp, decl} s d =
+    case mapfold {kind = fn k => fn s => S.Continue (kind (k, s)),
+                  con = fn c => fn s => S.Continue (con (c, s)),
+                  exp = fn e => fn s => S.Continue (exp (e, s)),
+                  decl = fn d => fn s => S.Continue (decl (d, s))} d s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.Decl.foldMap: Impossible"
+
+fun foldMapB {kind, con, exp, decl, bind} ctx s d =
+    case mapfoldB {kind = fn ctx => fn k => fn s => S.Continue (kind (ctx, k, s)),
+                   con = fn ctx => fn c => fn s => S.Continue (con (ctx, c, s)),
+                   exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
+                   decl = fn ctx => fn d => fn s => S.Continue (decl (ctx, d, s)),
+                   bind = bind} ctx d s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.Decl.foldMapB: Impossible"
+
+fun exists {kind, con, exp, decl} d =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ()),
+                  decl = fn d => fn () =>
+                                   if decl d then
+                                       S.Return ()
+                                   else
+                                       S.Continue (d, ())} d () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure File = struct
+
+datatype binder = datatype Exp.binder
+
+fun mapfoldB (all as {bind, ...}) =
+    let
+        val mfd = Decl.mapfoldB all
+
+        fun mff ctx ds =
+            case ds of
+                nil => S.return2 nil
+              | d :: ds' =>
+                S.bind2 (mfd ctx d,
+                         fn d' =>
+                            let
+                                val ctx' =
+                                    case #1 d' of
+                                        DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c))
+                                      | DDatatype dts =>
+                                        foldl (fn ((x, n, xs, xncs), ctx) =>
+                                                  let
+                                                      val loc = #2 d'
+                                                      val k = (KType, loc)
+                                                      val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
+
+                                                      val ctx = bind (ctx, NamedC (x, n, k', NONE))
+                                                      val t = (CNamed n, #2 d')
+                                                      val t = ListUtil.foldli (fn (i, _, t) =>
+                                                                                  (CApp (t, (CRel i, loc)), loc))
+                                                                              t xs
+                                                  in
+                                                      foldl (fn ((x, n, to), ctx) =>
+                                                                let
+                                                                    val t = case to of
+                                                                                NONE => t
+                                                                              | SOME t' => (TFun (t', t), #2 d')
+                                                                    val t = foldr (fn (x, t) => (TCFun (x, k, t), loc))
+                                                                                  t xs
+                                                                in
+                                                                    bind (ctx, NamedE (x, n, t, NONE, ""))
+                                                                end)
+                                                            ctx xncs
+                                                  end)
+                                        ctx dts
+                                      | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
+                                      | DValRec vis =>
+                                        foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
+                                        ctx vis
+                                      | DExport _ => ctx
+                                      | DTable (x, n, c, s, _, pc, _, cc) =>
+                                        let
+                                            val loc = #2 d'
+                                            val ct = (CFfi ("Basis", "sql_table"), loc)
+                                            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+                                            val ct = (CApp (ct, cc), loc)
+                                        in
+                                            bind (ctx, NamedE (x, n, ct, NONE, s))
+                                        end
+                                      | DSequence (x, n, s) =>
+                                        let
+                                            val t = (CFfi ("Basis", "sql_sequence"), #2 d')
+                                        in
+                                            bind (ctx, NamedE (x, n, t, NONE, s))
+                                        end
+                                      | DView (x, n, s, _, c) =>
+                                        let
+                                            val loc = #2 d'
+                                            val ct = (CFfi ("Basis", "sql_view"), loc)
+                                            val ct = (CApp (ct, c), loc)
+                                        in
+                                            bind (ctx, NamedE (x, n, ct, NONE, s))
+                                        end
+                                      | DDatabase _ => ctx
+                                      | DCookie (x, n, c, s) =>
+                                        let
+                                            val t = (CApp ((CFfi ("Basis", "http_cookie"), #2 d'), c), #2 d')
+                                        in
+                                            bind (ctx, NamedE (x, n, t, NONE, s))
+                                        end
+                                      | DStyle (x, n, s) =>
+                                        let
+                                            val t = (CFfi ("Basis", "css_class"), #2 d')
+                                        in
+                                            bind (ctx, NamedE (x, n, t, NONE, s))
+                                        end
+                                      | DTask _ => ctx
+                                      | DPolicy _ => ctx
+                                      | DOnError _ => ctx
+                            in
+                                S.map2 (mff ctx' ds',
+                                     fn ds' =>
+                                        d' :: ds')
+                            end)
+    in
+        mff
+    end
+
+fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              exp = fn () => fe,
+              decl = fn () => fd,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, con, exp, decl, bind} ctx ds =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
+                   decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()),
+                   bind = bind} ctx ds () of
+        S.Continue (ds, ()) => ds
+      | S.Return _ => raise Fail "CoreUtil.File.mapB: Impossible"
+
+fun map {kind, con, exp, decl} ds =
+    mapB {kind = fn () => kind,
+          con = fn () => con,
+          exp = fn () => exp,
+          decl = fn () => decl,
+          bind = fn _ => ()} () ds
+
+fun fold {kind, con, exp, decl} s d =
+    case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)),
+                  con = fn c => fn s => S.Continue (c, con (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s)),
+                  decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "CoreUtil.File.fold: Impossible"
+
+fun foldMap {kind, con, exp, decl} s d =
+    case mapfold {kind = fn k => fn s => S.Continue (kind (k, s)),
+                  con = fn c => fn s => S.Continue (con (c, s)),
+                  exp = fn e => fn s => S.Continue (exp (e, s)),
+                  decl = fn d => fn s => S.Continue (decl (d, s))} d s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "CoreUtil.File.foldMap: Impossible"
+
+val maxName = foldl (fn ((d, _) : decl, count) =>
+                        case d of
+                            DCon (_, n, _, _) => Int.max (n, count)
+                          | DDatatype dts => foldl (fn ((_, n, _, ns), count) =>
+                                                       foldl (fn ((_, n', _), m) => Int.max (n', m))
+                                                             (Int.max (n, count)) ns) count dts
+                          | DVal (_, n, _, _, _) => Int.max (n, count)
+                          | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
+                          | DExport _ => count
+                          | DTable (_, n, _, _, _, _, _, _) => Int.max (n, count)
+                          | DSequence (_, n, _) => Int.max (n, count)
+                          | DView (_, n, _, _, _) => Int.max (n, count)
+                          | DDatabase _ => count
+                          | DCookie (_, n, _, _) => Int.max (n, count)
+                          | DStyle (_, n, _) => Int.max (n, count)
+                          | DTask _ => count
+                          | DPolicy _ => count
+                          | DOnError _ => count) 0
+              
+end
+
+end
diff --git a/src/corify.sig b/src/corify.sig
new file mode 100644
index 0000000..0e1bb80
--- /dev/null
+++ b/src/corify.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CORIFY = sig
+
+    val corify : Expl.file -> Core.file
+
+end
diff --git a/src/corify.sml b/src/corify.sml
new file mode 100644
index 0000000..19cd3ec
--- /dev/null
+++ b/src/corify.sml
@@ -0,0 +1,1330 @@
+(* Copyright (c) 2008-2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Corify :> CORIFY = struct
+
+structure EM = ErrorMsg
+structure L = Expl
+structure L' = Core
+
+structure IM = IntBinaryMap
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+fun doRestify k (mods, s) =
+    let
+        val s = if String.isPrefix "wrap_" s then
+                    String.extract (s, 5, NONE)
+                else
+                    s
+        val s = String.concatWith "/" (rev (s :: mods))
+        val s = String.implode (List.filter (fn ch => ch <> #"$") (String.explode s))
+    in
+        Settings.rewrite k s
+    end
+
+val relify = CharVector.map (fn #"/" => #"_"
+                              | ch => ch)
+
+local
+    val count = ref 0
+in
+
+fun reset v = count := v
+
+fun alloc () =
+    let
+        val r = !count
+    in
+        count := r + 1;
+        r
+    end
+
+fun getCounter () = !count
+fun setCounter n = count := n
+
+end
+
+structure St : sig
+    type t
+
+    val empty : t
+
+    val debug : t -> unit
+
+    val name : t -> string list
+
+    val enter : t * string list -> t
+    val leave : t -> {outer : t, inner : t}
+    val ffi : string -> L'.con SM.map -> (string * string list * L'.con option * L'.datatype_kind) SM.map -> t
+
+    val basisIs : t * int -> t
+    val lookupBasis : t -> int option
+
+    datatype core_con =
+             CNormal of int
+           | CFfi of string
+    val bindCon : t -> string -> int -> t * int
+    val lookupConById : t -> int -> int option
+    val lookupConByName : t -> string -> core_con
+
+    val bindConstructor : t -> string -> int -> t * int
+    val bindConstructorAs : t -> string -> int -> L'.patCon -> t
+    val lookupConstructorByNameOpt : t -> string -> L'.patCon option
+    val lookupConstructorByName : t -> string -> L'.patCon
+    val lookupConstructorById : t -> int -> L'.patCon
+    val lookupConstructorByIdOpt : t -> int -> L'.patCon option
+                                            
+    datatype core_val =
+             ENormal of int
+           | EFfi of string * L'.con
+    val bindVal : t -> string -> int -> t * int
+    val bindConstructorVal : t -> string -> int -> int -> t
+    val lookupValById : t -> int -> int option
+    val lookupValByName : t -> string -> core_val
+
+    val bindStr : t -> string -> int -> t -> t
+    val lookupStrById : t -> int -> t
+    val lookupStrByIdOpt : t -> int -> t option
+    val lookupStrByName : string * t -> t
+    val lookupStrByNameOpt : string * t -> t option
+
+    val bindFunctor : t -> string -> int -> string -> int -> L.str -> t
+    val lookupFunctorById : t -> int -> string * int * L.str
+    val lookupFunctorByIdOpt : t -> int -> (string * int * L.str) option
+    val lookupFunctorByName : string * t -> string * int * L.str
+end = struct
+
+datatype flattening =
+         FNormal of {name : string list,
+                     cons : int SM.map,
+                     constructors : L'.patCon SM.map,
+                     vals : int SM.map,
+                     strs : flattening SM.map,
+                     funs : (string * int * L.str) SM.map}
+       | FFfi of {mod : string,
+                  vals : L'.con SM.map,
+                  constructors : (string * string list * L'.con option * L'.datatype_kind) SM.map}
+
+type t = {
+     basis : int option,
+     cons : int IM.map,
+     constructors : L'.patCon IM.map,
+     vals : int IM.map,
+     strs : flattening IM.map,
+     funs : (string * int * L.str) IM.map,
+     current : flattening,
+     nested : flattening list
+}
+
+val empty = {
+    basis = NONE,
+    cons = IM.empty,
+    constructors = IM.empty,
+    vals = IM.empty,
+    strs = IM.empty,
+    funs = IM.empty,
+    current = FNormal { name = [], cons = SM.empty, constructors = SM.empty,
+                        vals = SM.empty, strs = SM.empty, funs = SM.empty },
+    nested = []
+}
+
+fun debug ({current = FNormal {cons, constructors, vals, strs, funs, ...}, ...} : t) =
+    print ("cons: " ^ Int.toString (SM.numItems cons) ^ "; "
+           ^ "constructors: " ^ Int.toString (SM.numItems constructors) ^ "; "
+           ^ "vals: " ^ Int.toString (SM.numItems vals) ^ "; "
+           ^ "strs: " ^ Int.toString (SM.numItems strs) ^ "; "
+           ^ "funs: " ^ Int.toString (SM.numItems funs) ^ "\n")
+  | debug _ = print "Not normal!\n"
+
+fun name ({current = FNormal {name, ...}, ...} : t) = name
+  | name {current = FFfi {mod = name, ...}, ...} = [name]
+
+fun basisIs ({cons, constructors, vals, strs, funs, current, nested, ...} : t, basis) =
+    {basis = SOME basis,
+     cons = cons,
+     constructors = constructors,
+     vals = vals,
+     strs = strs,
+     funs = funs,
+     current = current,
+     nested = nested}
+
+fun lookupBasis ({basis, ...} : t) = basis
+
+datatype core_con =
+         CNormal of int
+       | CFfi of string
+
+datatype core_val =
+         ENormal of int
+       | EFfi of string * L'.con
+
+fun bindCon {basis, cons, constructors, vals, strs, funs, current, nested} s n =
+    let
+        val n' = alloc ()
+
+        val current =
+            case current of
+                FFfi _ => raise Fail "Binding inside FFfi"
+              | FNormal {name, cons, constructors, vals, strs, funs} =>
+                FNormal {name = name,
+                         cons = SM.insert (cons, s, n'),
+                         constructors = constructors,
+                         vals = vals,
+                         strs = strs,
+                         funs = funs}
+    in
+        ({basis = basis,
+          cons = IM.insert (cons, n, n'),
+          constructors = constructors,
+          vals = vals,
+          strs = strs,
+          funs = funs,
+          current = current,
+          nested = nested},
+         n')
+    end
+
+fun lookupConById ({cons, ...} : t) n = IM.find (cons, n)
+
+fun lookupConByName ({current, ...} : t) x =
+    case current of
+        FFfi {mod = m, ...} => CFfi m
+      | FNormal {cons, ...} =>
+        case SM.find (cons, x) of
+            NONE => raise Fail ("Corify.St.lookupConByName " ^ x)
+          | SOME n => CNormal n
+
+fun bindVal {basis, cons, constructors, vals, strs, funs, current, nested} s n =
+    let
+        val n' = alloc ()
+
+        val current =
+            case current of
+                FFfi _ => raise Fail "Binding inside FFfi"
+              | FNormal {name, cons, constructors, vals, strs, funs} =>
+                FNormal {name = name,
+                         cons = cons,
+                         constructors = constructors,
+                         vals = SM.insert (vals, s, n'),
+                         strs = strs,
+                         funs = funs}
+    in
+        ({basis = basis,
+          cons = cons,
+          constructors = constructors,
+          vals = IM.insert (vals, n, n'),
+          strs = strs,
+          funs = funs,
+          current = current,
+          nested = nested},
+         n')
+    end
+
+fun bindConstructorVal {basis, cons, constructors, vals, strs, funs, current, nested} s n n' =
+    let
+        val current =
+            case current of
+                FFfi _ => raise Fail "Binding inside FFfi"
+              | FNormal {name, cons, constructors, vals, strs, funs} =>
+                FNormal {name = name,
+                         cons = cons,
+                         constructors = constructors,
+                         vals = SM.insert (vals, s, n'),
+                         strs = strs,
+                         funs = funs}
+    in
+        {basis = basis,
+         cons = cons,
+         constructors = constructors,
+         vals = IM.insert (vals, n, n'),
+         strs = strs,
+         funs = funs,
+         current = current,
+         nested = nested}
+    end
+
+
+fun lookupValById ({vals, ...} : t) n = IM.find (vals, n)
+
+fun lookupValByName ({current, ...} : t) x =
+    case current of
+        FFfi {mod = m, vals, ...} =>
+        (case SM.find (vals, x) of
+             NONE => raise Fail ("Corify.St.lookupValByName: no type for FFI val " ^ x)
+           | SOME t => EFfi (m, t))
+      | FNormal {name, vals, ...} =>
+        case SM.find (vals, x) of
+            NONE => raise Fail ("Corify.St.lookupValByName " ^ String.concatWith "." (rev name) ^ "." ^ x)
+          | SOME n => ENormal n
+
+fun bindConstructorAs {basis, cons, constructors, vals, strs, funs, current, nested} s n c' =
+    let
+        val current =
+            case current of
+                FFfi _ => raise Fail "Binding inside FFfi"
+              | FNormal {name, cons, constructors, vals, strs, funs} =>
+                FNormal {name = name,
+                         cons = cons,
+                         constructors = SM.insert (constructors, s, c'),
+                         vals = vals,
+                         strs = strs,
+                         funs = funs}
+    in
+        {basis = basis,
+         cons = cons,
+         constructors = IM.insert (constructors, n, c'),
+         vals = vals,
+         strs = strs,
+         funs = funs,
+         current = current,
+         nested = nested}
+    end
+
+fun bindConstructor st s n =
+    let
+        val n' = alloc ()
+        val c' = L'.PConVar n'
+    in
+        (bindConstructorAs st s n c', n')
+    end
+
+fun lookupConstructorById ({constructors, ...} : t) n =
+    case IM.find (constructors, n) of
+        NONE => raise Fail "Corify.St.lookupConstructorById"
+      | SOME x => x
+
+fun lookupConstructorByIdOpt ({constructors, ...} : t) n =
+    IM.find (constructors, n)
+
+fun lookupConstructorByNameOpt ({current, ...} : t) x =
+    case current of
+        FFfi {mod = m, constructors, ...} =>
+        (case SM.find (constructors, x) of
+             NONE => NONE
+           | SOME (n, xs, to, dk) => SOME (L'.PConFfi {mod = m, datatyp = n, params = xs, con = x, arg = to, kind = dk}))
+      | FNormal {constructors, ...} =>
+        case SM.find (constructors, x) of
+            NONE => NONE
+          | SOME n => SOME n
+
+fun lookupConstructorByName ({current, ...} : t) x =
+    case current of
+        FFfi {mod = m, constructors, ...} =>
+        (case SM.find (constructors, x) of
+             NONE => raise Fail "Corify.St.lookupConstructorByName [1]"
+           | SOME (n, xs, to, dk) => L'.PConFfi {mod = m, datatyp = n, params = xs, con = x, arg = to, kind = dk})
+      | FNormal {constructors, ...} =>
+        case SM.find (constructors, x) of
+            NONE => raise Fail "Corify.St.lookupConstructorByName [2]"
+          | SOME n => n
+
+fun enter ({basis, cons, constructors, vals, strs, funs, current, nested}, name) =
+    {basis = basis,
+     cons = cons,
+     constructors = constructors,
+     vals = vals,
+     strs = strs,
+     funs = funs,
+     current = FNormal {name = name,
+                        cons = SM.empty,
+                        constructors = SM.empty,
+                        vals = SM.empty,
+                        strs = SM.empty,
+                        funs = SM.empty},
+     nested = current :: nested}
+
+fun dummy (b, f) = {basis = b,
+                    cons = IM.empty,
+                    constructors = IM.empty,
+                    vals = IM.empty,
+                    strs = IM.empty,
+                    funs = IM.empty,
+                    current = f,
+                    nested = []}
+
+fun leave {basis, cons, constructors, vals, strs, funs, current, nested = m1 :: rest} =
+    {outer = {basis = basis,
+              cons = cons,
+              constructors = constructors,
+              vals = vals,
+              strs = strs,
+              funs = funs,
+              current = m1,
+              nested = rest},
+     inner = dummy (basis, current)}
+  | leave _ = raise Fail "Corify.St.leave"
+
+fun ffi m vals constructors = dummy (NONE, FFfi {mod = m, vals = vals, constructors = constructors})
+
+fun bindStr ({basis, cons, constructors, vals, strs, funs,
+              current = FNormal {name, cons = mcons, constructors = mconstructors,
+                                 vals = mvals, strs = mstrs, funs = mfuns}, nested} : t)
+            x n ({current = f, ...} : t) =
+    {basis = basis,
+     cons = cons,
+     constructors = constructors,
+     vals = vals,
+     strs = IM.insert (strs, n, f),
+     funs = funs,
+     current = FNormal {name = name,
+                        cons = mcons,
+                        constructors = mconstructors,
+                        vals = mvals,
+                        strs = SM.insert (mstrs, x, f),
+                        funs = mfuns},
+     nested = nested}
+  | bindStr _ _ _ _ = raise Fail "Corify.St.bindStr"
+
+fun lookupStrById ({basis, strs, ...} : t) n =
+    case IM.find (strs, n) of
+        NONE => raise Fail ("Corify.St.lookupStrById(" ^ Int.toString n ^ ")")
+      | SOME f => dummy (basis, f)
+
+fun lookupStrByIdOpt ({basis, strs, ...} : t) n =
+    case IM.find (strs, n) of
+        NONE => NONE
+      | SOME f => SOME (dummy (basis, f))
+
+fun lookupStrByName (m, {basis, current = FNormal {strs, ...}, ...} : t) =
+    (case SM.find (strs, m) of
+         NONE => raise Fail "Corify.St.lookupStrByName [1]"
+       | SOME f => dummy (basis, f))
+  | lookupStrByName _ = raise Fail "Corify.St.lookupStrByName [2]"
+
+fun lookupStrByNameOpt (m, {basis, current = FNormal {strs, ...}, ...} : t) =
+    (case SM.find (strs, m) of
+         NONE => NONE
+       | SOME f => SOME (dummy (basis, f)))
+  | lookupStrByNameOpt _ = NONE
+
+fun bindFunctor ({basis, cons, constructors, vals, strs, funs,
+                  current = FNormal {name, cons = mcons, constructors = mconstructors,
+                                     vals = mvals, strs = mstrs, funs = mfuns}, nested} : t)
+                x n xa na str =
+    {basis = basis,
+     cons = cons,
+     constructors = constructors,
+     vals = vals,
+     strs = strs,
+     funs = IM.insert (funs, n, (xa, na, str)),
+     current = FNormal {name = name,
+                        cons = mcons,
+                        constructors = mconstructors,
+                        vals = mvals,
+                        strs = mstrs,
+                        funs = SM.insert (mfuns, x, (xa, na, str))},
+     nested = nested}
+  | bindFunctor _ _ _ _ _ _ = raise Fail "Corify.St.bindFunctor"
+
+fun lookupFunctorById ({funs, ...} : t) n =
+    case IM.find (funs, n) of
+        NONE => raise Fail "Corify.St.lookupFunctorById"
+      | SOME v => v
+
+fun lookupFunctorByIdOpt ({funs, ...} : t) n =
+    IM.find (funs, n)
+
+fun lookupFunctorByName (m, {current = FNormal {funs, ...}, ...} : t) =
+    (case SM.find (funs, m) of
+         NONE => raise Fail ("Corify.St.lookupFunctorByName " ^ m ^ "[1]")
+       | SOME v => v)
+  | lookupFunctorByName _ = raise Fail "Corify.St.lookupFunctorByName [2]"
+
+end
+
+
+fun corifyKind (k, loc) =
+    case k of
+        L.KType => (L'.KType, loc)
+      | L.KArrow (k1, k2) => (L'.KArrow (corifyKind k1, corifyKind k2), loc)
+      | L.KName => (L'.KName, loc)
+      | L.KRecord k => (L'.KRecord (corifyKind k), loc)
+      | L.KUnit => (L'.KUnit, loc)
+      | L.KTuple ks => (L'.KTuple (map corifyKind ks), loc)
+
+      | L.KRel n => (L'.KRel n, loc)
+      | L.KFun (x, k) => (L'.KFun (x, corifyKind k), loc)
+
+fun corifyCon st (c, loc) =
+    case c of
+        L.TFun (t1, t2) => (L'.TFun (corifyCon st t1, corifyCon st t2), loc)
+      | L.TCFun (x, k, t) => (L'.TCFun (x, corifyKind k, corifyCon st t), loc)
+      | L.TKFun (x, t) => (L'.TKFun (x, corifyCon st t), loc)
+      | L.TRecord c => (L'.TRecord (corifyCon st c), loc)
+
+      | L.CRel n => (L'.CRel n, loc)
+      | L.CNamed n =>
+        (case St.lookupConById st n of
+             NONE => (L'.CNamed n, loc)
+           | SOME n => (L'.CNamed n, loc))
+      | L.CModProj (m, ms, x) =>
+        let
+            val st = St.lookupStrById st m
+            val st = foldl St.lookupStrByName st ms
+        in
+            case St.lookupConByName st x of
+                St.CNormal n => (L'.CNamed n, loc)
+              | St.CFfi m => 
+                if (m, x) = ("Basis", "unit") then 
+                    (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)
+                else
+                    (L'.CFfi (m, x), loc)
+        end
+
+      | L.CApp (c1, c2) => (L'.CApp (corifyCon st c1, corifyCon st c2), loc)
+      | L.CAbs (x, k, c) => (L'.CAbs (x, corifyKind k, corifyCon st c), loc)
+
+      | L.CKApp (c1, k) => (L'.CKApp (corifyCon st c1, corifyKind k), loc)
+      | L.CKAbs (x, c) => (L'.CKAbs (x, corifyCon st c), loc)
+
+      | L.CName s => (L'.CName s, loc)
+
+      | L.CRecord (k, xcs) =>
+        (L'.CRecord (corifyKind k, map (fn (c1, c2) => (corifyCon st c1, corifyCon st c2)) xcs), loc)
+      | L.CConcat (c1, c2) => (L'.CConcat (corifyCon st c1, corifyCon st c2), loc)
+      | L.CMap (k1, k2) => (L'.CMap (corifyKind k1, corifyKind k2), loc)
+      | L.CUnit => (L'.CUnit, loc)
+
+      | L.CTuple cs => (L'.CTuple (map (corifyCon st) cs), loc)
+      | L.CProj (c, n) => (L'.CProj (corifyCon st c, n), loc)
+
+fun corifyPatCon st pc =
+    case pc of
+        L.PConVar n => St.lookupConstructorById st n
+      | L.PConProj (m1, ms, x) =>
+        let
+            val st = St.lookupStrById st m1
+            val st = foldl St.lookupStrByName st ms
+        in
+            St.lookupConstructorByName st x
+        end
+
+fun corifyPat st (p, loc) =
+    case p of
+        L.PVar (x, t) => (L'.PVar (x, corifyCon st t), loc)
+      | L.PPrim p => (L'.PPrim p, loc)
+      | L.PCon (dk, pc, ts, po) => (L'.PCon (dk, corifyPatCon st pc, map (corifyCon st) ts,
+                                             Option.map (corifyPat st) po), loc)
+      | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, corifyPat st p, corifyCon st t)) xps), loc)
+
+fun corifyExp st (e, loc) =
+    case e of
+        L.EPrim p => (L'.EPrim p, loc)
+      | L.ERel n => (L'.ERel n, loc)
+      | L.ENamed n =>
+        (case St.lookupValById st n of
+             NONE => (L'.ENamed n, loc)
+           | SOME n => (L'.ENamed n, loc))
+      | L.EModProj (m, ms, x) =>
+        let
+            val st = St.lookupStrById st m
+            val st = foldl St.lookupStrByName st ms
+        in
+            case St.lookupConstructorByNameOpt st x of
+                SOME (pc as L'.PConFfi {mod = m, datatyp, params, arg, kind, ...}) =>
+                let
+                    val args = ListUtil.mapi (fn (i, _) => (L'.CRel i, loc)) params
+                    val e = case arg of
+                                NONE => (L'.ECon (kind, pc, args, NONE), loc)
+                              | SOME dom => (L'.EAbs ("x", dom, (L'.CFfi (m, datatyp), loc),
+                                                      (L'.ECon (kind, pc, args, SOME (L'.ERel 0, loc)), loc)), loc)
+
+                    val k = (L'.KType, loc)
+                in
+                    foldr (fn (x, e) => (L'.ECAbs (x, k, e), loc)) e params
+                end
+              | _ =>
+                case St.lookupValByName st x of
+                    St.ENormal n => (L'.ENamed n, loc)
+                  | St.EFfi (m, t) =>
+                    case t of
+                        (L'.CApp ((L'.CFfi ("Basis", "transaction"), _), dom), _) =>
+                        (L'.EAbs ("arg", dom, (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc),
+                                  (L'.EFfiApp (m, x, []), loc)), loc)
+                      | t as (L'.TFun _, _) =>
+                        let
+                            fun getArgs (all as (t, _), args) =
+                                case t of
+                                    L'.TFun (dom, ran) => getArgs (ran, dom :: args)
+                                  | _ => (all, rev args)
+
+                            val (result, args) = getArgs (t, [])
+                            val (isTransaction, result) =
+                                case result of
+                                    (L'.CApp ((L'.CFfi ("Basis", "transaction"), _),
+                                              result), _) => (true, result)
+                                  | _ => (false, result)
+
+                            fun makeApp n =
+                                let
+                                    val (actuals, _) = foldr (fn (t, (actuals, n)) =>
+                                                                 (((L'.ERel n, loc), t) :: actuals,
+                                                                  n + 1)) ([], n) args
+                                in
+                                    (L'.EFfiApp (m, x, actuals), loc)
+                                end
+                            val unit = (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)
+                            val (result, app) =
+                                if isTransaction then
+                                    ((L'.TFun (unit, result), loc),
+                                     (L'.EAbs ("_",
+                                               unit,
+                                               result,
+                                               makeApp 1), loc))
+                                else
+                                    (result, makeApp 0)
+                                     
+                            val (abs, _, _) = foldr (fn (t, (abs, ran, n)) =>
+                                                        ((L'.EAbs ("arg" ^ Int.toString n,
+                                                                   t,
+                                                                   ran,
+                                                                   abs), loc),
+                                                         (L'.TFun (t, ran), loc),
+                                                         n - 1)) (app, result, length args - 1) args
+                        in
+                            abs
+                        end
+                      | _ => (L'.EFfi (m, x), loc)
+        end
+      | L.EApp (e1, e2) => (L'.EApp (corifyExp st e1, corifyExp st e2), loc)
+      | L.EAbs (x, dom, ran, e1) => (L'.EAbs (x, corifyCon st dom, corifyCon st ran, corifyExp st e1), loc)
+      | L.ECApp (e1, c) => (L'.ECApp (corifyExp st e1, corifyCon st c), loc)
+      | L.ECAbs (x, k, e1) => (L'.ECAbs (x, corifyKind k, corifyExp st e1), loc)
+      | L.EKApp (e1, k) => (L'.EKApp (corifyExp st e1, corifyKind k), loc)
+      | L.EKAbs (x, e1) => (L'.EKAbs (x, corifyExp st e1), loc)
+
+      | L.ERecord xes => (L'.ERecord (map (fn (c, e, t) =>
+                                              (corifyCon st c, corifyExp st e, corifyCon st t)) xes), loc)
+      | L.EField (e1, c, {field, rest}) => (L'.EField (corifyExp st e1, corifyCon st c,
+                                                       {field = corifyCon st field, rest = corifyCon st rest}), loc)
+      | L.EConcat (e1, c1, e2, c2) => (L'.EConcat (corifyExp st e1, corifyCon st c1, corifyExp st e2,
+                                                   corifyCon st c2), loc)
+      | L.ECut (e1, c, {field, rest}) => (L'.ECut (corifyExp st e1, corifyCon st c,
+                                                   {field = corifyCon st field, rest = corifyCon st rest}), loc)
+      | L.ECutMulti (e1, c, {rest}) => (L'.ECutMulti (corifyExp st e1, corifyCon st c,
+                                                      {rest = corifyCon st rest}), loc)
+
+      | L.ECase (e, pes, {disc, result}) =>
+        (L'.ECase (corifyExp st e,
+                   map (fn (p, e) => (corifyPat st p, corifyExp st e)) pes,
+                   {disc = corifyCon st disc, result = corifyCon st result}),
+         loc)
+
+      | L.EWrite e => (L'.EWrite (corifyExp st e), loc)
+
+      | L.ELet (x, t, e1, e2) => (L'.ELet (x, corifyCon st t, corifyExp st e1, corifyExp st e2), loc)
+
+fun isTransactional (c, _) =
+    case c of
+        L'.TFun (_, c) => isTransactional c
+      | L'.CApp ((L'.CFfi ("Basis", "transaction"), _), _) => true
+      | _ => false
+
+fun corifyDecl mods (all as (d, loc : EM.span), st) =
+    case d of
+        L.DCon (x, n, k, c) =>
+        let
+            val (st, n) = St.bindCon st x n
+        in
+            ([(L'.DCon (x, n, corifyKind k, corifyCon st c), loc)], st)
+        end
+      | L.DDatatype dts =>
+        let
+            val (dts, st) = ListUtil.foldlMap (fn ((x, n, xs, xncs), st) =>
+                                                  let
+                                                      val (st, n) = St.bindCon st x n
+                                                  in
+                                                      ((x, n, xs, xncs), st)
+                                                  end)
+                                              st dts
+
+            val (dts, (st, dcons)) =
+                ListUtil.foldlMap
+                    (fn ((x, n, xs, xncs), (st, dcons)) =>
+                        let
+                            val (xncs, st) = ListUtil.foldlMap
+                                                 (fn ((x, n, co), st) =>
+                                                     let
+                                                         val (st, n') = St.bindConstructor st x n
+                                                         val st = St.bindConstructorVal st x n n'
+                                                         val co = Option.map (corifyCon st) co
+                                                     in
+                                                         ((x, n', co), st)
+                                                     end) st xncs
+
+                            val dk = ElabUtil.classifyDatatype xncs
+                            val t = (L'.CNamed n, loc)
+                            val nxs = length xs - 1
+                            val t = ListUtil.foldli
+                                        (fn (i, _, t) => (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
+                            val k = (L'.KType, loc)
+                            val dcons' = map (fn (x, n, to) =>
+                                                 let
+                                                     val args = ListUtil.mapi
+                                                                    (fn (i, _) => (L'.CRel (nxs - i), loc)) xs
+                                                     val (e, t) =
+                                                         case to of
+                                                             NONE => ((L'.ECon (dk, L'.PConVar n, args, NONE),
+                                                                       loc), t)
+                                                           | SOME t' => ((L'.EAbs ("x", t', t,
+                                                                                   (L'.ECon (dk, L'.PConVar n,
+                                                                                             args,
+                                                                                             SOME (L'.ERel 0,
+                                                                                                   loc)),
+                                                                                    loc)),
+                                                                          loc),
+                                                                         (L'.TFun (t', t), loc))
+                                                                        
+                                                     val t = foldr (fn (x, t) => (L'.TCFun (x, k, t), loc)) t xs
+                                                     val e = foldr (fn (x, e) => (L'.ECAbs (x, k, e), loc)) e xs
+                                                 in
+                                                     (L'.DVal (x, n, t, e, ""), loc)
+                                                 end) xncs
+                        in
+                            ((x, n, xs, xncs), (st, dcons' @ dcons))
+                        end)
+                (st, []) dts
+        in
+            ((L'.DDatatype dts, loc) :: dcons, st)
+        end
+      | L.DDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+        let
+            val (st, n) = St.bindCon st x n
+            val c = corifyCon st (L.CModProj (m1, ms, s), loc)
+
+            val m = foldl (fn (x, m) => (L.StrProj (m, x), loc)) (L.StrVar m1, loc) ms
+            val (_, {inner, ...}) = corifyStr mods (m, st)
+
+            val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) =>
+                                                   let
+                                                       val n' = St.lookupConstructorByName inner x
+                                                       val st = St.bindConstructorAs st x n n'
+                                                       val (st, n) = St.bindVal st x n
+                                                       val co = Option.map (corifyCon st) co
+                                                   in
+                                                       ((x, n, co), st)
+                                                   end) st xncs
+
+            val nxs = length xs - 1
+            val cBase = c
+            val c = ListUtil.foldli (fn (i, _, c) => (L'.CApp (c, (L'.CRel (nxs - i), loc)), loc)) c xs
+            val k = (L'.KType, loc)
+            val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+
+            val cds = map (fn (x, n, co) =>
+                              let
+                                  val t = case co of
+                                              NONE => c
+                                            | SOME t' => (L'.TFun (t', c), loc)
+                                  val e = corifyExp st (L.EModProj (m1, ms, x), loc)
+
+                                  val t = foldr (fn (x, t) => (L'.TCFun (x, k, t), loc)) t xs
+                              in
+                                  (L'.DVal (x, n, t, e, x), loc)
+                              end) xncs
+        in
+            ((L'.DCon (x, n, k', cBase), loc) :: cds, st)
+        end
+      | L.DVal (x, n, t, e as (L.ENamed n', _)) =>
+        let
+            val st =
+                case St.lookupConstructorByIdOpt st n' of
+                    SOME pc => St.bindConstructorAs st x n pc
+                  | _ => st
+
+            val (st, n) = St.bindVal st x n
+            val s = doRestify Settings.Url (mods, x)
+        in
+            ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st)
+        end
+      | L.DVal (x, n, t, e) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = doRestify Settings.Url (mods, x)
+        in
+            ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st)
+        end
+      | L.DValRec vis =>
+        let
+            val (vis, st) = ListUtil.foldlMap
+                                (fn ((x, n, t, e), st) =>
+                                    let
+                                        val (st, n) = St.bindVal st x n
+                                    in
+                                        ((x, n, t, e), st)
+                                    end)
+                                st vis
+
+            val vis = map
+                          (fn (x, n, t, e) =>
+                              let
+                                  val s = doRestify Settings.Url (mods, x)
+                              in
+                                  (x, n, corifyCon st t, corifyExp st e, s)
+                              end)
+                          vis
+        in
+            ([(L'.DValRec vis, loc)], st)
+        end
+      | L.DSgn _ => ([], st)
+
+      | L.DStr (x, n, _, (L.StrFun (xa, na, _, _, str), _)) =>
+        ([], St.bindFunctor st x n xa na str)
+
+      | L.DStr (x, n, _, (L.StrProj (str, x'), _)) =>
+        let
+            val (ds, {inner, outer}) = corifyStr mods (str, st)
+
+            val st = case St.lookupStrByNameOpt (x', inner) of
+                SOME st' => St.bindStr st x n st'
+              | NONE =>
+                let
+                    val (x', n', str') = St.lookupFunctorByName (x', inner)
+                in
+                    St.bindFunctor st x n x' n' str'
+                end
+        in
+            ([], st)
+        end
+
+      | L.DStr (x, n, _, (L.StrVar n', _)) =>
+        (case St.lookupFunctorByIdOpt st n' of
+             SOME (arg, dom, body) => ([], St.bindFunctor st x n arg dom body)
+           | NONE => ([], St.bindStr st x n (St.lookupStrById st n')))
+
+      | L.DStr (x, n, _, str) =>
+        let
+            val mods' =
+                if x = "anon" then
+                    mods
+                else
+                    x :: mods
+
+            val (ds, {inner, outer}) = corifyStr mods' (str, st)
+            val st = St.bindStr outer x n inner
+        in
+            (ds, st)
+        end
+
+      | L.DFfiStr (m, n, (sgn, _)) =>
+        (case sgn of
+             L.SgnConst sgis =>
+             let
+                 val (ds, cmap, conmap, st, _) =
+                     foldl (fn ((sgi, _), (ds, cmap, conmap, st, trans)) =>
+                               case sgi of
+                                   L.SgiConAbs (x, n, k) =>
+                                   let
+                                       val (st, n') = St.bindCon st x n
+
+                                       val trans =
+                                           if x = "transaction" then
+                                               SOME n
+                                           else
+                                               trans
+                                   in
+                                       ((L'.DCon (x, n', corifyKind k, (L'.CFfi (m, x), loc)), loc) :: ds,
+                                        cmap,
+                                        conmap,
+                                        st,
+                                        trans)
+                                   end
+                                 | L.SgiCon (x, n, k, _) =>
+                                   let
+                                       val (st, n') = St.bindCon st x n
+                                   in
+                                       ((L'.DCon (x, n', corifyKind k, (L'.CFfi (m, x), loc)), loc) :: ds,
+                                        cmap,
+                                        conmap,
+                                        st,
+                                        trans)
+                                   end
+
+                                 | L.SgiDatatype dts =>
+                                   let
+                                       val k = (L'.KType, loc)
+
+                                       val (dts, (ds', st, cmap, conmap)) =
+                                           ListUtil.foldlMap
+                                               (fn ((x, n, xs, xnts), (ds', st, cmap, conmap)) =>
+                                                   let
+                                                       val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc))
+                                                                      k xs
+
+                                                       val dk = ElabUtil.classifyDatatype xnts
+                                                       val (st, n') = St.bindCon st x n
+                                                       val (xnts, (ds', st, cmap, conmap)) =
+                                                           ListUtil.foldlMap
+                                                               (fn ((x', n, to), (ds', st, cmap, conmap)) =>
+                                                                   let
+                                                                       val dt = (L'.CNamed n', loc)
+                                                                       val args = ListUtil.mapi (fn (i, _) => (L'.CRel i, loc)) xs
+
+                                                                       val to = Option.map (corifyCon st) to
+
+                                                                       val pc = L'.PConFfi {mod = m,
+                                                                                            datatyp = x,
+                                                                                            params = xs,
+                                                                                            con = x',
+                                                                                            arg = to,
+                                                                                            kind = dk}
+
+                                                                       fun wrapT t =
+                                                                           foldr (fn (x, t) => (L'.TCFun (x, k, t), loc))
+                                                                                 t xs
+                                                                       fun wrapE e =
+                                                                           foldr (fn (x, e) => (L'.ECAbs (x, k, e), loc))
+                                                                                 e xs
+
+                                                                       val (cmap, d) =
+                                                                           case to of
+                                                                               NONE => (SM.insert (cmap, x', wrapT dt),
+                                                                                        (L'.DVal (x', n, wrapT dt,
+                                                                                                  wrapE
+                                                                                                      (L'.ECon (dk, pc,
+                                                                                                                args,
+                                                                                                                NONE),
+                                                                                                       loc),
+                                                                                                  ""), loc))
+                                                                             | SOME t =>
+                                                                               let
+                                                                                   val tf = (L'.TFun (t, dt), loc)
+                                                                                   val e = wrapE
+                                                                                               (L'.EAbs ("x", t, tf,
+                                                                                                         (L'.ECon (dk,
+                                                                                                                   pc,
+                                                                                                                   args,
+                                                                                                                   SOME
+                                                                                                                       (L'.ERel 0,
+                                                                                                                        loc)),
+                                                                                                          loc)), loc)
+                                                                                   val d = (L'.DVal (x', n, wrapT tf,
+                                                                                                     e, ""), loc)
+                                                                               in
+                                                                                   (SM.insert (cmap, x', wrapT tf), d)
+                                                                               end
+
+                                                                       val st = St.bindConstructorAs st x' n pc
+                                                                                
+                                                                       val conmap = SM.insert (conmap, x',
+                                                                                               (x, xs, to, dk))
+                                                                   in
+                                                                       ((x', n, to),
+                                                                        (d :: ds', st, cmap, conmap))
+                                                                   end) (ds', st, cmap, conmap) xnts
+
+                                                       val d = (L'.DCon (x, n', k', (L'.CFfi (m, x), loc)), loc)
+                                                   in
+                                                       ((x, n', xs, xnts), (d :: ds', st, cmap, conmap))
+                                                   end)
+                                           ([], st, cmap, conmap) dts
+                                   in
+                                       (List.revAppend (ds', ds),
+                                        cmap,
+                                        conmap,
+                                        st,
+                                        trans)
+                                   end
+
+                                 | L.SgiVal (x, _, c) =>
+                                   let
+                                       val c =
+                                           case trans of
+                                               NONE => corifyCon st c
+                                             | SOME trans =>
+                                               let
+                                                   fun transactify (all as (c, loc)) =
+                                                       case c of
+                                                           L.TFun (dom, ran) =>
+                                                           (L'.TFun (corifyCon st dom, transactify ran), loc)
+                                                         | L.CApp ((L.CNamed trans', _), t) =>
+                                                           if trans' = trans then
+                                                               (L'.CApp ((L'.CFfi (m, "transaction"), loc),
+                                                                        corifyCon st t), loc)
+                                                           else
+                                                               corifyCon st all
+                                                         | _ => corifyCon st all
+                                               in
+                                                   transactify c
+                                               end
+                                   in
+                                       if isTransactional c then
+                                           let
+                                               val ffi = (m, x)
+                                           in
+                                               if Settings.isBenignEffectful ffi then
+                                                   ()
+                                               else
+                                                   Settings.addEffectful ffi
+                                           end
+                                       else
+                                           ();
+                                       (ds,
+                                        SM.insert (cmap, x, c),
+                                        conmap,
+                                        st,
+                                        trans)
+                                   end
+                                 | _ => (ds, cmap, conmap, st, trans))
+                                                           ([], SM.empty, SM.empty, st, NONE) sgis
+
+                 val st = St.bindStr st m n (St.ffi m cmap conmap)
+             in
+                 (rev ds, if m = "Basis" then St.basisIs (st, n) else st)
+             end
+           | _ => raise Fail "Non-const signature for FFI structure")
+
+      | L.DExport (en, sgn, str) =>
+        (case #1 sgn of
+             L.SgnConst sgis =>
+             let
+                 fun pathify (str, _) =
+                     case str of
+                         L.StrVar m => SOME (m, [])
+                       | L.StrProj (str, s) =>
+                         Option.map (fn (m, ms) => (m, ms @ [s])) (pathify str)
+                       | _ => NONE
+             in
+                 case pathify str of
+                     NONE => (ErrorMsg.errorAt loc "Structure is too fancy to export";
+                              ([], st))
+                   | SOME (m, ms) =>
+                     let
+                         val basis_n = case St.lookupBasis st of
+                                           NONE => raise Fail "Corify: Don't know number of Basis"
+                                         | SOME n => n
+
+                         fun wrapSgi ((sgi, _), (wds, eds))  =
+                             case sgi of
+                                 L.SgiVal (s, _, t) =>
+                                 let
+                                     fun getPage (t, args) =
+                                         case #1 t of
+                                             L.CApp ((L.CModProj (basis, [], "transaction"), _),
+                                                     t' as
+                                                        (L.CApp
+                                                             ((L.CApp
+                                                                   ((L.CApp ((L.CModProj (basis', [], "xml"), _),
+                                                                             (L.CRecord (_, [((L.CName "Html", _),
+                                                                                              _)]), _)), _), _),
+                                                               _), _), _)) =>
+                                             if basis = basis_n andalso basis' = basis_n then
+                                                 SOME (t', rev args)
+                                             else
+                                                 NONE
+                                           | L.TFun (dom, ran) => getPage (ran, dom :: args)
+                                           | _ => NONE
+                                 in
+                                     case getPage (t, []) of
+                                         NONE => (wds, eds)
+                                       | SOME (ran', args) =>
+                                         let
+                                             val ran = (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc)
+                                             val ranT = (L.CApp ((L.CModProj (basis_n, [], "transaction"), loc),
+                                                                 ran), loc)
+                                             val e = (L.EModProj (m, ms, s), loc)
+
+                                             val ef = (L.EModProj (basis_n, [], "bind"), loc)
+                                             val ef = (L.ECApp (ef, (L.CModProj (basis_n, [], "transaction"), loc)), loc)
+                                             val ef = (L.ECApp (ef, ran'), loc)
+                                             val ef = (L.ECApp (ef, ran), loc)
+                                             val ef = (L.EApp (ef, (L.EModProj (basis_n, [], "transaction_monad"), loc)),
+                                                       loc)
+                                             val ea = ListUtil.foldri (fn (i, _, ea) =>
+                                                                          (L.EApp (ea, (L.ERel i, loc)), loc)) e args
+                                             val ef = (L.EApp (ef, ea), loc)
+
+                                             val eat = (L.CApp ((L.CModProj (basis_n, [], "transaction"), loc),
+                                                                ran), loc)
+                                             val ea = (L.EAbs ("p", ran', eat,
+                                                               (L.EWrite (L.ERel 0, loc), loc)), loc)
+
+                                             val (e, tf) = ListUtil.foldri (fn (i, t, (e, tf)) =>
+                                                                               ((L.EAbs ("x" ^ Int.toString i,
+                                                                                         t, tf, e), loc),
+                                                                                (L.TFun (t, tf), loc)))
+                                                           ((L.EApp (ef, ea), loc), ranT) args
+
+                                             val expKind = if List.exists (fn t =>
+                                                                              case corifyCon st t of
+                                                                                  (L'.CFfi ("Basis", "postBody"), _) => true
+                                                                                | _ => false) args then
+                                                               L'.Extern L'.ReadCookieWrite
+                                                           else
+                                                               L'.Link L'.ReadCookieWrite
+                                         in
+                                             ((L.DVal ("wrap_" ^ s, 0, tf, e), loc) :: wds,
+                                              (fn st =>
+                                                  case #1 (corifyExp st (L.EModProj (en, [], "wrap_" ^ s), loc)) of
+                                                      L'.ENamed n => (L'.DExport (expKind, n, false), loc)
+                                                    | _ => raise Fail "Corify: Value to export didn't corify properly")
+                                              :: eds)
+                                         end
+                                 end
+                               | _ => (wds, eds)
+
+                         val (wds, eds) = foldl wrapSgi ([], []) sgis
+                         val wrapper = (L.StrConst wds, loc)
+                         val mst = St.lookupStrById st m
+                         val mst = foldl St.lookupStrByName mst ms
+                         val (ds, {inner, outer}) = corifyStr (St.name mst) (wrapper, st)
+                         val st = St.bindStr outer "wrapper" en inner
+                                  
+                         val ds = ds @ map (fn f => f st) eds
+                     in
+                         (ds, st)
+                     end
+             end
+           | _ => raise Fail "Non-const signature for 'export'")
+
+      | L.DTable (_, x, n, c, pe, pc, ce, cc) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = relify (doRestify Settings.Table (mods, x))
+        in
+            ([(L'.DTable (x, n, corifyCon st c, s,
+                          corifyExp st pe, corifyCon st pc,
+                          corifyExp st ce, corifyCon st cc), loc)], st)
+        end
+      | L.DSequence (_, x, n) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = relify (doRestify Settings.Sequence (mods, x))
+        in
+            ([(L'.DSequence (x, n, s), loc)], st)
+        end
+      | L.DView (_, x, n, e, c) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = relify (doRestify Settings.View (mods, x))
+        in
+            ([(L'.DView (x, n, s, corifyExp st e, corifyCon st c), loc)], st)
+        end
+
+      | L.DDatabase s => ([(L'.DDatabase s, loc)], st)
+
+      | L.DCookie (_, x, n, c) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = doRestify Settings.Cookie (mods, x)
+        in
+            ([(L'.DCookie (x, n, corifyCon st c, s), loc)], st)
+        end
+      | L.DStyle (_, x, n) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = relify (doRestify Settings.Style (mods, x))
+        in
+            ([(L'.DStyle (x, n, s), loc)], st)
+        end
+
+      | L.DTask (e1, e2) =>
+        ([(L'.DTask (corifyExp st e1, corifyExp st e2), loc)], st)
+
+      | L.DPolicy e1 =>
+        ([(L'.DPolicy (corifyExp st e1), loc)], st)
+
+      | L.DOnError (m, ms, x) =>
+        let
+            val st = St.lookupStrById st m
+            val st = foldl St.lookupStrByName st ms
+        in
+            case St.lookupValByName st x of
+                St.ENormal n => ([(L'.DOnError n, loc)], st)
+              | _ => (ErrorMsg.errorAt loc "Wrong type of identifier for 'onError'";
+                      ([], st))
+        end
+
+      | L.DFfi (x, n, modes, t) =>
+        let
+            val m = case St.name st of
+                        [m] => m
+                      | _ => (ErrorMsg.errorAt loc "Used 'ffi' declaration beneath module top level";
+                              "")
+
+            val name = (m, x)
+
+            val (st, n) = St.bindVal st x n
+            val s = doRestify Settings.Url (mods, x)
+
+            val t' = corifyCon st t
+
+            fun numArgs (t : L'.con) =
+                case #1 t of
+                    L'.TFun (_, ran) => 1 + numArgs ran
+                  | _ => 0
+
+            fun makeArgs (i, t : L'.con, acc) =
+                case #1 t of
+                    L'.TFun (dom, ran) => makeArgs (i-1, ran, ((L'.ERel i, loc), dom) :: acc)
+                  | _ => rev acc
+
+            fun wrapAbs (i, t : L'.con, tTrans, e) =
+                case (#1 t, #1 tTrans) of
+                    (L'.TFun (dom, ran), L'.TFun (_, ran')) => (L'.EAbs ("x" ^ Int.toString i, dom, ran, wrapAbs (i+1, ran, ran', e)), loc)
+                  | _ => e
+
+            fun getRan (t : L'.con) =
+                case #1 t of
+                    L'.TFun (_, ran) => getRan ran
+                  | _ => t
+
+            fun addLastBit (t : L'.con) =
+                case #1 t of
+                    L'.TFun (dom, ran) => (L'.TFun (dom, addLastBit ran), #2 t)
+                  | _ => (L'.TFun ((L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), t), loc)
+
+            val isTrans = isTransactional t'
+            val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' -
+                                               (if isTrans then
+                                                    0
+                                                else
+                                                    1), t', [])), loc)
+            val (e, tTrans) = if isTrans then
+                                  ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t')
+                              else
+                                  (e, t')
+            val e = wrapAbs (0, t', tTrans, e)
+        in
+            app (fn Source.Effectful => Settings.addEffectful name
+                  | Source.BenignEffectful => Settings.addBenignEffectful name
+                  | Source.ClientOnly => Settings.addClientOnly name
+                  | Source.ServerOnly => Settings.addServerOnly name
+                  | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
+
+            if List.exists (fn Source.JsFunc _ => true | _ => false) modes then
+                ()
+            else
+                Settings.addJsFunc (name, #2 name);
+
+            if isTrans andalso not (Settings.isBenignEffectful name) then
+                Settings.addEffectful name
+            else
+                ();
+
+            ([(L'.DVal (x, n, t', e, s), loc)], st)
+        end
+
+and corifyStr mods ((str, loc), st) =
+    case str of
+        L.StrConst ds =>
+        let
+            val st = St.enter (st, mods)
+            val (ds, st) = ListUtil.foldlMapConcat (corifyDecl mods) st ds
+        in
+            (ds, St.leave st)
+        end
+      | L.StrVar n => ([], {inner = St.lookupStrById st n, outer = st})
+      | L.StrProj (str, x) =>
+        let
+            val (ds, {inner, outer}) = corifyStr mods (str, st)
+        in
+            (ds, {inner = St.lookupStrByName (x, inner), outer = outer})
+        end
+      | L.StrFun _ => raise Fail "Corify of nested functor definition"
+      | L.StrApp (str1, str2) =>
+        let
+            fun unwind' (str, _) =
+                case str of
+                    L.StrVar n => St.lookupStrById st n
+                  | L.StrProj (str, x) => St.lookupStrByName (x, unwind' str)
+                  | _ => raise Fail "Corify of fancy functor application [1]"
+
+            fun unwind (str, _) =
+                case str of
+                    L.StrVar n => St.lookupFunctorById st n
+                  | L.StrProj (str, x) => St.lookupFunctorByName (x, unwind' str)
+                  | _ => raise Fail "Corify of fancy functor application [2]"
+
+            val (xa, na, body) = unwind str1
+
+            (* An important step to make sure that nested functors
+             * "close under their environments": *)
+            val (next, body') = ExplRename.rename {NextId = getCounter (),
+                                                   FormalName = xa,
+                                                   FormalId = na,
+                                                   Body = body}
+
+            (*val () = Print.prefaces ("RENAME " ^ ErrorMsg.spanToString loc)
+                     [("FROM", ExplPrint.p_str ExplEnv.empty body),
+                      ("TO", ExplPrint.p_str ExplEnv.empty body')]*)
+            val body = body'
+
+            val () = setCounter next
+
+            val (ds1, {inner = inner', outer}) = corifyStr mods (str2, st)
+
+            val (ds2, {inner, outer}) = corifyStr mods (body, St.bindStr outer xa na inner')
+        in
+            (ds1 @ ds2, {inner = St.bindStr inner xa na inner', outer = outer})
+        end
+
+fun maxName ds = foldl (fn ((d, _), n) =>
+                           case d of
+                               L.DCon (_, n', _, _) => Int.max (n, n')
+                             | L.DDatatype dts => foldl (fn ((_, n', _, _), n) => Int.max (n, n')) n dts
+                             | L.DDatatypeImp (_, n', _, _, _, _, _) => Int.max (n, n')
+                             | L.DVal (_, n', _, _) => Int.max (n, n')
+                             | L.DValRec vis => foldl (fn ((_, n', _, _), n) => Int.max (n, n)) n vis
+                             | L.DSgn (_, n', _) => Int.max (n, n')
+                             | L.DStr (_, n', _, str) => Int.max (n, Int.max (n', maxNameStr str))
+                             | L.DFfiStr (_, n', _) => Int.max (n, n')
+                             | L.DExport _ => n
+                             | L.DTable (_, _, n', _, _, _, _, _) => Int.max (n, n')
+                             | L.DSequence (_, _, n') => Int.max (n, n')
+                             | 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.DTask _ => n
+                             | L.DPolicy _ => n
+                             | L.DOnError _ => n
+                             | L.DFfi (_, n', _, _) => Int.max (n, n'))
+                       0 ds
+
+and maxNameStr (str, _) =
+    case str of
+        L.StrConst ds => maxName ds
+      | L.StrVar n => n
+      | L.StrProj (str, _) => maxNameStr str
+      | L.StrFun (_, _, _, _, str) => maxNameStr str
+      | L.StrApp (str1, str2) => Int.max (maxNameStr str1, maxNameStr str2)
+
+fun corify ds =
+    let
+        val () = reset (maxName ds + 1)
+
+        val (ds, _) = ListUtil.foldlMapConcat (corifyDecl []) St.empty ds
+    in
+        ds
+    end
+
+end
diff --git a/src/css.sig b/src/css.sig
new file mode 100644
index 0000000..c7243cf
--- /dev/null
+++ b/src/css.sig
@@ -0,0 +1,43 @@
+(* Copyright (c) 2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CSS = sig
+
+    datatype inheritable = Block | List | Table | Caption | Td
+    datatype others = OBlock | OTable | OTd | Tr | NonReplacedInline | ReplacedInline | Width | Height
+
+    val inheritableToString : inheritable -> string
+    val othersToString : others -> string
+
+    type summary = inheritable list * others list
+
+    type report = {Overall : inheritable list,
+                   Classes : (string * summary) list}
+
+    val summarize : Core.file -> report
+
+end
diff --git a/src/css.sml b/src/css.sml
new file mode 100644
index 0000000..9e50686
--- /dev/null
+++ b/src/css.sml
@@ -0,0 +1,320 @@
+(* Copyright (c) 2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Css :> CSS = struct
+
+structure IM = IntBinaryMap
+
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+datatype inheritable = Block | List | Table | Caption | Td
+datatype others = OBlock | OTable | OTd | Tr | NonReplacedInline | ReplacedInline | Width | Height
+
+fun inheritableToString x =
+    case x of
+        Block => "B"
+      | List => "L"
+      | Table => "T"
+      | Caption => "C"
+      | Td => "D"
+
+fun othersToString x =
+    case x of
+        OBlock => "b"
+      | OTable => "t"
+      | OTd => "d"
+      | Tr => "-"
+      | NonReplacedInline => "N"
+      | ReplacedInline => "R"
+      | Width => "W"
+      | Height => "H"
+
+type summary = inheritable list * others list
+
+fun merge' (ls1, ls2) = foldl (fn (x, ls) => if List.exists (fn y => y = x) ls then ls else x :: ls) ls2 ls1
+fun merge ((in1, ot1), (in2, ot2)) = (merge' (in1, in2), merge' (ot1, ot2))
+fun mergePC {parent = (in1, ot1), child = in2} = (merge' (in1, in2), ot1)
+
+val nada = ([], [])
+val block = ([Block], [OBlock, Width, Height])
+val inline = ([], [NonReplacedInline])
+val list = ([Block, List], [OBlock, Width, Height])
+val replaced = ([], [ReplacedInline, Width, Height])
+val table = ([Block, Table], [OBlock, OTable, Width, Height])
+val tr = ([Block], [OBlock, Tr, Height])
+val td = ([Block, Td], [OBlock, OTd, Width])
+
+val tags = [("span", inline),
+            ("div", block),
+            ("p", block),
+            ("b", inline),
+            ("i", inline),
+            ("tt", inline),
+            ("h1", block),
+            ("h2", block),
+            ("h3", block),
+            ("h4", block),
+            ("h5", block),
+            ("h6", block),
+            ("li", list),
+            ("ol", list),
+            ("ul", list),
+            ("hr", block),
+            ("a", inline),
+            ("img", replaced),
+            ("form", block),
+            ("hidden", replaced),
+            ("textbox", replaced),
+            ("password", replaced),
+            ("textarea", replaced),
+            ("checkbox", replaced),
+            ("upload", replaced),
+            ("radio", replaced),
+            ("select", replaced),
+            ("submit", replaced),
+            ("label", inline),
+            ("ctextbox", replaced),
+            ("cpassword", replaced),
+            ("button", replaced),
+            ("ccheckbox", replaced),
+            ("cselect", replaced),
+            ("ctextarea", replaced),
+            ("tabl", table),
+            ("tr", tr),
+            ("th", td),
+            ("td", td)]
+
+val tags = foldl (fn ((tag, css), tags) =>
+                     SM.insert (tags, tag, css)) SM.empty tags
+
+open Core
+
+fun summarize file =
+    let
+        fun decl ((d, _), st as (globals, classes)) =
+            let
+                fun getTag (e, _) =
+                    case e of
+                        EFfi ("Basis", tag) => SOME tag
+                      | ECApp (e, _) => getTag e
+                      | EApp (e, _) => getTag e
+                      | _ => NONE
+
+                fun exp ((e, _), classes) =
+                    case e of
+                        EPrim _ => ([], classes)
+                      | ERel _ => ([], classes)
+                      | ENamed n =>
+                        (case IM.find (globals, n) of
+                             NONE => []
+                           | SOME (_, sm) => sm,
+                         classes)
+                      | ECon (_, _, _, NONE) => ([], classes)
+                      | ECon (_, _, _, SOME e) => exp (e, classes)
+                      | EFfi _ => ([], classes)
+                      | EFfiApp (_, _, es) => expList (map #1 es, classes)
+
+                      | EApp (
+                        (EApp (
+                         (EApp (
+                          (EApp (
+                           (EApp (
+                            (EApp (
+                             (EApp (
+                              (ECApp (
+                               (ECApp (
+                                (ECApp (
+                                 (ECApp (
+                                  (ECApp (
+                                   (ECApp (
+                                    (ECApp (
+                                     (ECApp (
+                                      (EFfi ("Basis", "tag"),
+                                       _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+                              (ENamed class, _)), _),
+                             _), _),
+                            _), _),
+                           _), _),
+                          attrs), _),
+                         tag), _),
+                        xml) =>
+                        let
+                            val (sm, classes) = exp (xml, classes)
+                            val (sm', classes) = exp (attrs, classes)
+                            val sm = merge' (sm, sm')
+                        in
+                            case getTag tag of
+                                NONE => (sm, classes)
+                              | SOME tag =>
+                                case SM.find (tags, tag) of
+                                    NONE => (sm, classes)
+                                  | SOME sm' =>
+                                    let
+                                        val sm'' = mergePC {parent = sm', child = sm}
+                                        val old = Option.getOpt (IM.find (classes, class), nada)
+                                        val classes = IM.insert (classes, class, merge (old, sm''))
+                                    in
+                                        (merge' (#1 sm', sm), classes)
+                                    end
+                        end
+
+                      | EApp (
+                        (EApp (
+                         (EApp (
+                          (EApp (
+                           (EApp (
+                            (EApp (
+                             (EApp (
+                              (ECApp (
+                               (ECApp (
+                                (ECApp (
+                                 (ECApp (
+                                  (ECApp (
+                                   (ECApp (
+                                    (ECApp (
+                                     (ECApp (
+                                      (EFfi ("Basis", "tag"),
+                                       _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+                              _), _),
+                             _), _),
+                            _), _),
+                           _), _),
+                          attrs), _),
+                         tag), _),
+                        xml) =>
+                        let
+                            val (sm, classes) = exp (xml, classes)
+                            val (sm', classes) = exp (attrs, classes)
+                            val sm = merge' (sm, sm')
+                        in
+                            case getTag tag of
+                                NONE => (sm, classes)
+                              | SOME tag =>
+                                case SM.find (tags, tag) of
+                                    NONE => (sm, classes)
+                                  | SOME sm' => (merge' (#1 sm', sm), classes)
+                        end
+
+                      | EApp (e1, e2) =>
+                        let
+                            val (sm1, classes) = exp (e1, classes)
+                            val (sm2, classes) = exp (e2, classes)
+                        in
+                            (merge' (sm1, sm2), classes)
+                        end
+                      | EAbs (_, _, _, e) => exp (e, classes)
+                      | ECApp (e, _) => exp (e, classes)
+                      | ECAbs (_, _, e) => exp (e, classes)
+                      | EKAbs (_, e) => exp (e, classes)
+                      | EKApp (e, _) => exp (e, classes)
+                      | ERecord xets => expList (map #2 xets, classes)
+                      | EField (e, _, _) => exp (e, classes)
+                      | EConcat (e1, _, e2, _) =>
+                        let
+                            val (sm1, classes) = exp (e1, classes)
+                            val (sm2, classes) = exp (e2, classes)
+                        in
+                            (merge' (sm1, sm2), classes)
+                        end
+                      | ECut (e, _, _) => exp (e, classes)
+                      | ECutMulti (e, _, _) => exp (e, classes)
+                      | ECase (e, pes, _) =>
+                        let
+                            val (sm, classes) = exp (e, classes)
+                            val (sms, classes) = expList (map #2 pes, classes)
+                        in
+                            (merge' (sm, sms), classes)
+                        end
+                      | EWrite e => exp (e, classes)
+                      | EClosure (_, es) => expList (es, classes)
+                      | ELet (_, _, e1, e2) =>
+                        let
+                            val (sm1, classes) = exp (e1, classes)
+                            val (sm2, classes) = exp (e2, classes)
+                        in
+                            (merge' (sm1, sm2), classes)
+                        end
+                      | EServerCall (_, es, _, _) => expList (es, classes)
+
+                and expList (es, classes) = foldl (fn (e, (sm, classes)) =>
+                                                      let
+                                                          val (sm', classes) = exp (e, classes)
+                                                      in
+                                                          (merge' (sm, sm'), classes)
+                                                      end) ([], classes) es
+            in
+                case d of
+                    DCon _ => st
+                  | DDatatype _ => st
+                  | DVal (_, n, _, e, _) =>
+                    let
+                        val (sm, classes) = exp (e, classes)
+                    in
+                        (IM.insert (globals, n, (NONE, sm)), classes)
+                    end
+                  | DValRec vis =>
+                    let
+                        val (sm, classes) = foldl (fn ((_, _, _, e, _),
+                                                       (sm, classes)) =>
+                                                      let
+                                                          val (sm', classes) = exp (e, classes)
+                                                      in
+                                                          (merge' (sm', sm), classes)
+                                                      end) ([], classes) vis
+                    in
+                        (foldl (fn ((_, n, _, _, _), globals) => IM.insert (globals, n, (NONE, sm))) globals vis,
+                         classes)
+                    end
+                  | DExport _ => st
+                  | DTable _ => st
+                  | DSequence _ => st
+                  | DView _ => st
+                  | DDatabase _ => st
+                  | DCookie _ => st
+                  | DStyle (_, n, s) => (IM.insert (globals, n, (SOME s, [])), classes)
+                  | DTask _ => st
+                  | DPolicy _ => st
+                  | DOnError _ => st
+            end
+
+        val (globals, classes) = foldl decl (IM.empty, IM.empty) file
+    in
+        {Overall = IM.foldl (fn ((_, sm), sm') => merge' (sm, sm')) [] globals,
+         Classes = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER)
+                                      (List.mapPartial (fn (i, sm) =>
+                                                           case IM.find (globals, i) of
+                                                               SOME (SOME s, _) => SOME (s, sm)
+                                                             | _ => NONE) (IM.listItemsi classes))}
+    end
+
+type report = {Overall : inheritable list,
+               Classes : (string * summary) list}
+
+end
diff --git a/src/datatype_kind.sml b/src/datatype_kind.sml
new file mode 100644
index 0000000..140a012
--- /dev/null
+++ b/src/datatype_kind.sml
@@ -0,0 +1,35 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure DatatypeKind = struct
+
+datatype datatype_kind =
+         Enum
+       | Option
+       | Default
+
+end
diff --git a/src/dbmodecheck.sig b/src/dbmodecheck.sig
new file mode 100644
index 0000000..4d4873c
--- /dev/null
+++ b/src/dbmodecheck.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature DB_MODE_CHECK = sig
+
+    val classify : Mono.file -> Mono.file
+
+end
diff --git a/src/dbmodecheck.sml b/src/dbmodecheck.sml
new file mode 100644
index 0000000..eb416ce
--- /dev/null
+++ b/src/dbmodecheck.sml
@@ -0,0 +1,86 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure DbModeCheck :> DB_MODE_CHECK = struct
+
+open Mono
+
+structure IM = IntBinaryMap
+
+fun classify (ds, ps) =
+    let
+        fun mergeModes (m1, m2) =
+            case (m1, m2) of
+                (NoDb, _) => m2
+              | (_, NoDb) => m1
+              | _ => AnyDb
+
+        fun modeOf modes =
+            MonoUtil.Exp.fold {typ = fn (_, dbm) => dbm,
+                               exp = fn (EQuery _, dbm) => mergeModes (OneQuery, dbm)
+                                      | (EDml _, _) => AnyDb
+                                      | (ENextval _, _) => AnyDb
+                                      | (ESetval _, _) => AnyDb
+                                      | (ENamed n, dbm) =>
+                                        (case IM.find (modes, n) of
+                                             NONE => dbm
+                                           | SOME dbm' => mergeModes (dbm, dbm'))
+                                      | (_, dbm) => dbm} NoDb
+
+        fun decl ((d, _), modes) =
+            case d of
+                DVal (x, n, _, e, _) => IM.insert (modes, n, modeOf modes e)
+              | DValRec xes =>
+                let
+                    val mode = foldl (fn ((_, _, _, e, _), mode) =>
+                                         let
+                                             val mode' = modeOf modes e
+                                         in
+                                             case mode' of
+                                                 NoDb => mode
+                                               | _ => AnyDb
+                                         end) NoDb xes
+                in
+                    foldl (fn ((_, n, _, _, _), modes) => IM.insert (modes, n, mode)) modes xes
+                end
+              | _ => modes
+
+        val modes = foldl decl IM.empty ds
+
+        val (ps, modes) = ListUtil.foldlMap (fn ((n, side, _), modes) =>
+                                                case IM.find (modes, n) of
+                                                    NONE => ((n, side, AnyDb), modes)
+                                                  | SOME mode => ((n, side, mode), #1 (IM.remove (modes, n))))
+                                            modes ps
+
+        val ps = IM.foldli (fn (n, mode, ps) => (n, ServerOnly, mode) :: ps) ps modes
+    in
+        (ds, ps)
+    end
+
+end
+
diff --git a/src/demo.sig b/src/demo.sig
new file mode 100644
index 0000000..57154ed
--- /dev/null
+++ b/src/demo.sig
@@ -0,0 +1,35 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature DEMO = sig
+
+    val make : {prefix : string, dirname : string, guided : bool} -> unit
+    val make' : {prefix : string, dirname : string, guided : bool} -> bool
+
+    val noEmacs : bool ref
+
+end
diff --git a/src/demo.sml b/src/demo.sml
new file mode 100644
index 0000000..62b9037
--- /dev/null
+++ b/src/demo.sml
@@ -0,0 +1,477 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Demo :> DEMO = struct
+
+val noEmacs = ref false
+
+fun make' {prefix, dirname, guided} =
+    let
+        val prose = OS.Path.joinDirFile {dir = dirname,
+                                         file = "prose"}
+        val inf = FileIO.txtOpenIn prose
+
+        val outDir = OS.Path.concat (dirname, "out")
+
+        val () = if OS.FileSys.access (outDir, []) then
+                     ()
+                 else
+                     OS.FileSys.mkDir outDir
+
+        val fname = OS.Path.joinDirFile {dir = outDir,
+                                         file = "index.html"}
+
+        val out = TextIO.openOut fname
+        val () = (TextIO.output (out, "<frameset cols=\"15%,85%\">\n");
+                  TextIO.output (out, "<frame src=\"demos.html\">\n");
+                  TextIO.output (out, "<frame src=\"intro.html\" name=\"staging\">\n");
+                  TextIO.output (out, "</frameset>\n");
+                  TextIO.closeOut out)
+
+        val fname = OS.Path.joinDirFile {dir = outDir,
+                                         file = "demos.html"}
+
+        val demosOut = TextIO.openOut fname
+        val () = (TextIO.output (demosOut, "<html><body>\n\n");
+                  TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"intro.html\">Intro</a></li>\n\n"))
+
+        val fname = OS.Path.joinDirFile {dir = dirname,
+                                         file = "demo.urs"}
+        val ursOut = TextIO.openOut fname
+        val () = (TextIO.output (ursOut, "val main : unit -> transaction page\n");
+                  TextIO.closeOut ursOut)
+
+        val fname = OS.Path.joinDirFile {dir = dirname,
+                                         file = "demo.ur"}
+        val urOut = TextIO.openOut fname
+        val () = TextIO.output (urOut, "fun main () = return <xml><body>\n")
+
+        fun mergeWith f (o1, o2) =
+            case (o1, o2) of
+                (NONE, _) => o2
+              | (_, NONE) => o1
+              | (SOME v1, SOME v2) => SOME (f (v1, v2))
+
+        fun combiner (combined : Compiler.job, urp : Compiler.job) = {
+            prefix = prefix,
+            database = mergeWith (fn (v1, v2) =>
+                                     if v1 = v2 then
+                                         v1
+                                     else
+                                         raise Fail "Different demos want to use different database strings")
+                                 (#database combined, #database urp),
+            sources = foldl (fn (file, files) =>
+                                if List.exists (fn x => x = file) files then
+                                    files
+                                else
+                                    files @ [file])
+                            (#sources combined) (#sources urp),
+            exe = case Settings.getExe () of
+                      NONE => OS.Path.joinDirFile {dir = dirname,
+                                                   file = "demo.exe"}
+                    | SOME s => s,
+            sql = SOME (case Settings.getSql () of
+                            NONE => OS.Path.joinDirFile {dir = dirname,
+                                                         file = "demo.sql"}
+                          | SOME s => s),
+            debug = Settings.getDebug (),
+            timeout = Int.max (#timeout combined, #timeout urp),
+            profile = false,
+            ffi = [],
+            link = [],
+            linker = NONE,
+            headers = [],
+            scripts = [],
+            clientToServer = [],
+            effectful = [],
+            benignEffectful = [],
+            clientOnly = [],
+            serverOnly = [],
+            jsModule = NONE,
+            jsFuncs = [],
+            rewrites = #rewrites combined @ #rewrites urp,
+            filterUrl = #filterUrl combined @ #filterUrl urp,
+            filterMime = #filterMime combined @ #filterMime urp,
+            filterRequest = #filterRequest combined @ #filterRequest urp,
+            filterResponse = #filterResponse combined @ #filterResponse urp,
+            filterEnv = #filterEnv combined @ #filterEnv urp,
+            filterMeta = #filterMeta combined @ #filterMeta urp,
+            protocol = mergeWith #2 (#protocol combined, #protocol urp),
+            dbms = mergeWith #2 (#dbms combined, #dbms urp),
+            sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
+            safeGets = #safeGets combined @ #safeGets urp,
+            onError = NONE,
+            minHeap = 0
+        }
+
+        val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
+
+        fun capitalize "" = ""
+          | capitalize s = str (Char.toUpper (String.sub (s, 0)))
+                           ^ String.extract (s, 1, NONE)
+
+        fun startUrp urp =
+            let
+                val base = OS.Path.base urp
+                val name = capitalize base
+
+                val () = (TextIO.output (demosOut, "<li> <a target=\"staging\" href=\"");
+                          TextIO.output (demosOut, base);
+                          TextIO.output (demosOut, ".html\">");
+                          TextIO.output (demosOut, name);
+                          TextIO.output (demosOut, "</a></li>\n"))
+
+                val () = (TextIO.output (urOut, "  <li> <a link={");
+                          TextIO.output (urOut, name);
+                          TextIO.output (urOut, ".main ()}>");
+                          TextIO.output (urOut, name);
+                          TextIO.output (urOut, "</a></li>\n"))
+
+                val urp_file = OS.Path.joinDirFile {dir = dirname,
+                                                    file = urp}
+
+                val out = OS.Path.joinBaseExt {base = base,
+                                               ext = SOME "html"}
+                val out = OS.Path.joinDirFile {dir = outDir,
+                                               file = out}
+                val out = TextIO.openOut out
+
+                val () = (TextIO.output (out, "<frameset rows=\"");
+                          TextIO.output (out, if guided then
+                                                  "*,100"
+                                              else
+                                                  "50%,*");
+                          TextIO.output (out, "\">\n");
+                          TextIO.output (out, "<frame src=\"");
+                          TextIO.output (out, prefix);
+                          TextIO.output (out, "/");
+                          TextIO.output (out, name);
+                          TextIO.output (out, "/main\" name=\"showcase\">\n");
+                          TextIO.output (out, "<frame src=\"");
+                          TextIO.output (out, base);
+                          TextIO.output (out, ".desc.html\">\n");
+                          TextIO.output (out, "</frameset>\n");
+                          TextIO.closeOut out)
+                val () = TextIO.closeOut out
+
+                val out = OS.Path.joinBaseExt {base = base,
+                                               ext = SOME "desc"}
+                val out = OS.Path.joinBaseExt {base = out,
+                                               ext = SOME "html"}
+                val out = TextIO.openOut (OS.Path.joinDirFile {dir = outDir,
+                                                               file = out})
+            in
+                case parse (OS.Path.base urp_file) of
+                    NONE => raise Fail ("Can't parse " ^ urp_file)
+                  | SOME urpData =>
+                    (TextIO.output (out, "<html><head>\n<title>");
+                     TextIO.output (out, name);
+                     TextIO.output (out, "</title>\n</head><body>\n\n<h1>");
+                     TextIO.output (out, name);
+                     TextIO.output (out, "</h1>\n\n<center>[ <a target=\"showcase\" href=\"");
+                     TextIO.output (out, prefix);
+                     TextIO.output (out, "/");
+                     TextIO.output (out, name);
+                     TextIO.output (out, "/main\">Application</a>");
+                     TextIO.output (out, " | <a target=\"showcase\" href=\"");
+                     TextIO.output (out, urp);
+                     TextIO.output (out, ".html\"><tt>");
+                     TextIO.output (out, urp);
+                     TextIO.output (out, "</tt></a>");
+                     app (fn file =>
+                             let
+                                 fun ifEx s =
+                                     let
+                                         val src = OS.Path.joinBaseExt {base = file,
+                                                                        ext = SOME s}
+                                         val src' = OS.Path.file src
+                                     in
+                                         if String.isPrefix (OS.Path.mkAbsolute {path = dirname,
+                                                                                 relativeTo = OS.FileSys.getDir ()}) src
+                                            andalso OS.FileSys.access (src, []) then
+                                             (TextIO.output (out, " | <a target=\"showcase\" href=\"");
+                                              TextIO.output (out, src');
+                                              TextIO.output (out, ".html\"><tt>");
+                                              TextIO.output (out, src');
+                                              TextIO.output (out, "</tt></a>"))
+                                         else
+                                             ()
+                                     end
+                             in
+                                 ifEx "urs";
+                                 ifEx "ur"
+                             end) (#sources urpData);
+                     TextIO.output (out, " ]</center>\n\n");
+
+                     (urpData, out))
+            end
+
+        fun endUrp out =
+            (TextIO.output (out, "\n</body></html>\n");
+             TextIO.closeOut out)
+
+        fun readUrp (combined, out) =
+            let
+                fun finished () = endUrp out
+
+                fun readUrp' () =
+                    case TextIO.inputLine inf of
+                        NONE => (finished ();
+                                 combined)
+                      | SOME line =>
+                        if String.isSuffix ".urp\n" line then
+                            let
+                                val urp = String.substring (line, 0, size line - 1)
+                                val (urpData, out) = startUrp urp
+                            in
+                                finished ();
+
+                                readUrp (combiner (combined, urpData),
+                                         out)
+                            end
+                        else
+                            (TextIO.output (out, line);
+                             readUrp' ())
+            in
+                readUrp' ()
+            end
+
+        val indexFile = OS.Path.joinDirFile {dir = outDir,
+                                             file = "intro.html"}
+
+        val out = TextIO.openOut indexFile
+        val () = TextIO.output (out, "<html><head>\n<title>Ur/Web Demo</title>\n</head><body>\n\n")
+
+        fun readIndex () =
+            let
+                fun finished () = (TextIO.output (out, "\n</body></html>\n");
+                                   TextIO.closeOut out)
+            in
+                case TextIO.inputLine inf of
+                    NONE => (finished ();
+                             NONE)
+                  | SOME line =>
+                    if String.isSuffix ".urp\n" line then
+                        let
+                            val urp = String.substring (line, 0, size line - 1)
+                            val (urpData, out) = startUrp urp
+                        in
+                            finished ();
+
+                            SOME (readUrp (urpData,
+                                           out))
+                        end
+                    else
+                        (TextIO.output (out, line);
+                         readIndex ())
+            end
+
+        fun prettyPrint () =
+            let
+                val dir = Posix.FileSys.opendir dirname
+
+                fun loop () =
+                    case Posix.FileSys.readdir dir of
+                        NONE => Posix.FileSys.closedir dir
+                      | SOME file =>
+                        let
+                            fun doit f =
+                                f (OS.Path.joinDirFile {dir = dirname,
+                                                        file = file},
+                                   OS.Path.mkAbsolute
+                                       {relativeTo = OS.FileSys.getDir (),
+                                        path = OS.Path.joinDirFile {dir = outDir,
+                                                                    file = OS.Path.joinBaseExt {base = file,
+                                                                                                ext = SOME "html"}}})
+
+                            fun highlight () =
+                                doit (fn (src, html) =>
+                                         let
+                                             val dirty =
+                                                 let
+                                                     val srcSt = Posix.FileSys.stat src
+                                                     val htmlSt = Posix.FileSys.stat html
+                                                 in
+                                                     Time.> (Posix.FileSys.ST.mtime srcSt,
+                                                             Posix.FileSys.ST.mtime htmlSt)
+                                                 end handle OS.SysErr _ => true
+
+                                             val cmd = "emacs -no-init-file --eval \"(progn "
+                                                       ^ "(global-font-lock-mode t) "
+                                                       ^ "(add-to-list 'load-path \\\""
+                                                       ^ !Settings.configSitelisp
+                                                       ^ "/\\\") "
+                                                       ^ "(load \\\"urweb-mode-startup\\\") "
+                                                       ^ "(load \\\"htmlize\\\") "
+                                                       ^ "(urweb-mode) "
+                                                       ^ "(find-file \\\""
+                                                       ^ src
+                                                       ^ "\\\") "
+                                                       ^ "(switch-to-buffer (htmlize-buffer)) "
+                                                       ^ "(write-file \\\""
+                                                       ^ html
+                                                       ^ "\\\") "
+                                                       ^ "(kill-emacs))\""
+                                         in
+                                             if dirty then
+                                                 (print (">>> " ^ cmd ^ "\n");
+                                                  ignore (OS.Process.system cmd))
+                                             else
+                                                 ()
+                                         end)
+
+                            val highlight = fn () => if !noEmacs then () else highlight ()
+                        in
+                            if OS.Path.base file = "demo" then
+                                ()
+                            else case OS.Path.ext file of
+                                     SOME "urp" =>
+                                     doit (fn (src, html) =>
+                                              let
+                                                  val inf = FileIO.txtOpenIn src
+                                                  val out = TextIO.openOut html
+
+                                                  fun loop () =
+                                                      case TextIO.inputLine inf of
+                                                          NONE => ()
+                                                        | SOME line => (TextIO.output (out, line);
+                                                                        loop ())
+                                              in
+                                                  TextIO.output (out, "<html><body>\n\n<pre>");
+                                                  loop ();
+                                                  TextIO.output (out, "</pre>\n\n</body></html>");
+
+                                                  TextIO.closeIn inf;
+                                                  TextIO.closeOut out
+                                              end)
+                                   | SOME "urs" => highlight ()
+                                   | SOME "ur" => highlight ()
+                                   | _ => ();
+                            loop ()
+                        end
+            in
+                loop ()
+            end
+    in
+        case readIndex () of
+            NONE => raise Fail "No demo applications!"
+          | SOME combined =>
+            let
+                val () = (TextIO.output (urOut, "</body></xml>\n");
+                          TextIO.closeOut urOut)
+
+                val fname = OS.Path.joinDirFile {dir = dirname,
+                                                 file = "demo.urp"}
+                val outf = TextIO.openOut fname
+
+                fun filters kind =
+                    app (fn rule : Settings.rule =>
+                            (TextIO.output (outf, case #action rule of
+                                                      Settings.Allow => "allow"
+                                                    | Settings.Deny => "deny");
+                             TextIO.output (outf, " ");
+                             TextIO.output (outf, kind);
+                             TextIO.output (outf, " ");
+                             TextIO.output (outf, #pattern rule);
+                             case #kind rule of
+                                 Settings.Exact => ()
+                               | Settings.Prefix => TextIO.output (outf, "*");
+                             TextIO.output (outf, "\n")))
+            in
+                Option.app (fn db => (TextIO.output (outf, "database ");
+                                      TextIO.output (outf, db);
+                                      TextIO.output (outf, "\n")))
+                           (#database combined);
+                TextIO.output (outf, "sql demo.sql\n");
+                TextIO.output (outf, "prefix ");
+                TextIO.output (outf, prefix);
+                TextIO.output (outf, "\n");
+                app (fn rule =>
+                        (TextIO.output (outf, "rewrite ");
+                         TextIO.output (outf, case #pkind rule of
+                                                  Settings.Any => "all"
+                                                | Settings.Url => "url"
+                                                | Settings.Table => "table"
+                                                | Settings.Sequence => "sequence"
+                                                | Settings.View => "view"
+                                                | Settings.Relation => "relation"
+                                                | Settings.Cookie => "cookie"
+                                                | Settings.Style => "style");
+                         TextIO.output (outf, " ");
+                         TextIO.output (outf, #from rule);
+                         case #kind rule of
+                             Settings.Exact => ()
+                           | Settings.Prefix => TextIO.output (outf, "*");
+                         TextIO.output (outf, " ");
+                         TextIO.output (outf, #to rule);
+                         if #hyphenate rule then
+                             TextIO.output (outf, " [-]")
+                         else
+                             ();
+                         TextIO.output (outf, "\n"))) (#rewrites combined);
+                filters "url" (#filterUrl combined);
+                filters "mime" (#filterMime combined);
+                app (fn path =>
+                        (TextIO.output (outf, "safeGet ");
+                         TextIO.output (outf, path);
+                         TextIO.output (outf, "\n"))) (#safeGets combined);
+                TextIO.output (outf, "\n");
+
+                app (fn s =>
+                        let
+                            val s = OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
+                                                        path = s}
+                        in
+                            TextIO.output (outf, s);
+                            TextIO.output (outf, "\n")
+                        end)
+                    (#sources combined);
+                TextIO.output (outf, "\n");
+                TextIO.output (outf, "demo\n");
+
+                TextIO.closeOut outf;
+
+                let
+                    val b = Compiler.compile (OS.Path.base fname)
+                in
+                    TextIO.output (demosOut, "\n</body></html>\n");
+                    TextIO.closeOut demosOut;
+                    if b then
+                        prettyPrint ()
+                    else
+                        ();
+                    b
+                end
+            end
+    end
+
+fun make args = if make' args then
+                    ()
+                else
+                    OS.Process.exit OS.Process.failure
+
+end
diff --git a/src/disjoint.sig b/src/disjoint.sig
new file mode 100644
index 0000000..7ca05fd
--- /dev/null
+++ b/src/disjoint.sig
@@ -0,0 +1,46 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature DISJOINT = sig
+    
+    type env
+
+    val empty : env
+    val enter : env -> env
+
+    type goal = ErrorMsg.span * ElabEnv.env * env * Elab.con * Elab.con
+
+    val assert : ElabEnv.env -> env -> Elab.con * Elab.con -> env
+
+    val prove : ElabEnv.env -> env -> Elab.con * Elab.con * ErrorMsg.span -> goal list
+
+    val p_env : env -> unit
+
+    val proved : int ref
+    val reset : unit -> unit
+
+end
diff --git a/src/disjoint.sml b/src/disjoint.sml
new file mode 100644
index 0000000..8fa8834
--- /dev/null
+++ b/src/disjoint.sml
@@ -0,0 +1,285 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Disjoint :> DISJOINT = struct
+
+open Elab
+open ElabOps
+
+datatype piece_fst =
+         NameC of string
+       | NameR of int
+       | NameN of int
+       | NameM of int * string list * string
+       | RowR of int
+       | RowN of int
+       | RowM of int * string list * string
+
+type piece = piece_fst * int list
+
+fun p2s p =
+    case p of
+        NameC s => "NameC(" ^ s ^ ")"
+      | NameR n => "NameR(" ^ Int.toString n ^ ")"
+      | NameN n => "NameN(" ^ Int.toString n ^ ")"
+      | NameM (n, _, s) => "NameR(" ^ Int.toString n ^ ", " ^ s ^ ")"
+      | RowR n => "RowR(" ^ Int.toString n ^ ")"
+      | RowN n => "RowN(" ^ Int.toString n ^ ")"
+      | RowM (n, _, s) => "RowR(" ^ Int.toString n ^ ", " ^ s ^ ")"
+
+fun pp p = print (p2s p ^ "\n")
+
+fun rp2s (p, ns) = String.concatWith " " (p2s p :: map Int.toString ns)
+
+structure PK = struct
+
+type ord_key = piece
+
+open Order
+
+fun compare' (p1, p2) =
+    case (p1, p2) of
+        (NameC s1, NameC s2) => String.compare (s1, s2)
+      | (NameR n1, NameR n2) => Int.compare (n1, n2)
+      | (NameN n1, NameN n2) => Int.compare (n1, n2)
+      | (NameM (n1, ss1, s1), NameM (n2, ss2, s2)) =>
+        join (Int.compare (n1, n2),
+           fn () => join (String.compare (s1, s2), fn () =>
+                                                      joinL String.compare (ss1, ss2)))
+      | (RowR n1, RowR n2) => Int.compare (n1, n2)
+      | (RowN n1, RowN n2) => Int.compare (n1, n2)
+      | (RowM (n1, ss1, s1), RowM (n2, ss2, s2)) =>
+        join (Int.compare (n1, n2),
+           fn () => join (String.compare (s1, s2), fn () =>
+                                                      joinL String.compare (ss1, ss2)))
+
+      | (NameC _, _) => LESS
+      | (_, NameC _) => GREATER
+
+      | (NameR _, _) => LESS
+      | (_, NameR _) => GREATER
+
+      | (NameN _, _) => LESS
+      | (_, NameN _) => GREATER
+
+      | (NameM _, _) => LESS
+      | (_, NameM _) => GREATER
+
+      | (RowR _, _) => LESS
+      | (_, RowR _) => GREATER
+
+      | (RowN _, _) => LESS
+      | (_, RowN _) => GREATER
+
+fun compare ((p1, ns1), (p2, ns2)) =
+    join (compare' (p1, p2),
+          fn () => joinL Int.compare (ns1, ns2))
+
+end
+
+structure PS = BinarySetFn(PK)
+structure PM = BinaryMapFn(PK)
+
+type env = PS.set PM.map
+
+fun p_env x =
+    (print "\nDENV:\n";
+     PM.appi (fn (p1, ps) =>
+                 PS.app (fn p2 =>
+                            print (rp2s p1 ^ " ~ " ^ rp2s p2 ^ "\n")) ps) x)
+     
+structure E = ElabEnv
+
+type goal = ErrorMsg.span * E.env * env * Elab.con * Elab.con
+
+val empty = PM.empty
+
+fun nameToRow (c, loc) =
+    (CRecord ((KUnit, loc), [((c, loc), (CUnit, loc))]), loc)
+
+fun pieceToRow' (p, loc) =
+    case p of
+        NameC s => nameToRow (CName s, loc)
+      | NameR n => nameToRow (CRel n, loc)
+      | NameN n => nameToRow (CNamed n, loc)
+      | NameM (n, xs, x) => nameToRow (CModProj (n, xs, x), loc)
+      | RowR n => (CRel n, loc)
+      | RowN n => (CNamed n, loc)
+      | RowM (n, xs, x) => (CModProj (n, xs, x), loc)
+
+fun pieceToRow ((p, ns), loc) =
+    foldl (fn (n, c) => (CProj (c, n), loc)) (pieceToRow' (p, loc)) ns
+
+datatype piece' =
+         Piece of piece
+       | Unknown of con
+
+fun pieceEnter' p =
+    case p of
+        NameR n => NameR (n + 1)
+      | RowR n => RowR (n + 1)
+      | _ => p
+
+fun pieceEnter (p, n) = (pieceEnter' p, n)
+
+fun enter denv =
+    PM.foldli (fn (p, pset, denv') =>
+                  PM.insert (denv', pieceEnter p, PS.map pieceEnter pset))
+    PM.empty denv
+
+val lowercase = CharVector.map Char.toLower
+
+fun prove1 denv (p1, p2) =
+    case (p1, p2) of
+        ((NameC s1, _), (NameC s2, _)) => lowercase s1 <> lowercase s2
+      | _ =>
+        case PM.find (denv, p1) of
+            NONE => false
+          | SOME pset => PS.member (pset, p2)
+
+val proved = ref 0
+fun reset () = (ElabOps.reset ();
+                proved := 0)
+
+fun decomposeRow env c =
+    let
+        val loc = #2 c
+
+        fun decomposeProj c =
+            let
+                val c = hnormCon env c
+            in
+                case #1 c of
+                    CProj (c, n) =>
+                    let
+                        val (c', ns) = decomposeProj c
+                    in
+                        (c', ns @ [n])
+                    end
+                  | _ => (c, [])
+            end
+
+        fun decomposeName (c, acc) =
+            let
+                val (cAll as (c, _), ns) = decomposeProj c
+            in
+                case c of
+                    CName s => Piece (NameC s, ns) :: acc
+                  | CRel n => Piece (NameR n, ns) :: acc
+                  | CNamed n => Piece (NameN n, ns) :: acc
+                  | CModProj (m1, ms, x) => Piece (NameM (m1, ms, x), ns) :: acc
+                  | _ => Unknown cAll :: acc
+            end
+
+        fun decomposeRow' (c, acc) =
+            let
+                fun default () =
+                    let
+                        val (cAll as (c, _), ns) = decomposeProj c
+                    in
+                        case c of
+                            CRecord (_, xcs) => foldl (fn ((x, _), acc) => decomposeName (x, acc)) acc xcs
+                          | CConcat (c1, c2) => decomposeRow' (c1, decomposeRow' (c2, acc))
+                          | CRel n => Piece (RowR n, ns) :: acc
+                          | CNamed n => Piece (RowN n, ns) :: acc
+                          | CModProj (m1, ms, x) => Piece (RowM (m1, ms, x), ns) :: acc
+                          | _ => Unknown cAll :: acc
+                    end
+            in
+                case #1 (hnormCon env c) of
+                    CApp (
+                    (CApp ((CMap _, _), _), _),
+                    r) => decomposeRow' (r, acc)
+                  | _ => default ()
+            end
+    in
+        decomposeRow' (c, [])
+    end
+
+and assert env denv (c1, c2) =
+    let
+        val ps1 = decomposeRow env c1
+        val ps2 = decomposeRow env c2
+
+        val unUnknown = List.mapPartial (fn Unknown _ => NONE | Piece p => SOME p)
+        val ps1 = unUnknown ps1
+        val ps2 = unUnknown ps2
+
+        (*val () = print "APieces1:\n"
+        val () = app pp ps1
+        val () = print "APieces2:\n"
+        val () = app pp ps2*)
+
+        fun assertPiece ps (p, denv) =
+            let
+                val pset = Option.getOpt (PM.find (denv, p), PS.empty)
+                val ps = case p of
+                             (NameC _, _) => List.filter (fn (NameC _, _) => false | _ => true) ps
+                           | _ => ps
+                val pset = PS.addList (pset, ps)
+            in
+                PM.insert (denv, p, pset)
+            end
+
+        val denv = foldl (assertPiece ps2) denv ps1
+    in
+        foldl (assertPiece ps1) denv ps2
+    end
+
+and prove env denv (c1, c2, loc) =
+    let
+        val () = proved := !proved + 1
+        val ps1 = decomposeRow env c1
+        val ps2 = decomposeRow env c2
+
+        val hasUnknown = List.exists (fn Unknown _ => true | _ => false)
+        val unUnknown = List.mapPartial (fn Unknown _ => NONE | Piece p => SOME p)
+    in
+        if (hasUnknown ps1 andalso not (List.null ps2))
+           orelse (hasUnknown ps2 andalso not (List.null ps1)) then
+            [(loc, env, denv, c1, c2)]
+        else
+            let
+                val ps1 = unUnknown ps1
+                val ps2 = unUnknown ps2
+            in
+                (*print "Pieces1:\n";
+                app pp ps1;
+                print "Pieces2:\n";
+                app pp ps2;*)
+
+                foldl (fn (p1, rem) =>
+                          foldl (fn (p2, rem) =>
+                                    if prove1 denv (p1, p2) then
+                                        rem
+                                    else
+                                        (loc, env, denv, pieceToRow (p1, loc), pieceToRow (p2, loc)) :: rem) rem ps2)
+                      [] ps1
+            end
+    end
+
+end
diff --git a/src/effectize.sig b/src/effectize.sig
new file mode 100644
index 0000000..1b638a3
--- /dev/null
+++ b/src/effectize.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EFFECTIZE = sig
+
+    val effectize : Core.file -> Core.file
+
+end
diff --git a/src/effectize.sml b/src/effectize.sml
new file mode 100644
index 0000000..2c9b237
--- /dev/null
+++ b/src/effectize.sml
@@ -0,0 +1,208 @@
+(* Copyright (c) 2009-2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Effective :> EFFECTIZE = struct
+
+open Core
+
+structure U = CoreUtil
+
+structure IM = IntBinaryMap
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+fun effectful x = Settings.isEffectful x andalso not (Settings.isClientOnly x)
+
+fun effectize file =
+    let
+        fun expOnload evs e =
+            case e of
+                EFfi f => effectful f
+              | EFfiApp (m, x, _) => effectful (m, x)
+              | ENamed n => IM.inDomain (evs, n)
+              | EServerCall (n, _, _, _) => IM.inDomain (evs, n)
+              | _ => false
+
+        fun couldWriteOnload evs = U.Exp.exists {kind = fn _ => false,
+                                                 con = fn _ => false,
+                                                 exp = expOnload evs}
+
+        fun exp evs e =
+            case e of
+                EFfi f => effectful f
+              | EFfiApp (m, x, _) => effectful (m, x)
+              | ENamed n => IM.inDomain (evs, n)
+              | ERecord xets => List.exists (fn ((CName "Onload", _), e, _) => couldWriteOnload evs e
+                                              | _ => false) xets
+              | _ => false
+
+        fun couldWrite evs = U.Exp.exists {kind = fn _ => false,
+                                           con = fn _ => false,
+                                           exp = exp evs}
+
+        fun exp writers readers pushers e =
+            case e of
+                ENamed n => IM.inDomain (pushers, n)
+              | EServerCall (n, _, _, _) => IM.inDomain (writers, n) andalso IM.inDomain (readers, n)
+              | _ => false
+
+        fun couldWriteWithRpc writers readers pushers = U.Exp.exists {kind = fn _ => false,
+                                                                      con = fn _ => false,
+                                                                      exp = exp writers readers pushers}
+
+        fun exp evs e =
+            case e of
+                EFfi ("Basis", "getCookie") => true
+              | EFfiApp ("Basis", "getHeader", _) => true
+              | EFfiApp ("Basis", "getenv", _) => true
+              | ENamed n => IM.inDomain (evs, n)
+              | EServerCall (n, _, _, _) => IM.inDomain (evs, n)
+              | _ => false
+
+        fun couldReadCookie evs = U.Exp.exists {kind = fn _ => false,
+                                                con = fn _ => false,
+                                                exp = exp evs}
+
+        val dejs = U.Exp.map {kind = fn x => x,
+                              con = fn c => c,
+                              exp = fn ERecord xets => ERecord (List.filter (fn ((CName x, _), _ , _) => x = "Onload" orelse not (String.isPrefix "On" x)
+                                                                              | _ => true) xets)
+                                     | e => e}
+
+        fun doDecl (d, evs as (writers, readers, pushers)) =
+            case #1 d of
+                DVal (x, n, t, e, s) =>
+                let
+                    val e' = dejs e
+                in
+                    (d, (if couldWrite writers e' then
+                             IM.insert (writers, n, (#2 d, s))
+                         else
+                             writers,
+                         if couldReadCookie readers e' then
+                             IM.insert (readers, n, (#2 d, s))
+                         else
+                             readers,
+                         if couldWriteWithRpc writers readers pushers e then
+                             IM.insert (pushers, n, (#2 d, s))
+                         else
+                             pushers))
+                end
+              | DValRec vis =>
+                let
+                    fun oneRound evs =
+                        foldl (fn ((_, n, _, e, s), (changed, (writers, readers, pushers))) =>
+                                  let
+                                      val e' = dejs e
+
+                                      val (changed, writers) =
+                                          if couldWrite writers e' andalso not (IM.inDomain (writers, n)) then
+                                              (true, IM.insert (writers, n, (#2 d, s)))
+                                          else
+                                              (changed, writers)
+
+                                      val (changed, readers) =
+                                          if couldReadCookie readers e' andalso not (IM.inDomain (readers, n)) then
+                                              (true, IM.insert (readers, n, (#2 d, s)))
+                                          else
+                                              (changed, readers)
+
+                                      val (changed, pushers) =
+                                          if couldWriteWithRpc writers readers pushers e
+                                             andalso not (IM.inDomain (pushers, n)) then
+                                              (true, IM.insert (pushers, n, (#2 d, s)))
+                                          else
+                                              (changed, pushers)
+                                  in
+                                      (changed, (writers, readers, pushers))
+                                  end) (false, evs) vis
+
+                    fun loop evs =
+                        let
+                            val (b, evs) = oneRound evs
+                        in
+                            if b then
+                                loop evs
+                            else
+                                evs
+                        end
+                in
+                    (d, loop (writers, readers, pushers))
+                end
+              | DExport (Link _, n, t) =>
+                (case IM.find (writers, n) of
+                     NONE => ()
+                   | SOME (loc, s) =>
+                     if Settings.isSafeGet s then
+                         ()
+                     else
+                         ErrorMsg.errorAt loc ("A handler (URI prefix \"" ^ s
+                                               ^ "\") accessible via GET could cause side effects; try accessing it only via forms, removing it from the signature of the main program module, or whitelisting it with the 'safeGet' .urp directive");
+                 ((DExport (Link (if IM.inDomain (writers, n) then
+                                      if IM.inDomain (readers, n) then
+                                          ReadCookieWrite
+                                      else
+                                          ReadWrite
+                                  else
+                                      ReadOnly), n, IM.inDomain (pushers, n)), #2 d), evs))
+              | DExport (Action _, n, _) =>
+                ((DExport (Action (if IM.inDomain (writers, n) then
+                                       if IM.inDomain (readers, n) then
+                                           ReadCookieWrite
+                                       else
+                                           ReadWrite
+                                   else
+                                       ReadOnly), n, IM.inDomain (pushers, n)), #2 d),
+                 evs)
+              | DExport (Rpc _, n, _) =>
+                ((DExport (Rpc (if IM.inDomain (writers, n) then
+                                    if IM.inDomain (readers, n) then
+                                        ReadCookieWrite
+                                    else
+                                        ReadWrite
+                                else
+                                    ReadOnly), n, IM.inDomain (pushers, n)), #2 d),
+                 evs)
+              | DExport (Extern _, n, _) =>
+                ((DExport (Extern (if IM.inDomain (writers, n) then
+                                       if IM.inDomain (readers, n) then
+                                           ReadCookieWrite
+                                       else
+                                           ReadWrite
+                                   else
+                                       ReadOnly), n, IM.inDomain (pushers, n)), #2 d),
+                 evs)
+              | _ => (d, evs)
+
+        val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty, IM.empty) file
+    in
+        file
+    end
+
+end
diff --git a/src/elab.sml b/src/elab.sml
new file mode 100644
index 0000000..90c14e4
--- /dev/null
+++ b/src/elab.sml
@@ -0,0 +1,204 @@
+(* Copyright (c) 2008-2011, 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Elab = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype kind' =
+         KType
+       | KArrow of kind * kind
+       | KName
+       | KRecord of kind
+       | KUnit
+       | KTuple of kind list
+
+       | KError
+       | KUnif of ErrorMsg.span * string * kunif ref
+       | KTupleUnif of ErrorMsg.span * (int * kind) list * kunif ref
+
+       | KRel of int
+       | KFun of string * kind
+
+and kunif =
+    KUnknown of kind -> bool (* Is the kind a valid unification? *)
+  | KKnown of kind
+
+withtype kind = kind' located
+
+datatype explicitness =
+         Explicit
+       | Implicit
+
+datatype con' =
+         TFun of con * con
+       | TCFun of explicitness * string * kind * con
+       | TRecord of con
+       | TDisjoint of con * con * con
+
+       | CRel of int
+       | CNamed of int
+       | CModProj of int * string list * string
+       | CApp of con * con
+       | CAbs of string * kind * con
+
+       | CKAbs of string * con
+       | CKApp of con * kind
+       | TKFun of string * con
+
+       | CName of string
+
+       | CRecord of kind * (con * con) list
+       | CConcat of con * con
+       | CMap of kind * kind
+
+       | CUnit
+
+       | CTuple of con list
+       | CProj of con * int
+
+       | CError
+       | CUnif of int * ErrorMsg.span * kind * string * cunif ref
+
+and cunif =
+    Unknown of con -> bool (* Is the constructor a valid unification? *)
+  | Known of con
+
+withtype con = con' located
+
+datatype datatype_kind = datatype DatatypeKind.datatype_kind
+
+datatype patCon =
+         PConVar of int
+       | PConProj of int * string list * string
+
+datatype pat' =
+         PVar of string * con
+       | PPrim of Prim.t
+       | PCon of datatype_kind * patCon * con list * pat option
+       | PRecord of (string * pat * con) list
+
+withtype pat = pat' located
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | EModProj of int * string list * string
+       | EApp of exp * exp
+       | EAbs of string * con * con * exp
+       | ECApp of exp * con
+       | ECAbs of explicitness * string * kind * exp
+
+       | EKAbs of string * exp
+       | EKApp of exp * kind
+
+       | ERecord of (con * exp * con) list
+       | EField of exp * con * { field : con, rest : con }
+       | EConcat of exp * con * exp * con
+       | ECut of exp * con * { field : con, rest : con }
+       | ECutMulti of exp * con * { rest : con }
+
+       | ECase of exp * (pat * exp) list * { disc : con, result : con }
+
+       | EError
+       | EUnif of exp option ref
+
+       | ELet of edecl list * exp * con
+
+and edecl' =
+    EDVal of pat * con * exp
+  | EDValRec of (string * con * exp) list
+
+withtype exp = exp' located
+     and edecl = edecl' located
+
+(* We have to be careful about crawling automatically generated signatures recursively,
+ * importing all type-class instances that we find.
+ * The reason is that selfification will add signatures of anonymous structures,
+ * and it's counterintuitive for instances to escape anonymous structures! *)
+datatype import_mode = Import | Skip
+
+datatype sgn_item' =
+         SgiConAbs of string * int * kind
+       | SgiCon of string * int * kind * con
+       | SgiDatatype of (string * int * string list * (string * int * con option) list) list
+       | SgiDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
+       | SgiVal of string * int * con
+       | SgiStr of import_mode * string * int * sgn
+       | SgiSgn of string * int * sgn
+       | SgiConstraint of con * con
+       | SgiClassAbs of string * int * kind
+       | SgiClass of string * int * kind * con
+
+and sgn' =
+    SgnConst of sgn_item list
+  | SgnVar of int
+  | SgnFun of string * int * sgn * sgn
+  | SgnWhere of sgn * string list * string * con
+  | SgnProj of int * string list * string
+  | SgnError
+
+withtype sgn_item = sgn_item' located
+and sgn = sgn' located
+
+datatype decl' =
+         DCon of string * int * kind * con
+       | DDatatype of (string * int * string list * (string * int * con option) list) list
+       | DDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
+       | DVal of string * int * con * exp
+       | DValRec of (string * int * con * exp) list
+       | DSgn of string * int * sgn
+       | DStr of string * int * sgn * str
+       | DFfiStr of string * int * sgn
+       | DConstraint of con * con
+       | DExport of int * sgn * str
+       | DTable of int * string * int * con * exp * con * exp * con
+       | DSequence of int * string * int
+       | DView of int * string * int * exp * con
+       | DDatabase of string
+       | DCookie of int * string * int * con
+       | DStyle of int * string * int
+       | DTask of exp * exp
+       | DPolicy of exp
+       | DOnError of int * string list * string
+       | DFfi of string * int * Source.ffi_mode list * con
+
+     and str' =
+         StrConst of decl list
+       | StrVar of int
+       | StrProj of str * string
+       | StrFun of string * int * sgn * sgn * str
+       | StrApp of str * str
+       | StrError
+
+withtype decl = decl' located
+     and str = str' located
+               
+type file = decl list
+
+end
diff --git a/src/elab_env.sig b/src/elab_env.sig
new file mode 100644
index 0000000..47b31c0
--- /dev/null
+++ b/src/elab_env.sig
@@ -0,0 +1,127 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ELAB_ENV = sig
+
+    val liftConInCon : int -> Elab.con -> Elab.con
+    val mliftConInCon : int -> Elab.con -> Elab.con
+
+    val liftConInExp : int -> Elab.exp -> Elab.exp
+    val liftExpInExp : int -> Elab.exp -> Elab.exp
+
+    val subExpInExp : (int * Elab.exp) -> Elab.exp -> Elab.exp
+
+    type env
+
+    val dump : env -> unit
+
+    val empty : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+
+    datatype 'a var =
+             NotBound
+           | Rel of int * 'a
+           | Named of int * 'a
+
+    val pushKRel : env -> string -> env
+    val lookupKRel : env -> int -> string
+    val lookupK : env -> string -> int option
+
+    val pushCRel : env -> string -> Elab.kind -> env
+    val lookupCRel : env -> int -> string * Elab.kind
+
+    val pushCNamed : env -> string -> Elab.kind -> Elab.con option -> env * int
+    val pushCNamedAs : env -> string -> int -> Elab.kind -> Elab.con option -> env
+    val lookupCNamed : env -> int -> string * Elab.kind * Elab.con option
+
+    val lookupC : env -> string -> Elab.kind var
+
+    val pushDatatype : env -> int -> string list -> (string * int * Elab.con option) list -> env
+    type datatyp
+    val lookupDatatype : env -> int -> datatyp
+    val lookupDatatypeConstructor : datatyp -> int -> string * Elab.con option
+    val datatypeArgs : datatyp -> string list
+    val constructors : datatyp -> (string * int * Elab.con option) list
+
+    val lookupConstructor : env -> string -> (Elab.datatype_kind * int * string list * Elab.con option * int) option
+
+    val pushClass : env -> int -> env
+    val isClass : env -> Elab.con -> bool
+    val resolveClass : (Elab.con -> Elab.con) -> (Elab.con * Elab.con -> bool)
+                       -> env -> Elab.con -> Elab.exp option
+    val resolveFailureCause : unit -> Elab.con option
+    val listClasses : env -> (Elab.con * (Elab.con * Elab.exp) list) list
+
+    val pushERel : env -> string -> Elab.con -> env
+    val lookupERel : env -> int -> string * Elab.con
+
+    val pushENamed : env -> string -> Elab.con -> env * int
+    val pushENamedAs : env -> string -> int -> Elab.con -> env
+    val lookupENamed : env -> int -> string * Elab.con
+    val checkENamed : env -> int -> bool
+
+    val lookupE : env -> string -> Elab.con var
+
+    val pushSgnNamed : env -> string -> Elab.sgn -> env * int
+    val pushSgnNamedAs : env -> string -> int -> Elab.sgn -> env
+    val lookupSgnNamed : env -> int -> string * Elab.sgn
+
+    val lookupSgn : env -> string -> (int * Elab.sgn) option
+
+    val pushStrNamed : env -> string -> Elab.sgn -> env * int
+    val pushStrNamedAs : env -> string -> int -> Elab.sgn -> env
+    val pushStrNamedAs' : bool (* also enrich typeclass instances? *) -> env -> string -> int -> Elab.sgn -> env
+    val lookupStrNamed : env -> int -> string * Elab.sgn
+
+    val lookupStr : env -> string -> (int * Elab.sgn) option
+
+    val edeclBinds : env -> Elab.edecl -> env
+    val declBinds : env -> Elab.decl -> env
+    val sgiBinds : env -> Elab.sgn_item -> env
+
+    val hnormSgn : env -> Elab.sgn -> Elab.sgn
+
+    val projectCon : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> (Elab.kind * Elab.con option) option
+    val projectDatatype : env -> { sgn : Elab.sgn, str : Elab.str, field : string }
+                          -> (string list * (string * int * Elab.con option) list) option
+    val projectConstructor : env -> { sgn : Elab.sgn, str : Elab.str, field : string }
+                             -> (Elab.datatype_kind * int * string list * Elab.con option * Elab.con) option
+    val projectVal : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.con option
+    val projectSgn : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.sgn option
+    val projectStr : env -> { sgn : Elab.sgn, str : Elab.str, field : string } -> Elab.sgn option
+    val projectConstraints : env -> { sgn : Elab.sgn, str : Elab.str } -> (Elab.con * Elab.con) list option
+
+    val newNamed : unit -> int
+
+    val chaseMpath : env -> (int * string list) -> Elab.str * Elab.sgn
+
+    val patBinds : env -> Elab.pat -> env
+    val patBindsN : Elab.pat -> int
+
+end
diff --git a/src/elab_env.sml b/src/elab_env.sml
new file mode 100644
index 0000000..8402bcb
--- /dev/null
+++ b/src/elab_env.sml
@@ -0,0 +1,1709 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ElabEnv :> ELAB_ENV = struct
+
+open Elab
+
+structure U = ElabUtil
+
+structure IM = IntBinaryMap
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+exception UnboundRel of int
+exception UnboundNamed of int
+
+
+(* AST utility functions *)
+
+val liftKindInKind =
+    U.Kind.mapB {kind = fn bound => fn k =>
+                                       case k of
+                                         KRel xn =>
+                                         if xn < bound then
+                                             k
+                                         else
+                                             KRel (xn + 1)
+                                       | _ => k,
+                 bind = fn (bound, _) => bound + 1}
+
+val liftKindInCon =
+    U.Con.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + 1)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                bind = fn (bound, U.Con.RelK _) => bound + 1
+                        | (bound, _) => bound}
+
+val liftConInCon =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | CUnif (nl, loc, k, s, r) => CUnif (nl+1, loc, k, s, r)
+                                       | _ => c,
+                bind = fn (bound, U.Con.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+val lift = liftConInCon 0
+
+fun mliftConInCon by c =
+    if by = 0 then
+        c
+    else
+        U.Con.mapB {kind = fn _ => fn k => k,
+                    con = fn bound => fn c =>
+                                         case c of
+                                             CRel xn =>
+                                             if xn < bound then
+                                                 c
+                                             else
+                                                 CRel (xn + by)
+                                           | CUnif (nl, loc, k, s, r) => CUnif (nl+by, loc, k, s, r)
+                                           | _ => c,
+                    bind = fn (bound, U.Con.RelC _) => bound + 1
+                            | (bound, _) => bound} 0 c
+
+val () = U.mliftConInCon := mliftConInCon
+
+val liftKindInExp =
+    U.Exp.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + 1)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelK _) => bound + 1
+                        | (bound, _) => bound}
+
+val liftConInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | CUnif (nl, loc, k, s, r) => CUnif (nl+1, loc, k, s, r)
+                                       | _ => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+val liftExpInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+
+val liftExp = liftExpInExp 0
+
+val subExpInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | ((xn, rep), U.Exp.RelC _) => (xn, liftConInExp 0 rep)
+                        | (ctx, _) => ctx}
+
+(* Back to environments *)
+
+datatype 'a var' =
+         Rel' of int * 'a
+       | Named' of int * 'a
+
+datatype 'a var =
+         NotBound
+       | Rel of int * 'a
+       | Named of int * 'a
+
+type datatyp = string list * (string * con option) IM.map
+
+datatype class_name =
+         ClNamed of int
+       | ClProj of int * string list * string
+
+fun class_name_out cn =
+    case cn of
+        ClNamed n => (CNamed n, ErrorMsg.dummySpan)
+      | ClProj x => (CModProj x, ErrorMsg.dummySpan)
+
+fun cn2s cn =
+    case cn of
+        ClNamed n => "Named(" ^ Int.toString n ^ ")"
+      | ClProj (m, ms, x) => "Proj(" ^ Int.toString m ^ "," ^ String.concatWith "," ms ^ "," ^ x ^ ")"
+
+structure CK = struct
+type ord_key = class_name
+open Order
+fun compare x =
+    case x of
+        (ClNamed n1, ClNamed n2) => Int.compare (n1, n2)
+      | (ClNamed _, _) => LESS
+      | (_, ClNamed _) => GREATER
+
+      | (ClProj (m1, ms1, x1), ClProj (m2, ms2, x2)) =>
+        join (Int.compare (m1, m2),
+              fn () => join (joinL String.compare (ms1, ms2),
+                             fn () => String.compare (x1, x2)))
+end
+
+structure CS = BinarySetFn(CK)
+structure CM = BinaryMapFn(CK)
+
+type rules = (int * con list * con * exp) list
+
+type class = {closedRules : rules,
+              openRules : rules}
+val empty_class = {closedRules = [],
+                   openRules = []}
+
+type env = {
+     renameK : int SM.map,
+     relK : string list,
+
+     renameC : kind var' SM.map,
+     relC : (string * kind) list,
+     namedC : (string * kind * con option) IM.map,
+
+     datatypes : datatyp IM.map,
+     constructors : (datatype_kind * int * string list * con option * int) SM.map,
+
+     classes : class CM.map,
+
+     renameE : con var' SM.map,
+     relE : (string * con) list,
+     namedE : (string * con) IM.map,
+
+     renameSgn : (int * sgn) SM.map,
+     sgn : (string * sgn) IM.map,
+
+     renameStr : (int * sgn) SM.map,
+     str : (string * sgn) IM.map
+}
+
+fun dump (env : env) =
+    (print "NamedC:\n";
+     IM.appi (fn (n, (x, k, co)) => print (x ^ " [" ^ Int.toString n ^ "]\n")) (#namedC env))
+
+val namedCounter = ref 0
+
+fun newNamed () =
+    let
+        val r = !namedCounter
+    in
+        namedCounter := r + 1;
+        r
+    end
+
+val empty = {
+    renameK = SM.empty,
+    relK = [],
+
+    renameC = SM.empty,
+    relC = [],
+    namedC = IM.empty,
+
+    datatypes = IM.empty,
+    constructors = SM.empty,
+
+    classes = CM.empty,
+
+    renameE = SM.empty,
+    relE = [],
+    namedE = IM.empty,
+
+    renameSgn = SM.empty,
+    sgn = IM.empty,
+
+    renameStr = SM.empty,
+    str = IM.empty
+}
+
+fun pushKRel (env : env) x =
+    let
+        val renameK = SM.map (fn n => n+1) (#renameK env)
+    in
+        {renameK = SM.insert (renameK, x, 0),
+         relK = x :: #relK env,
+
+         renameC = SM.map (fn Rel' (n, k) => Rel' (n, liftKindInKind 0 k)
+                            | x => x) (#renameC env),
+         relC = map (fn (x, k) => (x, liftKindInKind 0 k)) (#relC env),
+         namedC = #namedC env,
+
+         datatypes = #datatypes env,
+         constructors = #constructors env,
+
+         classes = CM.map (fn cl => {closedRules = #closedRules cl,
+                                     openRules = map (fn (nvs, cs, c, e) =>
+                                                         (nvs,
+                                                          map (liftKindInCon 0) cs,
+                                                          liftKindInCon 0 c,
+                                                          liftKindInExp 0 e))
+                                                     (#openRules cl)})
+                          (#classes env),
+
+         renameE = SM.map (fn Rel' (n, c) => Rel' (n, liftKindInCon 0 c)
+                            | Named' (n, c) => Named' (n, c)) (#renameE env),
+         relE = map (fn (x, c) => (x, liftKindInCon 0 c)) (#relE env),
+         namedE = #namedE env,
+
+         renameSgn = #renameSgn env,
+         sgn = #sgn env,
+
+         renameStr = #renameStr env,
+         str = #str env
+        }
+    end
+
+fun lookupKRel (env : env) n =
+    (List.nth (#relK env, n))
+    handle Subscript => raise UnboundRel n
+
+fun lookupK (env : env) x = SM.find (#renameK env, x)
+
+fun pushCRel (env : env) x k =
+    let
+        val renameC = SM.map (fn Rel' (n, k) => Rel' (n+1, k)
+                               | x => x) (#renameC env)
+    in
+        {renameK = #renameK env,
+         relK = #relK env,
+
+         renameC = SM.insert (renameC, x, Rel' (0, k)),
+         relC = (x, k) :: #relC env,
+         namedC = #namedC env,
+
+         datatypes = #datatypes env,
+         constructors = #constructors env,
+
+         classes = CM.map (fn class =>
+                              {closedRules = #closedRules class,
+                               openRules = map (fn (nvs, cs, c, e) =>
+                                                (nvs,
+                                                 map (liftConInCon 0) cs,
+                                                 liftConInCon 0 c,
+                                                 liftConInExp 0 e))
+                                            (#openRules class)})
+                          (#classes env),
+
+         renameE = SM.map (fn Rel' (n, c) => Rel' (n, lift c)
+                            | Named' (n, c) => Named' (n, c)) (#renameE env),
+         relE = map (fn (x, c) => (x, lift c)) (#relE env),
+         namedE = #namedE env,
+
+         renameSgn = #renameSgn env,
+         sgn = #sgn env,
+
+         renameStr = #renameStr env,
+         str = #str env
+        }
+    end
+
+fun lookupCRel (env : env) n =
+    (List.nth (#relC env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushCNamedAs (env : env) x n k co =
+    {renameK = #renameK env,
+     relK = #relK env,
+
+     renameC = SM.insert (#renameC env, x, Named' (n, k)),
+     relC = #relC env,
+     namedC = IM.insert (#namedC env, n, (x, k, co)),
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     classes = #classes env,
+
+     renameE = #renameE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     renameSgn = #renameSgn env,
+     sgn = #sgn env,
+     
+     renameStr = #renameStr env,
+     str = #str env}
+
+fun pushCNamed env x k co =
+    let
+        val n = !namedCounter
+    in
+        namedCounter := n + 1;
+        (pushCNamedAs env x n k co, n)
+    end
+
+fun lookupCNamed (env : env) n =
+    case IM.find (#namedC env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupC (env : env) x =
+    case SM.find (#renameC env, x) of
+        NONE => NotBound
+      | SOME (Rel' x) => Rel x
+      | SOME (Named' x) => Named x
+
+fun pushDatatype (env : env) n xs xncs =
+    let
+        val dk = U.classifyDatatype xncs
+    in
+        {renameK = #renameK env,
+         relK = #relK env,
+
+         renameC = #renameC env,
+         relC = #relC env,
+         namedC = #namedC env,
+
+         datatypes = IM.insert (#datatypes env, n,
+                                (xs, foldl (fn ((x, n, to), cons) =>
+                                               IM.insert (cons, n, (x, to))) IM.empty xncs)),
+         constructors = foldl (fn ((x, n', to), cmap) =>
+                                  SM.insert (cmap, x, (dk, n', xs, to, n)))
+                              (#constructors env) xncs,
+
+         classes = #classes env,
+
+         renameE = #renameE env,
+         relE = #relE env,
+         namedE = #namedE env,
+
+         renameSgn = #renameSgn env,
+         sgn = #sgn env,
+
+         renameStr = #renameStr env,
+         str = #str env}
+    end
+
+fun lookupDatatype (env : env) n =
+    case IM.find (#datatypes env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupDatatypeConstructor (_, dt) n =
+    case IM.find (dt, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupConstructor (env : env) s = SM.find (#constructors env, s)
+
+fun datatypeArgs (xs, _) = xs
+fun constructors (_, dt) = IM.foldri (fn (n, (x, to), ls) => (x, n, to) :: ls) [] dt
+
+fun listClasses (env : env) =
+    map (fn (cn, {closedRules, openRules}) =>
+            (class_name_out cn,
+             map (fn (nvs, cs, c, e) =>
+                       let
+                           val loc = #2 c
+                           val c = foldr (fn (c', c) => (TFun (c', c), loc)) c cs
+                           val c = ListUtil.foldli (fn (n, (), c) => (TCFun (Explicit,
+                                                                             "x" ^ Int.toString n,
+                                                                             (KError, loc),
+                                                                             c), loc))
+                                                   c (List.tabulate (nvs, fn _ => ()))
+                       in
+                           (c, e)
+                       end) (closedRules @ openRules))) (CM.listItemsi (#classes env))
+
+fun pushClass (env : env) n =
+    {renameK = #renameK env,
+     relK = #relK env,
+
+     renameC = #renameC env,
+     relC = #relC env,
+     namedC = #namedC env,
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     classes = CM.insert (#classes env, ClNamed n, empty_class),
+
+     renameE = #renameE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     renameSgn = #renameSgn env,
+     sgn = #sgn env,
+
+     renameStr = #renameStr env,
+     str = #str env}
+
+fun class_name_in (c, _) =
+    case c of
+        CNamed n => SOME (ClNamed n)
+      | CModProj x => SOME (ClProj x)
+      | CUnif (_, _, _, _, ref (Known c)) => class_name_in c
+      | _ => NONE
+
+fun isClass (env : env) c =
+    let
+        fun find NONE = false
+          | find (SOME c) = Option.isSome (CM.find (#classes env, c))
+    in
+        find (class_name_in c)
+    end
+
+fun class_head_in c =
+    case #1 c of
+        CApp (f, _) => class_head_in f
+      | CUnif (_, _, _, _, ref (Known c)) => class_head_in c
+      | _ => class_name_in c
+
+exception Unify
+
+fun unifyKinds (k1, k2) =
+    case (#1 k1, #1 k2) of
+        (KType, KType) => ()
+      | (KArrow (d1, r1), KArrow (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2))
+      | (KName, KName) => ()
+      | (KRecord k1, KRecord k2) => unifyKinds (k1, k2)
+      | (KUnit, KUnit) => ()
+      | (KTuple ks1, KTuple ks2) => (ListPair.appEq unifyKinds (ks1, ks2)
+                                     handle ListPair.UnequalLengths => raise Unify)
+      | (KUnif (_, _, ref (KKnown k1)), _) => unifyKinds (k1, k2)
+      | (_, KUnif (_, _, ref (KKnown k2))) => unifyKinds (k1, k2)
+      | (KRel n1, KRel n2) => if n1 = n2 then () else raise Unify
+      | (KFun (_, k1), KFun (_, k2)) => unifyKinds (k1, k2)
+      | _ => raise Unify
+
+fun eqCons (c1, c2) =
+    case (#1 c1, #1 c2) of
+        (CUnif (nl, _, _, _, ref (Known c1)), _) => eqCons (mliftConInCon nl c1, c2)
+      | (_, CUnif (nl, _, _, _, ref (Known c2))) => eqCons (c1, mliftConInCon nl c2)
+
+      | (CRel n1, CRel n2) => if n1 = n2 then () else raise Unify
+
+      | (TFun (d1, r1), TFun (d2, r2)) => (eqCons (d1, d2); eqCons (r1, r2))
+      | (TCFun (_, _, k1, r1), TCFun (_, _, k2, r2)) => (unifyKinds (k1, k2); eqCons (r1, r2))
+      | (TRecord c1, TRecord c2) => eqCons (c1, c2)
+      | (TDisjoint (a1, b1, c1), TDisjoint (a2, b2, c2)) =>
+        (eqCons (a1, a2); eqCons (b1, b2); eqCons (c1, c2))
+
+      | (CNamed n1, CNamed n2) => if n1 = n2 then () else raise Unify
+      | (CModProj (n1, ms1, x1), CModProj (n2, ms2, x2)) =>
+        if n1 = n2 andalso ms1 = ms2 andalso x1 = x2 then () else raise Unify
+      | (CApp (f1, x1), CApp (f2, x2)) => (eqCons (f1, f2); eqCons (x1, x2))
+      | (CAbs (_, k1, b1), CAbs (_, k2, b2)) => (unifyKinds (k1, k2); eqCons (b1, b2))
+
+      | (CKAbs (_, b1), CKAbs (_, b2)) => eqCons (b1, b2)
+      | (CKApp (c1, k1), CKApp (c2, k2)) => (eqCons (c1, c2); unifyKinds (k1, k2))
+      | (TKFun (_, c1), TKFun (_, c2)) => eqCons (c1, c2)
+
+      | (CName s1, CName s2) => if s1 = s2 then () else raise Unify
+
+      | (CRecord (k1, xcs1), CRecord (k2, xcs2)) =>
+        (unifyKinds (k1, k2);
+         if length xcs1 <> length xcs2 then
+             raise Unify
+         else
+             List.app (fn (x1, c1) =>
+                          if List.exists (fn (x2, c2) => (eqCons (x1, x2); eqCons (c1, c2); true) handle Unify => false) xcs2 then
+                              ()
+                          else
+                              raise Unify) xcs1)
+      | (CConcat (f1, x1), CConcat (f2, x2)) => (eqCons (f1, f2); eqCons (x1, x2))
+      | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2))
+
+      | (CUnit, CUnit) => ()
+
+      | (CTuple cs1, CTuple cs2) => (ListPair.appEq (eqCons) (cs1, cs2)
+                                     handle ListPair.UnequalLengths => raise Unify)
+      | (CProj (c1, n1), CProj (c2, n2)) => (eqCons (c1, c2);
+                                             if n1 = n2 then () else raise Unify)
+
+      | _ => raise Unify
+
+fun unifyCons (hnorm : con -> con) rs =
+    let
+        fun unify d (c1, c2) =
+            case (#1 (hnorm c1), #1 (hnorm c2)) of
+                (CUnif (nl, _, _, _, ref (Known c1)), _) => unify d (mliftConInCon nl c1, c2)
+              | (_, CUnif (nl, _, _, _, ref (Known c2))) => unify d (c1, mliftConInCon nl c2)
+
+              | (CUnif _, _) => ()
+
+              | (c1', CRel n2) =>
+                if n2 < d then
+                    case c1' of
+                        CRel n1 => if n1 = n2 then () else raise Unify
+                      | _ => raise Unify
+                else if n2 - d >= length rs then
+                    case c1' of
+                        CRel n1 => if n1 = n2 - length rs then () else raise Unify
+                      | _ => raise Unify
+                else
+                    let
+                        val r = List.nth (rs, n2 - d)
+                    in
+                        case !r of
+                            NONE => r := SOME c1
+                          | SOME c2 => eqCons (c1, c2)
+                    end
+
+              | (TFun (d1, r1), TFun (d2, r2)) => (unify d (d1, d2); unify d (r1, r2))
+              | (TCFun (_, _, k1, r1), TCFun (_, _, k2, r2)) => (unifyKinds (k1, k2); unify (d + 1) (r1, r2))
+              | (TRecord c1, TRecord c2) => unify d (c1, c2)
+              | (TDisjoint (a1, b1, c1), TDisjoint (a2, b2, c2)) =>
+                (unify d (a1, a2); unify d (b1, b2); unify d (c1, c2))
+
+              | (CNamed n1, CNamed n2) => if n1 = n2 then () else raise Unify
+              | (CModProj (n1, ms1, x1), CModProj (n2, ms2, x2)) =>
+                if n1 = n2 andalso ms1 = ms2 andalso x1 = x2 then () else raise Unify
+              | (CApp (f1, x1), CApp (f2, x2)) => (unify d (f1, f2); unify d (x1, x2))
+              | (CAbs (_, k1, b1), CAbs (_, k2, b2)) => (unifyKinds (k1, k2); unify (d + 1) (b1, b2))
+
+              | (CKAbs (_, b1), CKAbs (_, b2)) => unify d (b1, b2)
+              | (CKApp (c1, k1), CKApp (c2, k2)) => (unify d (c1, c2); unifyKinds (k1, k2))
+              | (TKFun (_, c1), TKFun (_, c2)) => unify d (c1, c2)
+
+              | (CName s1, CName s2) => if s1 = s2 then () else raise Unify
+
+              | (CRecord (k1, xcs1), CRecord (k2, xcs2)) =>
+                (unifyKinds (k1, k2);
+                 if length xcs1 <> length xcs2 then
+                     raise Unify
+                 else
+                     app (fn (x1, c1) =>
+                             if List.exists (fn (x2, c2) => (unify d (x1, x2); unify d (c1, c2); true) handle Unify => false) xcs2 then
+                                 ()
+                             else
+                                 raise Unify) xcs1)
+              | (CConcat (f1, x1), CConcat (f2, x2)) => (unify d (f1, f2); unify d (x1, x2))
+              | (CMap (d1, r1), CMap (d2, r2)) => (unifyKinds (d1, d2); unifyKinds (r1, r2))
+
+              | (CUnit, CUnit) => ()
+
+              | (CTuple cs1, CTuple cs2) => (ListPair.appEq (unify d) (cs1, cs2)
+                                             handle ListPair.UnequalLengths => raise Unify)
+              | (CProj (c1, n1), CProj (c2, n2)) => (unify d (c1, c2);
+                                                     if n1 = n2 then () else raise Unify)
+
+              | _ => raise Unify
+    in
+        unify
+    end
+
+fun tryUnify hnorm nRs (c1, c2) =
+    let
+        val rs = List.tabulate (nRs, fn _ => ref NONE)
+    in
+        (unifyCons hnorm rs 0 (c1, c2);
+         SOME (map (fn r => case !r of
+                                NONE => raise Unify
+                              | SOME c => c) rs))
+        handle Unify => NONE
+    end
+
+fun unifySubst (rs : con list) =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn d => fn c =>
+                                 case c of
+                                     CRel n =>
+                                     if n < d then
+                                         c
+                                     else if n - d >= length rs then
+                                         CRel (n - d)
+                                     else
+                                         #1 (List.nth (rs, n - d))
+                                   | _ => c,
+                bind = fn (d, U.Con.RelC _) => d + 1
+                        | (d, _) => d}
+               0
+
+exception Bad of con * con
+
+val hasUnif = U.Con.exists {kind = fn _ => false,
+                            con = fn CUnif (_, _, _, _, ref (Unknown _)) => true
+                                   | _ => false}
+
+fun startsWithUnif c =
+    let
+        fun firstArg (c, acc) =
+            case #1 c of
+                CApp (f, x) => firstArg (f, SOME x)
+              | _ => acc
+    in
+        case firstArg (c, NONE) of
+            NONE => false
+          | SOME x => hasUnif x
+    end
+
+val cause = ref (NONE : con option)
+fun resolveFailureCause () = !cause
+
+fun resolveClass (hnorm : con -> con) (consEq : con * con -> bool) (env : env) =
+    let
+        fun resolve firstLevel c =
+            let
+                fun notFound () = (if firstLevel then () else cause := SOME c; NONE)
+
+                fun doHead f =
+                    case CM.find (#classes env, f) of
+                        NONE => notFound ()
+                      | SOME class =>
+                        let
+                            val loc = #2 c
+
+                            fun generalize (c as (_, loc)) =
+                                case #1 c of
+                                    CApp (f, x) =>
+                                    let
+                                        val (f, equate) = generalize f
+
+                                        fun isRecord () =
+                                            let
+                                                val rk = ref (KUnknown (fn _ => true))
+                                                val k = (KUnif (loc, "k", rk), loc)
+                                                val r = ref (Unknown (fn _ => true))
+                                                val rc = (CUnif (0, loc, k, "x", r), loc)
+                                            in
+                                                ((CApp (f, rc), loc),
+                                              fn () => (if consEq (rc, x) then
+                                                            true
+                                                        else
+                                                            (raise Bad (rc, x);
+                                                             false))
+                                                       andalso equate ())
+                                            end
+                                    in
+                                        case #1 x of
+                                            CConcat _ => isRecord ()
+                                          | CRecord _ => isRecord ()
+                                          | _ => ((CApp (f, x), loc), equate)
+                                    end
+                                  | _ => (c, fn () => true)
+
+                            val (c, equate) = generalize c
+
+                            fun tryRules rules =
+                                case rules of
+                                    [] => notFound ()
+                                  | (nRs, cs, c', e) :: rules' =>
+                                     case tryUnify hnorm nRs (c, c') of
+                                        NONE => tryRules rules'
+                                      | SOME rs =>
+                                        let
+                                            val eos = map (resolve false o unifySubst rs) cs
+                                        in
+                                            if List.exists (not o Option.isSome) eos
+                                               orelse not (equate ())
+                                               orelse not (consEq (c, unifySubst rs c')) then
+                                                tryRules rules'
+                                            else
+                                                let
+                                                    val es = List.mapPartial (fn x => x) eos
+
+                                                    val e = foldr (fn (c, e) => (ECApp (e, c), loc)) e rs
+                                                    val e = foldl (fn (e', e) => (EApp (e, e'), loc)) e es
+                                                in
+                                                    SOME e
+                                                end
+                                        end
+                        in
+                            tryRules (#openRules class @ #closedRules class)
+                        end
+            in
+                if startsWithUnif c then
+                    notFound ()
+                else
+                    case #1 c of
+                        TRecord c =>
+                        (case #1 (hnorm c) of
+                             CRecord (_, xts) =>
+                             let
+                                 fun resolver (xts, acc) =
+                                     case xts of
+                                         [] => SOME (ERecord acc, #2 c)
+                                       | (x, t) :: xts =>
+                                         let
+                                             val t = hnorm t
+
+                                             val t = case t of
+                                                         (CApp (f, x), loc) => (CApp (hnorm f, hnorm x), loc)
+                                                       | _ => t
+                                         in
+                                             case resolve false t of
+                                                 NONE => notFound ()
+                                               | SOME e => resolver (xts, (x, e, t) :: acc)
+                                         end
+                             in
+                                 resolver (xts, [])
+                             end
+                           | _ => notFound ())
+                      | _ =>
+                        case class_head_in c of
+                            SOME f => doHead f
+                          | _ => notFound ()
+            end
+    in
+        cause := NONE;
+        resolve true
+    end
+
+fun rule_in c =
+    let
+        fun quantifiers (c, nvars) =
+            case #1 c of
+                CUnif (_, _, _, _, ref (Known c)) => quantifiers (c, nvars)
+              | TCFun (_, _, _, c) => quantifiers (c, nvars + 1)
+              | _ =>
+                let
+                    fun clauses (c, hyps) =
+                        case #1 c of
+                            TFun (hyp, c) =>
+                            (case class_head_in hyp of
+                                 SOME _ => clauses (c, hyp :: hyps)
+                               | NONE => NONE)
+                          | _ =>
+                            case class_head_in c of
+                                NONE => NONE
+                              | SOME f => SOME (f, nvars, rev hyps, c)
+                in
+                    clauses (c, [])
+                end
+    in
+        quantifiers (c, 0)
+    end
+
+fun pushERel (env : env) x t =
+    let
+        val renameE = SM.map (fn Rel' (n, t) => Rel' (n+1, t)
+                               | x => x) (#renameE env)
+
+        val classes = CM.map (fn class =>
+                                 {openRules = map (fn (nvs, cs, c, e) => (nvs, cs, c, liftExp e)) (#openRules class),
+                                  closedRules = #closedRules class}) (#classes env)
+        val classes = case rule_in t of
+                          NONE => classes
+                        | SOME (f, nvs, cs, c) =>
+                          case CM.find (classes, f) of
+                              NONE => classes
+                            | SOME class =>
+                              let
+                                  val rule = (nvs, cs, c, (ERel 0, #2 t))
+
+                                  val class = {openRules = rule :: #openRules class,
+                                               closedRules = #closedRules class}
+                              in
+                                  CM.insert (classes, f, class)
+                              end
+    in
+        {renameK = #renameK env,
+         relK = #relK env,
+
+         renameC = #renameC env,
+         relC = #relC env,
+         namedC = #namedC env,
+
+         datatypes = #datatypes env,
+         constructors = #constructors env,
+
+         classes = classes,
+
+         renameE = SM.insert (renameE, x, Rel' (0, t)),
+         relE = (x, t) :: #relE env,
+         namedE = #namedE env,
+
+         renameSgn = #renameSgn env,
+         sgn = #sgn env,
+
+         renameStr = #renameStr env,
+         str = #str env}
+    end
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushENamedAs (env : env) x n t =
+    let
+        val classes = #classes env
+        val classes = case rule_in t of
+                          NONE => classes
+                        | SOME (f, nvs, cs, c) =>
+                          case CM.find (classes, f) of
+                              NONE => classes
+                            | SOME class =>
+                              let
+                                  val e = (ENamed n, #2 t)
+
+                                  val class =
+                                      {openRules = #openRules class,
+                                       closedRules = (nvs, cs, c, e) :: #closedRules class}
+                              in
+                                  CM.insert (classes, f, class)
+                              end
+    in
+        {renameK = #renameK env,
+         relK = #relK env,
+
+         renameC = #renameC env,
+         relC = #relC env,
+         namedC = #namedC env,
+
+         datatypes = #datatypes env,
+         constructors = #constructors env,
+
+         classes = classes,
+
+         renameE = SM.insert (#renameE env, x, Named' (n, t)),
+         relE = #relE env,
+         namedE = IM.insert (#namedE env, n, (x, t)),
+
+         renameSgn = #renameSgn env,
+         sgn = #sgn env,
+         
+         renameStr = #renameStr env,
+         str = #str env}
+    end
+
+fun pushENamed env x t =
+    let
+        val n = !namedCounter
+    in
+        namedCounter := n + 1;
+        (pushENamedAs env x n t, n)
+    end
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun checkENamed (env : env) n =
+    Option.isSome (IM.find (#namedE env, n))
+
+fun lookupE (env : env) x =
+    case SM.find (#renameE env, x) of
+        NONE => NotBound
+      | SOME (Rel' x) => Rel x
+      | SOME (Named' x) => Named x
+
+fun pushSgnNamedAs (env : env) x n sgis =
+    {renameK = #renameK env,
+     relK = #relK env,
+
+     renameC = #renameC env,
+     relC = #relC env,
+     namedC = #namedC env,
+
+     datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     classes = #classes env,
+
+     renameE = #renameE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     renameSgn = SM.insert (#renameSgn env, x, (n, sgis)),
+     sgn = IM.insert (#sgn env, n, (x, sgis)),
+     
+     renameStr = #renameStr env,
+     str = #str env}
+
+fun pushSgnNamed env x sgis =
+    let
+        val n = !namedCounter
+    in
+        namedCounter := n + 1;
+        (pushSgnNamedAs env x n sgis, n)
+    end
+
+fun lookupSgnNamed (env : env) n =
+    case IM.find (#sgn env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupSgn (env : env) x = SM.find (#renameSgn env, x)
+
+fun lookupStrNamed (env : env) n =
+    case IM.find (#str env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupStr (env : env) x = SM.find (#renameStr env, x)
+
+
+fun sgiSeek (sgi, (sgns, strs, cons)) =
+    case sgi of
+        SgiConAbs (x, n, _) => (sgns, strs, IM.insert (cons, n, x))
+      | SgiCon (x, n, _, _) => (sgns, strs, IM.insert (cons, n, x))
+      | SgiDatatype dts => (sgns, strs, foldl (fn ((x, n, _, _), cons) => IM.insert (cons, n, x)) cons dts)
+      | SgiDatatypeImp (x, n, _, _, _, _, _) => (sgns, strs, IM.insert (cons, n, x))
+      | SgiVal _ => (sgns, strs, cons)
+      | SgiSgn (x, n, _) => (IM.insert (sgns, n, x), strs, cons)
+      | SgiStr (_, x, n, _) => (sgns, IM.insert (strs, n, x), cons)
+      | SgiConstraint _ => (sgns, strs, cons)
+      | SgiClassAbs (x, n, _) => (sgns, strs, IM.insert (cons, n, x))
+      | SgiClass (x, n, _, _) => (sgns, strs, IM.insert (cons, n, x))
+
+fun sgnSeek f sgis =
+    let
+        fun seek (sgis, sgns, strs, cons) =
+            case sgis of
+                [] => NONE
+              | (sgi, _) :: sgis =>
+                case f sgi of
+                    SOME v =>
+                    let
+                        val cons =
+                            case sgi of
+                                SgiDatatype dts => foldl (fn ((x, n, _, _), cons) => IM.insert (cons, n, x)) cons dts
+                              | SgiDatatypeImp (x, n, _, _, _, _, _) => IM.insert (cons, n, x)
+                              | _ => cons
+                    in
+                        SOME (v, (sgns, strs, cons))
+                    end
+                  | NONE =>
+                    let
+                        val (sgns, strs, cons) = sgiSeek (sgi, (sgns, strs, cons))
+                    in
+                        seek (sgis, sgns, strs, cons)
+                    end
+    in
+        seek (sgis, IM.empty, IM.empty, IM.empty)
+    end
+
+fun id x = x
+
+fun unravelStr (str, _) =
+    case str of
+        StrVar x => (x, [])
+      | StrProj (str, m) =>
+        let
+            val (x, ms) = unravelStr str
+        in
+            (x, ms @ [m])
+        end
+      | _ => raise Fail "unravelStr"
+
+fun sgnS_con (str, (sgns, strs, cons)) c =
+    case c of
+        CModProj (m1, ms, x) =>
+        (case IM.find (strs, m1) of
+             NONE => c
+           | SOME m1x =>
+             let
+                 val (m1, ms') = unravelStr str
+             in
+                 CModProj (m1, ms' @ m1x :: ms, x)
+             end)
+      | CNamed n =>
+        (case IM.find (cons, n) of
+             NONE => c
+           | SOME nx =>
+             let
+                 val (m1, ms) = unravelStr str
+             in
+                 CModProj (m1, ms, nx)
+             end)
+      | _ => c
+
+fun sgnS_con' (m1, ms', (sgns, strs, cons)) =
+    U.Con.map {kind = fn x => x,
+               con = fn c =>
+                        case c of
+                            CModProj (m1', ms, x) =>
+                            (case IM.find (strs, m1') of
+                                 NONE => c
+                               | SOME m1x => CModProj (m1, ms' @ m1x :: ms, x))
+                          | CNamed n =>
+                            (case IM.find (cons, n) of
+                                 NONE => c
+                               | SOME nx => CModProj (m1, ms', nx))
+                          | _ => c}
+
+fun sgnS_sgn (str, (sgns, strs, cons)) sgn =
+    case sgn of
+        SgnProj (m1, ms, x) =>
+        (case IM.find (strs, m1) of
+             NONE => sgn
+           | SOME m1x =>
+             let
+                 val (m1, ms') = unravelStr str
+             in
+                 SgnProj (m1, ms' @ m1x :: ms, x)
+             end)
+      | SgnVar n =>
+        (case IM.find (sgns, n) of
+             NONE => sgn
+           | SOME nx =>
+             let
+                 val (m1, ms) = unravelStr str
+             in
+                 SgnProj (m1, ms, nx)
+             end)
+      | _ => sgn
+
+fun projectStr env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        (case sgnSeek (fn SgiStr (_, x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of
+             NONE => NONE
+           | SOME (sgn, subs) => SOME (sgnSubSgn (str, subs) sgn))
+      | SgnError => SOME (SgnError, ErrorMsg.dummySpan)
+      | _ => NONE
+
+and sgnSubSgn x =
+    ElabUtil.Sgn.map {kind = id,
+                      con = sgnS_con x,
+                      sgn_item = id,
+                      sgn = sgnS_sgn x}
+
+and projectSgn env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        (case sgnSeek (fn SgiSgn (x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of
+             NONE => NONE
+           | SOME (sgn, subs) => SOME (sgnSubSgn (str, subs) sgn))
+      | SgnError => SOME (SgnError, ErrorMsg.dummySpan)
+      | _ => NONE
+
+and hnormSgn env (all as (sgn, loc)) =
+    case sgn of
+        SgnError => all
+      | SgnVar n => hnormSgn env (#2 (lookupSgnNamed env n))
+      | SgnConst _ => all
+      | SgnFun _ => all
+      | SgnProj (m, ms, x) =>
+        let
+            val (_, sgn) = lookupStrNamed env m
+
+            fun doProjection (m1, NONE) = NONE
+              | doProjection (m1, SOME (str, sgn)) =
+                case projectStr env {str = str,
+                                     sgn = sgn,
+                                     field = m1} of
+                    NONE => NONE
+                  | SOME sgn' => SOME ((StrProj (str, m1), loc), sgn')
+        in
+            case foldl doProjection (SOME ((StrVar m, loc), sgn)) ms of
+                NONE => raise Fail "ElabEnv.hnormSgn: pre-projectSgn failed"
+              | SOME (str, sgn) =>
+                case projectSgn env {str = str,
+                                     sgn = sgn,
+                                     field = x} of
+                    NONE => raise Fail "ElabEnv.hnormSgn: projectSgn failed"
+                  | SOME sgn => hnormSgn env sgn
+        end
+      | SgnWhere (sgn, ms, x, c) =>
+	let
+	    fun rewrite (sgn, ms) =
+		case #1 (hnormSgn env sgn) of
+		    SgnError => (SgnError, loc)
+		  | SgnConst sgis =>
+		    let
+			fun traverse (ms, pre, post) =
+			    case post of
+				[] => raise Fail "ElabEnv.hnormSgn: Can't reduce 'where' [1]"
+
+			      | (sgi as (SgiConAbs (x', n, k), loc)) :: rest =>
+				if List.null ms andalso x = x' then
+				    List.revAppend (pre, (SgiCon (x', n, k, c), loc) :: rest)
+				else
+				    traverse (ms, sgi :: pre, rest)
+
+			      | (sgi as (SgiStr (im, x', n, sgn'), loc)) :: rest =>
+				(case ms of
+				     [] => traverse (ms, sgi :: pre, rest)
+				   | x :: ms' =>
+				     if x = x' then
+					 List.revAppend (pre,
+							 (SgiStr (im, x', n,
+								  rewrite (sgn', ms')), loc) :: rest)
+				     else
+					 traverse (ms, sgi :: pre, rest))
+
+			      | sgi :: rest => traverse (ms, sgi :: pre, rest)
+					       
+			val sgis = traverse (ms, [], sgis)
+		    in
+			(SgnConst sgis, loc)
+		    end
+		  | _ => raise Fail "ElabEnv.hnormSgn: Can't reduce 'where' [2]"
+	in
+	    rewrite (sgn, ms)
+	end
+
+fun manifest (m, ms, loc) =
+    foldl (fn (m, str) => (StrProj (str, m), loc)) (StrVar m, loc) ms
+
+fun enrichClasses env classes (m1, ms) sgn =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        let
+            val (classes, _, _, _) =
+                foldl (fn (sgi, (classes, newClasses, fmap, env)) =>
+                          let
+                              fun found (x, n) =
+                                  (CM.insert (classes,
+                                              ClProj (m1, ms, x),
+                                              empty_class),
+                                   IM.insert (newClasses, n, x),
+                                   sgiSeek (#1 sgi, fmap),
+                                   env)
+
+                              fun default () = (classes, newClasses, sgiSeek (#1 sgi, fmap), env)
+                          in
+                              case #1 sgi of
+                                  SgiStr (Import, x, _, sgn) =>
+                                  let
+                                      val str = manifest (m1, ms, #2 sgi)
+                                      val sgn' = sgnSubSgn (str, fmap) sgn
+                                  in
+                                      (enrichClasses env classes (m1, ms @ [x]) sgn',
+                                       newClasses,
+                                       sgiSeek (#1 sgi, fmap),
+                                       env)
+                                  end
+                                | SgiSgn (x, n, sgn) =>
+                                  (classes,
+                                   newClasses,
+                                   fmap,
+                                   pushSgnNamedAs env x n sgn)
+
+                                | SgiClassAbs (x, n, _) => found (x, n)
+                                | SgiClass (x, n, _, _) => found (x, n)
+                                | SgiVal (x, n, c) =>
+                                  (case rule_in c of
+                                       NONE => default ()
+                                     | SOME (cn, nvs, cs, c) =>
+                                       let
+                                           val loc = #2 c
+                                           val globalize = sgnS_con' (m1, ms, fmap)
+
+                                           val nc =
+                                               case cn of
+                                                   ClNamed f => IM.find (newClasses, f)
+                                                 | _ => NONE
+                                       in
+                                           case nc of
+                                               NONE =>
+                                               let
+                                                   val classes =
+                                                       case CM.find (classes, cn) of
+                                                           NONE => classes
+                                                         | SOME class =>
+                                                           let
+                                                               val e = (EModProj (m1, ms, x), #2 sgn)
+
+                                                               val class =
+                                                                   {openRules = #openRules class,
+                                                                    closedRules = (nvs,
+                                                                                   map globalize cs,
+                                                                                   globalize c,
+                                                                                   e) :: #closedRules class}
+                                                           in
+                                                               CM.insert (classes, cn, class)
+                                                           end
+                                               in
+                                                   (classes,
+                                                    newClasses,
+                                                    fmap,
+                                                    env)
+                                               end
+                                             | SOME fx =>
+                                               let
+                                                   val cn = ClProj (m1, ms, fx)
+
+                                                   val classes =
+                                                       case CM.find (classes, cn) of
+                                                           NONE => classes
+                                                         | SOME class =>
+                                                           let
+                                                               val e = (EModProj (m1, ms, x), #2 sgn)
+
+                                                               val class = 
+                                                                   {openRules = #openRules class,
+                                                                    closedRules = (nvs,
+                                                                                   map globalize cs,
+                                                                                   globalize c,
+                                                                                   e) :: #closedRules class}
+                                                           in
+                                                               CM.insert (classes, cn, class)
+                                                           end
+                                               in
+                                                   (classes,
+                                                    newClasses,
+                                                    fmap,
+                                                    env)
+                                               end
+                                       end)
+                                | _ => default ()
+                          end)
+                      (classes, IM.empty, (IM.empty, IM.empty, IM.empty), env) sgis
+        in
+            classes
+        end
+      | _ => classes
+
+and pushStrNamedAs' enrich (env : env) x n sgn =
+    let
+        val renameStr = SM.insert (#renameStr env, x, (n, sgn))
+        val str = IM.insert (#str env, n, (x, sgn))
+        fun newEnv classes =
+            {renameK = #renameK env,
+             relK = #relK env,
+
+             renameC = #renameC env,
+             relC = #relC env,
+             namedC = #namedC env,
+
+             datatypes = #datatypes env,
+             constructors = #constructors env,
+
+             classes = classes,
+
+             renameE = #renameE env,
+             relE = #relE env,
+             namedE = #namedE env,
+
+             renameSgn = #renameSgn env,
+             sgn = #sgn env,
+
+             renameStr = renameStr,
+             str = str}
+    in
+        if enrich then
+            newEnv (enrichClasses (newEnv (#classes env)) (#classes env) (n, []) sgn)
+        else
+            newEnv (#classes env)
+    end
+
+and pushStrNamedAs env = pushStrNamedAs' true env
+
+fun pushStrNamed env x sgn =
+    let
+        val n = !namedCounter
+    in
+        namedCounter := n + 1;
+        (pushStrNamedAs env x n sgn, n)
+    end
+
+fun sgiBinds env (sgi, loc) =
+    case sgi of
+        SgiConAbs (x, n, k) => pushCNamedAs env x n k NONE
+      | SgiCon (x, n, k, c) => pushCNamedAs env x n k (SOME c)
+      | SgiDatatype dts =>
+        let
+            fun doOne ((x, n, xs, xncs), env) =
+                let
+                    val k = (KType, loc)
+                    val k' = foldr (fn (_, k') => (KArrow (k, k'), loc)) k xs
+
+                    val env = pushCNamedAs env x n k' NONE
+                in
+                    foldl (fn ((x', n', to), env) =>
+                              let
+                                  val t =
+                                      case to of
+                                          NONE => (CNamed n, loc)
+                                        | SOME t => (TFun (t, (CNamed n, loc)), loc)
+
+                                  val k = (KType, loc)
+                                  val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                              in
+                                  pushENamedAs env x' n' t
+                              end)
+                          env xncs
+                end
+        in
+            foldl doOne env dts
+        end
+      | SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
+        let
+            val k = (KType, loc)
+            val k' = foldr (fn (_, k') => (KArrow (k, k'), loc)) k xs
+
+            val env = pushCNamedAs env x n k' (SOME (CModProj (m1, ms, x'), loc))
+        in
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (Explicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
+            env xncs
+        end
+      | SgiVal (x, n, t) => pushENamedAs env x n t
+      | SgiStr (_, x, n, sgn) => pushStrNamedAs' false env x n sgn
+      | SgiSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
+      | SgiConstraint _ => env
+
+      | SgiClassAbs (x, n, k) => pushCNamedAs env x n k NONE
+      | SgiClass (x, n, k, c) => pushCNamedAs env x n k (SOME c)
+
+fun sgnSubCon x =
+    ElabUtil.Con.map {kind = id,
+                      con = sgnS_con x}
+
+fun chaseMpath env (n, ms) =
+    let
+        val (_, sgn) = lookupStrNamed env n
+    in
+        foldl (fn (m, (str, sgn)) =>
+                                   case projectStr env {sgn = sgn, str = str, field = m} of
+                                       NONE => raise Fail "kindof: Unknown substructure"
+                                     | SOME sgn => ((StrProj (str, m), #2 sgn), sgn))
+                               ((StrVar n, #2 sgn), sgn) ms
+    end
+
+fun projectCon env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        (case sgnSeek (fn SgiConAbs (x, _, k) => if x = field then SOME (k, NONE) else NONE
+                        | SgiCon (x, _, k, c) => if x = field then SOME (k, SOME c) else NONE
+                        | SgiDatatype dts =>
+                          (case List.find (fn (x, _, xs, _) => x = field) dts of
+                               SOME (_, _, xs, _) =>
+                               let
+                                   val k = (KType, #2 sgn)
+                                   val k' = foldl (fn (_, k') => (KArrow (k, k'), #2 sgn)) k xs
+                               in
+                                   SOME (k', NONE)
+                                   end
+                             | NONE => NONE)
+                        | SgiDatatypeImp (x, _, m1, ms, x', xs, _) =>
+                          if x = field then
+                              let
+                                  val k = (KType, #2 sgn)
+                                  val k' = foldl (fn (_, k') => (KArrow (k, k'), #2 sgn)) k xs
+                              in
+                                  SOME (k', SOME (CModProj (m1, ms, x'), #2 sgn))
+                              end
+                          else
+                              NONE
+                        | SgiClassAbs (x, _, k) => if x = field then
+                                                       SOME (k, NONE)
+                                                   else
+                                                       NONE
+                        | SgiClass (x, _, k, c) => if x = field then
+                                                       SOME (k, SOME c)
+                                                   else
+                                                       NONE
+                        | _ => NONE) sgis of
+             NONE => NONE
+           | SOME ((k, co), subs) => SOME (k, Option.map (sgnSubCon (str, subs)) co))
+      | SgnError => SOME ((KError, ErrorMsg.dummySpan), SOME (CError, ErrorMsg.dummySpan))
+      | _ => NONE
+
+fun projectDatatype env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        (case sgnSeek (fn SgiDatatype dts =>
+                          (case List.find (fn (x, _, _, _) => x = field) dts of
+                               SOME (_, _, xs, xncs) => SOME (xs, xncs)
+                             | NONE => NONE)
+                        | SgiDatatypeImp (x, _, _, _, _, xs, xncs) => if x = field then SOME (xs, xncs) else NONE
+                        | _ => NONE) sgis of
+             NONE => NONE
+           | SOME ((xs, xncs), subs) => SOME (xs,
+                                              map (fn (x, n, to) => (x, n, Option.map (sgnSubCon (str, subs)) to)) xncs))
+      | _ => NONE
+
+fun projectConstructor env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        let
+            fun consider (n, xs, xncs) =
+                ListUtil.search (fn (x, n', to) =>
+                                    if x <> field then
+                                        NONE
+                                    else
+                                        SOME (U.classifyDatatype xncs, n', xs, to, (CNamed n, #2 str))) xncs
+        in
+            case sgnSeek (fn SgiDatatype dts =>
+                             let
+                                 fun search dts =
+                                     case dts of
+                                         [] => NONE
+                                       | (_, n, xs, xncs) :: dts =>
+                                         case consider (n, xs, xncs) of
+                                             NONE => search dts
+                                           | v => v
+                             in
+                                 search dts
+                             end
+                           | SgiDatatypeImp (_, n, _, _, _, xs, xncs) => consider (n, xs, xncs)
+                           | _ => NONE) sgis of
+                NONE => NONE
+              | SOME ((dk, n, xs, to, t), subs) => SOME (dk, n, xs, Option.map (sgnSubCon (str, subs)) to,
+                                                         sgnSubCon (str, subs) t)
+        end
+      | _ => NONE
+
+fun projectVal env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        let
+            fun seek (n, xs, xncs) =
+                ListUtil.search (fn (x, _, to) =>
+                                    if x = field then
+                                        SOME (let
+                                                  val base = (CNamed n, #2 sgn)
+                                                  val nxs = length xs
+                                                  val base = ListUtil.foldli (fn (i, _, base) =>
+                                                                                 (CApp (base,
+                                                                                       (CRel (nxs - i - 1), #2 sgn)),
+                                                                                  #2 sgn))
+                                                                             base xs
+
+                                                  val t =
+                                                      case to of
+                                                          NONE => base
+                                                        | SOME t => (TFun (t, base), #2 sgn)
+                                                  val k = (KType, #2 sgn)
+                                              in
+                                                  foldr (fn (x, t) => (TCFun (Implicit, x, k, t), #2 sgn))
+                                                  t xs
+                                              end)
+                                    else
+                                        NONE) xncs
+        in
+            case sgnSeek (fn SgiVal (x, _, c) => if x = field then SOME c else NONE
+                           | SgiDatatype dts =>
+                             let
+                                 fun search dts =
+                                     case dts of
+                                         [] => NONE
+                                       | (_, n, xs, xncs) :: dts =>
+                                         case seek (n, xs, xncs) of
+                                             NONE => search dts
+                                           | v => v
+                             in
+                                 search dts
+                             end
+                           | SgiDatatypeImp (_, n, _, _, _, xs, xncs) => seek (n, xs, xncs)
+                           | _ => NONE) sgis of
+                NONE => NONE
+              | SOME (c, subs) => SOME (sgnSubCon (str, subs) c)
+        end
+      | SgnError => SOME (CError, ErrorMsg.dummySpan)
+      | _ => NONE
+
+fun sgnSeekConstraints (str, sgis) =
+    let
+        fun seek (sgis, sgns, strs, cons, acc) =
+            case sgis of
+                [] => acc
+              | (sgi, _) :: sgis =>
+                case sgi of
+                    SgiConstraint (c1, c2) =>
+                    let
+                        val sub = sgnSubCon (str, (sgns, strs, cons))
+                    in
+                        seek (sgis, sgns, strs, cons, (sub c1, sub c2) :: acc)
+                    end
+                  | SgiConAbs (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiCon (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiDatatype dts => seek (sgis, sgns, strs,
+                                             foldl (fn ((x, n, _, _), cons) => IM.insert (cons, n, x)) cons dts, acc)
+                  | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiVal _ => seek (sgis, sgns, strs, cons, acc)
+                  | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons, acc)
+                  | SgiStr (_, x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons, acc)
+                  | SgiClassAbs (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+                  | SgiClass (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
+    in
+        seek (sgis, IM.empty, IM.empty, IM.empty, [])
+    end
+
+fun projectConstraints env {sgn, str} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis => SOME (sgnSeekConstraints (str, sgis))
+      | SgnError => SOME []
+      | _ => NONE
+
+fun patBinds env (p, loc) =
+    case p of
+        PVar (x, t) => pushERel env x t
+      | PPrim _ => env
+      | PCon (_, _, _, NONE) => env
+      | PCon (_, _, _, SOME p) => patBinds env p
+      | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+
+fun patBindsN (p, _) =
+    case p of
+        PVar _ => 1
+      | PPrim _ => 0
+      | PCon (_, _, _, NONE) => 0
+      | PCon (_, _, _, SOME p) => patBindsN p
+      | PRecord xps => foldl (fn ((_, p, _), n) => patBindsN p + n) 0 xps
+
+fun edeclBinds env (d, loc) =
+    case d of
+        EDVal (p, _, _) => patBinds env p
+      | EDValRec vis => foldl (fn ((x, t, _), env) => pushERel env x t) env vis
+
+fun declBinds env (d, loc) =
+    case d of
+        DCon (x, n, k, c) => pushCNamedAs env x n k (SOME c)
+      | DDatatype dts =>
+        let
+            fun doOne ((x, n, xs, xncs), env) =
+                let
+                    val k = (KType, loc) 
+                    val nxs = length xs
+                    val (tb, kb) = ListUtil.foldli (fn (i, x', (tb, kb)) =>
+                                                       ((CApp (tb, (CRel (nxs - i - 1), loc)), loc),
+                                                        (KArrow (k, kb), loc)))
+                                                   ((CNamed n, loc), k) xs
+                                   
+                    val env = pushCNamedAs env x n kb NONE
+                    val env = pushDatatype env n xs xncs
+                in
+                    foldl (fn ((x', n', to), env) =>
+                              let
+                                  val t =
+                                      case to of
+                                          NONE => tb
+                                        | SOME t => (TFun (t, tb), loc)
+                                  val t = foldr (fn (x, t) => (TCFun (Implicit, x, k, t), loc)) t xs
+                              in
+                                  pushENamedAs env x' n' t
+                              end)
+                          env xncs
+                end
+        in
+            foldl doOne env dts
+        end
+      | DDatatypeImp (x, n, m, ms, x', xs, xncs) =>
+        let
+            val t = (CModProj (m, ms, x'), loc)
+            val k = (KType, loc) 
+            val nxs = length xs
+            val (tb, kb) = ListUtil.foldli (fn (i, x', (tb, kb)) =>
+                                               ((CApp (tb, (CRel (nxs - i - 1), loc)), loc),
+                                                (KArrow (k, kb), loc)))
+                                           ((CNamed n, loc), k) xs
+
+            val env = pushCNamedAs env x n kb (SOME t)
+            val env = pushDatatype env n xs xncs
+        in
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => tb
+                                | SOME t => (TFun (t, tb), loc)
+                          val t = foldr (fn (x, t) => (TCFun (Implicit, x, k, t), loc)) t xs
+                      in
+                          pushENamedAs env x' n' t
+                      end)
+                  env xncs
+        end
+      | DVal (x, n, t, _) => pushENamedAs env x n t
+      | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamedAs env x n t) env vis
+      | DSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
+      | DStr (x, n, sgn, _) => pushStrNamedAs' false env x n sgn
+      | DFfiStr (x, n, sgn) => pushStrNamedAs' false env x n sgn
+      | DConstraint _ => env
+      | DExport _ => env
+      | DTable (tn, x, n, c, _, pc, _, cc) =>
+        let
+            val ct = (CModProj (tn, [], "sql_table"), loc)
+            val ct = (CApp (ct, c), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+        in
+            pushENamedAs env x n ct
+        end
+      | DSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
+        in
+            pushENamedAs env x n t
+        end
+      | DView (tn, x, n, _, c) =>
+        let
+            val ct = (CModProj (tn, [], "sql_view"), loc)
+            val ct = (CApp (ct, c), loc)
+        in
+            pushENamedAs env x n ct
+        end
+      | DDatabase _ => env
+      | DCookie (tn, x, n, c) =>
+        let
+            val t = (CApp ((CModProj (tn, [], "cookie"), loc), c), loc)
+        in
+            pushENamedAs env x n t
+        end
+      | DStyle (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "css_class"), loc)
+        in
+            pushENamedAs env x n t
+        end
+      | DTask _ => env
+      | DPolicy _ => env
+      | DOnError _ => env
+      | DFfi (x, n, _, t) => pushENamedAs env x n t
+
+end
diff --git a/src/elab_err.sig b/src/elab_err.sig
new file mode 100644
index 0000000..acf137d
--- /dev/null
+++ b/src/elab_err.sig
@@ -0,0 +1,125 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ELAB_ERR = sig
+
+    datatype kind_error =
+             UnboundKind of ErrorMsg.span * string
+
+    val kindError : ElabEnv.env -> kind_error -> unit
+
+    datatype kunify_error =
+             KOccursCheckFailed of Elab.kind * Elab.kind
+           | KIncompatible of Elab.kind * Elab.kind
+           | KScope of Elab.kind * Elab.kind
+
+    val kunifyError : ElabEnv.env -> kunify_error -> unit
+
+    datatype con_error =
+             UnboundCon of ErrorMsg.span * string
+           | UnboundDatatype of ErrorMsg.span * string
+           | UnboundStrInCon of ErrorMsg.span * string
+           | WrongKind of Elab.con * Elab.kind * Elab.kind * ElabEnv.env * kunify_error
+           | DuplicateField of ErrorMsg.span * string
+           | ProjBounds of Elab.con * int
+           | ProjMismatch of Elab.con * Elab.kind
+
+    val conError : ElabEnv.env -> con_error -> unit
+
+    datatype cunify_error =
+             CKind of Elab.kind * Elab.kind * ElabEnv.env * kunify_error
+           | COccursCheckFailed of Elab.con * Elab.con
+           | CIncompatible of Elab.con * Elab.con
+           | CExplicitness of Elab.con * Elab.con
+           | CKindof of Elab.kind * Elab.con * string
+           | CRecordFailure of Elab.con * Elab.con * (Elab.con * Elab.con * Elab.con * (ElabEnv.env * cunify_error) option) option
+           | TooLifty of ErrorMsg.span * ErrorMsg.span
+           | TooUnify of Elab.con * Elab.con
+           | TooDeep
+           | CScope of Elab.con * Elab.con
+
+    val cunifyError : ElabEnv.env -> cunify_error -> unit
+
+    datatype exp_error =
+             UnboundExp of ErrorMsg.span * string
+           | UnboundStrInExp of ErrorMsg.span * string
+           | Unify of Elab.exp * Elab.con * Elab.con * ElabEnv.env * cunify_error
+           | Unif of string * ErrorMsg.span * Elab.con
+           | WrongForm of string * Elab.exp * Elab.con
+           | IncompatibleCons of Elab.con * Elab.con
+           | DuplicatePatternVariable of ErrorMsg.span * string
+           | PatUnify of Elab.pat * Elab.con * Elab.con * ElabEnv.env * cunify_error
+           | UnboundConstructor of ErrorMsg.span * string list * string
+           | PatHasArg of ErrorMsg.span
+           | PatHasNoArg of ErrorMsg.span
+           | Inexhaustive of ErrorMsg.span * Elab.pat
+           | DuplicatePatField of ErrorMsg.span * string
+           | Unresolvable of ErrorMsg.span * Elab.con
+           | OutOfContext of ErrorMsg.span * (Elab.exp * Elab.con) option
+           | IllegalRec of string * Elab.exp
+           | IllegalFlex of Source.exp
+
+    val expError : ElabEnv.env -> exp_error -> unit
+
+    datatype decl_error =
+             KunifsRemain of Elab.decl list
+           | CunifsRemain of Elab.decl list
+           | Nonpositive of Elab.decl
+
+    val declError : ElabEnv.env -> decl_error -> unit
+
+    datatype sgn_error =
+             UnboundSgn of ErrorMsg.span * string
+           | UnmatchedSgi of ErrorMsg.span * Elab.sgn_item
+           | SgiWrongKind of ErrorMsg.span * Elab.sgn_item * Elab.kind * Elab.sgn_item * Elab.kind * ElabEnv.env * kunify_error
+           | SgiWrongCon of ErrorMsg.span * Elab.sgn_item * Elab.con * Elab.sgn_item * Elab.con * ElabEnv.env * cunify_error
+           | SgiMismatchedDatatypes of ErrorMsg.span * Elab.sgn_item * Elab.sgn_item
+                                       * (Elab.con * Elab.con * ElabEnv.env * cunify_error) option
+           | SgnWrongForm of ErrorMsg.span * Elab.sgn * Elab.sgn
+           | UnWhereable of Elab.sgn * string
+           | WhereWrongKind of Elab.kind * Elab.kind * ElabEnv.env * kunify_error
+           | NotIncludable of Elab.sgn
+           | DuplicateCon of ErrorMsg.span * string
+           | DuplicateVal of ErrorMsg.span * string
+           | DuplicateSgn of ErrorMsg.span * string
+           | DuplicateStr of ErrorMsg.span * string
+           | NotConstraintsable of Elab.sgn
+
+    val sgnError : ElabEnv.env -> sgn_error -> unit
+
+    datatype str_error =
+             UnboundStr of ErrorMsg.span * string
+           | NotFunctor of Elab.sgn
+           | FunctorRebind of ErrorMsg.span
+           | UnOpenable of Elab.sgn
+           | NotType of ErrorMsg.span * Elab.kind * (Elab.kind * Elab.kind * ElabEnv.env * kunify_error)
+           | DuplicateConstructor of string * ErrorMsg.span
+           | NotDatatype of ErrorMsg.span
+
+    val strError : ElabEnv.env -> str_error -> unit
+
+end
diff --git a/src/elab_err.sml b/src/elab_err.sml
new file mode 100644
index 0000000..385caca
--- /dev/null
+++ b/src/elab_err.sml
@@ -0,0 +1,440 @@
+(* Copyright (c) 2008-2010, 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ElabErr :> ELAB_ERR = struct
+
+structure L = Source
+open Elab
+
+structure E = ElabEnv
+structure U = ElabUtil
+
+open Print
+structure P = ElabPrint
+
+val p_kind = P.p_kind
+             
+datatype kind_error =
+         UnboundKind of ErrorMsg.span * string
+
+fun kindError env err =
+    case err of
+        UnboundKind (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound kind variable " ^ s)
+
+datatype kunify_error =
+         KOccursCheckFailed of kind * kind
+       | KIncompatible of kind * kind
+       | KScope of kind * kind
+
+fun kunifyError env err =
+    case err of
+        KOccursCheckFailed (k1, k2) =>
+        eprefaces "Kind occurs check failed"
+        [("Kind 1", p_kind env k1),
+         ("Kind 2", p_kind env k2)]
+      | KIncompatible (k1, k2) =>
+        eprefaces "Incompatible kinds"
+        [("Kind 1", p_kind env k1),
+         ("Kind 2", p_kind env k2)]
+      | KScope (k1, k2) =>
+        eprefaces "Scoping prevents kind unification"
+        [("Kind 1", p_kind env k1),
+         ("Kind 2", p_kind env k2)]
+
+fun p_con env c = P.p_con env (ElabOps.reduceCon env c)
+
+datatype con_error =
+         UnboundCon of ErrorMsg.span * string
+       | UnboundDatatype of ErrorMsg.span * string
+       | UnboundStrInCon of ErrorMsg.span * string
+       | WrongKind of con * kind * kind * E.env * kunify_error
+       | DuplicateField of ErrorMsg.span * string
+       | ProjBounds of con * int
+       | ProjMismatch of con * kind
+
+fun conError env err =
+    case err of
+        UnboundCon (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound constructor variable " ^ s)
+      | UnboundDatatype (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound datatype " ^ s)
+      | UnboundStrInCon (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound structure " ^ s)
+      | WrongKind (c, k1, k2, env', kerr) =>
+        (ErrorMsg.errorAt (#2 c) "Wrong kind";
+         eprefaces' [("Constructor", p_con env c),
+                     ("Have kind", p_kind env k1),
+                     ("Need kind", p_kind env k2)];
+         kunifyError env' kerr)
+      | DuplicateField (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate record field " ^ s)
+      | ProjBounds (c, n) =>
+        (ErrorMsg.errorAt (#2 c) "Out of bounds constructor projection";
+         eprefaces' [("Constructor", p_con env c),
+                     ("Index", Print.PD.string (Int.toString n))])
+      | ProjMismatch (c, k) =>
+        (ErrorMsg.errorAt (#2 c) "Projection from non-tuple constructor";
+         eprefaces' [("Constructor", p_con env c),
+                     ("Kind", p_kind env k)])
+
+datatype cunify_error =
+         CKind of kind * kind * E.env * kunify_error
+       | COccursCheckFailed of con * con
+       | CIncompatible of con * con
+       | CExplicitness of con * con
+       | CKindof of kind * con * string
+       | CRecordFailure of con * con * (con * con * con * (E.env * cunify_error) option) option
+       | TooLifty of ErrorMsg.span * ErrorMsg.span
+       | TooUnify of con * con
+       | TooDeep
+       | CScope of con * con
+
+fun cunifyError env err : unit =
+    case err of
+        CKind (k1, k2, env', kerr) =>
+        (eprefaces "Kind unification failure"
+                   [("Have", p_kind env k1),
+                    ("Need", p_kind env k2)];
+         kunifyError env' kerr)
+      | COccursCheckFailed (c1, c2) =>
+        eprefaces "Constructor occurs check failed"
+                  [("Have", p_con env c1),
+                   ("Need", p_con env c2)]
+      | CIncompatible (c1, c2) =>
+        eprefaces "Incompatible constructors"
+                  [("Have", p_con env c1),
+                   ("Need", p_con env c2)]
+      | CExplicitness (c1, c2) =>
+        eprefaces "Differing constructor function explicitness"
+                  [("Have", p_con env c1),
+                   ("Need", p_con env c2)]
+      | CKindof (k, c, expected) =>
+        eprefaces ("Unexpected kind for kindof calculation (expecting " ^ expected ^ ")")
+                  [("Kind", p_kind env k),
+                   ("Con", p_con env c)]
+      | CRecordFailure (c1, c2, fo) =>
+        (eprefaces "Can't unify record constructors"
+                   (("Have", p_con env c1)
+                    :: ("Need", p_con env c2)
+                    :: (case fo of
+                            NONE => []
+                          | SOME (nm, t1, t2, _) =>
+                            [("Field", p_con env nm),
+                             ("Value 1", p_con env t1),
+                             ("Value 2", p_con env t2)]));
+         case fo of
+             SOME (_, _, _, SOME (env', err')) => cunifyError env' err'
+           | _ => ())
+      | TooLifty (loc1, loc2) =>
+        (ErrorMsg.errorAt loc1 "Can't unify two unification variables that both have suspended liftings";
+         eprefaces' [("Other location", Print.PD.string (ErrorMsg.spanToString loc2))])
+      | TooUnify (c1, c2) =>
+        (ErrorMsg.errorAt (#2 c1) "Substitution in constructor is blocked by a too-deep unification variable";
+         eprefaces' [("Replacement", p_con env c1),
+                     ("Body", p_con env c2)])
+      | TooDeep => ErrorMsg.error "Can't reverse-engineer unification variable lifting"
+      | CScope (c1, c2) =>
+        eprefaces "Scoping prevents constructor unification"
+                  [("Have", p_con env c1),
+                   ("Need", p_con env c2)]
+
+datatype exp_error =
+       UnboundExp of ErrorMsg.span * string
+     | UnboundStrInExp of ErrorMsg.span * string
+     | Unify of exp * con * con * E.env * cunify_error
+     | Unif of string * ErrorMsg.span * con
+     | WrongForm of string * exp * con
+     | IncompatibleCons of con * con
+     | DuplicatePatternVariable of ErrorMsg.span * string
+     | PatUnify of pat * con * con * E.env * cunify_error
+     | UnboundConstructor of ErrorMsg.span * string list * string
+     | PatHasArg of ErrorMsg.span
+     | PatHasNoArg of ErrorMsg.span
+     | Inexhaustive of ErrorMsg.span * pat
+     | DuplicatePatField of ErrorMsg.span * string
+     | Unresolvable of ErrorMsg.span * con
+     | OutOfContext of ErrorMsg.span * (exp * con) option
+     | IllegalRec of string * exp
+     | IllegalFlex of Source.exp
+
+val simplExp = U.Exp.mapB {kind = fn _ => fn k => k,
+                           con = fn env => fn c => #1 (ElabOps.reduceCon env (c, ErrorMsg.dummySpan)),
+                           exp = fn _ => fn e => e,
+                           bind = fn (env, U.Exp.RelC (x, k)) => E.pushCRel env x k
+                                   | (env, U.Exp.NamedC (x, n, k, co)) => E.pushCNamedAs env x n k co
+                                   | (env, _) => env}
+
+fun p_exp env e = P.p_exp env (simplExp env e)
+val p_pat = P.p_pat
+
+fun expError env err =
+    case err of
+        UnboundExp (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound expression variable " ^ s)
+      | UnboundStrInExp (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound structure " ^ s)
+      | Unify (e, c1, c2, env', uerr) =>
+        (ErrorMsg.errorAt (#2 e) "Unification failure";
+         eprefaces' [("Expression", p_exp env e),
+                     ("Have con", p_con env c1),
+                     ("Need con", p_con env c2)];
+         cunifyError env' uerr)
+      | Unif (action, loc, c) =>
+        (ErrorMsg.errorAt loc ("Unification variable blocks " ^ action);
+         eprefaces' [("Con", p_con env c)])
+      | WrongForm (variety, e, t) =>
+        (ErrorMsg.errorAt (#2 e) ("Expression is not a " ^ variety);
+         eprefaces' [("Expression", p_exp env e),
+                     ("Type", p_con env t)])
+      | IncompatibleCons (c1, c2) =>
+        (ErrorMsg.errorAt (#2 c1) "Incompatible constructors";
+         eprefaces' [("Have", p_con env c1),
+                     ("Need", p_con env c2)])
+      | DuplicatePatternVariable (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate pattern variable " ^ s)
+      | PatUnify (p, c1, c2, env', uerr) =>
+        (ErrorMsg.errorAt (#2 p) "Unification failure for pattern";
+         eprefaces' [("Pattern", p_pat env p),
+                     ("Have con", p_con env c1),
+                     ("Need con", p_con env c2)];
+         cunifyError env' uerr)
+      | UnboundConstructor (loc, ms, s) =>
+        ErrorMsg.errorAt loc ("Unbound constructor " ^ String.concatWith "." (ms @ [s]) ^ " in pattern")
+      | PatHasArg loc =>
+        ErrorMsg.errorAt loc "Constructor expects no argument but is used with argument"
+      | PatHasNoArg loc =>
+        ErrorMsg.errorAt loc "Constructor expects argument but is used with no argument"
+      | Inexhaustive (loc, p) =>
+        (ErrorMsg.errorAt loc "Inexhaustive 'case'";
+         eprefaces' [("Missed case", p_pat env p)])
+      | DuplicatePatField (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate record field " ^ s ^ " in pattern")
+      | OutOfContext (loc, co) =>
+        (ErrorMsg.errorAt loc "Type class wildcard occurs out of context";
+         Option.app (fn (e, c) => eprefaces' [("Function", p_exp env e),
+                                              ("Type", p_con env c)]) co)
+      | Unresolvable (loc, c) =>
+        (ErrorMsg.errorAt loc "Can't resolve type class instance";
+         eprefaces' ([("Class constraint", p_con env c)]
+                     @ (case E.resolveFailureCause () of
+                            NONE => []
+                          | SOME c' => [("Reduced to unresolvable", p_con env c')]))(*;
+         app (fn (c, rs) => (eprefaces' [("CLASS", p_con env c)];
+                             app (fn (c, e) => eprefaces' [("RULE", p_con env c),
+                                                           ("IMPL", p_exp env e)]) rs))
+             (E.listClasses env)*))
+      | IllegalRec (x, e) =>
+        (ErrorMsg.errorAt (#2 e) "Illegal 'val rec' righthand side (must be a function abstraction)";
+         eprefaces' [("Variable", PD.string x),
+                     ("Expression", p_exp env e)])
+      | IllegalFlex e =>
+        (ErrorMsg.errorAt (#2 e) "Flex record syntax (\"...\") only allowed in patterns";
+         eprefaces' [("Expression", SourcePrint.p_exp e)])
+
+
+datatype decl_error =
+         KunifsRemain of decl list
+       | CunifsRemain of decl list
+       | Nonpositive of decl
+
+fun lspan [] = ErrorMsg.dummySpan
+  | lspan ((_, loc) :: _) = loc
+
+val baseLen = 2000
+
+fun p_decl env d =
+    let
+        val fname = OS.FileSys.tmpName ()
+        val out' = TextIO.openOut fname
+        val out = Print.openOut {dst = out', wid = 80}
+
+        fun readFromFile () =
+            let
+                val inf = FileIO.txtOpenIn fname
+
+                fun loop acc =
+                    case TextIO.inputLine inf of
+                        NONE => String.concat (rev acc)
+                      | SOME line => loop (line :: acc)
+            in
+                loop []
+                before TextIO.closeIn inf
+            end
+    in
+        Print.fprint out (P.p_decl env d);
+        TextIO.closeOut out';
+        let
+            val content = readFromFile ()
+        in
+            OS.FileSys.remove fname;
+            Print.PD.string (if size content <= baseLen then
+                                 content
+                             else
+                                 let
+                                     val (befor, after) = Substring.position "<UNIF:" (Substring.full content)
+                                 in
+                                     if Substring.isEmpty after then
+                                         raise Fail "No unification variables in rendering"
+                                     else
+                                         Substring.concat [Substring.full "\n.....\n",
+                                                           if Substring.size befor <= baseLen then
+                                                               befor
+                                                           else
+                                                               Substring.slice (befor, Substring.size befor - baseLen, SOME baseLen),
+                                                           if Substring.size after <= baseLen then
+                                                               after
+                                                           else
+                                                               Substring.slice (after, 0, SOME baseLen),
+                                                           Substring.full "\n.....\n"]
+                                 end)
+        end
+    end
+
+fun declError env err =
+    case err of
+        KunifsRemain ds =>
+        (ErrorMsg.errorAt (lspan ds) "Some kind unification variables are undetermined in declaration\n(look for them as \"<UNIF:...>\")";
+         eprefaces' [("Decl", p_list_sep PD.newline (p_decl env) ds)])
+      | CunifsRemain ds =>
+        (ErrorMsg.errorAt (lspan ds) "Some constructor unification variables are undetermined in declaration\n(look for them as \"<UNIF:...>\")";
+         eprefaces' [("Decl", p_list_sep PD.newline (p_decl env) ds)])
+      | Nonpositive d =>
+        (ErrorMsg.errorAt (#2 d) "Non-strictly-positive datatype declaration (could allow non-termination)";
+         eprefaces' [("Decl", p_decl env d)])
+
+datatype sgn_error =
+         UnboundSgn of ErrorMsg.span * string
+       | UnmatchedSgi of ErrorMsg.span * sgn_item
+       | SgiWrongKind of ErrorMsg.span * sgn_item * kind * sgn_item * kind * E.env * kunify_error
+       | SgiWrongCon of ErrorMsg.span * sgn_item * con * sgn_item * con * E.env * cunify_error
+       | SgiMismatchedDatatypes of ErrorMsg.span * sgn_item * sgn_item
+                                   * (con * con * E.env * cunify_error) option
+       | SgnWrongForm of ErrorMsg.span * sgn * sgn
+       | UnWhereable of sgn * string
+       | WhereWrongKind of kind * kind * E.env * kunify_error
+       | NotIncludable of sgn
+       | DuplicateCon of ErrorMsg.span * string
+       | DuplicateVal of ErrorMsg.span * string
+       | DuplicateSgn of ErrorMsg.span * string
+       | DuplicateStr of ErrorMsg.span * string
+       | NotConstraintsable of sgn
+
+val p_sgn_item = P.p_sgn_item
+val p_sgn = P.p_sgn
+
+fun sgnError env err =
+    case err of
+        UnboundSgn (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound signature variable " ^ s)
+      | UnmatchedSgi (loc, sgi) =>
+        (ErrorMsg.errorAt loc "Unmatched signature item";
+         eprefaces' [("Item", p_sgn_item env sgi)])
+      | SgiWrongKind (loc, sgi1, k1, sgi2, k2, env', kerr) =>
+        (ErrorMsg.errorAt loc "Kind unification failure in signature matching:";
+         eprefaces' [("Have", p_sgn_item env sgi1),
+                     ("Need", p_sgn_item env sgi2),
+                     ("Kind 1", p_kind env k1),
+                     ("Kind 2", p_kind env k2)];
+         kunifyError env' kerr)
+      | SgiWrongCon (loc, sgi1, c1, sgi2, c2, env', cerr) =>
+        (ErrorMsg.errorAt loc "Constructor unification failure in signature matching:";
+         eprefaces' [("Have", p_sgn_item env sgi1),
+                     ("Need", p_sgn_item env sgi2),
+                     ("Con 1", p_con env c1),
+                     ("Con 2", p_con env c2)];
+         cunifyError env' cerr)
+      | SgiMismatchedDatatypes (loc, sgi1, sgi2, cerro) =>
+        (ErrorMsg.errorAt loc "Mismatched 'datatype' specifications:";
+         eprefaces' [("Have", p_sgn_item env sgi1),
+                     ("Need", p_sgn_item env sgi2)];
+         Option.app (fn (c1, c2, env', ue) =>
+                        (eprefaces "Unification error"
+                                   [("Con 1", p_con env' c1),
+                                    ("Con 2", p_con env' c2)];
+                         cunifyError env' ue)) cerro)
+      | SgnWrongForm (loc, sgn1, sgn2) =>
+        (ErrorMsg.errorAt loc "Incompatible signatures:";
+         eprefaces' [("Sig 1", p_sgn env sgn1),
+                     ("Sig 2", p_sgn env sgn2)])
+      | UnWhereable (sgn, x) =>
+        (ErrorMsg.errorAt (#2 sgn) "Unavailable field for 'where'";
+         eprefaces' [("Signature", p_sgn env sgn),
+                     ("Field", PD.string x)])
+      | WhereWrongKind (k1, k2, env', kerr) =>
+        (ErrorMsg.errorAt (#2 k1) "Wrong kind for 'where'";
+         eprefaces' [("Have", p_kind env k1),
+                     ("Need", p_kind env k2)];
+         kunifyError env' kerr)
+      | NotIncludable sgn =>
+        (ErrorMsg.errorAt (#2 sgn) "Invalid signature to 'include'";
+         eprefaces' [("Signature", p_sgn env sgn)])
+      | DuplicateCon (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate constructor " ^ s ^ " in signature")
+      | DuplicateVal (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate value " ^ s ^ " in signature")
+      | DuplicateSgn (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate signature " ^ s ^ " in signature")
+      | DuplicateStr (loc, s) =>
+        ErrorMsg.errorAt loc ("Duplicate structure " ^ s ^ " in signature")
+      | NotConstraintsable sgn =>
+        (ErrorMsg.errorAt (#2 sgn) "Invalid signature for 'open constraints'";
+         eprefaces' [("Signature", p_sgn env sgn)])
+
+datatype str_error =
+         UnboundStr of ErrorMsg.span * string
+       | NotFunctor of sgn
+       | FunctorRebind of ErrorMsg.span
+       | UnOpenable of sgn
+       | NotType of ErrorMsg.span * kind * (kind * kind * E.env * kunify_error)
+       | DuplicateConstructor of string * ErrorMsg.span
+       | NotDatatype of ErrorMsg.span
+
+fun strError env err =
+    case err of
+        UnboundStr (loc, s) =>
+        ErrorMsg.errorAt loc ("Unbound structure variable " ^ s)
+      | NotFunctor sgn =>
+        (ErrorMsg.errorAt (#2 sgn) "Application of non-functor";
+         eprefaces' [("Signature", p_sgn env sgn)])
+      | FunctorRebind loc =>
+        ErrorMsg.errorAt loc "Attempt to rebind functor"
+      | UnOpenable sgn =>
+        (ErrorMsg.errorAt (#2 sgn) "Un-openable structure";
+         eprefaces' [("Signature", p_sgn env sgn)])
+      | NotType (loc, k, (k1, k2, env', ue)) =>
+        (ErrorMsg.errorAt loc "'val' type kind is not 'Type'";
+         eprefaces' [("Kind", p_kind env k),
+                     ("Subkind 1", p_kind env k1),
+                     ("Subkind 2", p_kind env k2)];
+         kunifyError env' ue)
+      | DuplicateConstructor (x, loc) =>
+        ErrorMsg.errorAt loc ("Duplicate datatype constructor " ^ x)
+      | NotDatatype loc =>
+        ErrorMsg.errorAt loc "Trying to import non-datatype as a datatype"
+
+end
diff --git a/src/elab_ops.sig b/src/elab_ops.sig
new file mode 100644
index 0000000..97e4b60
--- /dev/null
+++ b/src/elab_ops.sig
@@ -0,0 +1,50 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ELAB_OPS = sig
+
+    exception SubUnif
+
+    val liftKindInKind : int -> Elab.kind -> Elab.kind
+    val subKindInKind : int * Elab.kind -> Elab.kind -> Elab.kind
+
+    val liftKindInCon : int -> Elab.con -> Elab.con
+    val subKindInCon : int * Elab.kind -> Elab.con -> Elab.con
+
+    val liftConInCon : int -> Elab.con -> Elab.con
+    val subConInCon : int * Elab.con -> Elab.con -> Elab.con
+    val subStrInSgn : int * int -> Elab.sgn -> Elab.sgn
+
+    val hnormCon : ElabEnv.env -> Elab.con -> Elab.con
+    val reduceCon : ElabEnv.env -> Elab.con -> Elab.con
+
+    val identity : int ref
+    val distribute : int ref
+    val fuse : int ref
+    val reset : unit -> unit
+
+end
diff --git a/src/elab_ops.sml b/src/elab_ops.sml
new file mode 100644
index 0000000..6ff5e03
--- /dev/null
+++ b/src/elab_ops.sml
@@ -0,0 +1,517 @@
+(* Copyright (c) 2008, 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ElabOps :> ELAB_OPS = struct
+
+open Elab
+
+structure E = ElabEnv
+structure U = ElabUtil
+
+fun liftKindInKind' by =
+    U.Kind.mapB {kind = fn bound => fn k =>
+                                       case k of
+                                         KRel xn =>
+                                         if xn < bound then
+                                             k
+                                         else
+                                             KRel (xn + by)
+                                       | _ => k,
+                bind = fn (bound, _) => bound + 1}
+
+fun subKindInKind' rep =
+    U.Kind.mapB {kind = fn (by, xn) => fn k =>
+                                          case k of
+                                              KRel xn' =>
+                                              (case Int.compare (xn', xn) of
+                                                   EQUAL => #1 (liftKindInKind' by 0 rep)
+                                                 | GREATER => KRel (xn' - 1)
+                                                 | LESS => k)
+                                            | _ => k,
+                 bind = fn ((by, xn), _) => (by+1, xn+1)}
+
+val liftKindInKind = liftKindInKind' 1
+
+fun subKindInKind (xn, rep) = subKindInKind' rep (0, xn)
+
+fun liftKindInCon by =
+    U.Con.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + by)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                bind = fn (bound, U.Con.RelK _) => bound + 1
+                        | (bound, _) => bound}
+
+fun subKindInCon' rep =
+    U.Con.mapB {kind = fn (by, xn) => fn k =>
+                                         case k of
+                                             KRel xn' =>
+                                             (case Int.compare (xn', xn) of
+                                                  EQUAL => #1 (liftKindInKind' by 0 rep)
+                                                | GREATER => KRel (xn' - 1)
+                                                | LESS => k)
+                                           | _ => k,
+                con = fn _ => fn c => c,
+                bind = fn ((by, xn), U.Con.RelK _) => (by+1, xn+1)
+                        | (st, _) => st}
+
+val liftKindInCon = liftKindInCon 1
+
+fun subKindInCon (xn, rep) = subKindInCon' rep (0, xn)
+
+fun liftConInCon by =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + by)
+                                       | CUnif (nl, loc, k, s, r) => CUnif (nl+by, loc, k, s, r)
+                                       | _ => c,
+                bind = fn (bound, U.Con.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+exception SubUnif
+
+fun subConInCon' rep =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn (by, xn) => fn c =>
+                                        case c of
+                                            CRel xn' =>
+                                            (case Int.compare (xn', xn) of
+                                                 EQUAL => #1 (liftConInCon by 0 rep)
+                                               | GREATER => CRel (xn' - 1)
+                                               | LESS => c)
+                                          | CUnif (0, _, _, _, _) => raise SubUnif
+                                          | CUnif (n, loc, k, s, r) => CUnif (n-1, loc, k, s, r)
+                                          | _ => c,
+                bind = fn ((by, xn), U.Con.RelC _) => (by+1, xn+1)
+                        | (ctx, _) => ctx}
+
+val liftConInCon = liftConInCon 1
+
+fun subConInCon (xn, rep) = subConInCon' rep (0, xn)
+
+fun subStrInSgn (m1, m2) =
+    U.Sgn.map {kind = fn k => k,
+               con = fn c as CModProj (m1', ms, x) =>
+                        if m1 = m1' then
+                            CModProj (m2, ms, x)
+                        else
+                            c
+                      | c => c,
+               sgn_item = fn sgi => sgi,
+               sgn = fn sgn => sgn}
+
+val occurs =
+    U.Con.existsB {kind = fn _ => false,
+                   con = fn (n, c) =>
+                            case c of
+                                CRel n' => n' = n
+                              | _ => false,
+                   bind = fn (n, b) =>
+                             case b of
+                                 U.Con.RelC _ => n + 1
+                               | _ => n}
+                  0
+
+val identity = ref 0
+val distribute = ref 0
+val fuse = ref 0
+
+fun reset () = (identity := 0;
+                distribute := 0;
+                fuse := 0)
+
+fun hnormCon env (cAll as (c, loc)) =
+    case c of
+        CUnif (nl, _, _, _, ref (Known c)) => (#1 (hnormCon env (E.mliftConInCon nl c)), loc)
+
+      | CNamed xn =>
+        (case E.lookupCNamed env xn of
+             (_, _, SOME c') => hnormCon env c'
+           | _ => cAll)
+
+      | CModProj (n, ms, x) =>
+        let
+            val (_, sgn) = E.lookupStrNamed env n
+            val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                       case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                           NONE => raise Fail "hnormCon: Unknown substructure"
+                                         | SOME sgn => ((StrProj (str, m), loc), sgn))
+                             ((StrVar n, loc), sgn) ms
+        in
+            case E.projectCon env {sgn = sgn, str = str, field = x} of
+                NONE => raise Fail "kindof: Unknown con in structure"
+              | SOME (_, NONE) => cAll
+              | SOME (_, SOME c) => hnormCon env c
+        end
+
+      (* Eta reduction *)
+      | CAbs (x, k, b) =>
+        (case #1 (hnormCon (E.pushCRel env x k) b) of
+             CApp (f, (CRel 0, _)) =>
+             if occurs f then
+                 cAll
+             else
+                 hnormCon env (subConInCon (0, (CUnit, loc)) f)
+           | _ => cAll)
+
+      | CApp (c1, c2) =>
+        (case #1 (hnormCon env c1) of
+             CAbs (x, k, cb) =>
+             let
+                 val sc = (hnormCon env (subConInCon (0, c2) cb))
+                     handle SynUnif => cAll
+                 (*val env' = E.pushCRel env x k*)
+             in
+                 (*Print.eprefaces "Subst" [("x", Print.PD.string x),
+                                          ("cb", ElabPrint.p_con env' cb),
+                                          ("c2", ElabPrint.p_con env c2),
+                                          ("sc", ElabPrint.p_con env sc)];*)
+                 sc
+             end
+           | c1' as CApp (c', f) =>
+             let
+                 fun default () = (CApp ((c1', loc), hnormCon env c2), loc)
+             in
+                 case #1 (hnormCon env c') of
+                     CMap (ks as (k1, k2)) =>
+                     (case #1 (hnormCon env c2) of
+                          CRecord (_, []) => (CRecord (k2, []), loc)
+                        | CRecord (_, (x, c) :: rest) =>
+                          hnormCon env
+                                   (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                             (CApp (c1, (CRecord (k2, rest), loc)), loc)), loc)
+                        | CConcat ((CRecord (k, (x, c) :: rest), _), rest') =>
+                          let
+                              val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc)
+                          in
+                              hnormCon env
+                                       (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                                 (CApp (c1, rest''), loc)), loc)
+                          end
+                        | _ =>
+                          let
+                              fun unconstraint c =
+                                  case hnormCon env c of
+                                      (TDisjoint (_, _, c), _) => unconstraint c
+                                    | c => c
+
+                              fun inc r = r := !r + 1
+
+                              fun tryDistributivity () =
+                                  case hnormCon env c2 of
+                                      (CConcat (c1, c2'), _) =>
+                                      let
+                                          val c = (CMap ks, loc)
+                                          val c = (CApp (c, f), loc)
+                                                  
+                                          val c1 = (CApp (c, c1), loc)
+                                          val c2 = (CApp (c, c2'), loc)
+                                          val c = (CConcat (c1, c2), loc)
+                                      in
+                                          inc distribute;
+                                          hnormCon env c
+                                      end
+                                    | _ => default ()
+
+                              fun tryFusion () =
+                                  case #1 (hnormCon env c2) of
+                                      CApp (f', r') =>
+                                      (case #1 (hnormCon env f') of
+                                           CApp (f', inner_f) =>
+                                           (case #1 (hnormCon env f') of
+                                                CMap (dom, _) =>
+                                                let
+                                                    val inner_f = liftConInCon 0 inner_f
+                                                    val f = liftConInCon 0 f
+
+                                                    val f' = (CApp (inner_f, (CRel 0, loc)), loc)
+                                                    val f' = (CApp (f, f'), loc)
+                                                    val f' = (CAbs ("v", dom, f'), loc)
+
+                                                    val c = (CMap (dom, k2), loc)
+                                                    val c = (CApp (c, f'), loc)
+                                                    val c = (CApp (c, r'), loc)
+                                                in
+                                                    inc fuse;
+                                                    hnormCon env c
+                                                end
+                                              | _ => tryDistributivity ())
+                                         | _ => tryDistributivity ())
+                                    | _ => tryDistributivity ()
+
+                              fun tryIdentity () =
+                                  let
+                                      fun cunif () =
+                                          let
+                                              val r = ref (Unknown (fn _ => true))
+                                          in
+                                              (r, (CUnif (0, loc, (KType, loc), "_", r), loc))
+                                          end
+                                          
+                                      val (vR, v) = cunif ()
+
+                                      val c = (CApp (f, v), loc)
+                                  in
+                                      case unconstraint c of
+                                          (CUnif (_, _, _, _, vR'), _) =>
+                                          if vR' = vR then
+                                              (inc identity;
+                                               hnormCon env c2)
+                                          else
+                                              tryFusion ()
+                                        | _ => tryFusion ()
+                                  end
+                          in
+                              tryIdentity ()
+                          end)
+                   | _ => default ()
+             end
+           | c1' => (CApp ((c1', loc), hnormCon env c2), loc))
+
+      | CKApp (c1, k) =>
+        (case hnormCon env c1 of
+             (CKAbs (_, body), _) => hnormCon env (subKindInCon (0, k) body)
+           | _ => cAll)
+        
+      | CConcat (c1, c2) =>
+        (case (hnormCon env c1, hnormCon env c2) of
+             ((CRecord (k, xcs1), loc), (CRecord (_, xcs2), _)) =>
+             (CRecord (k, xcs1 @ xcs2), loc)
+           | ((CRecord (_, []), _), c2') => c2'
+           | ((CConcat (c11, c12), loc), c2') =>
+             hnormCon env (CConcat (c11, (CConcat (c12, c2'), loc)), loc)
+           | (c1', (CRecord (_, []), _)) => c1'
+           | (c1', c2') => (CConcat (c1', c2'), loc))
+
+      | CProj (c, n) =>
+        (case hnormCon env c of
+             (CTuple cs, _) => hnormCon env (List.nth (cs, n - 1))
+           | _ => cAll)
+
+      | _ => cAll
+
+fun reduceCon env (cAll as (c, loc)) =
+    case c of
+        TFun (c1, c2) => (TFun (reduceCon env c1, reduceCon env c2), loc)
+      | TCFun (exp, x, k, c) => (TCFun (exp, x, k, reduceCon env c), loc)
+      | TRecord c => (TRecord (reduceCon env c), loc)
+      | TDisjoint (c1, c2, c3) => (TDisjoint (reduceCon env c1, reduceCon env c2, reduceCon env c3), loc)
+
+      | CRel _ => cAll
+      | CNamed xn =>
+        (case E.lookupCNamed env xn of
+             (_, _, SOME c') => reduceCon env c'
+           | _ => cAll)
+      | CModProj (n, ms, x) =>
+        let
+            val (_, sgn) = E.lookupStrNamed env n
+            val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                       case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                           NONE => raise Fail "reduceCon: Unknown substructure"
+                                         | SOME sgn => ((StrProj (str, m), loc), sgn))
+                                   ((StrVar n, loc), sgn) ms
+        in
+            case E.projectCon env {sgn = sgn, str = str, field = x} of
+                NONE => raise Fail "reduceCon: kindof: Unknown con in structure"
+              | SOME (_, NONE) => cAll
+              | SOME (_, SOME c) => reduceCon env c
+        end
+
+      | CApp (c1, c2) =>
+        let
+            val c1 = reduceCon env c1
+            val c2 = reduceCon env c2
+            fun default () = (CApp (c1, c2), loc)
+        in
+            case #1 c1 of
+                CAbs (x, k, cb) =>
+                ((reduceCon env (subConInCon (0, c2) cb))
+                 handle SynUnif => default ())
+              | CApp (c', f) =>
+                let
+                    val c' = reduceCon env c'
+                    val f = reduceCon env f
+                in
+                    case #1 c' of
+                        CMap (ks as (k1, k2)) =>
+                        (case #1 c2 of
+                             CRecord (_, []) => (CRecord (k2, []), loc)
+                           | CRecord (_, (x, c) :: rest) =>
+                             reduceCon env
+                                       (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                                 (CApp (c1, (CRecord (k2, rest), loc)), loc)), loc)
+                           | CConcat ((CRecord (k, (x, c) :: rest), _), rest') =>
+                             let
+                                 val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc)
+                             in
+                                 reduceCon env
+                                           (CConcat ((CRecord (k2, [(x, (CApp (f, c), loc))]), loc),
+                                                     (CApp (c1, rest''), loc)), loc)
+                             end
+                           | _ =>
+                             let
+                                 fun unconstraint c =
+                                     case reduceCon env c of
+                                         (TDisjoint (_, _, c), _) => unconstraint c
+                                       | c => c
+
+                                 fun inc r = r := !r + 1
+
+                                 fun tryDistributivity () =
+                                     case reduceCon env c2 of
+                                         (CConcat (c1, c2), _) =>
+                                         let
+                                             val c = (CMap ks, loc)
+                                             val c = (CApp (c, f), loc)
+                                                  
+                                             val c1 = (CApp (c, c1), loc)
+                                             val c2 = (CApp (c, c2), loc)
+                                             val c = (CConcat (c1, c2), loc)
+                                         in
+                                             inc distribute;
+                                             reduceCon env c
+                                         end
+                                       | _ => default ()
+
+                                 fun tryFusion () =
+                                     case #1 (reduceCon env c2) of
+                                         CApp (f', r') =>
+                                         (case #1 (reduceCon env f') of
+                                              CApp (f', inner_f) =>
+                                              (case #1 (reduceCon env f') of
+                                                   CMap (dom, _) =>
+                                                   let
+                                                       val inner_f = liftConInCon 0 inner_f
+                                                       val f = liftConInCon 0 f
+
+                                                       val f' = (CApp (inner_f, (CRel 0, loc)), loc)
+                                                       val f' = (CApp (f, f'), loc)
+                                                       val f' = (CAbs ("v", dom, f'), loc)
+
+                                                       val c = (CMap (dom, k2), loc)
+                                                       val c = (CApp (c, f'), loc)
+                                                       val c = (CApp (c, r'), loc)
+                                                   in
+                                                       inc fuse;
+                                                       reduceCon env c
+                                                   end
+                                                 | _ => tryDistributivity ())
+                                            | _ => tryDistributivity ())
+                                       | _ => tryDistributivity ()
+
+                                 fun tryIdentity () =
+                                     let
+                                         fun cunif () =
+                                             let
+                                                 val r = ref (Unknown (fn _ => true))
+                                             in
+                                                 (r, (CUnif (0, loc, (KType, loc), "_", r), loc))
+                                             end
+                                             
+                                         val (vR, v) = cunif ()
+
+                                         val c = (CApp (f, v), loc)
+                                     in
+                                         case unconstraint c of
+                                             (CUnif (_, _, _, _, vR'), _) =>
+                                             if vR' = vR then
+                                                 (inc identity;
+                                                  reduceCon env c2)
+                                             else
+                                                 tryFusion ()
+                                           | _ => tryFusion ()
+                                     end
+                             in
+                                 tryIdentity ()
+                             end)
+                      | _ => default ()
+                end
+              | _ => default ()
+        end
+      | CAbs (x, k, b) =>
+        let
+            val b = reduceCon (E.pushCRel env x k) b
+            fun default () = (CAbs (x, k, b), loc)
+        in
+            case #1 b of
+                CApp (f, (CRel 0, _)) =>
+                if occurs f then
+                    default ()
+                else
+                    reduceCon env (subConInCon (0, (CUnit, loc)) f)
+              | _ => default ()
+        end
+
+      | CKAbs (x, b) => (CKAbs (x, reduceCon (E.pushKRel env x) b), loc)
+      | CKApp (c1, k) =>
+        (case reduceCon env c1 of
+             (CKAbs (_, body), _) => reduceCon env (subKindInCon (0, k) body)
+           | c1 => (CKApp (c1, k), loc))
+      | TKFun (x, c) => (TKFun (x, reduceCon env c), loc)
+
+      | CName _ => cAll
+
+      | CRecord (k, xcs) => (CRecord (k, map (fn (x, c) => (reduceCon env x, reduceCon env c)) xcs), loc)
+      | CConcat (c1, c2) =>
+        let
+            val c1 = reduceCon env c1
+            val c2 = reduceCon env c2
+        in
+            case (c1, c2) of
+                ((CRecord (k, xcs1), loc), (CRecord (_, xcs2), _)) => (CRecord (k, xcs1 @ xcs2), loc)
+              | ((CRecord (_, []), _), _) => c2
+              | ((CConcat (c11, c12), loc), _) => reduceCon env (CConcat (c11, (CConcat (c12, c2), loc)), loc)
+              | (_, (CRecord (_, []), _)) => c1
+              | ((CRecord (k, xcs1), loc), (CConcat ((CRecord (_, xcs2), _), c2'), _)) => (CConcat ((CRecord (k, xcs1 @ xcs2), loc), c2'), loc)
+              | _ => (CConcat (c1, c2), loc)
+        end
+      | CMap _ => cAll
+
+      | CUnit => cAll
+
+      | CTuple cs => (CTuple (map (reduceCon env) cs), loc)
+      | CProj (c, n) =>
+        (case reduceCon env c of
+             (CTuple cs, _) => reduceCon env (List.nth (cs, n - 1))
+           | c => (CProj (c, n), loc))
+
+      | CError => cAll
+
+      | CUnif (nl, _, _, _, ref (Known c)) => reduceCon env (E.mliftConInCon nl c)
+      | CUnif _ => cAll
+
+end
diff --git a/src/elab_print.sig b/src/elab_print.sig
new file mode 100644
index 0000000..1eb832b
--- /dev/null
+++ b/src/elab_print.sig
@@ -0,0 +1,44 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web *)
+
+signature ELAB_PRINT = sig
+    val p_kind : ElabEnv.env -> Elab.kind Print.printer
+    val p_explicitness : Elab.explicitness Print.printer
+    val p_con : ElabEnv.env -> Elab.con Print.printer
+    val p_pat : ElabEnv.env -> Elab.pat Print.printer
+    val p_exp : ElabEnv.env -> Elab.exp Print.printer
+    val p_decl : ElabEnv.env -> Elab.decl Print.printer
+    val p_sgn_item : ElabEnv.env -> Elab.sgn_item Print.printer
+    val p_sgn : ElabEnv.env -> Elab.sgn Print.printer
+    val p_str : ElabEnv.env -> Elab.str Print.printer
+    val p_file : ElabEnv.env -> Elab.file Print.printer
+
+    val debug : bool ref
+end
+
diff --git a/src/elab_print.sml b/src/elab_print.sml
new file mode 100644
index 0000000..8a6a651
--- /dev/null
+++ b/src/elab_print.sml
@@ -0,0 +1,906 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing elaborated Ur/Web *)
+
+structure ElabPrint :> ELAB_PRINT = struct
+
+open Print.PD
+open Print
+
+open Elab
+
+structure E = ElabEnv
+
+val debug = ref false
+
+fun p_kind' par env (k, _) =
+    case k of
+        KType => string "Type"
+      | KArrow (k1, k2) => parenIf par (box [p_kind' true env k1,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_kind env k2])
+      | KName => string "Name"
+      | KRecord k => box [string "{", p_kind env k, string "}"]
+      | KUnit => string "Unit"
+      | KTuple ks => box [string "(",
+                          p_list_sep (box [space, string "*", space]) (p_kind env) ks,
+                          string ")"]
+
+      | KError => string "<ERROR>"
+      | KUnif (_, _, ref (KKnown k)) => p_kind' par env k
+      | KUnif (_, s, _) => string ("<UNIF:" ^ s ^ ">")
+      | KTupleUnif (_, _, ref (KKnown k)) => p_kind' par env k
+      | KTupleUnif (_, nks, _) => box [string "(",
+                                       p_list_sep (box [space, string "*", space])
+                                                  (fn (n, k) => box [string (Int.toString n ^ ":"),
+                                                                     space,
+                                                                     p_kind env k]) nks,
+                                       space,
+                                       string "*",
+                                       space,
+                                       string "...)"]
+
+      | KRel n => ((if !debug then
+                         string (E.lookupKRel env n ^ "_" ^ Int.toString n)
+                     else
+                         string (E.lookupKRel env n))
+                    handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | KFun (x, k) => box [string x,
+                            space,
+                            string "-->",
+                            space,
+                            p_kind (E.pushKRel env x) k]
+
+and p_kind env = p_kind' false env
+
+fun p_explicitness e =
+    case e of
+        Explicit => string "::"
+      | Implicit => string ":::"
+
+fun p_con' par env (c, _) =
+    case c of
+        TFun (t1, t2) => parenIf par (box [p_con' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_con env t2])
+      | TCFun (e, x, k, c) => parenIf par (box [string x,
+                                                space,
+                                                p_explicitness e,
+                                                space,
+                                                p_kind env k,
+                                                space,
+                                                string "->",
+                                                space,
+                                                p_con (E.pushCRel env x k) c])
+      | TDisjoint (c1, c2, c3) => parenIf par (box [string "[",
+                                                    p_con env c1,
+                                                    space,
+                                                    string "~",
+                                                    space,
+                                                    p_con env c2,
+                                                    string "]",
+                                                    space,
+                                                    string "=>",
+                                                    space,
+                                                    p_con env c3])
+      | TRecord (CRecord (_, xcs), _) =>
+        let
+            fun isTuple (n, xcs) =
+                case xcs of
+                    [] => n > 2
+                  | ((CName s, _), _) :: xcs' =>
+                    s = Int.toString n andalso isTuple (n+1, xcs')
+                  | _ => false
+        in
+            if isTuple (1, xcs) then
+                case xcs of
+                    (_, c) :: xcs =>
+                    parenIf par (box [p_con' true env c,
+                                      p_list_sep (box []) (fn (_, c) => box [space,
+                                                                             string "*",
+                                                                             space,
+                                                                             p_con' true env c]) xcs])
+                  | _ => raise Fail "ElabPrint: surprise empty tuple"
+            else
+                box [string "{",
+                     p_list (fn (x, c) =>
+                                box [p_name env x,
+                                     space,
+                                     string ":",
+                                     space,
+                                     p_con env c]) xcs,
+                     string "}"]
+        end
+      | TRecord c => box [string "$",
+                          p_con' true env c]
+
+      | CRel n =>
+        ((if !debug then
+              string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCRel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | CNamed n =>
+        ((if !debug then
+              string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCNamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | CModProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+               
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            if m1x = "Basis" andalso (case E.lookupC env x of
+                                          E.Named (n, _) =>
+                                          let
+                                              val (_, _, co) = E.lookupCNamed env n
+                                          in
+                                              case co of
+                                                  SOME (CModProj (m1', [], x'), _) => m1' = m1 andalso x' = x
+                                                | _ => false
+                                          end
+                                        | E.NotBound => true
+                                        | _ => false) then
+                string x
+            else
+                p_list_sep (string ".") string (m1s :: ms @ [x])
+        end 
+
+      | CApp (c1, c2) => parenIf par (box [p_con env c1,
+                                           space,
+                                           p_con' true env c2])
+      | CAbs (x, k, c) => parenIf true (box [string "fn",
+                                             space,
+                                             string x,
+                                             space,
+                                             string "::",
+                                             space,
+                                             p_kind env k,
+                                             space,
+                                             string "=>",
+                                             space,
+                                             p_con (E.pushCRel env x k) c])
+
+      | CName s => box [string "#", string s]
+
+      | CRecord (k, xcs) =>
+        if !debug then
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_name env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]::",
+                              p_kind env k])
+        else
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_name env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]"])
+      | CConcat (c1, c2) => parenIf par (box [p_con' true env c1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_con env c2])
+      | CMap _ => string "map"
+
+      | CUnit => string "()"
+
+      | CTuple cs => box [string "(",
+                          p_list (p_con env) cs,
+                          string ")"]
+      | CProj (c, n) => box [p_con env c,
+                             string ".",
+                             string (Int.toString n)]
+
+      | CError => string "<ERROR>"
+      | CUnif (nl, _, _, _, ref (Known c)) => p_con' par env (E.mliftConInCon nl c)
+      | CUnif (nl, _, k, s, _) => box [string ("<UNIF:" ^ s ^ "::"),
+                                       p_kind env k,
+                                       case nl of
+                                           0 => box []
+                                         | _ => string ("+" ^ Int.toString nl),
+                                       string ">"]
+
+      | CKAbs (x, c) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_con (E.pushKRel env x) c]
+      | CKApp (c, k) => box [p_con env c,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+      | TKFun (x, c) => box [string x,
+                             space,
+                             string "-->",
+                             space,
+                             p_con (E.pushKRel env x) c]
+
+        
+and p_con env = p_con' false env
+
+and p_name env (all as (c, _)) =
+    case c of
+        CName s => string s
+      | _ => p_con env all
+
+fun p_patCon env pc =
+    case pc of
+        PConVar n =>
+        ((if !debug then
+              string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupENamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | PConProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+                  
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1x :: ms @ [x])
+        end
+
+fun p_pat' par env (p, _) =
+    case p of
+        PVar (s, _) => string s
+      | PPrim p => Prim.p_t p
+      | PCon (_, pc, _, NONE) => p_patCon env pc
+      | PCon (_, pc, _, SOME p) => parenIf par (box [p_patCon env pc,
+                                                  space,
+                                                  p_pat' true env p])
+      | PRecord xps =>
+        box [string "{",
+             p_list_sep (box [string ",", space]) (fn (x, p, t) =>
+                                                      box [string x,
+                                                           space,
+                                                           string "=",
+                                                           space,
+                                                           p_pat env p,
+                                                           if !debug then
+                                                               box [space,
+                                                                    string ":",
+                                                                    space,
+                                                                    p_con env t]
+                                                           else
+                                                               box []]) xps,
+             string "}"]
+
+and p_pat x = p_pat' false x
+
+fun p_exp' par env (e, _) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n =>
+        ((if !debug then
+              string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupERel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | ENamed n =>
+        ((if !debug then
+              string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupENamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | EModProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+                  
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1x :: ms @ [x])
+        end
+                                         
+      | EApp (e1, e2) => parenIf par (box [p_exp env e1,
+                                           space,
+                                           p_exp' true env e2])
+      | EAbs (x, t, _, e) => parenIf par (box [string "fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               string ":",
+                                               space,
+                                               p_con env t,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_exp (E.pushERel env x t) e])
+      | ECApp (e, c) => parenIf par (box [p_exp env e,
+                                          space,
+                                          string "[",
+                                          p_con env c,
+                                          string "]"])
+      | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
+                                                  space,
+                                                  string x,
+                                                  space,
+                                                  p_explicitness exp,
+                                                  space,
+                                                  p_kind env k,
+                                                  space,
+                                                  string "=>",
+                                                  space,
+                                                  p_exp (E.pushCRel env x k) e])
+
+      | ERecord xes => box [string "{",
+                            p_list (fn (x, e, _) =>
+                                       box [p_name env x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_exp env e]) xes,
+                            string "}"]
+      | EField (e, c, {field, rest}) =>
+        if !debug then
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c,
+                 space,
+                 string "[",
+                 p_con env field,
+                 space,
+                 string " in ",
+                 space,
+                 p_con env rest,
+                 string "]"]
+        else
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c]
+      | EConcat (e1, c1, e2, c2) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e1,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c1,
+                              space,
+                              string "++",
+                              space,
+                              p_exp' true env e2,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c2]
+                     else
+                         box [p_exp' true env e1,
+                              space,
+                              string "++",
+                              space,
+                              p_exp' true env e2])
+      | ECut (e, c, {field, rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env field,
+                              space,
+                              string " in ",
+                              space,
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c])
+      | ECutMulti (e, c, {rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c])
+
+      | ECase (e, pes, _) => parenIf par (box [string "case",
+                                               space,
+                                               p_exp env e,
+                                               space,
+                                               string "of",
+                                               space,
+                                               p_list_sep (box [space, string "|", space])
+                                                          (fn (p, e) => box [p_pat env p,
+                                                                             space,
+                                                                             string "=>",
+                                                                             space,
+                                                                             p_exp (E.patBinds env p) e]) pes])
+
+      | EError => string "<ERROR>"
+      | EUnif (ref (SOME e)) => p_exp env e
+      | EUnif _ => string "_"
+
+      | ELet (ds, e, _) =>
+        let
+            val (dsp, env) = ListUtil.foldlMap
+                             (fn (d, env) =>
+                                 (p_edecl env d,
+                                  E.edeclBinds env d))
+                             env ds
+        in
+            box [string "let",
+                 newline,
+                 box [p_list_sep newline (fn x => x) dsp],
+                 newline,
+                 string "in",
+                 newline,
+                 box [p_exp env e],
+                 newline,
+                 string "end"]
+        end
+
+      | EKAbs (x, e) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_exp (E.pushKRel env x) e]
+      | EKApp (e, k) => box [p_exp env e,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+
+and p_exp env = p_exp' false env
+
+and p_edecl env (dAll as (d, _)) =
+    case d of
+        EDVal (p, t, e) => box [string "val",
+                                space,
+                                p_pat env p,
+                                space,
+                                string ":",
+                                space,
+                                p_con env t,
+                                space,
+                                string "=",
+                                space,
+                                p_exp env e]
+      | EDValRec vis =>
+        let
+            val env = E.edeclBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_evali env) vis]
+        end
+
+and p_evali env (x, t, e) = box [string x,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_con env t,
+                                 space,
+                                 string "=",
+                                 space,
+                                 p_exp env e]
+
+fun p_datatype env (x, n, xs, cons) =
+    let
+        val k = (KType, ErrorMsg.dummySpan)
+        val env = E.pushCNamedAs env x n k NONE
+        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
+    in
+        box [string x,
+             p_list_sep (box []) (fn x => box [space, string x]) xs,
+             space,
+             string "=",
+             space,
+             p_list_sep (box [space, string "|", space])
+                        (fn (x, _, NONE) => string x
+                          | (x, _, SOME t) => box [string x, space, string "of", space, p_con env t])
+                        cons]
+    end
+
+fun p_named x n =
+    if !debug then
+        box [string x,
+             string "__",
+             string (Int.toString n)]
+    else
+        string x
+
+fun p_sgn_item env (sgiAll as (sgi, _)) =
+    case sgi of
+        SgiConAbs (x, n, k) => box [string "con",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind env k]
+      | SgiCon (x, n, k, c) => box [string "con",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind env k,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_con env c]
+      | SgiDatatype x => box [string "datatype",
+                              space,
+                              p_list_sep (box [space, string "and", space]) (p_datatype (E.sgiBinds env sgiAll)) x]
+      | SgiDatatypeImp (x, _, m1, ms, x', _, _) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+        in
+            box [string "datatype",
+                 space,
+                 string x,
+                 space,
+                 string "=",
+                 space,
+                 string "datatype",
+                 space,
+                 p_list_sep (string ".") string (m1x :: ms @ [x'])]
+        end
+      | SgiVal (x, n, c) => box [string "val",
+                                 space,
+                                 p_named x n,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_con env c]
+      | SgiStr (_, x, n, sgn) => box [string "structure",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn env sgn]
+      | SgiSgn (x, n, sgn) => box [string "signature",
+                                   space,
+                                   p_named x n,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_sgn env sgn]
+      | SgiConstraint (c1, c2) => box [string "constraint",
+                                       space,
+                                       p_con env c1,
+                                       space,
+                                       string "~",
+                                       space,
+                                       p_con env c2]
+      | SgiClassAbs (x, n, k) => box [string "class",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string "::",
+                                      space,
+                                      p_kind env k]
+      | SgiClass (x, n, k, c) => box [string "class",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string "::",
+                                      space,
+                                      p_kind env k,
+                                      space,
+                                      string "=",
+                                      space,
+                                      p_con env c]
+
+and p_sgn env (sgn, _) =
+    case sgn of
+        SgnConst sgis => box [string "sig",
+                              newline,
+                              let
+                                  val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) =>
+                                                                         (p_sgn_item env sgi,
+                                                                          E.sgiBinds env sgi))
+                                                                     env sgis
+                              in
+                                  p_list_sep newline (fn x => x) psgis
+                              end,
+                              newline,
+                              string "end"]
+      | SgnVar n => ((string (#1 (E.lookupSgnNamed env n)))
+                     handle E.UnboundNamed _ => string ("UNBOUND_SGN_" ^ Int.toString n))
+      | SgnFun (x, n, sgn, sgn') => box [string "functor",
+                                         space,
+                                         string "(",
+                                         string x,
+                                         space,
+                                         string ":",
+                                         space,
+                                         p_sgn env sgn,
+                                         string ")",
+                                         space,
+                                         string ":",
+                                         space,
+                                         p_sgn (E.pushStrNamedAs' false env x n sgn) sgn']
+      | SgnWhere (sgn, ms, x, c) => box [p_sgn env sgn,
+					 space,
+					 string "where",
+					 space,
+					 string "con",
+					 space,
+					 p_list_sep (string ".") string (ms @ [x]),
+					 space,
+					 string "=",
+					 space,
+					 p_con env c]
+      | SgnProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_SGN_" ^ Int.toString m1
+                   
+            val m1x = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+         in
+            p_list_sep (string ".") string (m1x :: ms @ [x])
+        end
+      | SgnError => string "<ERROR>"
+
+fun p_vali env (x, n, t, e) = box [p_named x n,
+                                   space,
+                                   string ":",
+                                   space,
+                                   p_con env t,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_exp env e]
+
+
+
+fun p_decl env (dAll as (d, _) : decl) =
+    case d of
+        DCon (x, n, k, c) => box [string "con",
+                                  space,
+                                  p_named x n,
+                                  space,
+                                  string "::",
+                                  space,
+                                  p_kind env k,
+                                  space,
+                                  string "=",
+                                  space,
+                                  p_con env c]
+      | DDatatype x => box [string "datatype",
+                            space,
+                            p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
+      | DDatatypeImp (x, _, m1, ms, x', _, _) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+        in
+            box [string "datatype",
+                 space,
+                 string x,
+                 space,
+                 string "=",
+                 space,
+                 string "datatype",
+                 space,
+                 p_list_sep (string ".") string (m1x :: ms @ [x'])]
+        end
+      | DVal vi => box [string "val",
+                        space,
+                        p_vali env vi]
+      | DValRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
+        end
+                             
+      | DSgn (x, n, sgn) => box [string "signature",
+                                 space,
+                                 p_named x n,
+                                 space,
+                                 string "=",
+                                 space,
+                                 p_sgn env sgn]
+      | DStr (x, n, sgn, str) => box [string "structure",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn env sgn,
+                                      space,
+                                      string "=",
+                                      space,
+                                      p_str env str]
+      | DFfiStr (x, n, sgn) => box [string "extern",
+                                    space,
+                                    string "structure",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_sgn env sgn]
+      | DConstraint (c1, c2) => box [string "constraint",
+                                     space,
+                                     p_con env c1,
+                                     space,
+                                     string "~",
+                                     space,
+                                     p_con env c2]
+      | DExport (_, sgn, str) => box [string "export",
+                                      space,
+                                      p_str env str,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn env sgn]
+      | DTable (_, x, n, c, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp env ce]
+      | DSequence (_, x, n) => box [string "sequence",
+                                    space,
+                                    p_named x n]
+      | DView (_, x, n, e, _) => box [string "view",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string "as",
+                                      space,
+                                      p_exp env e]
+      | DDatabase s => box [string "database",
+                            space,
+                            string s]
+      | DCookie (_, x, n, c) => box [string "cookie",
+                                     space,
+                                     p_named x n,
+                                     space,
+                                     string ":",
+                                     space,
+                                     p_con env c]
+      | DStyle (_, x, n) => box [string "style",
+                                 space,
+                                 p_named x n]
+      | DTask (e1, e2) => box [string "task",
+                               space,
+                               p_exp env e1,
+                               space,
+                               string "=",
+                               space,
+                               p_exp env e2]
+      | DPolicy e1 => box [string "policy",
+                           space,
+                           p_exp env e1]
+      | DOnError _ => string "ONERROR"
+      | DFfi _ => string "FFI"
+
+and p_str env (str, _) =
+    case str of
+        StrConst ds => box [string "struct",
+                            newline,
+                            p_file env ds,
+                            newline,
+                            string "end"]
+      | StrVar n => ((string (#1 (E.lookupStrNamed env n)))
+                     handle E.UnboundNamed _ => string ("UNBOUND_STR_" ^ Int.toString n))
+      | StrProj (str, s) => box [p_str env str,
+                                 string ".",
+                                 string s]
+      | StrFun (x, n, sgn, sgn', str) =>
+        let
+            val env' = E.pushStrNamedAs' false env x n sgn
+        in
+            box [string "functor",
+                 space,
+                 string "(",
+                 string x,
+                 space,
+                 string ":",
+                 space,
+                 p_sgn env sgn,
+                 string ")",
+                 space,
+                 string ":",
+                 space,
+                 p_sgn env' sgn',
+                 space,
+                 string "=>",
+                 space,
+                 p_str env' str]
+        end
+      | StrApp (str1, str2) => box [p_str env str1,
+                                    string "(",
+                                    p_str env str2,
+                                    string ")"]
+      | StrError => string "<ERROR>"
+
+and p_file env file =
+    let
+        val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
+                                             (p_decl env d,
+                                              E.declBinds env d))
+                                         env file
+    in
+        p_list_sep newline (fn x => x) pds
+    end
+
+end
diff --git a/src/elab_util.sig b/src/elab_util.sig
new file mode 100644
index 0000000..dc07f6f
--- /dev/null
+++ b/src/elab_util.sig
@@ -0,0 +1,257 @@
+(* Copyright (c) 2008-2010, 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ELAB_UTIL = sig
+
+val classifyDatatype : (string * int * 'a option) list -> Elab.datatype_kind
+
+val mliftConInCon : (int -> Elab.con -> Elab.con) ref
+
+structure Kind : sig
+    val mapfoldB : {kind : ('context, Elab.kind', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * string -> 'context}
+                   -> ('context, Elab.kind, 'state, 'abort) Search.mapfolderB
+    val mapfold : (Elab.kind', 'state, 'abort) Search.mapfolder
+                  -> (Elab.kind, 'state, 'abort) Search.mapfolder
+    val exists : (Elab.kind' -> bool) -> Elab.kind -> bool
+    val mapB : {kind : 'context -> Elab.kind' -> Elab.kind',
+                bind : 'context * string -> 'context}
+               -> 'context -> (Elab.kind -> Elab.kind)
+    val foldB : {kind : 'context * Elab.kind' * 'state -> 'state,
+                 bind : 'context * string -> 'context}
+                -> 'context -> 'state -> Elab.kind -> 'state
+end
+
+structure Con : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Elab.kind
+           | NamedC of string * int * Elab.kind * Elab.con option
+
+    val mapfoldB : {kind : ('context, Elab.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Elab.con', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Elab.con, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Elab.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Elab.con', 'state, 'abort) Search.mapfolder}
+                  -> (Elab.con, 'state, 'abort) Search.mapfolder
+
+    val mapB : {kind : 'context -> Elab.kind' -> Elab.kind',
+                con : 'context -> Elab.con' -> Elab.con',
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Elab.con -> Elab.con)
+    val map : {kind : Elab.kind' -> Elab.kind',
+               con : Elab.con' -> Elab.con'}
+              -> Elab.con -> Elab.con
+    val appB : {kind : 'context -> Elab.kind' -> unit,
+                con : 'context -> Elab.con' -> unit,
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Elab.con -> unit)
+    val app : {kind : Elab.kind' -> unit,
+               con : Elab.con' -> unit}
+              -> Elab.con -> unit
+    val existsB : {kind : 'context * Elab.kind' -> bool,
+                  con : 'context * Elab.con' -> bool,
+                   bind : 'context * binder -> 'context}
+                  -> 'context -> Elab.con -> bool
+    val exists : {kind : Elab.kind' -> bool,
+                  con : Elab.con' -> bool} -> Elab.con -> bool
+
+    val foldB : {kind : 'context * Elab.kind' * 'state -> 'state,
+                 con : 'context * Elab.con' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Elab.con -> 'state
+    val fold : {kind : Elab.kind' * 'state -> 'state,
+                 con : Elab.con' * 'state -> 'state}
+                -> 'state -> Elab.con -> 'state
+end
+
+structure Exp : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Elab.kind
+           | NamedC of string * int * Elab.kind * Elab.con option
+           | RelE of string * Elab.con
+           | NamedE of string * Elab.con
+
+    val mapfoldB : {kind : ('context, Elab.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Elab.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Elab.exp', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Elab.exp, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Elab.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Elab.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Elab.exp', 'state, 'abort) Search.mapfolder}
+                  -> (Elab.exp, 'state, 'abort) Search.mapfolder
+    val mapB : {kind : 'context -> Elab.kind' -> Elab.kind',
+                con : 'context -> Elab.con' -> Elab.con',
+                exp : 'context -> Elab.exp' -> Elab.exp',
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Elab.exp -> Elab.exp)
+    val exists : {kind : Elab.kind' -> bool,
+                  con : Elab.con' -> bool,
+                  exp : Elab.exp' -> bool} -> Elab.exp -> bool
+    val existsB : {kind : 'context * Elab.kind' -> bool,
+                   con : 'context * Elab.con' -> bool,
+                   exp : 'context * Elab.exp' -> bool,
+                   bind : 'context * binder -> 'context}
+                  -> 'context -> Elab.exp -> bool
+
+    val foldB : {kind : 'context * Elab.kind' * 'state -> 'state,
+                 con : 'context * Elab.con' * 'state -> 'state,
+                 exp : 'context * Elab.exp' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Elab.exp -> 'state
+end
+
+structure Sgn : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Elab.kind
+           | NamedC of string * int * Elab.kind * Elab.con option
+           | Str of string * int * Elab.sgn
+           | Sgn of string * int * Elab.sgn
+
+    val mapfoldB : {kind : ('context, Elab.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Elab.con', 'state, 'abort) Search.mapfolderB,
+                    sgn_item : ('context, Elab.sgn_item', 'state, 'abort) Search.mapfolderB,
+                    sgn : ('context, Elab.sgn', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Elab.sgn, 'state, 'abort) Search.mapfolderB
+
+
+    val mapfold : {kind : (Elab.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Elab.con', 'state, 'abort) Search.mapfolder,
+                   sgn_item : (Elab.sgn_item', 'state, 'abort) Search.mapfolder,
+                   sgn : (Elab.sgn', 'state, 'abort) Search.mapfolder}
+                  -> (Elab.sgn, 'state, 'abort) Search.mapfolder
+
+    val map : {kind : Elab.kind' -> Elab.kind',
+               con : Elab.con' -> Elab.con',
+               sgn_item : Elab.sgn_item' -> Elab.sgn_item',
+               sgn : Elab.sgn' -> Elab.sgn'}
+              -> Elab.sgn -> Elab.sgn
+
+    val mapB : {kind : 'context -> Elab.kind' -> Elab.kind',
+                con : 'context -> Elab.con' -> Elab.con',
+                sgn_item : 'context -> Elab.sgn_item' -> Elab.sgn_item',
+                sgn : 'context -> Elab.sgn' -> Elab.sgn',
+                bind : 'context * binder -> 'context}
+               -> 'context -> Elab.sgn -> Elab.sgn
+                              
+end
+
+structure Decl : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Elab.kind
+           | NamedC of string * int * Elab.kind * Elab.con option
+           | RelE of string * Elab.con
+           | NamedE of string * Elab.con
+           | Str of string * int * Elab.sgn
+           | Sgn of string * int * Elab.sgn
+
+    val mapfoldB : {kind : ('context, Elab.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Elab.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Elab.exp', 'state, 'abort) Search.mapfolderB,
+                    sgn_item : ('context, Elab.sgn_item', 'state, 'abort) Search.mapfolderB,
+                    sgn : ('context, Elab.sgn', 'state, 'abort) Search.mapfolderB,
+                    str : ('context, Elab.str', 'state, 'abort) Search.mapfolderB,
+                    decl : ('context, Elab.decl', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Elab.decl, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Elab.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Elab.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Elab.exp', 'state, 'abort) Search.mapfolder,
+                   sgn_item : (Elab.sgn_item', 'state, 'abort) Search.mapfolder,
+                   sgn : (Elab.sgn', 'state, 'abort) Search.mapfolder,
+                   str : (Elab.str', 'state, 'abort) Search.mapfolder,
+                   decl : (Elab.decl', 'state, 'abort) Search.mapfolder}
+                  -> (Elab.decl, 'state, 'abort) Search.mapfolder
+    val exists : {kind : Elab.kind' -> bool,
+                  con : Elab.con' -> bool,
+                  exp : Elab.exp' -> bool,
+                  sgn_item : Elab.sgn_item' -> bool,
+                  sgn : Elab.sgn' -> bool,
+                  str : Elab.str' -> bool,
+                  decl : Elab.decl' -> bool}
+                 -> Elab.decl -> bool
+    val search : {kind : Elab.kind' -> 'a option,
+                  con : Elab.con' -> 'a option,
+                  exp : Elab.exp' -> 'a option,
+                  sgn_item : Elab.sgn_item' -> 'a option,
+                  sgn : Elab.sgn' -> 'a option,
+                  str : Elab.str' -> 'a option,
+                  decl : Elab.decl' -> 'a option}
+                 -> Elab.decl -> 'a option
+
+    val foldMapB : {kind : 'context * Elab.kind' * 'state -> Elab.kind' * 'state,
+                    con : 'context * Elab.con' * 'state -> Elab.con' * 'state,
+                    exp : 'context * Elab.exp' * 'state -> Elab.exp' * 'state,
+                    sgn_item : 'context * Elab.sgn_item' * 'state -> Elab.sgn_item' * 'state,
+                    sgn : 'context * Elab.sgn' * 'state -> Elab.sgn' * 'state,
+                    str : 'context * Elab.str' * 'state -> Elab.str' * 'state,
+                    decl : 'context * Elab.decl' * 'state -> Elab.decl' * 'state,
+                    bind : 'context * binder -> 'context}
+                   -> 'context -> 'state -> Elab.decl -> Elab.decl * 'state
+
+    val map : {kind : Elab.kind' -> Elab.kind',
+               con : Elab.con' -> Elab.con',
+               exp : Elab.exp' -> Elab.exp',
+               sgn_item : Elab.sgn_item' -> Elab.sgn_item',
+               sgn : Elab.sgn' -> Elab.sgn',
+               str : Elab.str' -> Elab.str',
+               decl : Elab.decl' -> Elab.decl'}
+              -> Elab.decl -> Elab.decl
+
+    val mapB : {kind : 'context -> Elab.kind' -> Elab.kind',
+                con : 'context -> Elab.con' -> Elab.con',
+                exp : 'context -> Elab.exp' -> Elab.exp',
+                sgn_item : 'context -> Elab.sgn_item' -> Elab.sgn_item',
+                sgn : 'context -> Elab.sgn' -> Elab.sgn',
+                str : 'context -> Elab.str' -> Elab.str',
+                decl : 'context -> Elab.decl' -> Elab.decl',
+                bind : 'context * binder -> 'context}
+               -> 'context -> Elab.decl -> Elab.decl
+
+    val fold : {kind : Elab.kind' * 'state -> 'state,
+               con : Elab.con' * 'state -> 'state,
+               exp : Elab.exp' * 'state -> 'state,
+               sgn_item : Elab.sgn_item' * 'state -> 'state,
+               sgn : Elab.sgn' * 'state -> 'state,
+               str : Elab.str' * 'state -> 'state,
+               decl : Elab.decl' * 'state -> 'state}
+              -> 'state -> Elab.decl -> 'state
+end
+
+structure File : sig
+    val maxName : Elab.file -> int
+
+    val findDecl : (Elab.decl -> bool) -> Elab.file -> Elab.decl option
+end
+
+end
diff --git a/src/elab_util.sml b/src/elab_util.sml
new file mode 100644
index 0000000..0cdb9cc
--- /dev/null
+++ b/src/elab_util.sml
@@ -0,0 +1,1310 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ElabUtil :> ELAB_UTIL = struct
+
+open Elab
+
+fun classifyDatatype xncs =
+    case xncs of
+        [(_, _, NONE), (_, _, SOME _)] => Option
+      | [(_, _, SOME _), (_, _, NONE)] => Option
+      | _ =>
+        if List.all (fn (_, _, NONE) => true | _ => false) xncs then
+            Enum
+        else
+            Default
+
+structure S = Search
+
+structure Kind = struct
+
+fun mapfoldB {kind, bind} =
+    let
+        fun mfk ctx k acc =
+            S.bindP (mfk' ctx k acc, kind ctx)
+
+        and mfk' ctx (kAll as (k, loc)) =
+            case k of
+                KType => S.return2 kAll
+
+              | KArrow (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                      fn k1' =>
+                         S.map2 (mfk ctx k2,
+                              fn k2' =>
+                                 (KArrow (k1', k2'), loc)))
+
+              | KName => S.return2 kAll
+
+              | KRecord k =>
+                S.map2 (mfk ctx k,
+                        fn k' =>
+                           (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
+
+              | KTuple ks =>
+                S.map2 (ListUtil.mapfold (mfk ctx) ks,
+                        fn ks' =>
+                           (KTuple ks', loc))
+
+              | KError => S.return2 kAll
+
+              | KUnif (_, _, ref (KKnown k)) => mfk' ctx k
+              | KUnif _ => S.return2 kAll
+
+              | KTupleUnif (_, _, ref (KKnown k)) => mfk' ctx k
+              | KTupleUnif (loc, nks, r) =>
+                S.map2 (ListUtil.mapfold (fn (n, k) =>
+                                             S.map2 (mfk ctx k,
+                                                  fn k' =>
+                                                     (n, k'))) nks,
+                     fn nks' =>
+                        (KTupleUnif (loc, nks', r), loc))
+
+
+              | KRel _ => S.return2 kAll
+              | KFun (x, k) =>
+                S.map2 (mfk (bind (ctx, x)) k,
+                        fn k' =>
+                           (KFun (x, k'), loc))
+    in
+        mfk
+    end
+
+fun mapfold fk =
+    mapfoldB {kind = fn () => fk,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, bind} ctx k =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   bind = bind} ctx k () of
+        S.Continue (k, ()) => k
+      | S.Return _ => raise Fail "ElabUtil.Kind.mapB: Impossible"
+
+fun exists f k =
+    case mapfold (fn k => fn () =>
+                             if f k then
+                                 S.Return ()
+                             else
+                                 S.Continue (k, ())) k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun foldB {kind, bind} ctx st k =
+    case mapfoldB {kind = fn ctx => fn k => fn st => S.Continue (k, kind (ctx, k, st)),
+                   bind = bind} ctx k st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Kind.foldB: Impossible"
+
+end
+
+val mliftConInCon = ref (fn n : int => fn c : con => (raise Fail "You didn't set ElabUtil.mliftConInCon!") : con)
+
+structure Con = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Elab.kind
+       | NamedC of string * int * Elab.kind * Elab.con option
+
+fun mapfoldB {kind = fk, con = fc, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, s) => bind (ctx, RelK s)}
+
+        fun mfc ctx c acc =
+            S.bindP (mfc' ctx c acc, fc ctx)
+
+        and mfc' ctx (cAll as (c, loc)) =
+            case c of
+                TFun (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (TFun (c1', c2'), loc)))
+              | TCFun (e, x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (TCFun (e, x, k', c'), loc)))
+              | TDisjoint (c1, c2, c3) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.bind2 (mfc ctx c2,
+                              fn c2' =>
+                                 S.map2 (mfc ctx c3,
+                                         fn c3' =>
+                                            (TDisjoint (c1', c2', c3'), loc))))
+              | TRecord c =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (TRecord c', loc))
+
+              | CRel _ => S.return2 cAll
+              | CNamed _ => S.return2 cAll
+              | CModProj _ => S.return2 cAll
+              | CApp (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CApp (c1', c2'), loc)))
+              | CAbs (x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (CAbs (x, k', c'), loc)))
+
+              | CName _ => S.return2 cAll
+
+              | CRecord (k, xcs) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (ListUtil.mapfold (fn (x, c) =>
+                                                      S.bind2 (mfc ctx x,
+                                                            fn x' =>
+                                                               S.map2 (mfc ctx c,
+                                                                    fn c' =>
+                                                                       (x', c'))))
+                                 xcs,
+                              fn xcs' =>
+                                 (CRecord (k', xcs'), loc)))
+              | CConcat (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CConcat (c1', c2'), loc)))
+              | CMap (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                         fn k1' =>
+                            S.map2 (mfk ctx k2,
+                                    fn k2' =>
+                                       (CMap (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
+
+              | CTuple cs =>
+                S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                        fn cs' =>
+                           (CTuple cs', loc))
+
+              | CProj (c, n) =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (CProj (c', n), loc))
+
+              | CError => S.return2 cAll
+              | CUnif (nl, _, _, _, ref (Known c)) => mfc' ctx (!mliftConInCon nl c)
+              | CUnif _ => S.return2 cAll
+                        
+              | CKAbs (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (CKAbs (x, c'), loc))
+              | CKApp (c, k) =>
+                S.bind2 (mfc ctx c,
+                      fn c' =>
+                         S.map2 (mfk ctx k,
+                                 fn k' =>
+                                    (CKApp (c', k'), loc)))
+              | TKFun (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (TKFun (x, c'), loc))
+    in
+        mfc
+    end
+
+fun mapfold {kind = fk, con = fc} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   bind = bind} ctx c () of
+        S.Continue (c, ()) => c
+      | S.Return _ => raise Fail "ElabUtil.Con.mapB: Impossible"
+
+fun map {kind, con} s =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ())} s () of
+        S.Return () => raise Fail "ElabUtil.Con.map: Impossible"
+      | S.Continue (s, ()) => s
+
+fun appB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () => (kind ctx k; S.Continue (k, ())),
+                   con = fn ctx => fn c => fn () => (con ctx c; S.Continue (c, ())),
+                   bind = bind} ctx c () of
+        S.Continue _ => ()
+      | S.Return _ => raise Fail "ElabUtil.Con.appB: Impossible"
+
+fun app {kind, con} s =
+    case mapfold {kind = fn k => fn () => (kind k; S.Continue (k, ())),
+                  con = fn c => fn () => (con c; S.Continue (c, ()))} s () of
+        S.Return () => raise Fail "ElabUtil.Con.app: Impossible"
+      | S.Continue _ => ()
+
+fun existsB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () =>
+                                               if kind (ctx, k) then
+                                                   S.Return ()
+                                               else
+                                                   S.Continue (k, ()),
+                   con = fn ctx => fn c => fn () =>
+                                              if con (ctx, c) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (c, ()),
+                   bind = bind} ctx c () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun exists {kind, con} c =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ())} c () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun foldB {kind, con, bind} ctx st c =
+    case mapfoldB {kind = fn ctx => fn k => fn st => S.Continue (k, kind (ctx, k, st)),
+                   con = fn ctx => fn c => fn st => S.Continue (c, con (ctx, c, st)),
+                   bind = bind} ctx c st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Con.foldB: Impossible"
+
+fun fold {kind, con} st c =
+    case mapfoldB {kind = fn () => fn k => fn st => S.Continue (k, kind (k, st)),
+                   con = fn () => fn c => fn st => S.Continue (c, con (c, st)),
+                   bind = fn ((), _) => ()} () c st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Con.fold: Impossible"
+
+end
+
+structure Exp = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Elab.kind
+       | NamedC of string * int * Elab.kind * Elab.con option
+       | RelE of string * Elab.con
+       | NamedE of string * Elab.con
+
+fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
+
+        fun doVars ((p, _), ctx) =
+            case p of
+                PVar xt => bind (ctx, RelE xt)
+              | PPrim _ => ctx
+              | PCon (_, _, _, NONE) => ctx
+              | PCon (_, _, _, SOME p) => doVars (p, ctx)
+              | PRecord xpcs =>
+                foldl (fn ((_, p, _), ctx) => doVars (p, ctx))
+                      ctx xpcs
+
+        fun mfe ctx e acc =
+            S.bindP (mfe' ctx e acc, fe ctx)
+
+        and mfe' ctx (eAll as (e, loc)) =
+            case e of
+                EPrim _ => S.return2 eAll
+              | ERel _ => S.return2 eAll
+              | ENamed _ => S.return2 eAll
+              | EModProj _ => S.return2 eAll
+              | EApp (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EApp (e1', e2'), loc)))
+              | EAbs (x, dom, ran, e) =>
+                S.bind2 (mfc ctx dom,
+                      fn dom' =>
+                         S.bind2 (mfc ctx ran,
+                                  fn ran' =>
+                                     S.map2 (mfe (bind (ctx, RelE (x, dom'))) e,
+                                          fn e' =>
+                                             (EAbs (x, dom', ran', e'), loc))))
+                         
+              | ECApp (e, c) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.map2 (mfc ctx c,
+                              fn c' =>
+                                 (ECApp (e', c'), loc)))
+              | ECAbs (expl, x, k, e) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfe (bind (ctx, RelC (x, k))) e,
+                              fn e' =>
+                                 (ECAbs (expl, x, k', e'), loc)))
+
+              | ERecord xes =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfc ctx x,
+                                                   fn x' =>
+                                                      S.bind2 (mfe ctx e,
+                                                           fn e' =>
+                                                              S.map2 (mfc ctx t,
+                                                                   fn t' =>
+                                                                      (x', e', t')))))
+                                         xes,
+                     fn xes' =>
+                        (ERecord xes', loc))
+              | EField (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (EField (e', c', {field = field', rest = rest'}), loc)))))
+              | EConcat (e1, c1, e2, c2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.bind2 (mfc ctx c1,
+                              fn c1' =>
+                                 S.bind2 (mfe ctx e2,
+                                       fn e2' =>
+                                          S.map2 (mfc ctx c2,
+                                               fn c2' =>
+                                                  (EConcat (e1', c1', e2', c2'),
+                                                   loc)))))
+              | ECut (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (ECut (e', c', {field = field', rest = rest'}), loc)))))
+
+              | ECutMulti (e, c, {rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.map2 (mfc ctx rest,
+                                      fn rest' =>
+                                         (ECutMulti (e', c', {rest = rest'}), loc))))
+
+              | ECase (e, pes, {disc, result}) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.bind2 (ListUtil.mapfold (fn (p, e) =>
+                                                          let
+                                                              fun pb ((p, _), ctx) =
+                                                                  case p of
+                                                                      PVar (x, t) => bind (ctx, RelE (x, t))
+                                                                    | PPrim _ => ctx
+                                                                    | PCon (_, _, _, NONE) => ctx
+                                                                    | PCon (_, _, _, SOME p) => pb (p, ctx)
+                                                                    | PRecord xps => foldl (fn ((_, p, _), ctx) =>
+                                                                                               pb (p, ctx)) ctx xps
+                                                          in
+                                                              S.bind2 (mfp ctx p,
+                                                                       fn p' =>
+                                                                          S.map2 (mfe (pb (p', ctx)) e,
+                                                                               fn e' => (p', e')))
+                                                          end) pes,
+                                    fn pes' =>
+                                       S.bind2 (mfc ctx disc,
+                                             fn disc' =>
+                                                S.map2 (mfc ctx result,
+                                                     fn result' =>
+                                                        (ECase (e', pes', {disc = disc', result = result'}), loc)))))
+
+              | EError => S.return2 eAll
+              | EUnif (ref (SOME e)) => mfe ctx e
+              | EUnif _ => S.return2 eAll
+
+              | ELet (des, e, t) =>
+                let
+                    val (des, ctx') = foldl (fn (ed, (des, ctx)) =>
+                                                let
+                                                    val ctx' =
+                                                        case #1 ed of
+                                                            EDVal (p, _, _) => doVars (p, ctx)
+                                                          | EDValRec vis =>
+                                                            foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t)))
+                                                                  ctx vis
+                                                in
+                                                    (S.bind2 (des,
+                                                           fn des' =>
+                                                              S.map2 (mfed ctx ed,
+                                                                   fn ed' => ed' :: des')),
+                                                     ctx')
+                                                end)
+                                            (S.return2 [], ctx) des
+                in
+                    S.bind2 (des,
+                         fn des' =>
+                            S.bind2 (mfe ctx' e,
+                                    fn e' =>
+                                       S.map2 (mfc ctx t,
+                                               fn t' =>
+                                                  (ELet (rev des', e', t'), loc))))
+                end
+
+              | EKAbs (x, e) =>
+                S.map2 (mfe (bind (ctx, RelK x)) e,
+                        fn e' =>
+                           (EKAbs (x, e'), loc))
+              | EKApp (e, k) =>
+                S.bind2 (mfe ctx e,
+                        fn e' =>
+                           S.map2 (mfk ctx k,
+                                   fn k' =>
+                                      (EKApp (e', k'), loc)))
+
+        and mfp ctx (pAll as (p, loc)) =
+            case p of
+                PVar (x, t) =>
+                S.map2 (mfc ctx t,
+                        fn t' =>
+                           (PVar (x, t'), loc))
+              | PPrim _ => S.return2 pAll
+              | PCon (dk, pc, args, po) =>
+                S.bind2 (ListUtil.mapfold (mfc ctx) args,
+                      fn args' =>
+                         S.map2 ((case po of
+                                      NONE => S.return2 NONE
+                                    | SOME p => S.map2 (mfp ctx p, SOME)),
+                              fn po' =>
+                                 (PCon (dk, pc, args', po'), loc)))
+              | PRecord xps =>
+                S.map2 (ListUtil.mapfold (fn (x, p, c) =>
+                                              S.bind2 (mfp ctx p,
+                                                       fn p' =>
+                                                          S.map2 (mfc ctx c,
+                                                                  fn c' =>
+                                                                     (x, p', c')))) xps,
+                         fn xps' =>
+                            (PRecord xps', loc))
+
+        and mfed ctx (dAll as (d, loc)) =
+            case d of
+                EDVal (p, t, e) =>
+                S.bind2 (mfc ctx t,
+                         fn t' =>
+                            S.map2 (mfe ctx e,
+                                 fn e' =>
+                                    (EDVal (p, t', e'), loc)))
+              | EDValRec vis =>
+                let
+                    val ctx = foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) ctx vis
+                in
+                    S.map2 (ListUtil.mapfold (mfvi ctx) vis,
+                         fn vis' =>
+                            (EDValRec vis', loc))
+                end
+
+        and mfvi ctx (x, c, e) =
+            S.bind2 (mfc ctx c,
+                  fn c' =>
+                     S.map2 (mfe ctx e,
+                          fn e' =>
+                             (x, c', e')))
+    in
+        mfe
+    end
+
+fun mapfold {kind = fk, con = fc, exp = fe} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              exp = fn () => fe,
+              bind = fn ((), _) => ()} ()
+
+fun existsB {kind, con, exp, bind} ctx e =
+    case mapfoldB {kind = fn ctx => fn k => fn () =>
+                                               if kind (ctx, k) then
+                                                   S.Return ()
+                                               else
+                                                   S.Continue (k, ()),
+                   con = fn ctx => fn c => fn () =>
+                                              if con (ctx, c) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (c, ()),
+                   exp = fn ctx => fn e => fn () =>
+                                              if exp (ctx, e) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (e, ()),
+                   bind = bind} ctx e () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun exists {kind, con, exp} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun mapB {kind, con, exp, bind} ctx e =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
+                   bind = bind} ctx e () of
+        S.Continue (e, ()) => e
+      | S.Return _ => raise Fail "ElabUtil.Exp.mapB: Impossible"
+
+fun foldB {kind, con, exp, bind} ctx st e =
+    case mapfoldB {kind = fn ctx => fn k => fn st => S.Continue (k, kind (ctx, k, st)),
+                   con = fn ctx => fn c => fn st => S.Continue (c, con (ctx, c, st)),
+                   exp = fn ctx => fn e => fn st => S.Continue (e, exp (ctx, e, st)),
+                   bind = bind} ctx e st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Exp.foldB: Impossible"
+
+end
+
+structure Sgn = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Elab.kind
+       | NamedC of string * int * Elab.kind * Elab.con option
+       | Str of string * int * Elab.sgn
+       | Sgn of string * int * Elab.sgn
+
+fun mapfoldB {kind, con, sgn_item, sgn, bind} =
+    let
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val con = Con.mapfoldB {kind = kind, con = con, bind = bind'}
+
+        val kind = Kind.mapfoldB {kind = kind, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun sgi ctx si acc =
+            S.bindP (sgi' ctx si acc, sgn_item ctx)
+
+        and sgi' ctx (siAll as (si, loc)) =
+            case si of
+                SgiConAbs (x, n, k) =>
+                S.map2 (kind ctx k,
+                     fn k' =>
+                        (SgiConAbs (x, n, k'), loc))
+              | SgiCon (x, n, k, c) =>
+                S.bind2 (kind ctx k,
+                     fn k' =>
+                        S.map2 (con ctx c,
+                             fn c' =>
+                                (SgiCon (x, n, k', c'), loc)))
+              | SgiDatatype dts =>
+                S.map2 (ListUtil.mapfold (fn (x, n, xs, xncs) =>
+                                             S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                                          case c of
+                                                                              NONE => S.return2 (x, n, c)
+                                                                            | SOME c =>
+                                                                              S.map2 (con ctx c,
+                                                                                   fn c' => (x, n, SOME c'))) xncs,
+                                                  fn xncs' => (x, n, xs, xncs'))) dts,
+                        fn dts' =>
+                           (SgiDatatype dts', loc))
+              | SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+                S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                             case c of
+                                                 NONE => S.return2 (x, n, c)
+                                               | SOME c =>
+                                                 S.map2 (con ctx c,
+                                                      fn c' => (x, n, SOME c'))) xncs,
+                        fn xncs' =>
+                           (SgiDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
+              | SgiVal (x, n, c) =>
+                S.map2 (con ctx c,
+                     fn c' =>
+                        (SgiVal (x, n, c'), loc))
+              | SgiStr (im, x, n, s) =>
+                S.map2 (sg ctx s,
+                     fn s' =>
+                        (SgiStr (im, x, n, s'), loc))
+              | SgiSgn (x, n, s) =>
+                S.map2 (sg ctx s,
+                     fn s' =>
+                        (SgiSgn (x, n, s'), loc))
+              | SgiConstraint (c1, c2) =>
+                S.bind2 (con ctx c1,
+                         fn c1' =>
+                            S.map2 (con ctx c2,
+                                    fn c2' =>
+                                       (SgiConstraint (c1', c2'), loc)))
+              | SgiClassAbs (x, n, k) =>
+                S.map2 (kind ctx k,
+                        fn k' =>
+                           (SgiClassAbs (x, n, k'), loc))
+              | SgiClass (x, n, k, c) =>
+                S.bind2 (kind ctx k,
+                      fn k' => 
+                         S.map2 (con ctx c,
+                              fn c' =>
+                                 (SgiClass (x, n, k', c'), loc)))
+
+        and sg ctx s acc =
+            S.bindP (sg' ctx s acc, sgn ctx)
+
+        and sg' ctx (sAll as (s, loc)) =
+            case s of
+                SgnConst sgis =>
+                S.map2 (ListUtil.mapfoldB (fn (ctx, si)  =>
+                                              (case #1 si of
+                                                   SgiConAbs (x, n, k) =>
+                                                   bind (ctx, NamedC (x, n, k, NONE))
+                                                 | SgiCon (x, n, k, c) =>
+                                                   bind (ctx, NamedC (x, n, k, SOME c))
+                                                 | SgiDatatype dts =>
+                                                   foldl (fn ((x, n, ks, _), ctx) =>
+                                                             let
+                                                                 val k' = (KType, loc)
+                                                                 val k = foldl (fn (_, k) => (KArrow (k', k), loc))
+                                                                               k' ks
+                                                             in
+                                                                 bind (ctx, NamedC (x, n, k, NONE))
+                                                             end) ctx dts
+                                                 | SgiDatatypeImp (x, n, m1, ms, s, _, _) =>
+                                                   bind (ctx, NamedC (x, n, (KType, loc),
+                                                                      SOME (CModProj (m1, ms, s), loc)))
+                                                 | SgiVal _ => ctx
+                                                 | SgiStr (_, x, n, sgn) =>
+                                                   bind (ctx, Str (x, n, sgn))
+                                                 | SgiSgn (x, n, sgn) =>
+                                                   bind (ctx, Sgn (x, n, sgn))
+                                                 | SgiConstraint _ => ctx
+                                                 | SgiClassAbs (x, n, k) =>
+                                                   bind (ctx, NamedC (x, n, (KArrow (k, (KType, loc)), loc), NONE))
+                                                 | SgiClass (x, n, k, c) =>
+                                                   bind (ctx, NamedC (x, n, (KArrow (k, (KType, loc)), loc), SOME c)),
+                                               sgi ctx si)) ctx sgis,
+                     fn sgis' =>
+                        (SgnConst sgis', loc))
+                
+              | SgnVar _ => S.return2 sAll
+              | SgnFun (m, n, s1, s2) =>
+                S.bind2 (sg ctx s1,
+                         fn s1' =>
+                            S.map2 (sg (bind (ctx, Str (m, n, s1'))) s2,
+                                    fn s2' =>
+                                       (SgnFun (m, n, s1', s2'), loc)))
+              | SgnProj _ => S.return2 sAll
+              | SgnWhere (sgn, ms, x, c) =>
+                S.bind2 (sg ctx sgn,
+                      fn sgn' =>
+                         S.map2 (con ctx c,
+                              fn c' =>
+                                 (SgnWhere (sgn', ms, x, c'), loc)))
+              | SgnError => S.return2 sAll
+    in
+        sg
+    end
+
+fun mapfold {kind, con, sgn_item, sgn} =
+    mapfoldB {kind = fn () => kind,
+              con = fn () => con,
+              sgn_item = fn () => sgn_item,
+              sgn = fn () => sgn,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, con, sgn_item, sgn, bind} ctx s =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   sgn_item = fn ctx => fn sgi => fn () => S.Continue (sgn_item ctx sgi, ()),
+                   sgn = fn ctx => fn s => fn () => S.Continue (sgn ctx s, ()),
+                   bind = bind} ctx s () of
+        S.Continue (s, ()) => s
+      | S.Return _ => raise Fail "ElabUtil.Sgn.mapB: Impossible"
+
+fun map {kind, con, sgn_item, sgn} s =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ()),
+                  sgn_item = fn si => fn () => S.Continue (sgn_item si, ()),
+                  sgn = fn s => fn () => S.Continue (sgn s, ())} s () of
+        S.Return () => raise Fail "Elab_util.Sgn.map"
+      | S.Continue (s, ()) => s
+
+end
+
+structure Decl = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Elab.kind
+       | NamedC of string * int * Elab.kind * Elab.con option
+       | RelE of string * Elab.con
+       | NamedE of string * Elab.con
+       | Str of string * int * Elab.sgn
+       | Sgn of string * int * Elab.sgn
+
+fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = fst, decl = fd, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Exp.RelK x => RelK x
+                           | Exp.RelC x => RelC x
+                           | Exp.NamedC x => NamedC x
+                           | Exp.RelE x => RelE x
+                           | Exp.NamedE x => NamedE x
+            in
+                bind (ctx, b')
+            end
+        val mfe = Exp.mapfoldB {kind = fk, con = fc, exp = fe, bind = bind'}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Sgn.RelK x => RelK x
+                           | Sgn.RelC x => RelC x
+                           | Sgn.NamedC x => NamedC x
+                           | Sgn.Sgn x => Sgn x
+                           | Sgn.Str x => Str x
+            in
+                bind (ctx, b')
+            end
+        val mfsg = Sgn.mapfoldB {kind = fk, con = fc, sgn_item = fsgi, sgn = fsg, bind = bind'}
+
+        fun mfst ctx str acc =
+            S.bindP (mfst' ctx str acc, fst ctx)
+
+        and mfst' ctx (strAll as (str, loc)) =
+            case str of
+                StrConst ds => 
+                S.map2 (ListUtil.mapfoldB (fn (ctx, d)  =>
+                                              (case #1 d of
+                                                   DCon (x, n, k, c) =>
+                                                   bind (ctx, NamedC (x, n, k, SOME c))
+                                                 | DDatatype dts =>
+                                                   let
+                                                       fun doOne ((x, n, xs, xncs), ctx) =
+                                                           let
+                                                               val ctx = bind (ctx, NamedC (x, n, (KType, loc), NONE))
+                                                           in
+                                                               foldl (fn ((x, _, co), ctx) =>
+                                                                         let
+                                                                             val t =
+                                                                                 case co of
+                                                                                     NONE => CNamed n
+                                                                                   | SOME t => TFun (t, (CNamed n, loc))
+                                                                                               
+                                                                             val k = (KType, loc)
+                                                                             val t = (t, loc)
+                                                                             val t = foldr (fn (x, t) =>
+                                                                                               (TCFun (Explicit,
+                                                                                                       x,
+                                                                                                       k,
+                                                                                                       t), loc))
+                                                                                           t xs
+                                                                         in
+                                                                             bind (ctx, NamedE (x, t))
+                                                                         end)
+                                                                     ctx xncs
+                                                           end
+                                                   in
+                                                       foldl doOne ctx dts
+                                                   end
+                                                 | DDatatypeImp (x, n, m, ms, x', _, _) =>
+                                                   bind (ctx, NamedC (x, n, (KType, loc),
+                                                                      SOME (CModProj (m, ms, x'), loc)))
+                                                 | DVal (x, _, c, _) =>
+                                                   bind (ctx, NamedE (x, c))
+                                                 | DValRec vis =>
+                                                   foldl (fn ((x, _, c, _), ctx) => bind (ctx, NamedE (x, c))) ctx vis
+                                                 | DSgn (x, n, sgn) =>
+                                                   bind (ctx, Sgn (x, n, sgn))
+                                                 | DStr (x, n, sgn, _) =>
+                                                   bind (ctx, Str (x, n, sgn))
+                                                 | DFfiStr (x, n, sgn) =>
+                                                   bind (ctx, Str (x, n, sgn))
+                                                 | DConstraint _ => ctx
+                                                 | DExport _ => ctx
+                                                 | DTable (tn, x, n, c, _, pc, _, cc) =>
+                                                   let
+                                                       val ct = (CModProj (n, [], "sql_table"), loc)
+                                                       val ct = (CApp (ct, c), loc)
+                                                       val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+                                                   in
+                                                       bind (ctx, NamedE (x, ct))
+                                                   end
+                                                 | DSequence (tn, x, n) =>
+                                                   bind (ctx, NamedE (x, (CModProj (n, [], "sql_sequence"), loc)))
+                                                 | DView (tn, x, n, _, c) =>
+                                                   let
+                                                       val ct = (CModProj (n, [], "sql_view"), loc)
+                                                       val ct = (CApp (ct, c), loc)
+                                                   in
+                                                       bind (ctx, NamedE (x, ct))
+                                                   end
+                                                 | DDatabase _ => ctx
+                                                 | DCookie (tn, x, n, c) =>
+                                                   bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "cookie"), loc),
+                                                                                c), loc)))
+                                                 | DStyle (tn, x, n) =>
+                                                   bind (ctx, NamedE (x, (CModProj (n, [], "css_class"), loc)))
+                                                 | DTask _ => ctx
+                                                 | DPolicy _ => ctx
+                                                 | DOnError _ => ctx
+                                                 | DFfi (x, _, _, t) => bind (ctx, NamedE (x, t)),
+                                               mfd ctx d)) ctx ds,
+                     fn ds' => (StrConst ds', loc))
+              | StrVar _ => S.return2 strAll
+              | StrProj (str, x) =>
+                S.map2 (mfst ctx str,
+                        fn str' =>
+                           (StrProj (str', x), loc))
+              | StrFun (x, n, sgn1, sgn2, str) =>
+                S.bind2 (mfsg ctx sgn1,
+                         fn sgn1' =>
+                            S.bind2 (mfsg ctx sgn2,
+                                     fn sgn2' =>
+                                        S.map2 (mfst ctx str,
+                                                fn str' =>
+                                                   (StrFun (x, n, sgn1', sgn2', str'), loc))))
+              | StrApp (str1, str2) =>
+                S.bind2 (mfst ctx str1,
+                         fn str1' =>
+                            S.map2 (mfst ctx str2,
+                                    fn str2' =>
+                                       (StrApp (str1', str2'), loc)))
+              | StrError => S.return2 strAll
+
+        and mfd ctx d acc =
+            S.bindP (mfd' ctx d acc, fd ctx)
+
+        and mfd' ctx (dAll as (d, loc)) =
+            case d of
+                DCon (x, n, k, c) =>
+                S.bind2 (mfk ctx k,
+                         fn k' =>
+                            S.map2 (mfc ctx c,
+                                    fn c' =>
+                                       (DCon (x, n, k', c'), loc)))
+              | DDatatype dts =>
+                S.map2 (ListUtil.mapfold (fn (x, n, xs, xncs) =>
+                                             S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                                          case c of
+                                                                              NONE => S.return2 (x, n, c)
+                                                                            | SOME c =>
+                                                                              S.map2 (mfc ctx c,
+                                                                                   fn c' => (x, n, SOME c'))) xncs,
+                                                     fn xncs' =>
+                                                        (x, n, xs, xncs'))) dts,
+                     fn dts' =>
+                        (DDatatype dts', loc))
+              | DDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+                S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                             case c of
+                                                 NONE => S.return2 (x, n, c)
+                                               | SOME c =>
+                                                 S.map2 (mfc ctx c,
+                                                      fn c' => (x, n, SOME c'))) xncs,
+                        fn xncs' =>
+                           (DDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
+              | DVal vi =>
+                S.map2 (mfvi ctx vi,
+                     fn vi' =>
+                        (DVal vi', loc))
+              | DValRec vis =>
+                S.map2 (ListUtil.mapfold (mfvi ctx) vis,
+                     fn vis' =>
+                        (DValRec vis', loc))
+              | DSgn (x, n, sgn) =>
+                S.map2 (mfsg ctx sgn,
+                        fn sgn' =>
+                           (DSgn (x, n, sgn'), loc))
+              | DStr (x, n, sgn, str) =>
+                S.bind2 (mfsg ctx sgn,
+                         fn sgn' =>
+                            S.map2 (mfst ctx str,
+                                    fn str' =>
+                                       (DStr (x, n, sgn', str'), loc)))
+              | DFfiStr (x, n, sgn) =>
+                S.map2 (mfsg ctx sgn,
+                        fn sgn' =>
+                           (DFfiStr (x, n, sgn'), loc))
+              | DConstraint (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                         fn c1' =>
+                            S.map2 (mfc ctx c2,
+                                    fn c2' =>
+                                       (DConstraint (c1', c2'), loc)))
+              | DExport (en, sgn, str) =>
+                S.bind2 (mfsg ctx sgn,
+                         fn sgn' =>
+                            S.map2 (mfst ctx str,
+                                    fn str' =>
+                                       (DExport (en, sgn', str'), loc)))
+
+              | DTable (tn, x, n, c, pe, pc, ce, cc) =>
+                S.bind2 (mfc ctx c,
+                        fn c' =>
+                           S.bind2 (mfe ctx pe,
+                                   fn pe' =>
+                                      S.bind2 (mfc ctx pc,
+                                            fn pc' =>
+                                               S.bind2 (mfe ctx ce,
+                                                     fn ce' =>
+                                                        S.map2 (mfc ctx cc,
+                                                              fn cc' =>
+                                                                 (DTable (tn, x, n, c', pe', pc', ce', cc'), loc))))))
+              | DSequence _ => S.return2 dAll
+              | DView (tn, x, n, e, c) =>
+                S.bind2 (mfe ctx e,
+                        fn e' =>
+                           S.map2 (mfc ctx c,
+                                   fn c' =>
+                                      (DView (tn, x, n, e', c'), loc)))
+
+              | DDatabase _ => S.return2 dAll
+
+              | DCookie (tn, x, n, c) =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (DCookie (tn, x, n, c'), loc))
+              | DStyle _ => S.return2 dAll
+              | DTask (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                        fn e1' =>
+                           S.map2 (mfe ctx e2,
+                                fn e2' =>
+                                   (DTask (e1', e2'), loc)))
+              | DPolicy e1 =>
+                S.map2 (mfe ctx e1,
+                     fn e1' =>
+                        (DPolicy e1', loc))
+              | DOnError _ => S.return2 dAll
+              | DFfi (x, n, modes, t) =>
+                S.map2 (mfc ctx t,
+                        fn t' =>
+                           (DFfi (x, n, modes, t'), loc))
+
+        and mfvi ctx (x, n, c, e) =
+            S.bind2 (mfc ctx c,
+                  fn c' =>
+                     S.map2 (mfe ctx e,
+                          fn e' =>
+                             (x, n, c', e')))
+    in
+        mfd
+    end
+
+fun mapfold {kind, con, exp, sgn_item, sgn, str, decl} =
+    mapfoldB {kind = fn () => kind,
+              con = fn () => con,
+              exp = fn () => exp,
+              sgn_item = fn () => sgn_item,
+              sgn = fn () => sgn,
+              str = fn () => str,
+              decl = fn () => decl,
+              bind = fn ((), _) => ()} ()
+
+fun exists {kind, con, exp, sgn_item, sgn, str, decl} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ()),
+                  sgn_item = fn sgi => fn () =>
+                                        if sgn_item sgi then
+                                            S.Return ()
+                                        else
+                                            S.Continue (sgi, ()),
+                  sgn = fn x => fn () =>
+                                   if sgn x then
+                                       S.Return ()
+                                   else
+                                       S.Continue (x, ()),
+                  str = fn x => fn () =>
+                                   if str x then
+                                       S.Return ()
+                                   else
+                                       S.Continue (x, ()),
+                  decl = fn x => fn () =>
+                                    if decl x then
+                                        S.Return ()
+                                    else
+                                        S.Continue (x, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun search {kind, con, exp, sgn_item, sgn, str, decl} k =
+    case mapfold {kind = fn x => fn () =>
+                                    case kind x of
+                                        NONE => S.Continue (x, ())
+                                      | SOME v => S.Return v,
+
+                  con = fn x => fn () =>
+                                   case con x of
+                                       NONE => S.Continue (x, ())
+                                     | SOME v => S.Return v,
+
+                  exp = fn x => fn () =>
+                                   case exp x of
+                                       NONE => S.Continue (x, ())
+                                     | SOME v => S.Return v,
+
+                  sgn_item = fn x => fn () =>
+                                        case sgn_item x of
+                                            NONE => S.Continue (x, ())
+                                          | SOME v => S.Return v,
+
+                  sgn = fn x => fn () =>
+                                   case sgn x of
+                                       NONE => S.Continue (x, ())
+                                     | SOME v => S.Return v,
+
+                  str = fn x => fn () =>
+                                   case str x of
+                                       NONE => S.Continue (x, ())
+                                     | SOME v => S.Return v,
+
+                  decl = fn x => fn () =>
+                                    case decl x of
+                                        NONE => S.Continue (x, ())
+                                      | SOME v => S.Return v
+
+                 } k () of
+        S.Return x => SOME x
+      | S.Continue _ => NONE
+
+fun foldMapB {kind, con, exp, sgn_item, sgn, str, decl, bind} ctx st d =
+    case mapfoldB {kind = fn ctx => fn x => fn st => S.Continue (kind (ctx, x, st)),
+                   con = fn ctx => fn x => fn st => S.Continue (con (ctx, x, st)),
+                   exp = fn ctx => fn x => fn st => S.Continue (exp (ctx, x, st)),
+                   sgn_item = fn ctx => fn x => fn st => S.Continue (sgn_item (ctx, x, st)),
+                   sgn = fn ctx => fn x => fn st => S.Continue (sgn (ctx, x, st)),
+                   str = fn ctx => fn x => fn st => S.Continue (str (ctx, x, st)),
+                   decl = fn ctx => fn x => fn st => S.Continue (decl (ctx, x, st)),
+                   bind = bind} ctx d st of
+        S.Continue x => x
+      | S.Return _ => raise Fail "ElabUtil.Decl.foldMapB: Impossible"
+
+fun map {kind, con, exp, sgn_item, sgn, str, decl} s =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ()),
+                  exp = fn e => fn () => S.Continue (exp e, ()),
+                  sgn_item = fn si => fn () => S.Continue (sgn_item si, ()),
+                  sgn = fn s => fn () => S.Continue (sgn s, ()),
+                  str = fn si => fn () => S.Continue (str si, ()),
+                  decl = fn s => fn () => S.Continue (decl s, ())} s () of
+        S.Return () => raise Fail "Elab_util.Decl.map"
+      | S.Continue (s, ()) => s
+
+fun mapB {kind, con, exp, sgn_item, sgn, str, decl, bind} ctx s =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   exp = fn ctx => fn c => fn () => S.Continue (exp ctx c, ()),
+                   sgn_item = fn ctx => fn sgi => fn () => S.Continue (sgn_item ctx sgi, ()),
+                   sgn = fn ctx => fn s => fn () => S.Continue (sgn ctx s, ()),
+                   str = fn ctx => fn sgi => fn () => S.Continue (str ctx sgi, ()),
+                   decl = fn ctx => fn s => fn () => S.Continue (decl ctx s, ()),
+                   bind = bind} ctx s () of
+        S.Continue (s, ()) => s
+      | S.Return _ => raise Fail "ElabUtil.Decl.mapB: Impossible"
+
+fun fold {kind, con, exp, sgn_item, sgn, str, decl} (st : 'a) d : 'a =
+    case mapfold {kind = fn k => fn st => S.Continue (k, kind (k, st)),
+                  con = fn c => fn st => S.Continue (c, con (c, st)),
+                  exp = fn e => fn st => S.Continue (e, exp (e, st)),
+                  sgn_item = fn sgi => fn st => S.Continue (sgi, sgn_item (sgi, st)),
+                  sgn = fn s => fn st => S.Continue (s, sgn (s, st)),
+                  str = fn str' => fn st => S.Continue (str', str (str', st)),
+                  decl = fn d => fn st => S.Continue (d, decl (d, st))} d st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Decl.fold: Impossible"
+
+end
+
+structure File = struct
+
+fun maxName ds = foldl (fn (d, count) => Int.max (maxNameDecl d, count)) 0 ds
+
+and maxNameDecl (d, _) =
+    case d of
+        DCon (_, n, _, _) => n
+      | DDatatype dts =>
+        foldl (fn ((_, n, _, ns), max) =>
+                  foldl (fn ((_, n', _), m) => Int.max (n', m))
+                        (Int.max (n, max)) ns) 0 dts
+      | DDatatypeImp (_, n1, n2, _, _, _, ns) =>
+        foldl (fn ((_, n', _), m) => Int.max (n', m))
+              (Int.max (n1, n2)) ns
+      | DVal (_, n, _, _) => n
+      | DValRec vis => foldl (fn ((_, n, _, _), count) => Int.max (n, count)) 0 vis
+      | DStr (_, n, sgn, str) => Int.max (n, Int.max (maxNameSgn sgn, maxNameStr str))
+      | DSgn (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | DFfiStr (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | DConstraint _ => 0
+      | DExport _ => 0
+      | DTable (n1, _, n2, _, _, _, _, _) => Int.max (n1, n2)
+      | DSequence (n1, _, n2) => Int.max (n1, n2)
+      | DView (n1, _, n2, _, _) => Int.max (n1, n2)
+      | DDatabase _ => 0
+      | DCookie (n1, _, n2, _) => Int.max (n1, n2)
+      | DStyle (n1, _, n2) => Int.max (n1, n2)
+      | DTask _ => 0
+      | DPolicy _ => 0
+      | DOnError _ => 0
+      | DFfi (_, n, _, _) => n
+and maxNameStr (str, _) =
+    case str of
+        StrConst ds => maxName ds
+      | StrVar n => n
+      | StrProj (str, _) => maxNameStr str
+      | StrFun (_, n, dom, ran, str) => foldl Int.max n [maxNameSgn dom, maxNameSgn ran, maxNameStr str]
+      | StrApp (str1, str2) => Int.max (maxNameStr str1, maxNameStr str2)
+      | StrError => 0
+
+and maxNameSgn (sgn, _) =
+    case sgn of
+        SgnConst sgis => foldl (fn (sgi, count) => Int.max (maxNameSgi sgi, count)) 0 sgis
+      | SgnVar n => n
+      | SgnFun (_, n, dom, ran) => Int.max (n, Int.max (maxNameSgn dom, maxNameSgn ran))
+      | SgnWhere (sgn, _, _, _) => maxNameSgn sgn
+      | SgnProj (n, _, _) => n
+      | SgnError => 0
+
+and maxNameSgi (sgi, _) =
+    case sgi of
+        SgiConAbs (_, n, _) => n
+      | SgiCon (_, n, _, _) => n
+      | SgiDatatype dts =>
+        foldl (fn ((_, n, _, ns), max) =>
+                  foldl (fn ((_, n', _), m) => Int.max (n', m))
+                        (Int.max (n, max)) ns) 0 dts
+      | SgiDatatypeImp (_, n1, n2, _, _, _, ns) =>
+        foldl (fn ((_, n', _), m) => Int.max (n', m))
+              (Int.max (n1, n2)) ns
+      | SgiVal (_, n, _) => n
+      | SgiStr (_, _, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | SgiSgn (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | SgiConstraint _ => 0
+      | SgiClassAbs (_, n, _) => n
+      | SgiClass (_, n, _, _) => n
+
+fun findDecl pred file =
+    let
+        fun decl d =
+            let
+                val r = case #1 d of
+                            DStr (_, _, _, s) => str s
+                          | _ => NONE
+            in
+                case r of
+                    NONE => if pred d then SOME d else NONE
+                  | _ => r
+            end
+
+        and str s =
+            case #1 s of
+                StrConst ds => ListUtil.search decl ds
+              | StrFun (_, _, _, _, s) => str s
+              | StrApp (s1, s2) =>
+                (case str s1 of
+                     NONE => str s2
+                   | r => r)
+              | _ => NONE
+    in
+        ListUtil.search decl file
+    end
+              
+end
+
+end
diff --git a/src/elaborate.sig b/src/elaborate.sig
new file mode 100644
index 0000000..d60cff4
--- /dev/null
+++ b/src/elaborate.sig
@@ -0,0 +1,50 @@
+(* Copyright (c) 2008, 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ELABORATE = sig
+
+    val elabFile : Source.sgn_item list -> Time.time
+                   -> Source.decl list -> Source.sgn_item list -> Time.time
+                   -> ElabEnv.env -> Source.file -> Elab.file
+
+    val resolveClass : ElabEnv.env -> Elab.con -> Elab.exp option
+
+    val dumpTypes : bool ref
+    (* After elaboration (successful or failed), should I output a mapping from
+     * all identifiers to their kinds/types? *)
+
+    val dumpTypesOnError : bool ref
+    (* Like above, but only used if there are compile errors. *)
+
+    val unifyMore : bool ref
+    (* Run all phases of type inference, even if an error is detected by an
+     * early phase. *)
+
+    val incremental : bool ref
+    val verbose : bool ref
+
+end
diff --git a/src/elaborate.sml b/src/elaborate.sml
new file mode 100644
index 0000000..4a04d4b
--- /dev/null
+++ b/src/elaborate.sml
@@ -0,0 +1,5100 @@
+(* Copyright (c) 2008-2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+ structure Elaborate :> ELABORATE = struct
+
+ structure P = Prim
+ structure L = Source
+ structure L' = Elab
+ structure E = ElabEnv
+ structure U = ElabUtil
+ structure D = Disjoint
+
+ open Print
+ open ElabPrint
+ open ElabErr
+
+ val dumpTypes = ref false
+ val dumpTypesOnError = ref false
+ val unifyMore = ref false
+ val incremental = ref false
+ val verbose = ref false
+
+ structure IS = IntBinarySet
+ structure IM = IntBinaryMap
+
+ structure SK = struct
+ type ord_key = string
+ val compare = String.compare
+ end
+
+ structure SS = BinarySetFn(SK)
+ structure SM = BinaryMapFn(SK)
+
+ val basis_r = ref 0
+ val top_r = ref 0
+
+ fun elabExplicitness e =
+     case e of
+         L.Explicit => L'.Explicit
+       | L.Implicit => L'.Implicit
+
+ fun occursKind r =
+     U.Kind.exists (fn L'.KUnif (_, _, r') => r = r'
+                     | _ => false)
+
+ fun validateCon env c =
+     (U.Con.appB {kind = fn env' => fn k => case k of
+                                                L'.KRel n => ignore (E.lookupKRel env' n)
+                                              | L'.KUnif (_, _, r as ref (L'.KUnknown f)) =>
+                                                r := L'.KUnknown (fn k => f k andalso validateKind env' k)
+                                              | _ => (),
+                  con = fn env' => fn c => case c of
+                                               L'.CRel n => ignore (E.lookupCRel env' n)
+                                             | L'.CNamed n => ignore (E.lookupCNamed env' n)
+                                             | L'.CModProj (n, _, _) => ignore (E.lookupStrNamed env' n)
+                                             | L'.CUnif (_, _, _, _, r as ref (L'.Unknown f)) =>
+                                               r := L'.Unknown (fn c => f c andalso validateCon env' c)
+                                             | _ => (),
+                  bind = fn (env', b) => case b of
+                                             U.Con.RelK x => E.pushKRel env' x
+                                           | U.Con.RelC (x, k) => E.pushCRel env' x k
+                                           | U.Con.NamedC (x, n, k, co) => E.pushCNamedAs env x n k co}
+                 env c;
+      true)
+     handle _ => false
+
+ and validateKind env k = validateCon env (L'.CRecord (k, []), ErrorMsg.dummySpan)
+
+ exception KUnify' of E.env * kunify_error
+
+ fun unifyKinds' env (k1All as (k1, _)) (k2All as (k2, _)) =
+     let
+         fun err f = raise KUnify' (env, f (k1All, k2All))
+     in
+         case (k1, k2) of
+             (L'.KType, L'.KType) => ()
+           | (L'.KUnit, L'.KUnit) => ()
+
+           | (L'.KArrow (d1, r1), L'.KArrow (d2, r2)) =>
+             (unifyKinds' env d1 d2;
+              unifyKinds' env r1 r2)
+           | (L'.KName, L'.KName) => ()
+           | (L'.KRecord k1, L'.KRecord k2) => unifyKinds' env k1 k2
+           | (L'.KTuple ks1, L'.KTuple ks2) =>
+             ((ListPair.appEq (fn (k1, k2) => unifyKinds' env k1 k2) (ks1, ks2))
+              handle ListPair.UnequalLengths => err KIncompatible)
+
+           | (L'.KRel n1, L'.KRel n2) =>
+             if n1 = n2 then
+                 ()
+             else
+                 err KIncompatible
+           | (L'.KFun (x, k1), L'.KFun (_, k2)) =>
+             unifyKinds' (E.pushKRel env x) k1 k2
+
+           | (L'.KError, _) => ()
+           | (_, L'.KError) => ()
+
+           | (L'.KUnif (_, _, ref (L'.KKnown k1All)), _) => unifyKinds' env k1All k2All
+           | (_, L'.KUnif (_, _, ref (L'.KKnown k2All))) => unifyKinds' env k1All k2All
+
+           | (L'.KTupleUnif (_, _, ref (L'.KKnown k)), _) => unifyKinds' env k k2All
+           | (_, L'.KTupleUnif (_, _, ref (L'.KKnown k))) => unifyKinds' env k1All k
+
+           | (L'.KUnif (_, _, r1 as ref (L'.KUnknown f1)), L'.KUnif (_, _, r2 as ref (L'.KUnknown f2))) =>
+             if r1 = r2 then
+                 ()
+             else
+                 (r1 := L'.KKnown k2All;
+                  r2 := L'.KUnknown (fn x => f1 x andalso f2 x))
+
+           | (L'.KUnif (_, _, r as ref (L'.KUnknown f)), _) =>
+             if occursKind r k2All then
+                 err KOccursCheckFailed
+             else if not (f k2All) then
+                 err KScope
+             else
+                 r := L'.KKnown k2All
+           | (_, L'.KUnif (_, _, r as ref (L'.KUnknown f))) =>
+             if occursKind r k1All then
+                 err KOccursCheckFailed
+             else if not (f k1All) then
+                 err KScope
+             else
+                 r := L'.KKnown k1All
+
+           | (L'.KTupleUnif (_, nks, r as ref (L'.KUnknown f)), L'.KTuple ks) =>
+             if not (f k2All) then
+                 err KScope
+             else
+                 ((app (fn (n, k) => unifyKinds' env k (List.nth (ks, n-1))) nks;
+                   r := L'.KKnown k2All)
+                  handle Subscript => err KIncompatible)
+           | (L'.KTuple ks, L'.KTupleUnif (_, nks, r as ref (L'.KUnknown f))) =>
+             if not (f k2All) then
+                 err KScope
+             else
+                 ((app (fn (n, k) => unifyKinds' env (List.nth (ks, n-1)) k) nks;
+                   r := L'.KKnown k1All)
+                  handle Subscript => err KIncompatible)
+           | (L'.KTupleUnif (loc, nks1, r1 as ref (L'.KUnknown f1)), L'.KTupleUnif (_, nks2, r2 as ref (L'.KUnknown f2))) =>
+             if r1 = r2 then
+                 ()
+             else
+                 let
+                     val nks = foldl (fn (p as (n, k1), nks) =>
+                                         case ListUtil.search (fn (n', k2) =>
+                                                                  if n' = n then
+                                                                      SOME k2
+                                                                  else
+                                                                      NONE) nks2 of
+                                             NONE => p :: nks
+                                           | SOME k2 => (unifyKinds' env k1 k2;
+                                                         nks)) nks2 nks1
+
+                     val k = (L'.KTupleUnif (loc, nks, ref (L'.KUnknown (fn x => f1 x andalso f2 x))), loc)
+                 in
+                     r1 := L'.KKnown k;
+                     r2 := L'.KKnown k
+                 end
+
+           | _ => err KIncompatible
+     end
+
+ exception KUnify of L'.kind * L'.kind * E.env * kunify_error
+
+ fun unifyKinds env k1 k2 =
+     unifyKinds' env k1 k2
+     handle KUnify' (env', err) => raise KUnify (k1, k2, env', err)
+
+ fun checkKind env c k1 k2 =
+     unifyKinds env k1 k2
+     handle KUnify (k1, k2, env', err) =>
+            conError env (WrongKind (c, k1, k2, env', err))
+
+ val dummy = ErrorMsg.dummySpan
+
+ val ktype = (L'.KType, dummy)
+ val kname = (L'.KName, dummy)
+ val ktype_record = (L'.KRecord ktype, dummy)
+
+ val cerror = (L'.CError, dummy)
+ val kerror = (L'.KError, dummy)
+ val eerror = (L'.EError, dummy)
+ val sgnerror = (L'.SgnError, dummy)
+ val strerror = (L'.StrError, dummy)
+
+ val int = ref cerror
+ val float = ref cerror
+ val string = ref cerror
+ val char = ref cerror
+ val table = ref cerror
+
+
+ local
+     val count = ref 0
+ in
+
+ fun resetKunif () = count := 0
+
+ fun kunif' f loc =
+     let
+         val n = !count
+         val s = if n <= 26 then
+                     str (chr (ord #"A" + n))
+                 else
+                     "U" ^ Int.toString (n - 26)
+     in
+         count := n + 1;
+         (L'.KUnif (loc, s, ref (L'.KUnknown f)), loc)
+     end
+
+ fun kunif env = kunif' (validateKind env)
+
+ end
+
+ local
+     val count = ref 0
+ in
+
+ fun resetCunif () = count := 0
+
+ fun cunif' f (loc, k) =
+     let
+         val n = !count
+         val s = if n < 26 then
+                     str (chr (ord #"A" + n))
+                 else
+                     "U" ^ Int.toString (n - 26)
+     in
+         count := n + 1;
+         (L'.CUnif (0, loc, k, s, ref (L'.Unknown f)), loc)
+     end
+
+ fun cunif env = cunif' (validateCon env)
+
+ end
+
+ fun elabKind env (k, loc) =
+     case k of
+         L.KType => (L'.KType, loc)
+       | L.KArrow (k1, k2) => (L'.KArrow (elabKind env k1, elabKind env k2), loc)
+       | L.KName => (L'.KName, loc)
+       | L.KRecord k => (L'.KRecord (elabKind env k), loc)
+       | L.KUnit => (L'.KUnit, loc)
+       | L.KTuple ks => (L'.KTuple (map (elabKind env) ks), loc)
+       | L.KWild => kunif env loc
+
+       | L.KVar s => (case E.lookupK env s of
+                          NONE =>
+                          (kindError env (UnboundKind (loc, s));
+                           kerror)
+                        | SOME n => (L'.KRel n, loc))
+       | L.KFun (x, k) => (L'.KFun (x, elabKind (E.pushKRel env x) k), loc)
+
+ fun mapKind (dom, ran, loc)=
+     (L'.KArrow ((L'.KArrow (dom, ran), loc),
+                 (L'.KArrow ((L'.KRecord dom, loc),
+                             (L'.KRecord ran, loc)), loc)), loc)
+
+ fun hnormKind (kAll as (k, _)) =
+     case k of
+         L'.KUnif (_, _, ref (L'.KKnown k)) => hnormKind k
+       | L'.KTupleUnif (_, _, ref (L'.KKnown k)) => hnormKind k
+       | _ => kAll
+
+ open ElabOps
+
+ fun elabConHead env (c as (_, loc)) k =
+     let
+         fun unravel (k, c) =
+             case hnormKind k of
+                 (L'.KFun (x, k'), _) =>
+                 let
+                     val u = kunif env loc
+                             
+                     val k'' = subKindInKind (0, u) k'
+                 in
+                     unravel (k'', (L'.CKApp (c, u), loc))
+                 end
+               | _ => (c, k)
+    in
+         unravel (k, c)
+    end
+
+ fun elabCon (env, denv) (c, loc) =
+     case c of
+         L.CAnnot (c, k) =>
+         let
+             val k' = elabKind env k
+             val (c', ck, gs) = elabCon (env, denv) c
+         in
+             checkKind env c' ck k';
+             (c', k', gs)
+         end
+
+       | L.TFun (t1, t2) =>
+         let
+             val (t1', k1, gs1) = elabCon (env, denv) t1
+             val (t2', k2, gs2) = elabCon (env, denv) t2
+         in
+             checkKind env t1' k1 ktype;
+             checkKind env t2' k2 ktype;
+             ((L'.TFun (t1', t2'), loc), ktype, gs1 @ gs2)
+         end
+       | L.TCFun (e, x, k, t) =>
+         let
+             val e' = elabExplicitness e
+             val k' = elabKind env k
+             val env' = E.pushCRel env x k'
+             val (t', tk, gs) = elabCon (env', D.enter denv) t
+         in
+             checkKind env t' tk ktype;
+             ((L'.TCFun (e', x, k', t'), loc), ktype, gs)
+         end
+       | L.TKFun (x, t) =>
+         let
+             val env' = E.pushKRel env x
+             val (t', tk, gs) = elabCon (env', denv) t
+         in
+             checkKind env t' tk ktype;
+             ((L'.TKFun (x, t'), loc), ktype, gs)
+         end
+       | L.TDisjoint (c1, c2, c) =>
+         let
+             val (c1', k1, gs1) = elabCon (env, denv) c1
+             val (c2', k2, gs2) = elabCon (env, denv) c2
+
+             val ku1 = kunif env loc
+             val ku2 = kunif env loc
+
+             val denv' = D.assert env denv (c1', c2')
+             val (c', k, gs4) = elabCon (env, denv') c
+         in
+             checkKind env c1' k1 (L'.KRecord ku1, loc);
+             checkKind env c2' k2 (L'.KRecord ku2, loc);
+             checkKind env c' k (L'.KType, loc);
+
+             ((L'.TDisjoint (c1', c2', c'), loc), k, gs1 @ gs2 @ gs4)
+         end
+       | L.TRecord c =>
+         let
+             val (c', ck, gs) = elabCon (env, denv) c
+             val k = (L'.KRecord ktype, loc)
+         in
+             checkKind env c' ck k;
+             ((L'.TRecord c', loc), ktype, gs)
+         end
+
+       | L.CVar ([], s) =>
+         (case E.lookupC env s of
+              E.NotBound =>
+              (conError env (UnboundCon (loc, s));
+               (cerror, kerror, []))
+            | E.Rel (n, k) =>
+              let
+                  val (c, k) = elabConHead env (L'.CRel n, loc) k
+              in
+                  (c, k, [])
+              end
+            | E.Named (n, k) =>
+              let
+                  val (c, k) = elabConHead env (L'.CNamed n, loc) k
+              in
+                  (c, k, [])
+              end)
+       | L.CVar (m1 :: ms, s) =>
+         (case E.lookupStr env m1 of
+              NONE => (conError env (UnboundStrInCon (loc, m1));
+                       (cerror, kerror, []))
+            | SOME (n, sgn) =>
+              let
+                  val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                      case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                          NONE => (conError env (UnboundStrInCon (loc, m));
+                                                   (strerror, sgnerror))
+                                        | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                   ((L'.StrVar n, loc), sgn) ms
+
+                  val (c, k) = case E.projectCon env {sgn = sgn, str = str, field = s} of
+                                   NONE => (conError env (UnboundCon (loc, s));
+                                            (cerror, kerror))
+                                 | SOME (k, _) => elabConHead env (L'.CModProj (n, ms, s), loc) k
+              in
+                  (c, k, [])
+              end)
+
+       | L.CApp (c1, c2) =>
+         let
+             val (c1', k1, gs1) = elabCon (env, denv) c1
+             val (c2', k2, gs2) = elabCon (env, denv) c2
+             val dom = kunif env loc
+             val ran = kunif env loc
+         in
+             checkKind env c1' k1 (L'.KArrow (dom, ran), loc);
+             checkKind env c2' k2 dom;
+             ((L'.CApp (c1', c2'), loc), ran, gs1 @ gs2)
+         end
+       | L.CAbs (x, ko, t) =>
+         let
+             val k' = case ko of
+                          NONE => kunif env loc
+                        | SOME k => elabKind env k
+             val env' = E.pushCRel env x k'
+             val (t', tk, gs) = elabCon (env', D.enter denv) t
+         in
+             ((L'.CAbs (x, k', t'), loc),
+              (L'.KArrow (k', tk), loc),
+              gs)
+         end
+       | L.CKAbs (x, t) =>
+         let
+             val env' = E.pushKRel env x
+             val (t', tk, gs) = elabCon (env', denv) t
+         in
+             ((L'.CKAbs (x, t'), loc),
+              (L'.KFun (x, tk), loc),
+              gs)
+         end
+
+       | L.CName s =>
+         ((L'.CName s, loc), kname, [])
+
+       | L.CRecord xcs =>
+         let
+             val k = kunif env loc
+
+             val (xcs', gs) = ListUtil.foldlMap (fn ((x, c), gs) =>
+                                                    let
+                                                        val (x', xk, gs1) = elabCon (env, denv) x
+                                                        val (c', ck, gs2) = elabCon (env, denv) c
+                                                    in
+                                                        checkKind env x' xk kname;
+                                                        checkKind env c' ck k;
+                                                        ((x', c'), gs1 @ gs2 @ gs)
+                                                    end) [] xcs
+
+             val rc = (L'.CRecord (k, xcs'), loc)
+             (* Add duplicate field checking later. *)
+
+             fun prove (xcs, ds) =
+                 case xcs of
+                     [] => ds
+                   | xc :: rest =>
+                     let
+                         val r1 = (L'.CRecord (k, [xc]), loc)
+                         val ds = foldl (fn (xc', ds) =>
+                                            let
+                                                val r2 = (L'.CRecord (k, [xc']), loc)
+                                            in
+                                                D.prove env denv (r1, r2, loc) @ ds
+                                            end)
+                                  ds rest
+                     in
+                         prove (rest, ds)
+                     end
+         in
+             (rc, (L'.KRecord k, loc), prove (xcs', gs))
+         end
+       | L.CConcat (c1, c2) =>
+         let
+             val (c1', k1, gs1) = elabCon (env, denv) c1
+             val (c2', k2, gs2) = elabCon (env, denv) c2
+             val ku = kunif env loc
+             val k = (L'.KRecord ku, loc)
+         in
+             checkKind env c1' k1 k;
+             checkKind env c2' k2 k;
+             ((L'.CConcat (c1', c2'), loc), k,
+              D.prove env denv (c1', c2', loc) @ gs1 @ gs2)
+         end
+       | L.CMap =>
+         let
+             val dom = kunif env loc
+             val ran = kunif env loc
+         in
+             ((L'.CMap (dom, ran), loc),
+              mapKind (dom, ran, loc),
+              [])
+         end
+
+       | L.CUnit => ((L'.CUnit, loc), (L'.KUnit, loc), [])
+
+       | L.CTuple cs =>
+         let
+             val (cs', ks, gs) = foldl (fn (c, (cs', ks, gs)) =>
+                                           let
+                                               val (c', k, gs') = elabCon (env, denv) c
+                                           in
+                                               (c' :: cs', k :: ks, gs' @ gs)
+                                           end) ([], [], []) cs
+         in
+             ((L'.CTuple (rev cs'), loc), (L'.KTuple (rev ks), loc), gs)
+         end
+       | L.CProj (c, n) =>
+         let
+             val (c', k, gs) = elabCon (env, denv) c
+
+             val k' = kunif env loc
+         in
+             if n <= 0 then
+                 (conError env (ProjBounds (c', n));
+                  (cerror, kerror, []))
+             else
+                 (checkKind env c' k (L'.KTupleUnif (loc, [(n, k')], ref (L'.KUnknown (validateKind env))), loc);
+                  ((L'.CProj (c', n), loc), k', gs))
+         end
+
+       | L.CWild k =>
+         let
+             val k' = elabKind env k
+         in
+             (cunif env (loc, k'), k', [])
+         end
+
+ fun kunifsRemain k =
+     case k of
+         L'.KUnif (_, _, ref (L'.KUnknown _)) => true
+       | L'.KTupleUnif (_, _, ref (L'.KUnknown _)) => true
+       | _ => false
+ fun cunifsRemain c =
+     case c of
+         L'.CUnif (_, loc, k, _, r as ref (L'.Unknown _)) =>
+         (case #1 (hnormKind k) of
+              L'.KUnit => (r := L'.Known (L'.CUnit, loc); false)
+            | _ => true)
+       | _ => false
+
+ val kunifsInDecl = U.Decl.exists {kind = kunifsRemain,
+                                   con = fn _ => false,
+                                   exp = fn _ => false,
+                                   sgn_item = fn _ => false,
+                                   sgn = fn _ => false,
+                                   str = fn _ => false,
+                                   decl = fn _ => false}
+
+ val cunifsInDecl = U.Decl.exists {kind = fn _ => false,
+                                   con = cunifsRemain,
+                                   exp = fn _ => false,
+                                   sgn_item = fn _ => false,
+                                   sgn = fn _ => false,
+                                   str = fn _ => false,
+                                   decl = fn _ => false}
+
+ fun occursCon r =
+     U.Con.exists {kind = fn _ => false,
+                   con = fn L'.CUnif (_, _, _, _, r') => r = r'
+                          | _ => false}
+
+ exception CUnify' of E.env * cunify_error
+
+ type record_summary = {
+      fields : (L'.con * L'.con) list,
+      unifs : (L'.con * L'.cunif ref) list,
+      others : L'.con list
+ }
+
+ fun summaryToCon {fields, unifs, others} =
+     let
+         fun concat (c1, c2) =
+             case #1 c1 of
+                 L'.CRecord (_, []) => c2
+               | _ => case #1 c2 of
+                          L'.CRecord (_, []) => c1
+                        | _ => (L'.CConcat (c1, c2), dummy)
+
+         val c = (L'.CRecord (ktype, []), dummy)
+         val c = List.foldr concat c others
+         val c = List.foldr (fn ((c', _), c) => concat (c', c)) c unifs
+     in
+         concat ((L'.CRecord (ktype, fields), dummy), c)
+     end
+
+ fun p_summary env s = p_con env (summaryToCon s)
+
+ exception CUnify of L'.con * L'.con * E.env * cunify_error
+
+ fun kindof env (c, loc) =
+     case c of
+         L'.TFun _ => ktype
+       | L'.TCFun _ => ktype
+       | L'.TRecord _ => ktype
+       | L'.TDisjoint _ => ktype
+
+       | L'.CRel xn => #2 (E.lookupCRel env xn)
+       | L'.CNamed xn => #2 (E.lookupCNamed env xn)
+       | L'.CModProj (n, ms, x) =>
+         let
+             val (_, sgn) = E.lookupStrNamed env n
+             val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                        case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                            NONE => raise Fail "kindof: Unknown substructure"
+                                          | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                              ((L'.StrVar n, loc), sgn) ms
+         in
+             case E.projectCon env {sgn = sgn, str = str, field = x} of
+                 NONE => raise Fail "kindof: Unknown con in structure"
+               | SOME (k, _) => k
+         end
+
+       | L'.CApp (c, _) =>
+         (case hnormKind (kindof env c) of
+              (L'.KArrow (_, k), _) => k
+            | (L'.KError, _) => kerror
+            | k => raise CUnify' (env, CKindof (k, c, "arrow")))
+       | L'.CAbs (x, k, c) => (L'.KArrow (k, kindof (E.pushCRel env x k) c), loc)
+
+
+       | L'.CName _ => kname
+
+       | L'.CRecord (k, _) => (L'.KRecord k, loc)
+       | L'.CConcat (c, _) => kindof env c
+       | L'.CMap (dom, ran) => mapKind (dom, ran, loc)
+
+       | L'.CUnit => (L'.KUnit, loc)
+
+       | L'.CTuple cs => (L'.KTuple (map (kindof env) cs), loc)
+       | L'.CProj (c, n) =>
+         (case hnormKind (kindof env c) of
+              (L'.KTuple ks, _) => List.nth (ks, n - 1)
+            | (L'.KUnif (_, _, r), _) =>
+              let
+                  val ku = kunif env loc
+                  val k = (L'.KTupleUnif (loc, [(n, ku)], ref (L'.KUnknown (fn _ => true))), loc)
+              in
+                  r := L'.KKnown k;
+                  ku
+              end
+            | (L'.KTupleUnif (_, nks, r), _) =>
+              (case ListUtil.search (fn (n', k) => if n' = n then SOME k else NONE) nks of
+                   SOME k => k
+                 | NONE =>
+                   let
+                       val ku = kunif env loc
+                       val k = (L'.KTupleUnif (loc, ((n, ku) :: nks), ref (L'.KUnknown (fn _ => true))), loc)
+                   in
+                       r := L'.KKnown k;
+                       ku
+                   end)
+            | k => raise CUnify' (env, CKindof (k, c, "tuple")))
+
+       | L'.CError => kerror
+       | L'.CUnif (_, _, k, _, _) => k
+
+       | L'.CKAbs (x, c) => (L'.KFun (x, kindof (E.pushKRel env x) c), loc)
+       | L'.CKApp (c, k) =>
+         (case hnormKind (kindof env c) of
+              (L'.KFun (_, k'), _) => subKindInKind (0, k) k'
+            | k => raise CUnify' (env, CKindof (k, c, "kapp")))
+       | L'.TKFun _ => ktype
+
+ exception GuessFailure
+
+ fun isUnitCon env (c, loc) =
+     case c of
+         L'.TFun _ => false
+       | L'.TCFun _ => false
+       | L'.TRecord _ => false
+       | L'.TDisjoint _ => false
+
+       | L'.CRel xn => #1 (hnormKind (#2 (E.lookupCRel env xn))) = L'.KUnit
+       | L'.CNamed xn => #1 (hnormKind (#2 (E.lookupCNamed env xn))) = L'.KUnit
+       | L'.CModProj (n, ms, x) => false
+         (*let
+             val (_, sgn) = E.lookupStrNamed env n
+             val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                        case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                            NONE => raise Fail "kindof: Unknown substructure"
+                                          | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                              ((L'.StrVar n, loc), sgn) ms
+         in
+             case E.projectCon env {sgn = sgn, str = str, field = x} of
+                 NONE => raise Fail "kindof: Unknown con in structure"
+               | SOME ((k, _), _) => k = L'.KUnit
+         end*)
+
+       | L'.CApp (c, _) => false
+         (*(case hnormKind (kindof env c) of
+              (L'.KArrow (_, k), _) => #1 k = L'.KUnit
+            | (L'.KError, _) => false
+            | k => raise CUnify' (CKindof (k, c, "arrow")))*)
+       | L'.CAbs _ => false
+
+       | L'.CName _ => false
+
+       | L'.CRecord _ => false
+       | L'.CConcat _ => false
+       | L'.CMap _ => false
+
+       | L'.CUnit => true
+
+       | L'.CTuple _ => false
+       | L'.CProj (c, n) => false
+         (*(case hnormKind (kindof env c) of
+              (L'.KTuple ks, _) => #1 (List.nth (ks, n - 1)) = L'.KUnit
+            | k => raise CUnify' (CKindof (k, c, "tuple")))*)
+
+       | L'.CError => false
+       | L'.CUnif (_, _, k, _, _) => #1 (hnormKind k) = L'.KUnit
+
+       | L'.CKAbs _ => false
+       | L'.CKApp _ => false
+       | L'.TKFun _ => false
+
+ val recdCounter = ref 0
+
+ val mayDelay = ref false
+ val delayedUnifs = ref ([] : (ErrorMsg.span * E.env * L'.kind * record_summary * record_summary) list)
+
+ val delayedExhaustives = ref ([] : (E.env * L'.con * L'.pat list * ErrorMsg.span) list)
+
+ exception CantSquish
+
+ fun squish by =
+     U.Con.mapB {kind = fn _ => fn k => k,
+                 con = fn bound => fn c =>
+                                      case c of
+                                          L'.CRel xn =>
+                                          if xn < bound then
+                                              c
+                                          else if bound <= xn andalso xn < bound + by then
+                                              raise CantSquish
+                                          else
+                                              L'.CRel (xn - by)
+                                        | L'.CUnif _ => raise CantSquish
+                                        | _ => c,
+                 bind = fn (bound, U.Con.RelC _) => bound + 1
+                         | (bound, _) => bound} 0
+
+ val reducedSummaries = ref (NONE : (Print.PD.pp_desc * Print.PD.pp_desc) option)
+
+ fun unifyRecordCons env (loc, c1, c2) =
+     let
+         fun rkindof c =
+             case hnormKind (kindof env c) of
+                 (L'.KRecord k, _) => k
+               | (L'.KError, _) => kerror
+               | (L'.KUnif (_, _, r as ref (L'.KUnknown f)), _) =>
+                 let
+                     val k = kunif' f (#2 c)
+                 in
+                     r := L'.KKnown (L'.KRecord k, #2 c);
+                     k
+                 end
+               | k => raise CUnify' (env, CKindof (k, c, "record"))
+
+         val k1 = rkindof c1
+         val k2 = rkindof c2
+
+         val r1 = recordSummary env c1
+         val r2 = recordSummary env c2
+     in
+         unifyKinds env k1 k2;
+         unifySummaries env (loc, k1, r1, r2)
+     end
+
+ and normalizeRecordSummary env (r : record_summary) =
+     recordSummary env (summaryToCon r)
+
+ and recordSummary env c =
+     let
+         val c = hnormCon env c
+
+         val sum =
+             case c of
+                 (L'.CRecord (_, xcs), _) => {fields = map (fn (x, c) => (hnormCon env x, hnormCon env c)) xcs,
+                                              unifs = [], others = []}
+               | (L'.CConcat (c1, c2), _) =>
+                 let
+                     val s1 = recordSummary env c1
+                     val s2 = recordSummary env c2
+                 in
+                     {fields = #fields s1 @ #fields s2,
+                      unifs = #unifs s1 @ #unifs s2,
+                      others = #others s1 @ #others s2}
+                 end
+               | (L'.CUnif (nl, _, _, _, ref (L'.Known c)), _) => recordSummary env (E.mliftConInCon nl c)
+               | c' as (L'.CUnif (0, _, _, _, r), _) => {fields = [], unifs = [(c', r)], others = []}
+               | c' => {fields = [], unifs = [], others = [c']}
+     in
+         sum
+     end
+
+ and consEq env loc (c1, c2) =
+     let
+         val mayDelay' = !mayDelay
+     in
+         (mayDelay := false;
+          unifyCons env loc c1 c2;
+          mayDelay := mayDelay';
+          true)
+         handle CUnify _ => (mayDelay := mayDelay'; false)
+     end
+
+ and consNeq env (c1, c2) =
+     case (#1 (hnormCon env c1), #1 (hnormCon env c2)) of
+         (L'.CName x1, L'.CName x2) => x1 <> x2
+       | (L'.CName _, L'.CRel _) => true
+       | (L'.CRel _, L'.CName _) => true
+       | (L'.CRel n1, L'.CRel n2) => n1 <> n2
+       | (L'.CRel _, L'.CNamed _) => true
+       | (L'.CNamed _, L'.CRel _) => true
+       | (L'.CRel _, L'.CModProj _) => true
+       | (L'.CModProj _, L'.CRel _) => true
+       | (L'.CModProj (_, _, n1), L'.CModProj (_, _, n2)) => n1 <> n2
+       | (L'.CModProj _, L'.CName _) => true
+       | (L'.CName _, L'.CModProj _) => true
+       | (L'.CNamed _, L'.CName _) => true
+       | (L'.CName _, L'.CNamed _) => true
+       | _ => false
+
+ and unifySummaries env (loc, k, s1 : record_summary, s2 : record_summary) =
+     let
+         val () = reducedSummaries := NONE
+
+         (*val () = eprefaces "Summaries" [("loc", PD.string (ErrorMsg.spanToString loc)),
+                                         ("#1", p_summary env s1),
+                                         ("#2", p_summary env s2)]*)
+
+         fun eatMatching p (ls1, ls2) =
+             let
+                 fun em (ls1, ls2, passed1) =
+                     case ls1 of
+                         [] => (rev passed1, ls2)
+                       | h1 :: t1 =>
+                         let
+                             fun search (ls2', passed2) =
+                                 case ls2' of
+                                     [] => em (t1, ls2, h1 :: passed1)
+                                   | h2 :: t2 =>
+                                     if p (h1, h2) then
+                                         em (t1, List.revAppend (passed2, t2), passed1)
+                                     else
+                                         search (t2, h2 :: passed2)
+                         in
+                             search (ls2, [])
+                         end
+             in
+                 em (ls1, ls2, [])
+             end
+
+         val (fs1, fs2) = eatMatching (fn ((x1, c1), (x2, c2)) =>
+                                          not (consNeq env (x1, x2))
+                                          andalso consEq env loc (c1, c2)
+                                          andalso consEq env loc (x1, x2))
+                                      (#fields s1, #fields s2)
+         (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}),
+                                          ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*)
+
+         val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2)
+
+         val hasUnifs = U.Con.exists {kind = fn _ => false,
+                                      con = fn L'.CUnif _ => true
+                                             | _ => false}
+
+         val (others1, others2) = eatMatching (fn (c1, c2) =>
+                                                  c1 = c2
+                                                  orelse (not (hasUnifs c1 andalso hasUnifs c2)
+                                                          andalso consEq env loc (c1, c2))) (#others s1, #others s2)
+         (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
+                                          ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
+
+         fun unsummarize {fields, unifs, others} =
+             let
+                 val c = (L'.CRecord (k, fields), loc)
+
+                 val c = foldl (fn ((c1, _), c2) => (L'.CConcat (c1, c2), loc))
+                               c unifs
+             in
+                 foldl (fn (c1, c2) => (L'.CConcat (c1, c2), loc))
+                       c others
+             end
+
+         val empties = ([], [], [], [], [], [])
+
+         val (unifs1, fs1, others1, unifs2, fs2, others2) =
+             case (unifs1, fs1, others1, unifs2, fs2, others2) of
+                 orig as ([(_, r as ref (L'.Unknown f))], [], [], _, _, _) =>
+                 let
+                     val c = unsummarize {fields = fs2, others = others2, unifs = unifs2}
+                 in
+                     if occursCon r c orelse not (f c) then
+                         orig
+                     else
+                         (r := L'.Known c;
+                          empties)
+                 end
+               | orig as (_, _, _, [(_, r as ref (L'.Unknown f))], [], []) =>
+                 let
+                     val c = unsummarize {fields = fs1, others = others1, unifs = unifs1}
+                 in
+                     if occursCon r c orelse not (f c) then
+                         orig
+                     else
+                         (r := L'.Known c;
+                          empties)
+                 end
+               | orig as ([(_, r1 as ref (L'.Unknown f1))], _, [], [(_, r2 as ref (L'.Unknown f2))], _, []) =>
+                 if List.all (fn (x1, _) => List.all (fn (x2, _) => consNeq env (x1, x2)) fs2) fs1 then
+                     let
+                         val kr = (L'.KRecord k, loc)
+                         val u = cunif env (loc, kr)
+
+                         val c1 = (L'.CConcat ((L'.CRecord (k, fs2), loc), u), loc)
+                         val c2 = (L'.CConcat ((L'.CRecord (k, fs1), loc), u), loc)
+                     in
+                         if not (f1 c1) orelse not (f2 c2) then
+                             orig
+                         else
+                             (r1 := L'.Known c1;
+                              r2 := L'.Known c2;
+                              empties)
+                     end
+                 else
+                     orig
+               | orig => orig
+
+         (*val () = eprefaces "Summaries4" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
+                                          ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
+
+         fun isGuessable (other, fs, unifs) =
+             let
+                 val c = (L'.CRecord (k, fs), loc)
+                 val c = foldl (fn ((c', _), c) => (L'.CConcat (c', c), loc)) c unifs
+             in
+                 (guessMap env loc (other, c, GuessFailure);
+                  true)
+                 handle GuessFailure => false
+             end
+
+         val (fs1, fs2, others1, others2, unifs1, unifs2) =
+             case (fs1, fs2, others1, others2, unifs1, unifs2) of
+                 ([], _, [other1], [], [], _) =>
+                 if isGuessable (other1, fs2, unifs2) then
+                     ([], [], [], [], [], [])
+                 else
+                     (fs1, fs2, others1, others2, unifs1, unifs2)
+               | (_, [], [], [other2], _, []) =>
+                  if isGuessable (other2, fs1, unifs1) then
+                      ([], [], [], [], [], [])
+                  else
+                      (fs1, fs2, others1, others2, unifs1, unifs2)
+               | _ => (fs1, fs2, others1, others2, unifs1, unifs2)
+
+         val () = if !mayDelay then
+                      ()
+                  else
+                      let
+                          val c1 = summaryToCon {fields = fs1, unifs = unifs1, others = others1}
+                          val c2 = summaryToCon {fields = fs2, unifs = unifs2, others = others2}
+                      in
+                          case (c1, c2) of
+                              ((L'.CRecord (_, []), _), (L'.CRecord (_, []), _)) => reducedSummaries := NONE
+                            | _ => reducedSummaries := SOME (p_con env c1, p_con env c2)
+                      end
+
+         (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
+                                          ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
+
+         val empty = (L'.CRecord (k, []), loc)
+         fun failure () =
+             let
+                 val fs2 = #fields s2
+
+                 fun findPointwise fs1 =
+                     case fs1 of
+                         [] => NONE
+                       | (nm1, c1) :: fs1 =>
+                         case List.find (fn (nm2, _) => consEq env loc (nm1, nm2)) fs2 of
+                             NONE => findPointwise fs1
+                           | SOME (_, c2) =>
+                             if consEq env loc (c1, c2) then
+                                 findPointwise fs1
+                             else
+                                 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE)
+                                                    handle CUnify (_, _, env', err) => (reducedSummaries := NONE;
+                                                                                        SOME (env', err)))
+             in
+                 raise CUnify' (env, CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1)))
+             end
+
+         fun default () = if !mayDelay then
+                              delayedUnifs := (loc, env, k, s1, s2) :: !delayedUnifs
+                          else
+                              failure ()
+     in
+         (case (unifs1, fs1, others1, unifs2, fs2, others2) of
+              (_, [], [], [], [], []) =>
+              app (fn (_, r) => r := L'.Known empty) unifs1
+            | ([], [], [], _, [], []) =>
+              app (fn (_, r) => r := L'.Known empty) unifs2
+            | (_, _, _, [], [], [cr as (L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f)), _)]) =>
+              let
+                  val c = summaryToCon {fields = fs1, unifs = unifs1, others = others1}
+              in
+                  if occursCon r c then
+                      (reducedSummaries := NONE;
+                       raise CUnify' (env, COccursCheckFailed (cr, c)))
+                  else
+                      let
+                          val sq = squish nl c
+                      in
+                          if not (f sq) then
+                              default ()
+                          else
+                              r := L'.Known sq
+                      end
+                      handle CantSquish => default ()
+              end
+            | ([], [], [cr as (L'.CUnif (nl, _, _, _, r as ref (L'.Unknown f)), _)], _, _, _) =>
+              let
+                  val c = summaryToCon {fields = fs2, unifs = unifs2, others = others2}
+              in
+                  if occursCon r c then
+                      (reducedSummaries := NONE;
+                       raise CUnify' (env, COccursCheckFailed (cr, c)))
+                  else
+                      let
+                          val sq = squish nl c
+                      in
+                          if not (f sq) then
+                              default ()
+                          else
+                              r := L'.Known sq
+                      end
+                      handle CantSquish => default ()
+              end
+            | _ => default ())
+          
+         (*before eprefaces "Summaries'" [("#1", p_summary env (normalizeRecordSummary env s1)),
+                                        ("#2", p_summary env (normalizeRecordSummary env s2))]*)
+     end
+
+ and guessMap env loc (c1, c2, ex) =
+     let
+         fun unfold (dom, ran, f, r, c) =
+             let
+                 fun unfold (r, c) =
+                     case #1 (hnormCon env c) of
+                         L'.CRecord (_, []) => unifyCons env loc r (L'.CRecord (dom, []), loc)
+                       | L'.CRecord (_, [(x, v)]) =>
+                         let
+                             val v' = case dom of
+                                          (L'.KUnit, _) => (L'.CUnit, loc)
+                                        | _ => cunif env (loc, dom)
+                         in
+                             unifyCons env loc v (L'.CApp (f, v'), loc);
+                             unifyCons env loc r (L'.CRecord (dom, [(x, v')]), loc)
+                         end
+                       | L'.CRecord (_, (x, v) :: rest) =>
+                         let
+                             val r1 = cunif env (loc, (L'.KRecord dom, loc))
+                             val r2 = cunif env (loc, (L'.KRecord dom, loc))
+                         in
+                             unfold (r1, (L'.CRecord (ran, [(x, v)]), loc));
+                             unfold (r2, (L'.CRecord (ran, rest), loc));
+                             unifyCons env loc r (L'.CConcat (r1, r2), loc)
+                         end
+                       | L'.CConcat (c1', c2') =>
+                         let
+                             val r1 = cunif env (loc, (L'.KRecord dom, loc))
+                             val r2 = cunif env (loc, (L'.KRecord dom, loc))
+                         in
+                             unfold (r1, c1');
+                             unfold (r2, c2');
+                             unifyCons env loc r (L'.CConcat (r1, r2), loc)
+                         end
+                       | L'.CUnif (0, _, _, _, ur as ref (L'.Unknown rf)) =>
+                         let
+                             val c' = (L'.CApp ((L'.CApp ((L'.CMap (dom, ran), loc), f), loc), r), loc)
+                         in
+                             if not (rf c') then
+                                 cunifyError env (CScope (c, c'))
+                             else
+                                 ur := L'.Known c'
+                         end
+                       | _ => raise ex
+             in
+                 unfold (r, c)
+             end
+             handle _ => raise ex
+     in
+         case (#1 c1, #1 c2) of
+             (L'.CApp ((L'.CApp ((L'.CMap (dom, ran), _), f), _), r), _) =>
+             unfold (dom, ran, f, r, c2)
+           | (_, L'.CApp ((L'.CApp ((L'.CMap (dom, ran), _), f), _), r)) =>
+             unfold (dom, ran, f, r, c1)
+           | _ => raise ex
+     end
+
+ and unifyCons' env loc c1 c2 =
+     if isUnitCon env c1 andalso isUnitCon env c2 then
+         ()
+     else
+         let
+             (*val befor = Time.now ()
+              val old1 = c1
+              val old2 = c2*)
+             val c1 = hnormCon env c1
+             val c2 = hnormCon env c2
+         in
+             unifyCons'' env loc c1 c2
+             handle ex => guessMap env loc (c1, c2, ex)
+         end
+
+ and unifyCons'' env loc (c1All as (c1, _)) (c2All as (c2, _)) =
+     let
+         fun err f = raise CUnify' (env, f (c1All, c2All))
+
+         fun projSpecial1 (c1, n1, onFail) =
+             let
+                 fun trySnd () =
+                     case #1 (hnormCon env c2All) of
+                         L'.CProj (c2, n2) =>
+                         let
+                             fun tryNormal () =
+                                 if n1 = n2 then
+                                     unifyCons' env loc c1 c2
+                                 else
+                                     onFail ()
+                         in
+                             case #1 (hnormCon env c2) of
+                                 L'.CUnif (0, _, k, _, r as ref (L'.Unknown f)) =>
+                                 (case #1 (hnormKind k) of
+                                      L'.KTuple ks =>
+                                      let
+                                          val loc = #2 c2
+                                          val us = map (fn k => cunif' f (loc, k)) ks
+                                      in
+                                          r := L'.Known (L'.CTuple us, loc);
+                                          unifyCons' env loc c1All (List.nth (us, n2 - 1))
+                                      end
+                                    | _ => tryNormal ())
+                            | _ => tryNormal ()
+                         end
+                       | _ => onFail ()
+             in
+                 case #1 (hnormCon env c1) of
+                     L'.CUnif (0, _, k, _, r as ref (L'.Unknown f)) =>
+                     (case #1 (hnormKind k) of
+                          L'.KTuple ks =>
+                          let
+                              val loc = #2 c1
+                              val us = map (fn k => cunif' f (loc, k)) ks
+                          in
+                              r := L'.Known (L'.CTuple us, loc);
+                              unifyCons' env loc (List.nth (us, n1 - 1)) c2All
+                          end
+                        | _ => trySnd ())
+                   | _ => trySnd ()
+             end
+
+         fun projSpecial2 (c2, n2, onFail) =
+             case #1 (hnormCon env c2) of
+                 L'.CUnif (0, _, k, _, r as ref (L'.Unknown f)) =>
+                 (case #1 (hnormKind k) of
+                      L'.KTuple ks =>
+                      let
+                          val loc = #2 c2
+                          val us = map (fn k => cunif' f (loc, k)) ks
+                      in
+                          r := L'.Known (L'.CTuple us, loc);
+                          unifyCons' env loc c1All (List.nth (us, n2 - 1))
+                      end
+                    | _ => onFail ())
+               | _ => onFail ()
+
+         fun isRecord' () = unifyRecordCons env (loc, c1All, c2All)
+
+         fun isRecord () =
+             case (c1, c2) of
+                 (L'.CProj (c1, n1), _) => projSpecial1 (c1, n1, isRecord')
+               | (_, L'.CProj (c2, n2)) => projSpecial2 (c2, n2, isRecord')
+               | _ => isRecord' ()
+
+         fun maybeIsRecord c =
+             case c of
+                 L'.CRecord _ => isRecord ()
+               | L'.CConcat _ => isRecord ()
+               | _ => err COccursCheckFailed
+     in
+         (*eprefaces "unifyCons''" [("c1", p_con env c1All),
+                                  ("c2", p_con env c2All)];*)
+
+         (case (c1, c2) of
+             (L'.CError, _) => ()
+           | (_, L'.CError) => ()
+
+           | (L'.CUnif (nl1, loc1, k1, _, r1 as ref (L'.Unknown f1)), L'.CUnif (nl2, loc2, k2, _, r2 as ref (L'.Unknown f2))) =>
+             if r1 = r2 then
+                 if nl1 = nl2 then
+                     ()
+                 else
+                     err (fn _ => TooLifty (loc1, loc2))
+             else if nl1 = 0 then
+                 (unifyKinds env k1 k2;
+                  if f1 c2All then
+                      r1 := L'.Known c2All
+                  else
+                      err CScope)
+             else if nl2 = 0 then
+                 (unifyKinds env k1 k2;
+                  if f2 c1All then
+                      r2 := L'.Known c1All
+                  else
+                      err CScope)
+             else
+                 err (fn _ => TooLifty (loc1, loc2))
+
+           | (L'.CUnif (0, _, k1, _, r as ref (L'.Unknown f)), _) =>
+             (unifyKinds env k1 (kindof env c2All);
+              if occursCon r c2All then
+                  maybeIsRecord c2
+              else if f c2All then
+                  r := L'.Known c2All
+              else
+                  err CScope)
+           | (_, L'.CUnif (0, _, k2, _, r as ref (L'.Unknown f))) =>
+             (unifyKinds env (kindof env c1All) k2;
+              if occursCon r c1All then
+                  maybeIsRecord c1
+              else if f c1All then
+                  r := L'.Known c1All
+              else
+                  err CScope)
+
+           | (L'.CUnif (nl, _, k1, _, r as ref (L'.Unknown f)), _) =>
+             if occursCon r c2All then
+                 maybeIsRecord c2
+             else
+                 (unifyKinds env k1 (kindof env c2All);
+                  let
+                      val sq = squish nl c2All
+                  in
+                      if f sq then
+                          r := L'.Known sq
+                      else
+                          err CScope
+                  end
+                  handle CantSquish => err (fn _ => TooDeep))
+           | (_, L'.CUnif (nl, _, k2, _, r as ref (L'.Unknown f))) =>
+             if occursCon r c1All then
+                 maybeIsRecord c1
+             else
+                 (unifyKinds env (kindof env c1All) k2;
+                  let
+                      val sq = squish nl c1All
+                  in
+                      if f sq then
+                          r := L'.Known sq
+                      else
+                          err CScope
+                  end
+                  handle CantSquish => err (fn _ => TooDeep))
+
+           | (L'.CRecord _, _) => isRecord ()
+           | (_, L'.CRecord _) => isRecord ()
+           | (L'.CConcat _, _) => isRecord ()
+           | (_, L'.CConcat _) => isRecord ()
+
+
+           | (L'.CUnit, L'.CUnit) => ()
+
+           | (L'.TFun (d1, r1), L'.TFun (d2, r2)) =>
+             (unifyCons' env loc d1 d2;
+              unifyCons' env loc r1 r2)
+           | (L'.TCFun (expl1, x1, d1, r1), L'.TCFun (expl2, _, d2, r2)) =>
+             if expl1 <> expl2 then
+                 err CExplicitness
+             else
+                 (unifyKinds env d1 d2;
+                  let
+                      (*val befor = Time.now ()*)
+                      val env' = E.pushCRel env x1 d1
+                  in
+                      (*TextIO.print ("E.pushCRel: "
+                                    ^ LargeReal.toString (Time.toReal (Time.- (Time.now (), befor)))
+                                    ^ "\n");*)
+                      unifyCons' env' loc r1 r2
+                  end)
+           | (L'.TRecord r1, L'.TRecord r2) => unifyCons' env loc r1 r2
+           | (L'.TDisjoint (c1, d1, e1), L'.TDisjoint (c2, d2, e2)) =>
+             (unifyCons' env loc c1 c2;
+              unifyCons' env loc d1 d2;
+              unifyCons' env loc e1 e2)
+
+           | (L'.CRel n1, L'.CRel n2) =>
+             if n1 = n2 then
+                 ()
+             else
+                 err CIncompatible
+           | (L'.CNamed n1, L'.CNamed n2) =>
+             if n1 = n2 then
+                 ()
+             else
+                 err CIncompatible
+
+           | (L'.CApp (d1, r1), L'.CApp (d2, r2)) =>
+             (unifyCons' env loc d1 d2;
+              unifyCons' env loc r1 r2)
+           | (L'.CAbs (x1, k1, c1), L'.CAbs (_, k2, c2)) =>
+             (unifyKinds env k1 k2;
+              unifyCons' (E.pushCRel env x1 k1) loc c1 c2)
+
+           | (L'.CName n1, L'.CName n2) =>
+             if n1 = n2 then
+                 ()
+             else
+                 err CIncompatible
+
+           | (L'.CModProj (n1, ms1, x1), L'.CModProj (n2, ms2, x2)) =>
+             if n1 = n2 andalso ms1 = ms2 andalso x1 = x2 then
+                 ()
+             else
+                 err CIncompatible
+
+           | (L'.CTuple cs1, L'.CTuple cs2) =>
+             ((ListPair.appEq (fn (c1, c2) => unifyCons' env loc c1 c2) (cs1, cs2))
+              handle ListPair.UnequalLengths => err CIncompatible)
+
+           | (L'.CProj (c1, n1), _) => projSpecial1 (c1, n1, fn () => err CIncompatible)
+           | (_, L'.CProj (c2, n2)) => projSpecial2 (c2, n2, fn () => err CIncompatible)
+
+           | (L'.CTuple cs, L'.CRel x) =>
+             (case hnormKind (kindof env c2All) of
+                  (L'.KTuple ks, _) =>
+                  if length cs <> length ks then
+                      err CIncompatible
+                  else
+                      let
+                          fun rightProjs (cs, n) =
+                              case cs of
+                                  c :: cs' =>
+                                  (case hnormCon env c of
+                                       (L'.CProj ((L'.CRel x', _), n'), _) =>
+                                       x' = x andalso n' = n andalso rightProjs (cs', n+1)
+                                     | _ => false)
+                                  | [] => true
+                      in
+                          if rightProjs (cs, 1) then
+                              ()
+                          else
+                              err CIncompatible
+                      end
+                | _ => err CIncompatible)
+           | (L'.CRel x, L'.CTuple cs) =>
+             unifyCons'' env loc c2All c1All
+
+           | (L'.CMap (dom1, ran1), L'.CMap (dom2, ran2)) =>
+             (unifyKinds env dom1 dom2;
+              unifyKinds env ran1 ran2)
+
+           | (L'.CKAbs (x, c1), L'.CKAbs (_, c2)) =>
+             unifyCons' (E.pushKRel env x) loc c1 c2
+           | (L'.CKApp (c1, k1), L'.CKApp (c2, k2)) =>
+             (unifyKinds env k1 k2;
+              unifyCons' env loc c1 c2)
+           | (L'.TKFun (x, c1), L'.TKFun (_, c2)) =>
+             unifyCons' (E.pushKRel env x) loc c1 c2
+
+           | _ => err CIncompatible)(*;
+        eprefaces "/unifyCons''" [("c1", p_con env c1All),
+                                  ("c2", p_con env c2All)]*)
+     end
+
+ and unifyCons env loc c1 c2 =
+     ((*Print.prefaces "uc" [("c1", p_con env c1),
+                           ("c2", p_con env c2)];*)
+     unifyCons' env loc c1 c2)
+     handle CUnify' (env', err) => raise CUnify (c1, c2, env', err)
+          | KUnify (arg as {3 = env', ...}) => raise CUnify (c1, c2, env', CKind arg)
+
+ fun checkCon env e c1 c2 =
+     unifyCons env (#2 e) c1 c2
+     handle CUnify (c1, c2, env', err) =>
+            expError env (Unify (e, c1, c2, env', err))
+
+ fun checkPatCon env p c1 c2 =
+     unifyCons env (#2 p) c1 c2
+     handle CUnify (c1, c2, env', err) =>
+            expError env (PatUnify (p, c1, c2, env', err))
+
+ fun primType env p =
+     case p of
+         P.Int _ => !int
+       | P.Float _ => !float
+       | P.String _ => !string
+       | P.Char _ => !char
+                           
+ datatype constraint =
+          Disjoint of D.goal
+        | TypeClass of E.env * L'.con * L'.exp option ref * ErrorMsg.span
+
+ fun relocConstraint loc c =
+     case c of
+         Disjoint (_, a, b, c, d) => Disjoint (loc, a, b, c, d)
+       | TypeClass (a, b, c, _) => TypeClass (a, b, c, loc)
+
+ val enD = map Disjoint
+
+ fun isClassOrFolder env cl =
+     E.isClass env cl
+     orelse case hnormCon env cl of
+                (L'.CKApp (cl, _), _) =>
+                (case hnormCon env cl of
+                     (L'.CModProj (top_n, [], "folder"), _) => top_n = !top_r
+                   | _ => false)
+              | _ => false
+
+ fun subConInCon env x y =
+     ElabOps.subConInCon x y
+     handle SubUnif => (cunifyError env (TooUnify (#2 x, y));
+                        cerror)
+
+ fun elabHead (env, denv) infer (e as (_, loc)) t =
+     let
+         fun unravelKind (t, e) =
+             case hnormCon env t of
+                 (L'.TKFun (x, t'), _) =>
+                 let
+                     val u = kunif env loc
+
+                     val t'' = subKindInCon (0, u) t'
+                 in
+                     unravelKind (t'', (L'.EKApp (e, u), loc))
+                 end
+               | t => (e, t, [])
+
+         fun unravel (t, e) =
+             case hnormCon env t of
+                 (L'.TKFun (x, t'), _) =>
+                 let
+                     val u = kunif env loc
+
+                     val t'' = subKindInCon (0, u) t'
+                 in
+                     unravel (t'', (L'.EKApp (e, u), loc))
+                 end
+               | (L'.TCFun (L'.Implicit, x, k, t'), _) =>
+                 let
+                     val u = cunif env (loc, k)
+
+                     val t'' = subConInCon env (0, u) t'
+                 in
+                     unravel (t'', (L'.ECApp (e, u), loc))
+                 end
+               | (L'.TFun (dom, ran), _) =>
+                 let
+                     fun default () = (e, t, [])
+
+                     fun isInstance () =
+                         if infer <> L.TypesOnly then
+                             let
+                                 val r = ref NONE
+                                 val (e, t, gs) = unravel (ran, (L'.EApp (e, (L'.EUnif r, loc)), loc))
+                             in
+                                 (e, t, TypeClass (env, dom, r, loc) :: gs)
+                             end
+                         else
+                             default ()
+
+                     fun hasInstance c =
+                         case hnormCon env c of
+                             (L'.TRecord c, _) => U.Con.exists {kind = fn _ => false,
+                                                                con = fn c =>
+                                                                         isClassOrFolder env (hnormCon env (c, loc))} c
+                           | c =>
+                             let
+                                 fun findHead c =
+                                     case #1 c of
+                                         L'.CApp (f, _) => findHead f
+                                       | _ => c
+                                 
+                                 val cl = hnormCon env (findHead c)
+                             in
+                                 isClassOrFolder env cl
+                             end
+                 in
+                     if hasInstance dom then
+                         isInstance ()
+                     else
+                         default ()
+                 end
+               | (L'.TDisjoint (r1, r2, t'), loc) =>
+                 if infer <> L.TypesOnly then
+                     let
+                         val gs = D.prove env denv (r1, r2, #2 e)
+                         val (e, t, gs') = unravel (t', e)
+                     in
+                         (e, t, enD gs @ gs')
+                     end
+                 else
+                     (e, t, [])
+               | t => (e, t, [])
+
+         val (e, t, gs) = case infer of
+                              L.DontInfer => unravelKind (t, e)
+                            | _ => unravel (t, e)
+     in
+         ((#1 e, loc), (#1 t, loc), map (relocConstraint loc) gs)
+     end
+
+fun elabPat (pAll as (p, loc), (env, bound)) =
+    let
+        val terror = (L'.CError, loc)
+        val perror = (L'.PVar ("_", terror), loc)
+        val pterror = (perror, terror)
+        val rerror = (pterror, (env, bound))
+
+        fun pcon (pc, po, xs, to, dn, dk) =
+            case (po, to) of
+                (NONE, SOME _) => (expError env (PatHasNoArg loc);
+                                   rerror)
+              | (SOME _, NONE) => (expError env (PatHasArg loc);
+                                   rerror)
+              | (NONE, NONE) =>
+                let
+                    val k = (L'.KType, loc)
+                    val unifs = map (fn _ => cunif env (loc, k)) xs
+                    val dn = foldl (fn (u, dn) => (L'.CApp (dn, u), loc)) dn unifs
+                in
+                    (((L'.PCon (dk, pc, unifs, NONE), loc), dn),
+                     (env, bound))
+                end
+              | (SOME p, SOME t) =>
+                let
+                    val ((p', pt), (env, bound)) = elabPat (p, (env, bound))
+
+                    val k = (L'.KType, loc)
+                    val unifs = map (fn _ => cunif env (loc, k)) xs
+                    val nxs = length unifs - 1
+                    val t = ListUtil.foldli (fn (i, u, t) => subConInCon env (nxs - i,
+                                                                              E.mliftConInCon (nxs - i) u) t) t unifs
+                    val dn = foldl (fn (u, dn) => (L'.CApp (dn, u), loc)) dn unifs
+                in
+                    ignore (checkPatCon env p' pt t);
+                    (((L'.PCon (dk, pc, unifs, SOME p'), loc), dn),
+                     (env, bound))
+                end
+    in
+        case p of
+            L.PVar x =>
+            let
+                val t = if x <> "_" andalso SS.member (bound, x) then
+                            (expError env (DuplicatePatternVariable (loc, x));
+                             terror)
+                        else
+                            cunif env (loc, (L'.KType, loc))
+            in
+                (((L'.PVar (x, t), loc), t),
+                 (E.pushERel env x t, SS.add (bound, x)))
+            end
+          | L.PPrim p => (((L'.PPrim p, loc), primType env p),
+                          (env, bound))
+          | L.PCon ([], x, po) =>
+            (case E.lookupConstructor env x of
+                 NONE => (expError env (UnboundConstructor (loc, [], x));
+                          rerror)
+               | SOME (dk, n, xs, to, dn) => pcon (L'.PConVar n, po, xs, to, (L'.CNamed dn, loc), dk))
+          | L.PCon (m1 :: ms, x, po) =>
+            (case E.lookupStr env m1 of
+                 NONE => (expError env (UnboundStrInExp (loc, m1));
+                          rerror)
+               | SOME (n, sgn) =>
+                 let
+                     val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                    NONE => raise Fail "elabPat: Unknown substructure"
+                                                  | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                            ((L'.StrVar n, loc), sgn) ms
+                 in
+                     case E.projectConstructor env {str = str, sgn = sgn, field = x} of
+                         NONE => (expError env (UnboundConstructor (loc, m1 :: ms, x));
+                                  rerror)
+                       | SOME (dk, _, xs, to, dn) => pcon (L'.PConProj (n, ms, x), po, xs, to, dn, dk)
+                 end)
+
+          | L.PRecord (xps, flex) =>
+            let
+                val (xpts, (env, bound, _)) =
+                    ListUtil.foldlMap (fn ((x, p), (env, bound, fbound)) =>
+                                          let
+                                              val ((p', t), (env, bound)) = elabPat (p, (env, bound))
+                                          in
+                                              if SS.member (fbound, x) then
+                                                  expError env (DuplicatePatField (loc, x))
+                                              else
+                                                  ();
+                                              ((x, p', t), (env, bound, SS.add (fbound, x)))
+                                          end)
+                    (env, bound, SS.empty) xps
+
+                val k = (L'.KType, loc)
+                val c = (L'.CRecord (k, map (fn (x, _, t) => ((L'.CName x, loc), t)) xpts), loc)
+                val c =
+                    if flex then
+                        (L'.CConcat (c, cunif env (loc, (L'.KRecord k, loc))), loc)
+                    else
+                        c
+            in
+                (((L'.PRecord xpts, loc),
+                  (L'.TRecord c, loc)),
+                 (env, bound))
+            end
+
+          | L.PAnnot (p, t) =>
+            let
+                val ((p', pt), (env, bound)) = elabPat (p, (env, bound))
+                val (t', k, _) = elabCon (env, D.empty) t
+            in
+                checkPatCon env p' pt t';
+                ((p', t'), (env, bound))
+            end   
+    end
+
+(* This exhaustiveness checking follows Luc Maranget's paper "Warnings for pattern matching." *)
+fun exhaustive (env, t, ps, loc) =
+    let
+        val pwild = L'.PVar ("_", t)
+
+        fun fail n = raise Fail ("Elaborate.exhaustive: Impossible " ^ Int.toString n)
+
+        fun patConNum pc =
+            case pc of
+                L'.PConVar n => n
+              | L'.PConProj (m1, ms, x) =>
+                let
+                    val (str, sgn) = E.chaseMpath env (m1, ms)
+                in
+                    case E.projectConstructor env {str = str, sgn = sgn, field = x} of
+                        NONE => raise Fail "exhaustive: Can't project datatype"
+                      | SOME (_, n, _, _, _) => n
+                end
+
+        fun nameOfNum (t, n) =
+            case t of
+                L'.CModProj (m1, ms, x) =>
+                let
+                    val (str, sgn) = E.chaseMpath env (m1, ms)
+                in
+                    case E.projectDatatype env {str = str, sgn = sgn, field = x} of
+                        NONE => raise Fail "exhaustive: Can't project datatype"
+                      | SOME (_, cons) =>
+                        case ListUtil.search (fn (name, n', _) =>
+                                                 if n' = n then
+                                                     SOME name
+                                                 else
+                                                     NONE) cons of
+                            NONE => fail 9
+                          | SOME name => L'.PConProj (m1, ms, name)
+                end
+              | _ => L'.PConVar n
+
+        fun S (args, c, P) =
+            List.mapPartial
+            (fn [] => fail 1
+              | p1 :: ps =>
+                let
+                    val loc = #2 p1
+
+                    fun wild () =
+                        SOME (map (fn _ => (pwild, loc)) args @ ps)
+                in
+                    case #1 p1 of
+                        L'.PPrim _ => NONE
+                      | L'.PCon (_, c', _, NONE) =>
+                        if patConNum c' = c then
+                            SOME ps
+                        else
+                            NONE
+                      | L'.PCon (_, c', _, SOME p) =>
+                        if patConNum c' = c then
+                            SOME (p :: ps)
+                        else
+                            NONE
+                      | L'.PRecord xpts =>
+                        SOME (map (fn x =>
+                                      case ListUtil.search (fn (x', p, _) =>
+                                                               if x = x' then
+                                                                   SOME p
+                                                               else
+                                                                   NONE) xpts of
+                                          NONE => (pwild, loc)
+                                        | SOME p => p) args @ ps)
+                      | L'.PVar _ => wild ()
+                end)
+            P
+
+        fun D P =
+            List.mapPartial
+            (fn [] => fail 2
+              | (p1, _) :: ps =>
+                case p1 of
+                    L'.PVar _ => SOME ps
+                  | L'.PPrim _ => NONE
+                  | L'.PCon _ => NONE
+                  | L'.PRecord _ => NONE)
+            P
+
+        fun I (P, q) =
+            (*(prefaces "I" [("P", p_list (fn P' => box [PD.string "[", p_list (p_pat env) P', PD.string "]"]) P),
+                           ("q", p_list (p_con env) q)];*)
+            case q of
+                [] => (case P of
+                           [] => SOME []
+                         | _ => NONE)
+              | q1 :: qs =>
+                let
+                    val loc = #2 q1
+
+                    fun unapp (t, acc) =
+                        case #1 t of
+                            L'.CApp (t, arg) => unapp (t, arg :: acc)
+                          | _ => (t, rev acc)
+
+                    val (t1, args) = unapp (hnormCon env q1, [])
+                    val t1 = hnormCon env t1
+                    fun doSub t = foldl (fn (arg, t) => subConInCon env (0, arg) t) t args
+
+                    fun dtype (dtO, names) =
+                        let
+                            val nameSet = IS.addList (IS.empty, names)
+                            val nameSet = foldl (fn (ps, nameSet) =>
+                                                    case ps of
+                                                        [] => fail 4
+                                                      | (L'.PCon (_, pc, _, _), _) :: _ =>
+                                                        (IS.delete (nameSet, patConNum pc)
+                                                         handle NotFound => nameSet)
+                                                      | _ => nameSet)
+                                                nameSet P
+                        in
+                            nameSet
+                        end
+
+                    fun default () = (NONE, IS.singleton 0, [])
+
+                    val (dtO, unused, cons) =
+                        case #1 t1 of
+                            L'.CNamed n =>
+                            let
+                                val dt = E.lookupDatatype env n
+                                val cons = E.constructors dt
+                            in
+                                (SOME dt,
+                                 dtype (SOME dt, map #2 cons),
+                                 map (fn (_, n, co) =>
+                                         (n,
+                                          case co of
+                                              NONE => []
+                                            | SOME t => [("", doSub t)])) cons)
+                            end
+                          | L'.CModProj (m1, ms, x) =>
+                            let
+                                val (str, sgn) = E.chaseMpath env (m1, ms)
+                            in
+                                case E.projectDatatype env {str = str, sgn = sgn, field = x} of
+                                    NONE => default ()
+                                  | SOME (_, cons) =>
+                                    (NONE,
+                                     dtype (NONE, map #2 cons),
+                                     map (fn (s, _, co) =>
+                                             (patConNum (L'.PConProj (m1, ms, s)),
+                                              case co of
+                                                  NONE => []
+                                                | SOME t => [("", doSub t)])) cons)
+                            end
+                          | L'.TRecord t =>
+                            (case #1 (hnormCon env t) of
+                                 L'.CRecord (_, xts) =>
+                                 let
+                                     val xts = map (fn ((L'.CName x, _), co) => SOME (x, co)
+                                                     | _ => NONE) xts
+                                 in
+                                     if List.all Option.isSome xts then
+                                         let
+                                             val xts = List.mapPartial (fn x => x) xts
+                                             val xts = ListMergeSort.sort (fn ((x1, _), (x2, _)) =>
+                                                                              String.compare (x1, x2) = GREATER) xts
+                                         in
+                                             (NONE, IS.empty, [(0, xts)])
+                                         end
+                                     else
+                                         default ()
+                                 end
+                               | _ => default ())
+                          | _ => default ()
+                in
+                    if IS.isEmpty unused then
+                        let
+                            fun recurse cons =
+                                case cons of
+                                    [] => NONE
+                                  | (name, args) :: cons =>
+                                    case I (S (map #1 args, name, P),
+                                            map #2 args @ qs) of
+                                        NONE => recurse cons
+                                      | SOME ps =>
+                                        let
+                                            val nargs = length args
+                                            val argPs = List.take (ps, nargs)
+                                            val restPs = List.drop (ps, nargs)
+
+                                            val p = case name of
+                                                        0 => L'.PRecord (ListPair.map
+                                                                                  (fn ((name, t), p) => (name, p, t))
+                                                                                  (args, argPs))
+                                                      | _  => L'.PCon (L'.Default, nameOfNum (#1 t1, name), [],
+                                                                       case argPs of
+                                                                           [] => NONE
+                                                                         | [p] => SOME p
+                                                                         | _ => fail 3)
+                                        in
+                                            SOME ((p, loc) :: restPs)
+                                        end
+                        in
+                            recurse cons
+                        end
+                    else
+                        case I (D P, qs) of
+                            NONE => NONE
+                          | SOME ps =>
+                            let
+                                val p = case cons of
+                                            [] => pwild
+                                          | (0, _) :: _ => pwild
+                                          | _ =>
+                                            case IS.find (fn _ => true) unused of
+                                                NONE => fail 6
+                                              | SOME name =>
+                                                case ListUtil.search (fn (name', args) =>
+                                                                         if name = name' then
+                                                                             SOME (name', args)
+                                                                         else
+                                                                             NONE) cons of
+                                                    SOME (n, []) =>
+                                                    L'.PCon (L'.Default, nameOfNum (#1 t1, n), [], NONE)
+                                                  | SOME (n, [_]) =>
+                                                    L'.PCon (L'.Default, nameOfNum (#1 t1, n), [], SOME (pwild, loc))
+                                                  | _ => fail 7
+                            in
+                                SOME ((p, loc) :: ps)
+                            end
+                end
+    in
+        case I (map (fn x => [x]) ps, [t]) of
+            NONE => NONE
+          | SOME [p] => SOME p
+          | _ => fail 7
+    end
+
+fun unmodCon env (c, loc) =
+    case c of
+        L'.CNamed n =>
+        (case E.lookupCNamed env n of
+             (_, _, SOME (c as (L'.CModProj _, _))) => unmodCon env c
+           | _ => (c, loc))
+      | L'.CModProj (m1, ms, x) =>
+        let
+            val (str, sgn) = E.chaseMpath env (m1, ms)
+        in
+            case E.projectCon env {str = str, sgn = sgn, field = x} of
+                NONE => raise Fail "unmodCon: Can't projectCon"
+              | SOME (_, SOME (c as (L'.CModProj _, _))) => unmodCon env c
+              | _ => (c, loc)
+        end
+      | _ => (c, loc)
+
+fun normClassKey env c =
+    let
+        val c = hnormCon env c
+    in
+        case #1 c of
+            L'.CApp (c1, c2) =>
+            let
+                val c1 = normClassKey env c1
+                val c2 = normClassKey env c2
+            in
+                (L'.CApp (c1, c2), #2 c)
+            end
+          | L'.CRecord (k, xcs) => (L'.CRecord (k, map (fn (x, c) => (normClassKey env x,
+                                                                      normClassKey env c)) xcs), #2 c)
+          | _ => unmodCon env c
+    end
+
+fun normClassConstraint env (c, loc) =
+    case c of
+        L'.CApp (f, x) =>
+        let
+            val f = normClassKey env f
+            val x = normClassKey env x
+        in
+            (L'.CApp (f, x), loc)
+        end
+      | L'.TFun (c1, c2) =>
+        let
+            val c1 = normClassConstraint env c1
+            val c2 = normClassConstraint env c2
+        in
+            (L'.TFun (c1, c2), loc)
+        end
+      | L'.TCFun (expl, x, k, c1) => (L'.TCFun (expl, x, k, normClassConstraint env c1), loc)
+      | L'.CUnif (nl, _, _, _, ref (L'.Known c)) => normClassConstraint env (E.mliftConInCon nl c)
+      | _ => unmodCon env (c, loc)
+
+fun findHead e e' =
+    let
+        fun findHead (e, _) =
+            case e of
+                L.EVar (_, _, infer) =>
+                let
+                    fun findHead' (e, _) =
+                        case e of
+                            L'.ENamed _ => true
+                          | L'.EModProj _ => true
+                          | L'.ERel _ => true
+                          | L'.EApp (e, _) => findHead' e
+                          | L'.ECApp (e, _) => findHead' e
+                          | L'.EKApp (e, _) => findHead' e
+                          | _ => false
+                in
+                    if findHead' e' then
+                        SOME infer
+                    else
+                        NONE
+                end
+              | L.EApp (e, _) => findHead e
+              | L.ECApp (e, _) => findHead e
+              | L.EDisjointApp e => findHead e
+              | _ => NONE
+    in
+        findHead e
+    end
+
+datatype needed = Needed of {Cons : (L'.kind * int) SM.map,
+                             NextCon : int,
+                             Constraints : (E.env * (L'.con * L'.con) * ErrorMsg.span) list,
+                             Vals : SS.set,
+                             Mods : (E.env * needed) SM.map}
+
+fun ncons (Needed r) = map (fn (k, (v, _)) => (k, v))
+                       (ListMergeSort.sort (fn ((_, (_, n1)), (_, (_, n2))) => n1 > n2)
+                                           (SM.listItemsi (#Cons r)))
+fun nconstraints (Needed r) = #Constraints r
+fun nvals (Needed r) = #Vals r
+fun nmods (Needed r) = #Mods r
+
+val nempty = Needed {Cons = SM.empty,
+                     NextCon = 0,
+                     Constraints = nil,
+                     Vals = SS.empty,
+                     Mods = SM.empty}
+
+fun naddCon (r : needed, k, v) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = SM.insert (#Cons r, k, (v, #NextCon r)),
+                NextCon = #NextCon r + 1,
+                Constraints = #Constraints r,
+                Vals = #Vals r,
+                Mods = #Mods r}
+    end
+
+fun naddConstraint (r : needed, v) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = #Cons r,
+                NextCon = #NextCon r,
+                Constraints = v :: #Constraints r,
+                Vals = #Vals r,
+                Mods = #Mods r}
+    end
+
+fun naddVal (r : needed, k) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = #Cons r,
+                NextCon = #NextCon r,
+                Constraints = #Constraints r,
+                Vals = SS.add (#Vals r, k),
+                Mods = #Mods r}
+    end
+
+fun naddMod (r : needed, k, v) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = #Cons r,
+                NextCon = #NextCon r,
+                Constraints = #Constraints r,
+                Vals = #Vals r,
+                Mods = SM.insert (#Mods r, k, v)}
+    end
+
+fun ndelCon (r : needed, k) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = #1 (SM.remove (#Cons r, k)) handle NotFound => #Cons r,
+                NextCon = #NextCon r,
+                Constraints = #Constraints r,
+                Vals = #Vals r,
+                Mods = #Mods r}
+    end
+
+fun ndelVal (r : needed, k) =
+    let
+        val Needed r = r
+    in
+        Needed {Cons = #Cons r,
+                NextCon = #NextCon r,
+                Constraints = #Constraints r,
+                Vals = SS.delete (#Vals r, k) handle NotFound => #Vals r,
+                Mods = #Mods r}
+    end
+
+fun chaseUnifs c =
+    case #1 c of
+        L'.CUnif (_, _, _, _, ref (L'.Known c)) => chaseUnifs c
+      | _ => c
+
+val consEqSimple =
+    let
+        fun ces env (c1 : L'.con, c2 : L'.con) =
+            let
+                val c1 = hnormCon env c1
+                val c2 = hnormCon env c2
+            in
+                case (#1 c1, #1 c2) of
+                    (L'.CRel n1, L'.CRel n2) => n1 = n2
+                  | (L'.CNamed n1, L'.CNamed n2) =>
+                    n1 = n2 orelse
+                    (case #3 (E.lookupCNamed env n1) of
+                         SOME (L'.CNamed n2', _) => n2' = n1
+                       | _ => false)
+                  | (L'.CModProj n1, L'.CModProj n2) => n1 = n2
+                  | (L'.CApp (f1, x1), L'.CApp (f2, x2)) => ces env (f1, f2) andalso ces env (x1, x2)
+                  | (L'.CAbs (x1, k1, c1), L'.CAbs (_, _, c2)) => ces (E.pushCRel env x1 k1) (c1, c2)
+                  | (L'.CName x1, L'.CName x2) => x1 = x2
+                  | (L'.CRecord (_, xts1), L'.CRecord (_, xts2)) =>
+                    ListPair.all (fn ((x1, t1), (x2, t2)) =>
+                                     ces env (x1, x2) andalso ces env (t2, t2)) (xts1, xts2)
+                  | (L'.CConcat (x1, y1), L'.CConcat (x2, y2)) =>
+                    ces env (x1, x2) andalso ces env (y1, y2)
+                  | (L'.CMap _, L'.CMap _) => true
+                  | (L'.CUnit, L'.CUnit) => true
+                  | (L'.CTuple cs1, L'.CTuple cs2) => ListPair.all (ces env) (cs1, cs2)
+                  | (L'.CProj (c1, n1), L'.CProj (c2, n2)) => ces env (c1, c2) andalso n1 = n2
+                  | (L'.CUnif (_, _, _, _, r1), L'.CUnif (_, _, _, _, r2)) => r1 = r2
+
+                  | (L'.TFun (d1, r1), L'.TFun (d2, r2)) => ces env (d1, d2) andalso ces env (r1, r2)
+                  | (L'.TRecord c1, L'.TRecord c2) => ces env (c1, c2)
+                  
+                  | _ => false
+            end
+    in
+        ces
+    end
+    
+
+fun elabExp (env, denv) (eAll as (e, loc)) =
+    let
+        (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)]*)
+        (*val befor = Time.now ()*)
+
+        val r = case e of
+            L.EAnnot (e, t) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+                val (t', _, gs2) = elabCon (env, denv) t
+            in
+                checkCon env e' et t';
+                (e', t', gs1 @ enD gs2)
+            end
+
+          | L.EPrim p => ((L'.EPrim p, loc), primType env p, [])
+          | L.EVar ([], s, infer) =>
+            (case E.lookupE env s of
+                 E.NotBound =>
+                 (expError env (UnboundExp (loc, s));
+                  (eerror, cerror, []))
+               | E.Rel (n, t) => elabHead (env, denv) infer (L'.ERel n, loc) t
+               | E.Named (n, t) => elabHead (env, denv) infer (L'.ENamed n, loc) t)
+          | L.EVar (m1 :: ms, s, infer) =>
+            (case E.lookupStr env m1 of
+                 NONE => (expError env (UnboundStrInExp (loc, m1));
+                          (eerror, cerror, []))
+               | SOME (n, sgn) =>
+                 let
+                     val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                    NONE => (conError env (UnboundStrInCon (loc, m));
+                                                             (strerror, sgnerror))
+                                                  | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                            ((L'.StrVar n, loc), sgn) ms
+
+                     val t = case E.projectVal env {sgn = sgn, str = str, field = s} of
+                                 NONE => (expError env (UnboundExp (loc, s));
+                                          cerror)
+                               | SOME t => t
+                 in
+                     elabHead (env, denv) infer (L'.EModProj (n, ms, s), loc) t
+                 end)
+
+          | L.EWild =>
+            let
+                val r = ref NONE
+                val c = cunif env (loc, (L'.KType, loc))
+            in
+                ((L'.EUnif r, loc), c, [TypeClass (env, c, r, loc)])
+            end
+
+          | L.EApp (e1, e2) =>
+            let
+                val (e1', t1, gs1) = elabExp (env, denv) e1
+
+                val (e2', t2, gs2) = elabExp (env, denv) e2
+
+                val dom = cunif env (loc, ktype)
+                val ran = cunif env (loc, ktype)
+                val t = (L'.TFun (dom, ran), loc)
+
+                val () = checkCon env e1' t1 t
+                val () = checkCon env e2' t2 dom
+
+                val ef = (L'.EApp (e1', e2'), loc)
+                val (ef, et, gs3) =
+                    case findHead e1 e1' of
+                        NONE => (ef, (#1 (chaseUnifs ran), loc), [])
+                      | SOME infer => elabHead (env, denv) infer ef ran
+            in
+                (ef, et, gs1 @ gs2 @ gs3)
+            end
+          | L.EAbs (x, to, e) =>
+            let
+                val (t', gs1) = case to of
+                                    NONE => (cunif env (loc, ktype), [])
+                                  | SOME t =>
+                                    let
+                                        val (t', tk, gs) = elabCon (env, denv) t
+                                    in
+                                        checkKind env t' tk ktype;
+                                        (t', gs)
+                                    end
+                val dom = normClassConstraint env t'
+                val (e', et, gs2) = elabExp (E.pushERel env x dom, denv) e
+            in
+                ((L'.EAbs (x, t', et, e'), loc),
+                 (L'.TFun (t', et), loc),
+                 enD gs1 @ gs2)
+            end
+          | L.ECApp (e, c) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+
+                val oldEt = et
+                val (c', ck, gs2) = elabCon (env, denv) c
+                val (et', _) = hnormCon env et
+            in
+                case et' of
+                    L'.CError => (eerror, cerror, [])
+                  | L'.TCFun (_, x, k, eb) =>
+                    let
+                        val () = checkKind env c' ck k
+                        val eb' = subConInCon env (0, c') eb
+
+                        val ef = (L'.ECApp (e', c'), loc)
+                        val (ef, eb', gs3) =
+                            case findHead e e' of
+                                NONE => (ef, eb', [])
+                              | SOME infer => elabHead (env, denv) infer ef eb'
+                    in
+                        (*prefaces "Elab ECApp" [("e", SourcePrint.p_exp eAll),
+                                               ("et", p_con env oldEt),
+                                               ("x", PD.string x),
+                                               ("eb", p_con (E.pushCRel env x k) eb),
+                                               ("c", p_con env c'),
+                                               ("eb'", p_con env eb')];*)
+                        (ef, (#1 eb', loc), gs1 @ enD gs2 @ gs3)
+                    end
+
+                  | _ =>
+                    (expError env (WrongForm ("constructor function", e', et));
+                     (eerror, cerror, []))
+            end
+          | L.ECAbs (expl, x, k, e) =>
+            let
+                val expl' = elabExplicitness expl
+                val k' = elabKind env k
+
+                val env' = E.pushCRel env x k'
+                val (e', et, gs) = elabExp (env', D.enter denv) e
+            in
+                ((L'.ECAbs (expl', x, k', e'), loc),
+                 (L'.TCFun (expl', x, k', et), loc),
+                 gs)
+            end
+          | L.EKAbs (x, e) =>
+            let
+                val env' = E.pushKRel env x
+                val (e', et, gs) = elabExp (env', denv) e
+            in
+                ((L'.EKAbs (x, e'), loc),
+                 (L'.TKFun (x, et), loc),
+                 gs)
+            end
+
+          | L.EDisjoint (c1, c2, e) =>
+            let
+                val (c1', k1, gs1) = elabCon (env, denv) c1
+                val (c2', k2, gs2) = elabCon (env, denv) c2
+
+                val ku1 = kunif env loc
+                val ku2 = kunif env loc
+
+                val denv' = D.assert env denv (c1', c2')
+                val (e', t, gs3) = elabExp (env, denv') e
+            in
+                checkKind env c1' k1 (L'.KRecord ku1, loc);
+                checkKind env c2' k2 (L'.KRecord ku2, loc);
+
+                (e', (L'.TDisjoint (c1', c2', t), loc), enD gs1 @ enD gs2 @ gs3)
+            end
+          | L.EDisjointApp e =>
+            let
+                val (e', t, gs1) = elabExp (env, denv) e
+
+                val k1 = kunif env loc
+                val c1 = cunif env (loc, (L'.KRecord k1, loc))
+                val k2 = kunif env loc
+                val c2 = cunif env (loc, (L'.KRecord k2, loc))
+                val t' = cunif env (loc, ktype)
+                val () = checkCon env e' t (L'.TDisjoint (c1, c2, t'), loc)
+                val gs2 = D.prove env denv (c1, c2, loc)
+            in
+                (e', (#1 (chaseUnifs t'), loc), enD gs2 @ gs1)
+            end
+
+          | L.ERecord (xes, flex) =>
+            let
+                val () = if flex then
+                             expError env (IllegalFlex eAll)
+                         else
+                             ()
+
+                val (xes', gs) = ListUtil.foldlMap (fn ((x, e), gs) =>
+                                                       let
+                                                           val (x', xk, gs1) = elabCon (env, denv) x
+                                                           val (e', et, gs2) = elabExp (env, denv) e
+                                                       in
+                                                           checkKind env x' xk kname;
+                                                           ((x', e', et), enD gs1 @ gs2 @ gs)
+                                                       end)
+                                                   [] xes
+
+                val k = (L'.KType, loc)
+
+                fun prove (xets, gs) =
+                    case xets of
+                        [] => gs
+                      | (x, _, t) :: rest =>
+                        let
+                            val xc = (x, t)
+                            val r1 = (L'.CRecord (k, [xc]), loc)
+                            val gs = foldl (fn ((x', _, t'), gs) =>
+                                               let
+                                                   val xc' = (x', t')
+                                                   val r2 = (L'.CRecord (k, [xc']), loc)
+                                               in
+                                                   D.prove env denv (r1, r2, loc) @ gs
+                                               end)
+                                           gs rest
+                        in
+                            prove (rest, gs)
+                        end
+
+                val gsD = List.mapPartial (fn Disjoint d => SOME d | _ => NONE) gs
+                val gsO = List.filter (fn Disjoint _ => false | _ => true) gs
+            in
+                (*TextIO.print ("|gsO| = " ^ Int.toString (length gsO) ^ "\n");*)
+                ((L'.ERecord xes', loc),
+                 (L'.TRecord (L'.CRecord (ktype, map (fn (x', _, et) => (x', et)) xes'), loc), loc),
+                 enD (prove (xes', gsD)) @ gsO)
+            end
+
+          | L.EField (e, c) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+                val (c', ck, gs2) = elabCon (env, denv) c
+
+                val ft = cunif env (loc, ktype)
+                val rest = cunif env (loc, ktype_record)
+                val first = (L'.CRecord (ktype, [(c', ft)]), loc)
+                val () = checkCon env e' et
+                                  (L'.TRecord (L'.CConcat (first, rest), loc), loc);
+                val gs3 = D.prove env denv (first, rest, loc)
+            in
+                ((L'.EField (e', c', {field = ft, rest = rest}), loc), ft, gs1 @ enD gs2 @ enD gs3)
+            end
+
+          | L.EConcat (e1, e2) =>
+            let
+                val (e1', e1t, gs1) = elabExp (env, denv) e1
+                val (e2', e2t, gs2) = elabExp (env, denv) e2
+
+                val r1 = cunif env (loc, ktype_record)
+                val r2 = cunif env (loc, ktype_record)
+
+                val () = checkCon env e1' e1t (L'.TRecord r1, loc)
+                val () = checkCon env e2' e2t (L'.TRecord r2, loc)
+
+                val gs3 = D.prove env denv (r1, r2, loc)
+            in
+                ((L'.EConcat (e1', r1, e2', r2), loc),
+                 (L'.TRecord ((L'.CConcat (r1, r2), loc)), loc),
+                 gs1 @ gs2 @ enD gs3)
+            end
+          | L.ECut (e, c) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+                val (c', ck, gs2) = elabCon (env, denv) c
+
+                val ft = cunif env (loc, ktype)
+                val rest = cunif env (loc, ktype_record)
+                val first = (L'.CRecord (ktype, [(c', ft)]), loc)
+
+                val () = checkCon env e' et
+                                  (L'.TRecord (L'.CConcat (first, rest), loc), loc)
+                            
+                val gs3 = D.prove env denv (first, rest, loc)
+            in
+                checkKind env c' ck kname;
+                ((L'.ECut (e', c', {field = ft, rest = rest}), loc), (L'.TRecord rest, loc),
+                 gs1 @ enD gs2 @ enD gs3)
+            end
+          | L.ECutMulti (e, c) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+                val (c', ck, gs2) = elabCon (env, denv) c
+
+                val rest = cunif env (loc, ktype_record)
+
+                val () = checkCon env e' et
+                                  (L'.TRecord (L'.CConcat (c', rest), loc), loc)
+                            
+                val gs3 = D.prove env denv (c', rest, loc)
+            in
+                checkKind env c' ck (L'.KRecord ktype, loc);
+                ((L'.ECutMulti (e', c', {rest = rest}), loc), (L'.TRecord rest, loc),
+                 gs1 @ enD gs2 @ enD gs3)
+            end
+
+          | L.ECase (e, pes) =>
+            let
+                val (e', et, gs1) = elabExp (env, denv) e
+                val result = cunif env (loc, (L'.KType, loc))
+                val (pes', gs) = ListUtil.foldlMap
+                                 (fn ((p, e), gs) =>
+                                     let
+                                         val ((p', pt), (env, _)) = elabPat (p, (env, SS.empty))
+
+                                         val (e', et', gs1) = elabExp (env, denv) e
+                                     in
+                                         checkPatCon env p' pt et;
+                                         checkCon env e' et' result;
+                                         ((p', e'), gs1 @ gs)
+                                     end)
+                                 gs1 pes
+            in
+                case exhaustive (env, et, map #1 pes', loc) of
+                    NONE => ()
+                  | SOME p => if !mayDelay then
+                                  delayedExhaustives := (env, et, map #1 pes', loc) :: !delayedExhaustives
+                              else
+                                  expError env (Inexhaustive (loc, p));
+
+                ((L'.ECase (e', pes', {disc = et, result = result}), loc), result, gs)
+            end
+
+          | L.ELet (eds, e) =>
+            let
+                val (eds, (env, gs1)) = ListUtil.foldlMap (elabEdecl denv) (env, []) eds
+                val (e, t, gs2) = elabExp (env, denv) e
+            in
+                ((L'.ELet (eds, e, t), loc), t, gs1 @ gs2)
+            end
+    in
+        (*prefaces "/elabExp" [("e", SourcePrint.p_exp eAll)];*)
+        r
+    end
+
+and elabEdecl denv (dAll as (d, loc), (env, gs)) =
+    let
+        val r = 
+            case d of
+                L.EDVal (p, e) =>
+                let
+                    val ((p', pt), (env', _)) = elabPat (p, (env, SS.empty))
+                    val (e', et, gs1) = elabExp (env, denv) e
+
+                    val () = checkCon env e' et pt
+
+                    val env' = E.patBinds env p'
+                    (* Redo to get proper detection of type class witnesses *)
+
+                    val pt = normClassConstraint env pt
+                in
+                    case exhaustive (env, et, [p'], loc) of
+                        NONE => ()
+                      | SOME p => if !mayDelay then
+                                      delayedExhaustives := (env, et, [p'], loc) :: !delayedExhaustives
+                                  else
+                                      expError env (Inexhaustive (loc, p));
+
+                    ((L'.EDVal (p', pt, e'), loc), (env', gs1 @ gs))
+                end
+              | L.EDValRec vis =>
+                let
+                    fun allowable (e, _) =
+                        case e of
+                            L.EAbs _ => true
+                          | L.ECAbs (_, _, _, e) => allowable e
+                          | L.EKAbs (_, e) => allowable e
+                          | L.EDisjoint (_, _, e) => allowable e
+                          | _ => false
+
+                    val (vis, gs) = ListUtil.foldlMap
+                                        (fn ((x, co, e), gs) =>
+                                            let
+                                                val (c', _, gs1) = case co of
+                                                                       NONE => (cunif env (loc, ktype), ktype, [])
+                                                                     | SOME c => elabCon (env, denv) c
+                                            in
+                                                ((x, c', e), enD gs1 @ gs)
+                                            end) gs vis
+
+                    val env = foldl (fn ((x, c', _), env) => E.pushERel env x c') env vis
+
+                    val (vis, gs) = ListUtil.foldlMap (fn ((x, c', e), gs) =>
+                                                          let
+                                                              val (e', et, gs1) = elabExp (env, denv) e
+                                                          in
+                                                              checkCon env e' et c';
+                                                              if allowable e then
+                                                                  ()
+                                                              else
+                                                                  expError env (IllegalRec (x, e'));
+                                                              ((x, c', e'), gs1 @ gs)
+                                                          end) gs vis
+                in
+                    ((L'.EDValRec vis, loc), (env, gs))
+                end
+    in
+        r
+    end
+
+val hnormSgn = E.hnormSgn
+
+fun tableOf () = (L'.CModProj (!basis_r, [], "sql_table"), ErrorMsg.dummySpan)
+fun sequenceOf () = (L'.CModProj (!basis_r, [], "sql_sequence"), ErrorMsg.dummySpan)
+fun viewOf () = (L'.CModProj (!basis_r, [], "sql_view"), ErrorMsg.dummySpan)
+fun queryOf () = (L'.CModProj (!basis_r, [], "sql_query"), ErrorMsg.dummySpan)
+fun cookieOf () = (L'.CModProj (!basis_r, [], "http_cookie"), ErrorMsg.dummySpan)
+fun styleOf () = (L'.CModProj (!basis_r, [], "css_class"), ErrorMsg.dummySpan)
+
+fun patVarsOf (p : L.pat) =
+    case #1 p of
+        L.PVar x => [x]
+      | L.PPrim _ => []
+      | L.PCon (_, _, NONE) => []
+      | L.PCon (_, _, SOME p) => patVarsOf p
+      | L.PRecord (xps, _) => ListUtil.mapConcat (fn (_, p) => patVarsOf p) xps
+      | L.PAnnot (p', _) => patVarsOf p'
+
+fun dopenConstraints (loc, env, denv) {str, strs} =
+    case E.lookupStr env str of
+        NONE => (strError env (UnboundStr (loc, str));
+                 denv)
+      | SOME (n, sgn) =>
+        let
+            val (st, sgn) = foldl (fn (m, (str, sgn)) =>
+                                      case E.projectStr env {str = str, sgn = sgn, field = m} of
+                                          NONE => (strError env (UnboundStr (loc, m));
+                                                   (strerror, sgnerror))
+                                        | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                  ((L'.StrVar n, loc), sgn) strs
+
+            fun collect first (st, sgn) =
+                case E.projectConstraints env {sgn = sgn, str = st} of
+                    NONE => []
+                  | SOME cs =>
+                    case #1 (hnormSgn env sgn) of
+                        L'.SgnConst sgis =>
+                        foldl (fn (sgi, cs) =>
+                                  case #1 sgi of
+                                      L'.SgiStr (L'.Import, x, _, _) =>
+                                      (case E.projectStr env {sgn = sgn, str = st, field = x} of
+                                           NONE => raise Fail "Elaborate: projectStr in collect"
+                                         | SOME sgn' =>
+                                           List.revAppend (collect false ((L'.StrProj (st, x), loc), sgn'),
+                                                           cs))
+                                    | _ => cs) cs sgis
+                      | _ => cs
+        in
+            foldl (fn ((c1, c2), denv) =>
+                      D.assert env denv (c1, c2)) denv (collect true (st, sgn))
+        end
+
+fun tcdump env =
+    Print.preface("Instances", p_list_sep Print.PD.newline
+                                          (fn (cl, ls) =>
+                                              box [p_con env cl,
+                                                   box [Print.PD.string "{",
+                                                        p_list (fn (t, e) =>
+                                                                   box [p_exp env e,
+                                                                        Print.PD.string " : ",
+                                                                        p_con env t]) ls,
+                                                        Print.PD.string "}"]])
+                                          (E.listClasses env))
+
+fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
+    ((*Print.preface ("elabSgi", SourcePrint.p_sgn_item (sgi, loc));*)
+     case sgi of
+         L.SgiConAbs (x, k) =>
+         let
+             val k' = elabKind env k
+
+             val (env', n) = E.pushCNamed env x k' NONE
+         in
+             ([(L'.SgiConAbs (x, n, k'), loc)], (env', denv, gs))
+         end
+
+       | L.SgiCon (x, ko, c) =>
+         let
+             val k' = case ko of
+                          NONE => kunif env loc
+                        | SOME k => elabKind env k
+
+             val (c', ck, gs') = elabCon (env, denv) c
+             val (env', n) = E.pushCNamed env x k' (SOME c')
+         in
+             checkKind env c' ck k';
+
+             ([(L'.SgiCon (x, n, k', c'), loc)], (env', denv, gs' @ gs))
+         end
+
+       | L.SgiDatatype dts =>
+         let
+             val k = (L'.KType, loc)
+
+             val (dts, env) = ListUtil.foldlMap (fn ((x, xs, xcs), env) =>
+                                                    let
+                                                        val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                                        val (env, n) = E.pushCNamed env x k' NONE
+                                                    in
+                                                        ((x, n, xs, xcs), env)
+                                                    end)
+                                                env dts
+
+             val (dts, env) = ListUtil.foldlMap
+                                  (fn ((x, n, xs, xcs), env) =>
+                                      let
+                                          val t = (L'.CNamed n, loc)
+                                          val nxs = length xs - 1
+                                          val t = ListUtil.foldli (fn (i, _, t) =>
+                                                                      (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
+
+                                          val (env', denv') = foldl (fn (x, (env', denv')) =>
+                                                                        (E.pushCRel env' x k,
+                                                                         D.enter denv')) (env, denv) xs
+
+                                          val (xcs, (used, env, gs)) =
+                                              ListUtil.foldlMap
+                                                  (fn ((x, to), (used, env, gs)) =>
+                                                      let
+                                                          val (to, t, gs') = case to of
+                                                                                 NONE => (NONE, t, gs)
+                                                                               | SOME t' =>
+                                                                                 let
+                                                                                     val (t', tk, gs') =
+                                                                                         elabCon (env', denv') t'
+                                                                                 in
+                                                                                     checkKind env' t' tk k;
+                                                                                     (SOME t',
+                                                                                      (L'.TFun (t', t), loc),
+                                                                                      gs' @ gs)
+                                                                                 end
+                                                          val t = foldl (fn (x, t) => (L'.TCFun (L'.Implicit, x, k, t), loc))
+                                                                        t xs
+                                                                  
+                                                          val (env, n') = E.pushENamed env x t
+                                                      in
+                                                          if SS.member (used, x) then
+                                                              strError env (DuplicateConstructor (x, loc))
+                                                          else
+                                                              ();
+                                                          ((x, n', to), (SS.add (used, x), env, gs'))
+                                                      end)
+                                                  (SS.empty, env, []) xcs
+                                      in
+                                          ((x, n, xs, xcs), E.pushDatatype env n xs xcs)
+                                      end)
+                                  env dts
+         in
+             ([(L'.SgiDatatype dts, loc)], (env, denv, gs))
+         end
+
+       | L.SgiDatatypeImp (_, [], _) => raise Fail "Empty SgiDatatypeImp"
+
+       | L.SgiDatatypeImp (x, m1 :: ms, s) =>
+         (case E.lookupStr env m1 of
+              NONE => (strError env (UnboundStr (loc, m1));
+                       ([], (env, denv, gs)))
+            | SOME (n, sgn) =>
+              let
+                  val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                             case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                 NONE => (conError env (UnboundStrInCon (loc, m));
+                                                          (strerror, sgnerror))
+                                               | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                         ((L'.StrVar n, loc), sgn) ms
+              in
+                  case hnormCon env (L'.CModProj (n, ms, s), loc) of
+                      (L'.CModProj (n, ms, s), _) =>
+                      (case E.projectDatatype env {sgn = sgn, str = str, field = s} of
+                           NONE => (conError env (UnboundDatatype (loc, s));
+                                    ([], (env, denv, [])))
+                         | SOME (xs, xncs) =>
+                           let
+                               val k = (L'.KType, loc)
+                               val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+
+                               val t = (L'.CModProj (n, ms, s), loc)
+                               val (env, n') = E.pushCNamed env x k' (SOME t)
+                               val env = E.pushDatatype env n' xs xncs
+
+                               val t = (L'.CNamed n', loc)
+                               val env = foldl (fn ((x, n, to), env) =>
+                                                   let
+                                                       val t = case to of
+                                                                   NONE => t
+                                                                 | SOME t' => (L'.TFun (t', t), loc)
+
+                                                       val t = foldr (fn (x, t) =>
+                                                                         (L'.TCFun (L'.Implicit, x, k, t), loc))
+                                                                     t xs
+                                                   in
+                                                       E.pushENamedAs env x n t
+                                                   end) env xncs
+                           in
+                               ([(L'.SgiDatatypeImp (x, n', n, ms, s, xs, xncs), loc)], (env, denv, []))
+                           end)
+                    | _ => (strError env (NotDatatype loc);
+                            ([], (env, denv, [])))
+              end)
+
+       | L.SgiVal (x, c) =>
+         let
+             val (c', ck, gs') = elabCon (env, denv) c
+
+             val old = c'
+             val c' = normClassConstraint env c'
+             val (env', n) = E.pushENamed env x c'
+         in
+             (unifyKinds env ck ktype
+              handle KUnify arg => strError env (NotType (loc, ck, arg)));
+
+             ([(L'.SgiVal (x, n, c'), loc)], (env', denv, gs' @ gs))
+         end
+
+       | L.SgiTable (x, c, pe, ce) =>
+         let
+             val cstK = (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc)
+
+             val (c', ck, gs') = elabCon (env, denv) c
+             val pkey = cunif env (loc, cstK)
+             val visible = cunif env (loc, cstK)
+
+             val x' = x ^ "_hidden_constraints"
+             val (env', hidden_n) = E.pushCNamed env x' cstK NONE
+             val hidden = (L'.CNamed hidden_n, loc)
+
+             val uniques = (L'.CConcat (visible, hidden), loc)
+
+             val ct = tableOf ()
+             val ct = (L'.CApp (ct, c'), loc)
+             val ct = (L'.CApp (ct, (L'.CConcat (pkey, uniques), loc)), loc)
+
+             val (pe', pet, gs'') = elabExp (env', denv) pe
+             val gs'' = List.mapPartial (fn Disjoint x => SOME x
+                                          | _ => NONE) gs''
+
+             val pst = (L'.CModProj (!basis_r, [], "primary_key"), loc)
+             val pst = (L'.CApp (pst, c'), loc)
+             val pst = (L'.CApp (pst, pkey), loc)
+
+             val (ce', cet, gs''') = elabExp (env', denv) ce
+             val gs''' = List.mapPartial (fn Disjoint x => SOME x
+                                           | _ => NONE) gs'''
+
+             val cst = (L'.CModProj (!basis_r, [], "sql_constraints"), loc)
+             val cst = (L'.CApp (cst, c'), loc)
+             val cst = (L'.CApp (cst, visible), loc)
+
+             val (env', n) = E.pushENamed env' x ct
+         in
+             checkKind env c' ck (L'.KRecord (L'.KType, loc), loc);
+             checkCon env' pe' pet pst;
+             checkCon env' ce' cet cst;
+
+             ([(L'.SgiConAbs (x', hidden_n, cstK), loc),
+               (L'.SgiConstraint ((L'.CConcat (pkey, visible), loc), hidden), loc),
+               (L'.SgiVal (x, n, ct), loc)], (env', denv, gs''' @ gs'' @ gs' @ gs))
+         end
+
+       | L.SgiStr (x, sgn) =>
+         let
+             val (sgn', gs') = elabSgn (env, denv) sgn
+             val (env', n) = E.pushStrNamed env x sgn'
+             val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []}
+         in
+             ([(L'.SgiStr (L'.Import, x, n, sgn'), loc)], (env', denv', gs' @ gs))
+         end
+
+       | L.SgiSgn (x, sgn) =>
+         let
+             val (sgn', gs') = elabSgn (env, denv) sgn
+             val (env', n) = E.pushSgnNamed env x sgn'
+         in
+             ([(L'.SgiSgn (x, n, sgn'), loc)], (env', denv, gs' @ gs))
+         end
+
+       | L.SgiInclude sgn =>
+         let
+             val (sgn', gs') = elabSgn (env, denv) sgn
+         in
+             case #1 (hnormSgn env sgn') of
+                 L'.SgnConst sgis =>
+                 (sgis, (foldl (fn (sgi, env) => E.sgiBinds env sgi) env sgis, denv, gs' @ gs))
+               | _ => (sgnError env (NotIncludable sgn');
+                       ([], (env, denv, [])))
+         end
+
+       | L.SgiConstraint (c1, c2) =>
+         let
+             val (c1', k1, gs1) = elabCon (env, denv) c1
+             val (c2', k2, gs2) = elabCon (env, denv) c2
+
+             val denv = D.assert env denv (c1', c2')
+         in
+             checkKind env c1' k1 (L'.KRecord (kunif env loc), loc);
+             checkKind env c2' k2 (L'.KRecord (kunif env loc), loc);
+
+             ([(L'.SgiConstraint (c1', c2'), loc)], (env, denv, gs1 @ gs2))
+         end
+
+       | L.SgiClassAbs (x, k) =>
+         let
+             val k = elabKind env k
+             val (env, n) = E.pushCNamed env x k NONE
+             val env = E.pushClass env n
+         in
+             ([(L'.SgiClassAbs (x, n, k), loc)], (env, denv, []))
+         end
+
+       | L.SgiClass (x, k, c) =>
+         let
+             val k = elabKind env k
+             val (c', ck, gs) = elabCon (env, denv) c
+             val (env, n) = E.pushCNamed env x k (SOME c')
+             val env = E.pushClass env n
+         in
+             checkKind env c' ck k;
+             ([(L'.SgiClass (x, n, k, c'), loc)], (env, denv, []))
+         end)
+
+and elabSgn (env, denv) (sgn, loc) =
+    case sgn of
+        L.SgnConst sgis =>
+        let
+            val (sgis', (_, _, gs)) = ListUtil.foldlMapConcat elabSgn_item (env, denv, []) sgis
+
+            val _ = foldl (fn ((sgi, loc), (cons, vals, sgns, strs)) =>
+                              case sgi of
+                                  L'.SgiConAbs (x, _, _) =>
+                                  (if SS.member (cons, x) then
+                                       sgnError env (DuplicateCon (loc, x))
+                                   else
+                                       ();
+                                   (SS.add (cons, x), vals, sgns, strs))
+                                | L'.SgiCon (x, _, _, _) =>
+                                  (if SS.member (cons, x) then
+                                       sgnError env (DuplicateCon (loc, x))
+                                   else
+                                       ();
+                                   (SS.add (cons, x), vals, sgns, strs))
+                                | L'.SgiDatatype dts =>
+                                  let
+                                      val (cons, vals) =
+                                          let
+                                              fun doOne ((x, _, _, xncs), (cons, vals)) =
+                                                  let
+                                                      val vals = foldl (fn ((x, _, _), vals) =>
+                                                                           (if SS.member (vals, x) then
+                                                                                sgnError env (DuplicateVal (loc, x))
+                                                                            else
+                                                                                ();
+                                                                            SS.add (vals, x)))
+                                                                       vals xncs
+                                                  in
+                                                      if SS.member (cons, x) then
+                                                          sgnError env (DuplicateCon (loc, x))
+                                                      else
+                                                          ();
+                                                      (SS.add (cons, x), vals)
+                                                  end
+                                          in
+                                              foldl doOne (cons, vals) dts
+                                          end
+                                  in
+                                      (cons, vals, sgns, strs)
+                                  end
+                                | L'.SgiDatatypeImp (x, _, _, _, _, _, _) =>
+                                  (if SS.member (cons, x) then
+                                       sgnError env (DuplicateCon (loc, x))
+                                   else
+                                       ();
+                                   (SS.add (cons, x), vals, sgns, strs))
+                                | L'.SgiVal (x, _, _) =>
+                                  (if SS.member (vals, x) then
+                                       sgnError env (DuplicateVal (loc, x))
+                                   else
+                                       ();
+                                   (cons, SS.add (vals, x), sgns, strs))
+                                | L'.SgiSgn (x, _, _) =>
+                                  (if SS.member (sgns, x) then
+                                       sgnError env (DuplicateSgn (loc, x))
+                                   else
+                                       ();
+                                   (cons, vals, SS.add (sgns, x), strs))
+                                | L'.SgiStr (_, x, _, _) =>
+                                  (if SS.member (strs, x) then
+                                       sgnError env (DuplicateStr (loc, x))
+                                   else
+                                       ();
+                                   (cons, vals, sgns, SS.add (strs, x)))
+                                | L'.SgiConstraint _ => (cons, vals, sgns, strs)
+                                | L'.SgiClassAbs (x, _, _) =>
+                                  (if SS.member (cons, x) then
+                                       sgnError env (DuplicateCon (loc, x))
+                                   else
+                                       ();
+                                   (SS.add (cons, x), vals, sgns, strs))
+                                | L'.SgiClass (x, _, _, _) =>
+                                  (if SS.member (cons, x) then
+                                       sgnError env (DuplicateCon (loc, x))
+                                   else
+                                       ();
+                                   (SS.add (cons, x), vals, sgns, strs)))
+                    (SS.empty, SS.empty, SS.empty, SS.empty) sgis'
+        in
+            ((L'.SgnConst sgis', loc), gs)
+        end
+      | L.SgnVar x =>
+        (case E.lookupSgn env x of
+             NONE =>
+             (sgnError env (UnboundSgn (loc, x));
+              ((L'.SgnError, loc), []))
+           | SOME (n, sgis) => ((L'.SgnVar n, loc), []))
+      | L.SgnFun (m, dom, ran) =>
+        let
+            val (dom', gs1) = elabSgn (env, denv) dom
+            val (env', n) = E.pushStrNamed env m dom'
+            val denv' = dopenConstraints (loc, env', denv) {str = m, strs = []}
+            val (ran', gs2) = elabSgn (env', denv') ran
+        in
+            ((L'.SgnFun (m, n, dom', ran'), loc), gs1 @ gs2)
+        end
+      | L.SgnWhere (sgn, ms, x, c) =>
+        let
+            val (sgn', ds1) = elabSgn (env, denv) sgn
+            val (c', ck, ds2) = elabCon (env, denv) c
+
+	    fun checkPath (ms, sgn') =
+		case #1 (hnormSgn env sgn') of
+		    L'.SgnConst sgis =>
+                    List.exists (fn (L'.SgiConAbs (x', _, k), _) =>
+                                    List.null ms andalso x' = x andalso
+                                    (unifyKinds env k ck
+				     handle KUnify x => sgnError env (WhereWrongKind x);
+				     true)
+				  | (L'.SgiStr (_, x', _, sgn''), _) =>
+				    (case ms of
+					 [] => false
+				       | m :: ms' =>
+					 m = x' andalso
+					 checkPath (ms', sgn''))
+                                  | _ => false) sgis
+		  | _ => false
+	in
+	    if checkPath (ms, sgn') then
+                ((L'.SgnWhere (sgn', ms, x, c'), loc), ds1 @ ds2)
+            else
+                (sgnError env (UnWhereable (sgn', x));
+                 (sgnerror, []))
+        end
+      | L.SgnProj (m, ms, x) =>
+        (case E.lookupStr env m of
+             NONE => (strError env (UnboundStr (loc, m));
+                      (sgnerror, []))
+           | SOME (n, sgn) =>
+             let
+                 val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                          case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                              NONE => (strError env (UnboundStr (loc, m));
+                                                       (strerror, sgnerror))
+                                            | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                ((L'.StrVar n, loc), sgn) ms
+             in
+                 case E.projectSgn env {sgn = sgn, str = str, field = x} of
+                     NONE => (sgnError env (UnboundSgn (loc, x));
+                              (sgnerror, []))
+                   | SOME _ => ((L'.SgnProj (n, ms, x), loc), [])
+             end)
+                                                              
+
+and selfify env {str, strs, sgn} =
+    case #1 (hnormSgn env sgn) of
+        L'.SgnError => sgn
+      | L'.SgnVar _ => sgn
+
+      | L'.SgnConst sgis =>
+        (L'.SgnConst (#1 (ListUtil.foldlMapConcat
+                              (fn (sgi, env) =>
+                                  (case sgi of (L'.SgiConAbs (x, n, k), loc) =>
+                                               [(L'.SgiCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)]
+                                             | (L'.SgiDatatype dts, loc) =>
+                                               map (fn (x, n, xs, xncs) => (L'.SgiDatatypeImp (x, n, str, strs, x, xs, xncs), loc)) dts
+                                             | (L'.SgiClassAbs (x, n, k), loc) =>
+                                               [(L'.SgiClass (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)]
+                                             | (L'.SgiStr (im, x, n, sgn), loc) =>
+                                               [(L'.SgiStr (im, x, n, selfify env {str = str, strs = strs @ [x], sgn = sgn}), loc)]
+                                             | x => [x],
+                                   E.sgiBinds env sgi)) env sgis)), #2 sgn)
+      | L'.SgnFun _ => sgn
+      | L'.SgnWhere _ => sgn
+      | L'.SgnProj (m, ms, x) =>
+        case E.projectSgn env {str = foldl (fn (m, str) => (L'.StrProj (str, m), #2 sgn))
+                                           (L'.StrVar m, #2 sgn) ms,
+                               sgn = #2 (E.lookupStrNamed env m),
+                               field = x} of
+            NONE => raise Fail "Elaborate.selfify: projectSgn returns NONE"
+          | SOME sgn => selfify env {str = str, strs = strs, sgn = sgn}
+
+and selfifyAt env {str, sgn} =
+    let
+        fun self (str, _) =
+            case str of
+                L'.StrVar x => SOME (x, [])
+              | L'.StrProj (str, x) =>
+                (case self str of
+                     NONE => NONE
+                   | SOME (m, ms) => SOME (m, ms @ [x]))
+              | _ => NONE
+    in
+        case self str of
+            NONE => sgn
+          | SOME (str, strs) => selfify env {sgn = sgn, str = str, strs = strs}
+    end
+
+and dopen env {str, strs, sgn} =
+    let
+        fun isVisible x = x <> "" andalso String.sub (x, 0) <> #"?"
+
+        val m = foldl (fn (m, str) => (L'.StrProj (str, m), #2 sgn))
+                (L'.StrVar str, #2 sgn) strs
+    in
+        case #1 (hnormSgn env sgn) of
+            L'.SgnConst sgis =>
+            ListUtil.foldlMapConcat
+                (fn ((sgi, loc), env') =>
+                    let
+                        val d =
+                            case sgi of
+                                L'.SgiConAbs (x, n, k) =>
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
+                              | L'.SgiCon (x, n, k, c) =>
+                                if isVisible x then
+                                    [(L'.DCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
+                              | L'.SgiDatatype dts =>
+                                List.mapPartial (fn (x, n, xs, xncs) => if isVisible x then
+                                                                            SOME (L'.DDatatypeImp (x, n, str, strs, x, xs, xncs), loc)
+                                                                        else
+                                                                            NONE) dts
+                              | L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
+                                if isVisible x then
+                                    [(L'.DDatatypeImp (x, n, m1, ms, x', xs, xncs), loc)]
+                                else
+                                    []
+                              | L'.SgiVal (x, n, t) =>
+                                if isVisible x then
+                                    [(L'.DVal (x, n, t, (L'.EModProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
+                              | L'.SgiStr (_, x, n, sgn) =>
+                                if isVisible x then
+                                    [(L'.DStr (x, n, sgn, (L'.StrProj (m, x), loc)), loc)]
+                                else
+                                    []
+                              | L'.SgiSgn (x, n, sgn) =>
+                                if isVisible x then
+                                    [(L'.DSgn (x, n, (L'.SgnProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
+                              | L'.SgiConstraint (c1, c2) =>
+                                [(L'.DConstraint (c1, c2), loc)]
+                              | L'.SgiClassAbs (x, n, k) =>
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
+                              | L'.SgiClass (x, n, k, _) =>
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
+                    in
+                        (d, foldl (fn (d, env') => E.declBinds env' d) env' d)
+                    end)
+                env sgis
+          | _ => (strError env (UnOpenable sgn);
+                  ([], env))
+    end
+
+and sgiOfDecl (d, loc) =
+    case d of
+        L'.DCon (x, n, k, c) => [(L'.SgiCon (x, n, k, c), loc)]
+      | L'.DDatatype x => [(L'.SgiDatatype x, loc)]
+      | L'.DDatatypeImp x => [(L'.SgiDatatypeImp x, loc)]
+      | L'.DVal (x, n, t, _) => [(L'.SgiVal (x, n, t), loc)]
+      | L'.DValRec vis => map (fn (x, n, t, _) => (L'.SgiVal (x, n, t), loc)) vis
+      | L'.DSgn (x, n, sgn) => [(L'.SgiSgn (x, n, sgn), loc)]
+      | L'.DStr (x, n, sgn, _) => [(L'.SgiStr (L'.Import, x, n, sgn), loc)]
+      | L'.DFfiStr (x, n, sgn) => [(L'.SgiStr (L'.Import, x, n, sgn), loc)]
+      | L'.DConstraint cs => [(L'.SgiConstraint cs, loc)]
+      | L'.DExport _ => []
+      | L'.DTable (tn, x, n, c, _, pc, _, cc) =>
+        [(L'.SgiVal (x, n, (L'.CApp ((L'.CApp (tableOf (), c), loc),
+                                     (L'.CConcat (pc, cc), loc)), loc)), loc)]
+      | L'.DSequence (tn, x, n) => [(L'.SgiVal (x, n, sequenceOf ()), loc)]
+      | L'.DView (tn, x, n, _, c) =>
+        [(L'.SgiVal (x, n, (L'.CApp (viewOf (), c), loc)), loc)]
+      | 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'.DTask _ => []
+      | L'.DPolicy _ => []
+      | L'.DOnError _ => []
+      | L'.DFfi (x, n, _, t) => [(L'.SgiVal (x, n, t), loc)]
+
+and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
+    ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
+                        ("sgn2", p_sgn env sgn2)];*)
+    case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of
+        (L'.SgnError, _) => ()
+      | (_, L'.SgnError) => ()
+
+      | (L'.SgnConst sgis1, L'.SgnConst sgis2) =>
+        let
+           (*val () = prefaces "subSgn" [("sgn1", p_sgn env sgn1),
+                                        ("sgn2", p_sgn env sgn2),
+                                        ("sgis1", p_sgn env (L'.SgnConst sgis1, loc2)),
+                                        ("sgis2", p_sgn env (L'.SgnConst sgis2, loc2))]*)
+
+            fun cpart n = IM.find (!counterparts, n)
+            fun cparts (n2, n1) = counterparts := IM.insert (!counterparts, n2, n1)
+            fun uncparts n2 = (counterparts := #1 (IM.remove (!counterparts, n2)))
+                              handle NotFound => ()
+
+            val sub2 = U.Con.map {kind = fn k => k,
+                                  con = fn c =>
+                                           case c of
+                                               L'.CNamed n2 =>
+                                               (case cpart n2 of
+                                                    NONE => c
+                                                  | SOME n1 => L'.CNamed n1)
+                                             | _ => c}
+
+            fun folder (sgi2All as (sgi, loc), env) =
+                let
+                    (*val () = prefaces "folder" [("sgi2", p_sgn_item env sgi2All)]*)
+
+                    fun seek' f p =
+                        let
+                            fun seek env ls =
+                                case ls of
+                                    [] => f env
+                                  | h :: t =>
+                                    case p (env, h) of
+                                        NONE =>
+                                        let
+                                            val env = case #1 h of
+                                                          L'.SgiCon (x, n, k, c) =>
+                                                          if E.checkENamed env n then
+                                                              env
+                                                          else
+                                                              (uncparts n;
+                                                               E.pushCNamedAs env x n k (SOME c))
+                                                        | L'.SgiConAbs (x, n, k) =>
+                                                          if E.checkENamed env n then
+                                                              env
+                                                          else
+                                                              E.pushCNamedAs env x n k NONE
+                                                        | _ => env
+                                        in
+                                            seek (E.sgiBinds env h) t
+                                        end
+                                      | SOME envs => envs
+                        in
+                            seek env sgis1
+                        end
+
+                    val seek = seek' (fn env => (sgnError env (UnmatchedSgi (strLoc, sgi2All));
+                                                 env))
+                in
+                    case sgi of
+                        L'.SgiConAbs (x, n2, k2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 let
+                                     fun found (x', n1, k1, co1) =
+                                         if x = x' then
+                                             let
+                                                 val () = unifyKinds env k1 k2
+                                                     handle KUnify (k1, k2, env', err) =>
+                                                            sgnError env (SgiWrongKind (loc, sgi1All, k1,
+                                                                                        sgi2All, k2, env', err))
+                                                 val env = E.pushCNamedAs env x n1 k1 co1
+                                             in
+                                                 SOME (if n1 = n2 then
+                                                           env
+                                                       else
+                                                           (cparts (n2, n1);
+                                                            E.pushCNamedAs env x n2 k2 (SOME (L'.CNamed n1, loc2))))
+                                             end
+                                         else
+                                             NONE
+                                 in
+                                     case sgi1 of
+                                         L'.SgiConAbs (x', n1, k1) => found (x', n1, k1, NONE)
+                                       | L'.SgiCon (x', n1, k1, c1) => found (x', n1, k1, SOME c1)
+                                       | L'.SgiDatatype dts =>
+                                         let
+                                             val k = (L'.KType, loc)
+
+                                             fun search dts =
+                                                 case dts of
+                                                     [] => NONE
+                                                   | (x', n1, xs, _) :: dts =>
+                                                     let
+                                                         val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                                     in
+                                                         case found (x', n1, k', NONE) of
+                                                             NONE => search dts
+                                                           | x => x
+                                                     end
+                                         in
+                                             search dts
+                                         end
+                                       | L'.SgiDatatypeImp (x', n1, m1, ms, s, xs, _) =>
+                                         let
+                                             val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                         in
+                                             found (x', n1, k', SOME (L'.CModProj (m1, ms, s), loc))
+                                         end
+                                       | L'.SgiClassAbs (x', n1, k) => found (x', n1, k, NONE)
+                                       | L'.SgiClass (x', n1, k, c) => found (x', n1, k, SOME c)
+                                       | _ => NONE
+                                 end)
+
+                      | L'.SgiCon (x, n2, k2, c2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 let
+                                     fun found (x', n1, k1, c1) =
+                                         if x = x' then
+                                             let
+                                                 val c2 = sub2 c2
+
+                                                 fun good () =
+                                                     let
+                                                         val env = E.pushCNamedAs env x n2 k2 (SOME c2)
+                                                         val env = if n1 = n2 then
+                                                                       env
+                                                                   else
+                                                                       (cparts (n2, n1);
+                                                                        E.pushCNamedAs env x n1 k1 (SOME c1))
+                                                     in
+                                                         SOME env
+                                                     end
+                                             in
+                                                 (unifyCons env loc c1 c2;
+                                                  good ())
+                                                 handle CUnify (c1, c2, env', err) =>
+                                                        (sgnError env (SgiWrongCon (loc, sgi1All, c1,
+                                                                                    sgi2All, c2, env', err));
+                                                         good ())
+                                             end
+                                         else
+                                             NONE
+                                 in
+                                     case sgi1 of
+                                         L'.SgiCon (x', n1, k1, c1) => found (x', n1, k1, c1)
+                                       | L'.SgiClass (x', n1, k1, c1) => found (x', n1, k1, c1)
+                                       | _ => NONE
+                                 end)
+
+                      | L'.SgiDatatype dts2 =>
+                        let
+                            fun found' (sgi1All as (_, loc), (x1, n1, xs1, xncs1), (x2, n2, xs2, xncs2), env) =
+                                if x1 <> x2 then
+                                    NONE
+                                else
+                                    let
+                                        fun mismatched ue =
+                                            (sgnError env (SgiMismatchedDatatypes (loc, sgi1All, sgi2All, ue));
+                                             SOME env)
+
+                                        val k = (L'.KType, loc)
+                                        val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs1
+
+                                        fun good () =
+                                            let
+                                                val env = E.sgiBinds env sgi1All
+                                                val env = if n1 = n2 then
+                                                              env
+                                                          else
+                                                              (cparts (n2, n1);
+                                                               E.pushCNamedAs env x1 n2 k'
+                                                                              (SOME (L'.CNamed n1, loc)))
+                                            in
+                                                SOME env
+                                            end
+
+                                        val env = E.pushCNamedAs env x1 n1 k' NONE
+                                        val env = if n1 = n2 then
+                                                      env
+                                                  else
+                                                      (cparts (n2, n1);
+                                                       E.pushCNamedAs env x1 n2 k' (SOME (L'.CNamed n1, loc)))
+                                        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs1
+                                        fun xncBad ((x1, _, t1), (x2, _, t2)) =
+                                            String.compare (x1, x2) <> EQUAL
+                                            orelse case (t1, t2) of
+                                                       (NONE, NONE) => false
+                                                     | (SOME t1, SOME t2) =>
+                                                       (unifyCons env loc t1 (sub2 t2); false)
+                                                     | _ => true
+                                    in
+                                        (if xs1 <> xs2
+                                            orelse length xncs1 <> length xncs2
+                                            orelse ListPair.exists xncBad (xncs1, xncs2) then
+                                             mismatched NONE
+                                         else
+                                             good ())
+                                        handle CUnify ue => mismatched (SOME ue)
+                                    end
+                        in
+                            seek'
+                                (fn _ =>
+                                    let
+                                        fun seekOne (dt2, env) =
+                                            seek (fn (env, sgi1All as (sgi1, _)) =>
+                                                     case sgi1 of
+                                                         L'.SgiDatatypeImp (x', n1, _, _, _, xs, xncs1) =>
+                                                         found' (sgi1All, (x', n1, xs, xncs1), dt2, env)
+                                                       | _ => NONE)
+
+                                        fun seekAll (dts, env) =
+                                            case dts of
+                                                [] => env
+                                              | dt :: dts => seekAll (dts, seekOne (dt, env))
+                                    in
+                                        seekAll (dts2, env)
+                                    end)
+                                (fn (env, sgi1All as (sgi1, _)) =>
+                                    let
+                                        fun found dts1 =
+                                            let
+                                                fun iter (dts1, dts2, env) =
+                                                    case (dts1, dts2) of
+                                                        ([], []) => SOME env
+                                                      | (dt1 :: dts1, dt2 :: dts2) =>
+                                                        (case found' (sgi1All, dt1, dt2, env) of
+                                                             NONE => NONE
+                                                           | SOME env => iter (dts1, dts2, env))
+                                                      | _ => NONE
+                                            in
+                                                iter (dts1, dts2, env)
+                                            end
+                                    in
+                                        case sgi1 of
+                                            L'.SgiDatatype dts1 => found dts1
+                                          | _ => NONE
+                                    end)
+                        end
+
+                      | L'.SgiDatatypeImp (x, n2, m12, ms2, s2, xs, _) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 case sgi1 of
+                                     L'.SgiDatatypeImp (x', n1, m11, ms1, s1, _, _) =>
+                                     if x = x' then
+                                         let
+                                             val k = (L'.KType, loc)
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                             val t1 = (L'.CModProj (m11, ms1, s1), loc)
+                                             val t2 = (L'.CModProj (m12, ms2, s2), loc)
+
+                                             fun good () =
+                                                 let
+                                                     val env = E.pushCNamedAs env x n1 k' (SOME t1)
+                                                     val env = E.pushCNamedAs env x n2 k' (SOME t2)
+                                                 in
+                                                     cparts (n2, n1);
+                                                     SOME env
+                                                 end
+                                         in
+                                             (unifyCons env loc t1 t2;
+                                              good ())
+                                             handle CUnify (c1, c2, env', err) =>
+                                                    (sgnError env (SgiWrongCon (loc, sgi1All, c1, sgi2All, c2, env', err));
+                                                     good ())
+                                         end
+                                     else
+                                         NONE
+
+                                   | _ => NONE)
+
+                      | L'.SgiVal (x, n2, c2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 case sgi1 of
+                                     L'.SgiVal (x', n1, c1) =>
+                                     if x = x' then
+                                         ((*prefaces "val" [("x", PD.string x),
+                                                          ("n1", PD.string (Int.toString n1)),
+                                                          ("c1", p_con env c1),
+                                                          ("c2", p_con env c2),
+                                                          ("c2'", p_con env (sub2 c2))];*)
+                                          unifyCons env loc c1 (sub2 c2);
+                                          SOME env)
+                                         handle CUnify (c1, c2, env', err) =>
+                                                (sgnError env (SgiWrongCon (loc, sgi1All, c1, sgi2All, c2, env', err));
+                                                 SOME env)
+                                     else
+                                         NONE
+                                   | _ => NONE)
+
+                      | L'.SgiStr (_, x, n2, sgn2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 case sgi1 of
+                                     L'.SgiStr (_, x', n1, sgn1) =>
+                                     if x = x' then
+                                         let
+                                             (* Don't forget to save & restore the
+                                              * counterparts map around recursive calls!
+                                              * Otherwise, all sorts of mayhem may result. *)
+                                             val saved = !counterparts
+                                             val () = subSgn' counterparts env loc sgn1 sgn2
+                                             val () = counterparts := saved
+                                             val env = E.pushStrNamedAs env x n1 sgn1
+                                             val env = if n1 = n2 then
+                                                           env
+                                                       else
+                                                           E.pushStrNamedAs env x n2
+                                                                            (selfifyAt env {str = (L'.StrVar n1, #2 sgn2),
+                                                                                            sgn = sgn2})
+                                         in
+                                             SOME env
+                                         end
+                                     else
+                                         NONE
+                                   | _ => NONE)
+
+                      | L'.SgiSgn (x, n2, sgn2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 case sgi1 of
+                                     L'.SgiSgn (x', n1, sgn1) =>
+                                     if x = x' then
+                                         let
+                                             val () = subSgn' counterparts env loc sgn1 sgn2
+                                             val () = subSgn' counterparts env loc sgn2 sgn1
+
+                                             val env = E.pushSgnNamedAs env x n2 sgn2
+                                             val env = if n1 = n2 then
+                                                           env
+                                                       else
+                                                           (cparts (n2, n1);
+                                                            E.pushSgnNamedAs env x n1 sgn2)
+                                         in
+                                             SOME env
+                                         end
+                                     else
+                                         NONE
+                                   | _ => NONE)
+
+                      | L'.SgiConstraint (c2, d2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 case sgi1 of
+                                     L'.SgiConstraint (c1, d1) =>
+                                     (* It's important to do only simple equality checking here,
+                                      * with no unification, because constraints are unnamed.
+                                      * It's too easy to pick the wrong pair to unify! *)
+                                     if consEqSimple env (c1, c2)
+					andalso consEqSimple env (d1, d2) then
+                                         SOME env
+                                     else
+                                         NONE
+                                   | _ => NONE)
+
+                      | L'.SgiClassAbs (x, n2, k2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 let
+                                     fun found (x', n1, k1, co) =
+                                         if x = x' then
+                                             let
+                                                 val () = unifyKinds env k1 k2
+                                                     handle KUnify (k1, k2, env', err) =>
+                                                            sgnError env (SgiWrongKind (loc, sgi1All, k1,
+                                                                                        sgi2All, k2, env', err))
+
+                                                 val env = E.pushCNamedAs env x n1 k1 co
+                                             in
+                                                 SOME (if n1 = n2 then
+                                                           env
+                                                       else
+                                                           (cparts (n2, n1);
+                                                            E.pushCNamedAs env x n2 k1 (SOME (L'.CNamed n1, loc2))))
+                                             end
+                                         else
+                                             NONE
+                                 in
+                                     case sgi1 of
+                                         L'.SgiClassAbs (x', n1, k1) => found (x', n1, k1, NONE)
+                                       | L'.SgiClass (x', n1, k1, c) => found (x', n1, k1, SOME c)
+                                       | L'.SgiConAbs (x', n1, k1) => found (x', n1, k1, NONE)
+                                       | L'.SgiCon (x', n1, k1, c) => found (x', n1, k1, SOME c)
+                                       | _ => NONE
+                                 end)
+                      | L'.SgiClass (x, n2, k2, c2) =>
+                        seek (fn (env, sgi1All as (sgi1, loc)) =>
+                                 let
+                                     fun found (x', n1, k1, c1) =
+                                         if x = x' then
+                                             let
+                                                 val () = unifyKinds env k1 k2
+                                                     handle KUnify (k1, k2, env', err) =>
+                                                            sgnError env (SgiWrongKind (loc, sgi1All, k1,
+                                                                                        sgi2All, k2, env', err))
+
+                                                 val c2 = sub2 c2
+
+                                                 fun good () =
+                                                     let
+                                                         val env = E.pushCNamedAs env x n2 k2 (SOME c2)
+                                                         val env = if n1 = n2 then
+                                                                       env
+                                                                   else
+                                                                       (cparts (n2, n1);
+                                                                        E.pushCNamedAs env x n1 k2 (SOME c1))
+                                                     in
+                                                         SOME env
+                                                     end
+                                             in
+                                                 (unifyCons env loc c1 c2;
+                                                  good ())
+                                                 handle CUnify (c1, c2, env', err) =>
+                                                        (sgnError env (SgiWrongCon (loc, sgi1All, c1,
+                                                                                    sgi2All, c2, env', err));
+                                                         good ())
+                                             end
+                                         else
+                                             NONE
+                                 in
+                                     case sgi1 of
+                                         L'.SgiClass (x', n1, k1, c1) => found (x', n1, k1, c1)
+                                       | L'.SgiCon (x', n1, k1, c1) => found (x', n1, k1, c1)
+                                       | _ => NONE
+                                 end)
+                end
+        in
+            ignore (foldl folder env sgis2)
+        end
+
+      | (L'.SgnFun (m1, n1, dom1, ran1), L'.SgnFun (m2, n2, dom2, ran2)) =>
+        let
+            val ran2 =
+                if n1 = n2 then
+                    ran2
+                else
+                    subStrInSgn (n2, n1) ran2
+        in
+            subSgn' counterparts env strLoc dom2 dom1;
+            subSgn' counterparts (E.pushStrNamedAs env m1 n1 dom2) strLoc ran1 ran2
+        end
+
+      | _ => sgnError env (SgnWrongForm (strLoc, sgn1, sgn2)))
+
+and subSgn env x y z = subSgn' (ref IM.empty) env x y z
+    handle e as E.UnboundNamed _ => if ErrorMsg.anyErrors () then () else raise e
+
+and positive self =
+    let
+        open L
+
+        fun none (c, _) =
+            case c of
+                CAnnot (c, _) => none c
+
+              | TFun (c1, c2) => none c1 andalso none c2
+              | TCFun (_, _, _, c) => none c
+              | TRecord c => none c
+
+              | CVar ([], x) => x <> self
+              | CVar _ => true
+              | CApp (c1, c2) => none c1 andalso none c2
+              | CAbs _ => false
+              | TDisjoint (c1, c2, c3) => none c1 andalso none c2 andalso none c3
+
+              | CKAbs _ => false
+              | TKFun _ => false
+
+              | CName _ => true
+
+              | CRecord xcs => List.all (fn (c1, c2) => none c1 andalso none c2) xcs
+              | CConcat (c1, c2) => none c1 andalso none c2
+              | CMap => true
+
+              | CUnit => true
+
+              | CTuple cs => List.all none cs
+              | CProj (c, _) => none c
+
+              | CWild _ => false                
+
+        fun pos (c, _) =
+            case c of
+                CAnnot (c, _) => pos c
+
+              | TFun (c1, c2) => none c1 andalso pos c2
+              | TCFun (_, _, _, c) => pos c
+              | TRecord c => pos c
+
+              | CVar _ => true
+              | CApp (c1, c2) => pos c1 andalso none c2
+              | CAbs _ => false
+              | TDisjoint (c1, c2, c3) => none c1 andalso none c2 andalso none c3
+
+              | CKAbs _ => false
+              | TKFun _ => false
+
+              | CName _ => true
+
+              | CRecord xcs => List.all (fn (c1, c2) => none c1 andalso pos c2) xcs
+              | CConcat (c1, c2) => pos c1 andalso pos c2
+              | CMap => true
+
+              | CUnit => true
+
+              | CTuple cs => List.all pos cs
+              | CProj (c, _) => pos c
+
+              | CWild _ => false
+    in
+        pos
+    end
+
+and wildifyStr env (str, sgn) =
+    case #1 (hnormSgn env sgn) of
+        L'.SgnConst sgis =>
+        (case #1 str of
+             L.StrConst ds =>
+             let
+                 fun cname d =
+                     case d of
+                         L'.SgiCon (x, _, _, _) => SOME x
+                       | L'.SgiConAbs (x, _, _) => SOME x
+                       | L'.SgiClass (x, _, _, _) => SOME x
+                       | L'.SgiClassAbs (x, _, _) => SOME x
+                       | _ => NONE
+
+                 fun dname (d, _) =
+                     case d of
+                         L.DCon (x, _, _) => SOME x
+                       | _ => NONE
+                                                     
+                 fun decompileKind (k, loc) =
+                     case k of
+                         L'.KType => SOME (L.KType, loc)
+                       | L'.KArrow (k1, k2) =>
+                         (case (decompileKind k1, decompileKind k2) of
+                              (SOME k1, SOME k2) => SOME (L.KArrow (k1, k2), loc)
+                            | _ => NONE)
+                       | L'.KName => SOME (L.KName, loc)
+                       | L'.KRecord k =>
+                         (case decompileKind k of
+                              SOME k => SOME (L.KRecord k, loc)
+                            | _ => NONE)
+                       | L'.KUnit => SOME (L.KUnit, loc)
+                       | L'.KTuple ks =>
+                         let
+                             val ks' = List.mapPartial decompileKind ks
+                         in
+                             if length ks' = length ks then
+                                 SOME (L.KTuple ks', loc)
+                             else
+                                 NONE
+                         end
+
+                       | L'.KError => NONE
+                       | L'.KUnif (_, _, ref (L'.KKnown k)) => decompileKind k
+                       | L'.KUnif _ => NONE
+                       | L'.KTupleUnif (_, _, ref (L'.KKnown k)) => decompileKind k
+                       | L'.KTupleUnif _ => NONE
+
+                       | L'.KRel _ => NONE
+                       | L'.KFun _ => NONE
+
+                 fun maybeHnorm env c =
+		     hnormCon env c
+		     handle E.UnboundNamed _ => c
+
+                 fun decompileCon env c =
+		     case decompileCon' env c of
+			 SOME v => SOME v
+		       | NONE => decompileCon' env (maybeHnorm env c)
+
+		 and decompileCon' env (c as (_, loc)) =
+                     case #1 c of
+                         L'.CRel i =>
+                         let
+                             val (s, _) = E.lookupCRel env i
+                         in
+                             SOME (L.CVar ([], s), loc)
+                         end
+                       | L'.CNamed i =>
+                         let
+                             val (s, _, _) = E.lookupCNamed env i
+                         in
+                             SOME (L.CVar ([], s), loc)
+                         end
+                       | L'.CModProj (m1, ms, x) =>
+                         let
+                             val (s, _) = E.lookupStrNamed env m1
+                         in
+                             SOME (L.CVar (s :: ms, x), loc)
+                         end
+                       | L'.CName s => SOME (L.CName s, loc)
+                       | L'.CRecord (k, xcs) =>
+                         let
+                             fun fields xcs =
+                                 case xcs of
+                                     [] => SOME []
+                                   | (x, t) :: xcs =>
+                                     case (decompileCon env x, decompileCon env t, fields xcs) of
+                                         (SOME x, SOME t, SOME xcs) => SOME ((x, t) :: xcs)
+                                       | _ => NONE
+
+                             val c' = Option.map (fn xcs => (L.CRecord xcs, loc))
+                                                 (fields xcs)
+                         in
+                             Option.map (fn c' =>
+                                            case decompileKind k of
+                                                NONE => c'
+                                              | SOME k' => (L.CAnnot (c', (L.KRecord k', loc)), loc)) c'
+                         end
+                       | L'.CConcat (c1, c2) =>
+                         (case (decompileCon env c1, decompileCon env c2) of
+                              (SOME c1, SOME c2) => SOME (L.CConcat (c1, c2), loc)
+                            | _ => NONE)
+                       | L'.CUnit => SOME (L.CUnit, loc)
+                       | L'.CUnif (nl, _, _, _, ref (L'.Known c)) => decompileCon env (E.mliftConInCon nl c)
+
+                       | L'.CApp (f, x) =>
+                         (case (decompileCon env f, decompileCon env x) of
+                              (SOME f, SOME x) => SOME (L.CApp (f, x), loc)
+                            | _ => NONE)
+
+		       | L'.CTuple cs =>
+			 let
+			     val cs' = foldr (fn (c, cs') =>
+						 case cs' of
+						     NONE => NONE
+						   | SOME cs' =>
+						     case decompileCon env c of
+							 NONE => NONE
+						       | SOME c' => SOME (c' :: cs'))
+				       (SOME []) cs
+			 in
+			     case cs' of
+				 NONE => NONE
+			       | SOME cs' => SOME (L.CTuple cs', loc)
+			 end
+
+		       | L'.CMap _ => SOME (L.CMap, loc)
+		       | L'.TRecord c =>
+			 (case decompileCon env c of
+			      NONE => NONE
+			    | SOME c' => SOME (L.TRecord c', loc))
+
+                       | c => ((*Print.preface ("WTF?", p_con env (c, loc));*) NONE)
+
+                 fun isClassOrFolder' env (c : L'.con) =
+                     case #1 c of
+                         L'.CAbs (x, k, c) =>
+                         let
+                             val env = E.pushCRel env x k
+
+                             fun toHead (c : L'.con) =
+                                 case #1 c of
+                                     L'.CApp (c, _) => toHead c
+                                   | _ => isClassOrFolder env c
+                         in
+                             toHead (hnormCon env c)
+                         end
+                       | _ => isClassOrFolder env c
+
+                 fun buildNeeded env sgis =
+                     #1 (foldl (fn ((sgi, loc), (nd, env')) =>
+                                   (case sgi of
+                                        L'.SgiCon (x, _, k, _) => naddCon (nd, x, k)
+                                      | L'.SgiConAbs (x, _, k) => naddCon (nd, x, k)
+                                      | L'.SgiConstraint cs => naddConstraint (nd, (env', cs, loc))
+                                      | L'.SgiVal (x, _, t) =>
+                                        let
+                                            fun should t =
+                                                let
+                                                    val t = normClassConstraint env' t
+
+                                                    fun shouldR c =
+                                                        case hnormCon env' c of
+                                                            (L'.CApp (f, _), _) =>
+                                                            (case hnormCon env' f of
+                                                                 (L'.CApp (f, cl), loc) =>
+                                                                 (case hnormCon env' f of
+                                                                      (L'.CMap _, _) => isClassOrFolder' env' cl
+                                                                    | _ => false)
+                                                               | _ => false)
+                                                            | (L'.CConcat (c1, c2), _) =>
+                                                              shouldR c1 orelse shouldR c2
+                                                            | c => false
+                                                in
+                                                    case #1 t of
+                                                        L'.CApp (f, _) => isClassOrFolder env' f
+                                                      | L'.TRecord t => shouldR t
+                                                      | _ => false
+                                                end
+                                         in
+                                            if should t then
+                                                naddVal (nd, x)
+                                            else
+                                                nd
+                                        end
+                                      | L'.SgiStr (_, x, _, s) =>
+                                        (case #1 (hnormSgn env' s) of
+                                             L'.SgnConst sgis' => naddMod (nd, x, (env', buildNeeded env' sgis'))
+                                           | _ => nd)
+                                      | _ => nd,
+                                    E.sgiBinds env' (sgi, loc)))
+                               (nempty, env) sgis)
+
+                 val nd = buildNeeded env sgis
+
+                 fun removeUsed (nd, ds) =
+                     foldl (fn ((d, _), nd) =>
+                               case d of
+                                   L.DCon (x, _, _) => ndelCon (nd, x)
+                                 | L.DVal (p, _) =>
+                                   foldl (fn (x, nd) => ndelVal (nd, x)) nd (patVarsOf p)
+                                 | L.DOpen _ => nempty
+                                 | L.DStr (x, _, _, (L.StrConst ds', _), _) =>
+                                   (case SM.find (nmods nd, x) of
+                                        NONE => nd
+                                      | SOME (env, nd') => naddMod (nd, x, (env, removeUsed (nd', ds'))))
+                                 | _ => nd)
+                           nd ds
+
+                 val nd = removeUsed (nd, ds)
+
+                 (* Among the declarations present explicitly in the program, find the last constructor or constraint declaration.
+                  * The new constructor/constraint declarations that we add may safely be put after that point. *)
+                 fun findLast (ds, acc) =
+                     case ds of
+                         [] => ([], acc)
+                       | (d : L.decl) :: ds' =>
+                         let
+                             val isCony = case #1 d of
+                                              L.DCon _ => true
+                                            | L.DDatatype _ => true
+                                            | L.DDatatypeImp _ => true
+                                            | L.DStr _ => true
+                                            | L.DConstraint _ => true
+                                            | _ => false
+                         in
+                             if isCony then
+                                 (ds, acc)
+                             else
+                                 findLast (ds', d :: acc)
+                         end
+
+                 val (dPrefix, dSuffix) = findLast (rev ds, [])
+
+                 fun extend (env, nd, ds) =
+                     let
+                         val ds' = List.mapPartial (fn (env', (c1, c2), loc) =>
+                                                       case (decompileCon env' c1, decompileCon env' c2) of
+                                                           (SOME c1, SOME c2) =>
+                                                           SOME (L.DConstraint (c1, c2), loc)
+                                                         | _ => NONE) (nconstraints nd)
+
+                         val ds' =
+                             case SS.listItems (nvals nd) of
+                                 [] => ds'
+                               | xs =>
+                                 let
+                                     val ewild = (L.EWild, #2 str)
+                                     val ds'' = map (fn x => (L.DVal ((L.PVar x, #2 str), ewild), #2 str)) xs
+                                 in
+                                     ds'' @ ds'
+                                 end
+
+                         val ds' =
+                             case ncons nd of
+                                 [] => ds'
+                               | xs =>
+                                 map (fn (x, k) =>
+                                         let
+                                             val k =
+                                                 case decompileKind k of
+                                                     NONE => (L.KWild, #2 str)
+                                                   | SOME k => k
+                                                               
+                                             val cwild = (L.CWild k, #2 str)
+                                         in
+                                             (L.DCon (x, NONE, cwild), #2 str)
+                                         end) xs @ ds'
+
+                         val ds = ds @ ds'
+                     in
+                         map (fn d as (L.DStr (x, s, tm, (L.StrConst ds', loc'), r), loc) =>
+                                 (case SM.find (nmods nd, x) of
+                                      NONE => d
+                                    | SOME (env, nd') =>
+                                      (L.DStr (x, s, tm, (L.StrConst (extend (env, nd', ds')), loc'), r), loc))
+                               | d => d) ds
+                     end
+             in
+                 (L.StrConst (extend (env, nd, rev dPrefix) @ dSuffix), #2 str)
+             end
+           | _ => str)
+      | _ => str
+
+and elabDecl (dAll as (d, loc), (env, denv, gs)) =
+    let
+        (*val () = preface ("elabDecl", SourcePrint.p_decl dAll)*)
+        (*val befor = Time.now ()*)
+
+        val r = 
+            case d of
+                L.DCon (x, ko, c) =>
+                let
+                    val k' = case ko of
+                                 NONE => kunif env loc
+                               | SOME k => elabKind env k
+
+                    val (c', ck, gs') = elabCon (env, denv) c
+                    val (env', n) = E.pushCNamed env x k' (SOME c')
+                in
+                    checkKind env c' ck k';
+
+                    ([(L'.DCon (x, n, k', c'), loc)], (env', denv, enD gs' @ gs))
+                end
+              | L.DDatatype dts =>
+                let
+                    val k = (L'.KType, loc)
+
+                    val (dts, env) = ListUtil.foldlMap
+                                     (fn ((x, xs, xcs), env) =>
+                                         let
+                                             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                             val (env, n) = E.pushCNamed env x k' NONE
+                                         in
+                                             ((x, n, xs, xcs), env)
+                                         end)
+                                     env dts
+
+                    val (dts, (env, gs')) = ListUtil.foldlMap
+                                     (fn ((x, n, xs, xcs), (env, gs')) =>
+                                         let
+                                             val t = (L'.CNamed n, loc)
+                                             val nxs = length xs - 1
+                                             val t = ListUtil.foldli
+                                                         (fn (i, _, t) =>
+                                                             (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
+
+                                             val (env', denv') = foldl (fn (x, (env', denv')) =>
+                                                                           (E.pushCRel env' x k,
+                                                                            D.enter denv')) (env, denv) xs
+
+                                             val (xcs, (used, env, gs')) =
+                                                 ListUtil.foldlMap
+                                                     (fn ((x, to), (used, env, gs)) =>
+                                                         let
+                                                             val (to, t, gs') = case to of
+                                                                                    NONE => (NONE, t, gs)
+                                                                                  | SOME t' =>
+                                                                                    let
+                                                                                        val (t', tk, gs') = elabCon (env', denv') t'
+                                                                                    in
+                                                                                        checkKind env' t' tk k;
+                                                                                        (SOME t', (L'.TFun (t', t), loc), enD gs' @ gs)
+                                                                                    end
+                                                             val t = foldr (fn (x, t) => (L'.TCFun (L'.Implicit, x, k, t), loc)) t xs
+
+                                                             val (env, n') = E.pushENamed env x t
+                                                         in
+                                                             if SS.member (used, x) then
+                                                                 strError env (DuplicateConstructor (x, loc))
+                                                             else
+                                                                 ();
+                                                             ((x, n', to), (SS.add (used, x), env, gs'))
+                                                         end)
+                                                     (SS.empty, env, gs') xcs
+                                         in
+                                             ((x, n, xs, xcs), (E.pushDatatype env n xs xcs, gs'))
+                                         end)
+                                     (env, []) dts
+                in
+                    ([(L'.DDatatype dts, loc)], (env, denv, gs' @ gs))
+                end
+
+              | L.DDatatypeImp (_, [], _) => raise Fail "Empty DDatatypeImp"
+
+              | L.DDatatypeImp (x, m1 :: ms, s) =>
+                (case E.lookupStr env m1 of
+                     NONE => (expError env (UnboundStrInExp (loc, m1));
+                              ([], (env, denv, gs)))
+                   | SOME (n, sgn) =>
+                     let
+                         val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                    case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                        NONE => (conError env (UnboundStrInCon (loc, m));
+                                                                 (strerror, sgnerror))
+                                                      | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                                ((L'.StrVar n, loc), sgn) ms
+                     in
+                         case hnormCon env (L'.CModProj (n, ms, s), loc) of
+                             (L'.CModProj (n, ms, s), _) =>
+                             (case E.projectDatatype env {sgn = sgn, str = str, field = s} of
+                                  NONE => (conError env (UnboundDatatype (loc, s));
+                                           ([], (env, denv, gs)))
+                                | SOME (xs, xncs) =>
+                                  let
+                                      val k = (L'.KType, loc)
+                                      val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
+                                      val t = (L'.CModProj (n, ms, s), loc)
+                                      val (env, n') = E.pushCNamed env x k' (SOME t)
+                                      val env = E.pushDatatype env n' xs xncs
+
+                                      val t = (L'.CNamed n', loc)
+                                      val nxs = length xs
+                                      val t = ListUtil.foldli (fn (i, _, t) =>
+                                                                  (L'.CApp (t, (L'.CRel (nxs - 1 - i), loc)), loc))
+                                                              t xs
+                                      val env = foldl (fn ((x, n, to), env) =>
+                                                          let
+                                                              val t = case to of
+                                                                          NONE => t
+                                                                        | SOME t' => (L'.TFun (t', t), loc)
+
+                                                              val t = foldr (fn (x, t) =>
+                                                                                (L'.TCFun (L'.Implicit, x, k, t), loc))
+                                                                            t xs
+                                                          in
+                                                              E.pushENamedAs env x n t
+                                                          end) env xncs
+                                  in
+                                      ([(L'.DDatatypeImp (x, n', n, ms, s, xs, xncs), loc)], (env, denv, gs))
+                                  end)
+                           | _ => (strError env (NotDatatype loc);
+                                   ([], (env, denv, [])))
+                     end)
+
+              | L.DVal (p, e) =>
+                let
+                    val ((p', pt), (env', bound)) = elabPat (p, (env, SS.empty))
+
+                    val (e', et, gs1) = elabExp (env, denv) e
+
+                    val c' = normClassConstraint env et
+
+                    fun singleVar (p : L.pat) =
+                        case #1 p of
+                            L.PVar x => SOME x
+                          | L.PAnnot (p', _) => singleVar p'
+                          | _ => NONE
+                in
+                    unifyCons env loc et pt;
+
+                    (case exhaustive (env, et, [p'], loc) of
+                         NONE => ()
+                       | SOME p => if !mayDelay then
+                                       delayedExhaustives := (env, et, [p'], loc) :: !delayedExhaustives
+                                   else
+                                       expError env (Inexhaustive (loc, p)));
+
+                    case singleVar p of
+                        SOME x =>
+                        let
+                            val (env', n) = E.pushENamed env x et
+                        in
+                            ([(L'.DVal (x, n, c', e'), loc)], (env', denv, gs1 @ gs))
+                        end
+                      | NONE =>
+                        let
+                            val (env', n) = E.pushENamed env "$tmp" et
+                            val vars = SS.listItems bound
+                            val (decls, env') =
+                                ListUtil.foldlMap (fn (x, env') =>
+                                                      let
+                                                          val e = (L.ECase ((L.EVar ([], "$tmp", L.Infer), loc),
+                                                                            [(p, (L.EVar ([], x, L.Infer), loc))]), loc)
+                                                          val (e', t, _) = elabExp (env', denv) e
+                                                          val (env', n) = E.pushENamed env' x t
+                                                      in
+                                                          ((L'.DVal (x, n, t, e'), loc),
+                                                           env')
+                                                      end) env' vars
+                        in
+                            ((L'.DVal ("$tmp", n, c', e'), loc) :: decls,
+                             (env', denv, gs1 @ gs))
+                        end
+                end
+              | L.DValRec vis =>
+                let
+                    fun allowable (e, _) =
+                        case e of
+                            L.EAbs _ => true
+                          | L.ECAbs (_, _, _, e) => allowable e
+                          | L.EKAbs (_, e) => allowable e
+                          | L.EDisjoint (_, _, e) => allowable e
+                          | _ => false
+
+                    val (vis, gs) = ListUtil.foldlMap
+                                        (fn ((x, co, e), gs) =>
+                                            let
+                                                val (c', _, gs1) = case co of
+                                                                       NONE => (cunif env (loc, ktype), ktype, [])
+                                                                     | SOME c => elabCon (env, denv) c
+                                                val c' = normClassConstraint env c'
+                                            in
+                                                ((x, c', e), enD gs1 @ gs)
+                                            end) gs vis
+
+                    val (vis, env) = ListUtil.foldlMap (fn ((x, c', e), env) =>
+                                                           let
+                                                               val (env, n) = E.pushENamed env x c'
+                                                           in
+                                                               ((x, n, c', e), env)
+                                                           end) env vis
+
+                    val (vis, gs) = ListUtil.foldlMap (fn ((x, n, c', e), gs) =>
+                                                          let
+                                                              val (e', et, gs1) = elabExp (env, denv) e
+                                                          in
+                                                              checkCon env e' et c';
+                                                              if allowable e then
+                                                                  ()
+                                                              else
+                                                                  expError env (IllegalRec (x, e'));
+                                                              ((x, n, c', e'), gs1 @ gs)
+                                                          end) gs vis
+
+                    val vis = map (fn (x, n, t, e) => (x, n, normClassConstraint env t, e)) vis
+                    val d = (L'.DValRec vis, loc)
+                in
+                    ([d], (E.declBinds env d, denv, gs))
+                end
+
+              | L.DSgn (x, sgn) =>
+                let
+                    val (sgn', gs') = elabSgn (env, denv) sgn
+                    val (env', n) = E.pushSgnNamed env x sgn'
+                in
+                    ([(L'.DSgn (x, n, sgn'), loc)], (env', denv, enD gs' @ gs))
+                end
+
+              | L.DStr (x, sgno, tmo, str, _) =>
+                (case ModDb.lookup dAll of
+                     SOME d =>
+                     let
+                         val () = if !verbose then TextIO.print ("REUSE: " ^ x ^ "\n") else ()
+                         val env' = E.declBinds env d
+                         val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []}
+                     in
+                         ([d], (env', denv', gs))
+                     end
+                   | NONE =>
+                     let
+                         val () = if !verbose then TextIO.print ("CHECK: " ^ x ^ "\n") else ()
+
+                         val () = if x = "Basis" then
+                                      raise Fail "Not allowed to redefine structure 'Basis'"
+                                  else
+                                      ()
+
+                         val formal = Option.map (elabSgn (env, denv)) sgno
+
+                         val (str', sgn', gs') =
+                             case formal of
+                                 NONE =>
+                                 let
+                                     val (str', actual, gs') = elabStr (env, denv) str
+                                 in
+                                     (str', selfifyAt env {str = str', sgn = actual}, gs')
+                                 end
+                               | SOME (formal, gs1) =>
+                                 let
+                                     val str = wildifyStr env (str, formal)
+                                     val (str', actual, gs2) = elabStr (env, denv) str
+                                 in
+                                     subSgn env loc (selfifyAt env {str = str', sgn = actual}) formal;
+                                     (str', formal, enD gs1 @ gs2)
+                                 end
+
+                         val (env', n) = E.pushStrNamed env x sgn'
+
+                         val denv' =
+                             case #1 str' of
+                                 L'.StrConst _ => dopenConstraints (loc, env', denv) {str = x, strs = []}
+                               | L'.StrApp _ => dopenConstraints (loc, env', denv) {str = x, strs = []}
+                               | _ => denv
+
+                         val dNew = (L'.DStr (x, n, sgn', str'), loc)
+                     in
+                         case #1 (hnormSgn env sgn') of
+                             L'.SgnFun _ =>
+                             (case #1 str' of
+                                  L'.StrFun _ => ()
+                                | _ => strError env (FunctorRebind loc))
+                           | _ => ();
+                         Option.map (fn tm => ModDb.insert (dNew, tm)) tmo;
+                         ([dNew], (env', denv', gs' @ gs))
+                     end)
+
+              | L.DFfiStr (x, sgn, tmo) =>
+                (case ModDb.lookup dAll of
+                     SOME d =>
+                     let
+                         val env' = E.declBinds env d
+                         val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []}
+                     in
+                         ([d], (env', denv', []))
+                     end
+                   | NONE =>
+                     let
+                         val (sgn', gs') = elabSgn (env, denv) sgn
+                                           
+                         val (env', n) = E.pushStrNamed env x sgn'
+
+                         val dNew = (L'.DFfiStr (x, n, sgn'), loc)
+                     in
+                         case #1 sgn' of
+                             L'.SgnConst sgis =>
+                             (case List.find (fn (L'.SgiConAbs _, _) => false
+                                             | (L'.SgiCon _, _) => false
+                                             | (L'.SgiDatatype _, _) => false
+                                             | (L'.SgiVal _, _) => false
+                                             | _ => true) sgis of
+                                  NONE => ()
+                                | SOME sgi => (ErrorMsg.errorAt loc "Disallowed signature item for FFI module";
+                                               epreface ("item", p_sgn_item env sgi)))
+                           | _ => raise Fail "FFI signature isn't SgnConst";
+
+                         Option.map (fn tm => ModDb.insert (dNew, tm)) tmo;
+                         ([dNew], (env', denv, enD gs' @ gs))
+                     end)
+
+              | L.DOpen (m, ms) =>
+                (case E.lookupStr env m of
+                     NONE => (strError env (UnboundStr (loc, m));
+                              ([], (env, denv, gs)))
+                   | SOME (n, sgn) =>
+                     let
+                         val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                    case E.projectStr env {str = str, sgn = sgn, field = m} of
+                                                        NONE => (strError env (UnboundStr (loc, m));
+                                                                 (strerror, sgnerror))
+                                                      | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                                ((L'.StrVar n, loc), sgn) ms
+
+                         val sgn = selfifyAt env {str = str, sgn = sgn}
+
+                         val (ds, env') = dopen env {str = n, strs = ms, sgn = sgn}
+                         val denv' = dopenConstraints (loc, env', denv) {str = m, strs = ms}
+                     in
+                         (ds, (env', denv', gs))
+                     end)
+
+              | L.DConstraint (c1, c2) =>
+                let
+                    val (c1', k1, gs1) = elabCon (env, denv) c1
+                    val (c2', k2, gs2) = elabCon (env, denv) c2
+                    val gs3 = D.prove env denv (c1', c2', loc)
+
+                    val denv' = D.assert env denv (c1', c2')
+                in
+                    checkKind env c1' k1 (L'.KRecord (kunif env loc), loc);
+                    checkKind env c2' k2 (L'.KRecord (kunif env loc), loc);
+
+                    ([(L'.DConstraint (c1', c2'), loc)], (env, denv', enD gs1 @ enD gs2 @ enD gs3 @ gs))
+                end
+
+              | L.DOpenConstraints (m, ms) =>
+                let
+                    val denv = dopenConstraints (loc, env, denv) {str = m, strs = ms}
+                in
+                    ([], (env, denv, gs))
+                end
+
+              | L.DExport str =>
+                let
+                    val (str', sgn, gs') = elabStr (env, denv) str
+
+                    val sgn =
+                        case #1 (hnormSgn env sgn) of
+                            L'.SgnConst sgis =>
+                            let
+                                fun doOne (all as (sgi, _), env) =
+                                    (case sgi of
+                                         L'.SgiVal (x, n, t) =>
+                                         let
+                                             fun doPage (makeRes, ran) =
+                                                 case hnormCon env ran of
+                                                     (L'.CApp (tf, arg), _) =>
+                                                     (case (hnormCon env tf, hnormCon env arg) of
+                                                          ((L'.CModProj (basis, [], "transaction"), _),
+                                                           (L'.CApp (tf, arg3), _)) =>
+                                                          (case (basis = !basis_r,
+                                                                 hnormCon env tf, hnormCon env arg3) of
+                                                               (true,
+                                                                (L'.CApp (tf, arg2), _),
+                                                                ((L'.CRecord (_, []), _))) =>
+                                                               (case (hnormCon env tf) of
+                                                                    (L'.CApp (tf, arg1), _) =>
+                                                                    (case (hnormCon env tf,
+                                                                           hnormCon env arg1,
+                                                                           hnormCon env arg2) of
+                                                                         (tf, arg1,
+                                                                          (L'.CRecord (_, []), _)) =>
+                                                                         let
+                                                                             val t = (L'.CApp (tf, arg1), loc)
+                                                                             val t = (L'.CApp (t, arg2), loc)
+                                                                             val t = (L'.CApp (t, arg3), loc)
+                                                                             val t = (L'.CApp (
+                                                                                      (L'.CModProj
+                                                                                           (basis, [], "transaction"), loc),
+                                                                                      t), loc)
+
+                                                                             fun normArgs t =
+                                                                                 case hnormCon env t of
+                                                                                     (L'.TFun (dom, ran), loc) =>
+                                                                                     (L'.TFun (hnormCon env dom, normArgs ran), loc)
+                                                                                   | t' => t'
+                                                                         in
+                                                                             (L'.SgiVal (x, n, normArgs (makeRes t)), loc)
+                                                                         end
+                                                                       | _ => all)
+                                                                  | _ => all)
+                                                             | _ => all)
+                                                        | _ => all)
+                                                   | _ => all
+                                         in
+                                             case hnormCon env t of
+                                                 (L'.TFun (dom, ran), _) =>
+                                                 (case hnormCon env dom of
+                                                      (L'.TRecord domR, _) =>
+                                                      doPage (fn t => (L'.TFun ((L'.TRecord domR,
+                                                                                 loc),
+                                                                                t), loc), ran)
+                                                    | _ => all)
+                                               | _ => doPage (fn t => t, t)
+                                         end
+                                       | _ => all,
+                                     E.sgiBinds env all)
+                            in
+                                (L'.SgnConst (#1 (ListUtil.foldlMap doOne env sgis)), loc)
+                            end
+                          | _ => sgn
+                in
+                    ([(L'.DExport (E.newNamed (), sgn, str'), loc)], (env, denv, gs' @ gs))
+                end
+
+              | L.DTable (x, c, pe, ce) =>
+                let
+                    val cstK = (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc)
+
+                    val (c', k, gs') = elabCon (env, denv) c
+                    val pkey = cunif env (loc, cstK)
+                    val uniques = cunif env (loc, cstK)
+
+                    val ct = tableOf ()
+                    val ct = (L'.CApp (ct, c'), loc)
+                    val ct = (L'.CApp (ct, (L'.CConcat (pkey, uniques), loc)), loc)
+
+                    val (env, n) = E.pushENamed env x ct
+                    val (pe', pet, gs'') = elabExp (env, denv) pe
+                    val (ce', cet, gs''') = elabExp (env, denv) ce
+
+                    val pst = (L'.CModProj (!basis_r, [], "primary_key"), loc)
+                    val pst = (L'.CApp (pst, c'), loc)
+                    val pst = (L'.CApp (pst, pkey), loc)
+
+                    val cst = (L'.CModProj (!basis_r, [], "sql_constraints"), loc)
+                    val cst = (L'.CApp (cst, c'), loc)
+                    val cst = (L'.CApp (cst, uniques), loc)
+                in
+                    checkKind env c' k (L'.KRecord (L'.KType, loc), loc);
+                    checkCon env pe' pet pst;
+                    checkCon env ce' cet cst;
+                    ([(L'.DTable (!basis_r, x, n, c', pe', pkey, ce', uniques), loc)],
+                     (env, denv, gs''' @ gs'' @ enD gs' @ gs))
+                end
+              | L.DSequence x =>
+                let
+                    val (env, n) = E.pushENamed env x (sequenceOf ())
+                in
+                    ([(L'.DSequence (!basis_r, x, n), loc)], (env, denv, gs))
+                end
+              | L.DView (x, e) =>
+                let
+                    val (e', t, gs') = elabExp (env, denv) e
+
+                    val k = (L'.KRecord (L'.KType, loc), loc)
+                    val fs = cunif env (loc, k)
+                    val ts = cunif env (loc, (L'.KRecord k, loc))
+                    val tf = (L'.CApp ((L'.CMap (k, k), loc),
+                                       (L'.CAbs ("_", k, (L'.CRecord ((L'.KType, loc), []), loc)), loc)), loc)
+                    val ts = (L'.CApp (tf, ts), loc)
+
+                    val cv = viewOf ()
+                    val cv = (L'.CApp (cv, fs), loc)
+                    val (env', n) = E.pushENamed env x cv
+
+                    val ct = queryOf ()
+                    val ct = (L'.CApp (ct, (L'.CRecord ((L'.KRecord (L'.KType, loc), loc), []), loc)), loc)
+                    val ct = (L'.CApp (ct, (L'.CRecord ((L'.KRecord (L'.KType, loc), loc), []), loc)), loc)
+                    val ct = (L'.CApp (ct, ts), loc)
+                    val ct = (L'.CApp (ct, fs), loc)
+                in
+                    checkCon env e' t ct;
+                    ([(L'.DView (!basis_r, x, n, e', fs), loc)],
+                     (env', denv, gs' @ gs))
+                end
+
+              | L.DDatabase s => ([(L'.DDatabase s, loc)], (env, denv, gs))
+
+              | L.DCookie (x, c) =>
+                let
+                    val (c', k, gs') = elabCon (env, denv) c
+                    val (env, n) = E.pushENamed env x (L'.CApp (cookieOf (), c'), loc)
+                in
+                    checkKind env c' k (L'.KType, loc);
+                    ([(L'.DCookie (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs))
+                end
+              | L.DStyle x =>
+                let
+                    val (env, n) = E.pushENamed env x (styleOf ())
+                in
+                    ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs))
+                end
+              | L.DTask (e1, e2) =>
+                let
+                    val (e1', t1, gs1) = elabExp (env, denv) e1
+                    val (e2', t2, gs2) = elabExp (env, denv) e2
+
+                    val targ = cunif env (loc, (L'.KType, loc))
+
+                    val t1' = (L'.CModProj (!basis_r, [], "task_kind"), loc)
+                    val t1' = (L'.CApp (t1', targ), loc)
+
+                    val t2' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc),
+                                        (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc)
+                    val t2' = (L'.TFun (targ, t2'), loc)
+                in
+                    checkCon env e1' t1 t1';
+                    checkCon env e2' t2 t2';
+                    ([(L'.DTask (e1', e2'), loc)], (env, denv, gs2 @ gs1 @ gs))
+                end
+              | L.DPolicy e1 =>
+                let
+                    val (e1', t1, gs1) = elabExp (env, denv) e1
+
+                    val t1' = (L'.CModProj (!basis_r, [], "sql_policy"), loc)
+                in
+                    checkCon env e1' t1 t1';
+                    ([(L'.DPolicy e1', loc)], (env, denv, gs1 @ gs))
+                end
+
+              | L.DOnError (m1, ms, s) =>
+                (case E.lookupStr env m1 of
+                     NONE => (expError env (UnboundStrInExp (loc, m1));
+                              ([], (env, denv, [])))
+                   | SOME (n, sgn) =>
+                     let
+                         val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                    case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                        NONE => (conError env (UnboundStrInCon (loc, m));
+                                                                 (strerror, sgnerror))
+                                                      | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+                                                ((L'.StrVar n, loc), sgn) ms
+
+                         val t = case E.projectVal env {sgn = sgn, str = str, field = s} of
+                                     NONE => (expError env (UnboundExp (loc, s));
+                                              cerror)
+                                   | SOME t => t
+
+                         val page = (L'.CModProj (!basis_r, [], "page"), loc)
+                         val xpage = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), page), loc)
+                         val func = (L'.TFun ((L'.CModProj (!basis_r, [], "xbody"), loc), xpage), loc)
+                     in
+                         (unifyCons env loc t func
+                          handle CUnify _ => ErrorMsg.error "onError handler has wrong type.");
+                         ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs))
+                     end)
+
+              | L.DFfi (x, modes, t) =>
+                let
+                    val () = if Settings.getLessSafeFfi () then
+                                 ()
+                             else
+                                 ErrorMsg.errorAt loc "To enable 'ffi' declarations, the .urp directive 'lessSafeFfi' is mandatory."
+
+                    val (t', _, gs1) = elabCon (env, denv) t
+                    val t' = normClassConstraint env t'
+                    val (env', n) = E.pushENamed env x t'
+                in
+                    ([(L'.DFfi (x, n, modes, t'), loc)], (env', denv, enD gs1 @ gs))
+                end
+
+        (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
+    in
+        (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll),
+                              ("d'", p_list_sep PD.newline (ElabPrint.p_decl env) (#1 r))];*)
+        r
+    end
+
+and elabStr (env, denv) (str, loc) =
+    case str of
+        L.StrConst ds =>
+        let
+            val (ds', (_, _, gs)) = ListUtil.foldlMapConcat elabDecl (env, denv, []) ds
+            val sgis = ListUtil.mapConcat sgiOfDecl ds'
+
+            val (sgis, _, _, _, _) =
+                foldr (fn ((sgi, loc), (sgis, cons, vals, sgns, strs)) =>
+                          case sgi of
+                              L'.SgiConAbs (x, n, k) =>
+                              let
+                                  val (cons, x) =
+                                      if SS.member (cons, x) then
+                                          (cons, "?" ^ x)
+                                      else
+                                          (SS.add (cons, x), x)
+                              in
+                                  ((L'.SgiConAbs (x, n, k), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiCon (x, n, k, c) =>
+                              let
+                                  val (cons, x) =
+                                      if SS.member (cons, x) then
+                                          (cons, "?" ^ x)
+                                      else
+                                          (SS.add (cons, x), x)
+                              in
+                                  ((L'.SgiCon (x, n, k, c), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiDatatype dts =>
+                              let
+                                  fun doOne ((x, n, xs, xncs), (cons, vals)) =
+                                      let
+                                          val (cons, x) =
+                                              if SS.member (cons, x) then
+                                                  (cons, "?" ^ x)
+                                              else
+                                                  (SS.add (cons, x), x)
+                                                  
+                                          val (xncs, vals) =
+                                              ListUtil.foldlMap
+                                                  (fn ((x, n, t), vals) =>
+                                                      if SS.member (vals, x) then
+                                                          (("?" ^ x, n, t), vals)
+                                                      else
+                                                          ((x, n, t), SS.add (vals, x)))
+                                                  vals xncs
+                                      in
+                                          ((x, n, xs, xncs), (cons, vals))
+                                      end
+
+                                  val (dts, (cons, vals)) = ListUtil.foldlMap doOne (cons, vals) dts
+                              in
+                                  ((L'.SgiDatatype dts, loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
+                              let
+                                  val (cons, x) =
+                                      if SS.member (cons, x) then
+                                          (cons, "?" ^ x)
+                                      else
+                                          (SS.add (cons, x), x)
+                              in
+                                  ((L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiVal (x, n, c) =>
+                              let
+                                  val (vals, x) =
+                                      if SS.member (vals, x) then
+                                          (vals, "?" ^ x)
+                                      else
+                                          (SS.add (vals, x), x)
+                              in
+                                  ((L'.SgiVal (x, n, c), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiSgn (x, n, sgn) =>
+                              let
+                                  val (sgns, x) =
+                                      if SS.member (sgns, x) then
+                                          (sgns, "?" ^ x)
+                                      else
+                                          (SS.add (sgns, x), x)
+                              in
+                                  ((L'.SgiSgn (x, n, sgn), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+ 
+                            | L'.SgiStr (im, x, n, sgn) =>
+                              let
+                                  val (strs, x) =
+                                      if SS.member (strs, x) then
+                                          (strs, "?" ^ x)
+                                      else
+                                          (SS.add (strs, x), x)
+                              in
+                                  ((L'.SgiStr (im, x, n, sgn), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiConstraint _ => ((sgi, loc) :: sgis, cons, vals, sgns, strs)
+                            | L'.SgiClassAbs (x, n, k) =>
+                              let
+                                  val (cons, x) =
+                                      if SS.member (cons, x) then
+                                          (cons, "?" ^ x)
+                                      else
+                                          (SS.add (cons, x), x)
+                              in
+                                  ((L'.SgiClassAbs (x, n, k), loc) :: sgis, cons, vals, sgns, strs)
+                              end
+                            | L'.SgiClass (x, n, k, c) =>
+                              let
+                                  val (cons, x) =
+                                      if SS.member (cons, x) then
+                                          (cons, "?" ^ x)
+                                      else
+                                          (SS.add (cons, x), x)
+                              in
+                                  ((L'.SgiClass (x, n, k, c), loc) :: sgis, cons, vals, sgns, strs)
+                              end)
+
+                ([], SS.empty, SS.empty, SS.empty, SS.empty) sgis
+        in
+            ((L'.StrConst ds', loc), (L'.SgnConst sgis, loc), gs)
+        end
+      | L.StrVar x =>
+        (case E.lookupStr env x of
+             NONE =>
+             (strError env (UnboundStr (loc, x));
+              (strerror, sgnerror, []))
+           | SOME (n, sgn) => ((L'.StrVar n, loc), sgn, []))
+      | L.StrProj (str, x) =>
+        let
+            val (str', sgn, gs) = elabStr (env, denv) str
+        in
+            case E.projectStr env {str = str', sgn = sgn, field = x} of
+                NONE => (strError env (UnboundStr (loc, x));
+                         (strerror, sgnerror, []))
+              | SOME sgn => ((L'.StrProj (str', x), loc), sgn, gs)
+        end
+      | L.StrFun (m, dom, ranO, str) =>
+        let
+            val (dom', gs1) = elabSgn (env, denv) dom
+            val (env', n) = E.pushStrNamed env m dom'
+            val denv' = dopenConstraints (loc, env', denv) {str = m, strs = []}
+            val (str', actual, gs2) = elabStr (env', denv') str
+
+            val (formal, gs3) =
+                case ranO of
+                    NONE => (actual, [])
+                  | SOME ran =>
+                    let
+                        val (ran', gs) = elabSgn (env', denv') ran
+                    in
+                        subSgn env' loc actual ran';
+                        (ran', gs)
+                    end
+        in
+            ((L'.StrFun (m, n, dom', formal, str'), loc),
+             (L'.SgnFun (m, n, dom', formal), loc),
+             enD gs1 @ gs2 @ enD gs3)
+        end
+      | L.StrApp (str1, str2) =>
+        let
+            val (str1', sgn1, gs1) = elabStr (env, denv) str1
+            val str2 =
+                case sgn1 of
+                    (L'.SgnFun (_, _, dom, _), _) =>
+                    let
+                        val s = wildifyStr env (str2, dom)
+                    in
+                        (*Print.preface ("Wild", SourcePrint.p_str s);*)
+                        s
+                    end
+                  | _ => str2
+            val (str2', sgn2, gs2) = elabStr (env, denv) str2
+         in
+            case #1 (hnormSgn env sgn1) of
+                L'.SgnError => (strerror, sgnerror, [])
+              | L'.SgnFun (m, n, dom, ran) =>
+                (subSgn env loc sgn2 dom;
+                 case #1 (hnormSgn env ran) of
+                     L'.SgnError => (strerror, sgnerror, [])
+                   | L'.SgnConst sgis =>
+                     let
+                         (* This code handles a tricky case that led to a very nasty bug.
+                          * An invariant about signatures of elaborated modules is that no
+                          * identifier that could appear directly in a program is defined
+                          * twice.  We add "?" in front of identifiers where necessary to
+                          * maintain the invariant, but the code below, to extend a functor
+                          * body with a binding for the functor argument, wasn't written
+                          * with the invariant in mind.  Luckily for us, references to
+                          * an identifier later within a signature work by globally
+                          * unique index, so we just need to change the string name in the
+                          * new declaration.
+                          *
+                          * ~~~ A few days later.... ~~~
+                          * This is trickier than I thought!  We might need to add
+                          * arbitarily many question marks before the module name to
+                          * avoid a clash, since some other code might depend on
+                          * question-mark identifiers generated previously by this
+                          * very code fragment. *)
+                         fun mungeName m =
+                             if List.exists (fn (L'.SgiStr (_, x, _, _), _) => x = m
+                                              | _ => false) sgis then
+                                 mungeName ("?" ^ m)
+                             else
+                                 m
+
+                         val m = mungeName m
+                     in
+                         ((L'.StrApp (str1', str2'), loc),
+                          (L'.SgnConst ((L'.SgiStr (L'.Skip, m, n, selfifyAt env {str = str2', sgn = sgn2}), loc) :: sgis), loc),
+                          gs1 @ gs2)
+                     end
+                   | _ => raise Fail "Unable to hnormSgn in functor application")
+              | _ => (strError env (NotFunctor sgn1);
+                      (strerror, sgnerror, []))
+        end
+
+fun resolveClass env = E.resolveClass (hnormCon env) (consEq env dummy) env
+
+fun elabFile basis basis_tm topStr topSgn top_tm env file =
+    let
+        val () = ModDb.snapshot ()
+
+        val () = mayDelay := true
+        val () = delayedUnifs := []
+        val () = delayedExhaustives := []
+
+        val d = (L.DFfiStr ("Basis", (L.SgnConst basis, ErrorMsg.dummySpan), SOME basis_tm), ErrorMsg.dummySpan)
+        val (basis_n, env', sgn) =
+            case (if !incremental then ModDb.lookup d else NONE) of
+                NONE =>
+                let
+                    val (sgn, gs) = elabSgn (env, D.empty) (L.SgnConst basis, ErrorMsg.dummySpan)
+                    val () = case gs of
+                                 [] => ()
+                               | _ => (app (fn (_, env, _, c1, c2) =>
+                                               prefaces "Unresolved"
+                                                        [("c1", p_con env c1),
+                                                         ("c2", p_con env c2)]) gs;
+                                       raise Fail "Unresolved disjointness constraints in Basis")
+
+                    val (env', basis_n) = E.pushStrNamed env "Basis" sgn
+                in
+                    ModDb.insert ((L'.DFfiStr ("Basis", basis_n, sgn), ErrorMsg.dummySpan), basis_tm);
+                    (basis_n, env', sgn)
+                end
+              | SOME (d' as (L'.DFfiStr (_, basis_n, sgn), _)) =>
+                (basis_n, E.pushStrNamedAs env "Basis" basis_n sgn, sgn)
+              | _ => raise Fail "Elaborate: Basis impossible"
+                     
+        val () = basis_r := basis_n
+        val (ds, env') = dopen env' {str = basis_n, strs = [], sgn = sgn}
+
+        fun discoverC r x =
+            case E.lookupC env' x of
+                E.NotBound => raise Fail ("Constructor " ^ x ^ " unbound in Basis")
+              | E.Rel _ => raise Fail ("Constructor " ^ x ^ " bound relatively in Basis")
+              | E.Named (n, (_, loc)) => r := (L'.CNamed n, loc)
+
+        val () = discoverC int "int"
+        val () = discoverC float "float"
+        val () = discoverC string "string"
+        val () = discoverC char "char"
+        val () = discoverC table "sql_table"
+
+        val d = (L.DStr ("Top", SOME (L.SgnConst topSgn, ErrorMsg.dummySpan),
+                         SOME (if Time.< (top_tm, basis_tm) then basis_tm else top_tm),
+                         (L.StrConst topStr, ErrorMsg.dummySpan), false), ErrorMsg.dummySpan)
+        val (top_n, env', topSgn, topStr) =
+            case (if !incremental then ModDb.lookup d else NONE) of
+                NONE =>
+                let
+                    val (topSgn, gs) = elabSgn (env', D.empty) (L.SgnConst topSgn, ErrorMsg.dummySpan)
+                    val () = case gs of
+                                 [] => ()
+                               | _ => raise Fail "Unresolved disjointness constraints in top.urs"
+                    val (topStr, topSgn', gs) = elabStr (env', D.empty) (L.StrConst topStr, ErrorMsg.dummySpan)
+
+                    val () = case gs of
+                                 [] => ()
+                               | _ => app (fn Disjoint (loc, env, denv, c1, c2) =>
+                                              (case D.prove env denv (c1, c2, loc) of
+                                                   [] => ()
+                                                 | _ =>
+                                                   (prefaces "Unresolved constraint in top.ur"
+                                                             [("loc", PD.string (ErrorMsg.spanToString loc)),
+                                                              ("c1", p_con env c1),
+                                                              ("c2", p_con env c2)];
+                                                    raise Fail "Unresolved constraint in top.ur"))
+                                            | TypeClass (env, c, r, loc) =>
+                                              let
+                                                  val c = normClassKey env c
+                                              in
+                                                  case resolveClass env c of
+                                                      SOME e => r := SOME e
+                                                    | NONE => expError env (Unresolvable (loc, c))
+                                              end) gs
+
+                    val () = subSgn env' ErrorMsg.dummySpan topSgn' topSgn
+
+                    val (env', top_n) = E.pushStrNamed env' "Top" topSgn
+                in
+                    ModDb.insert ((L'.DStr ("Top", top_n, topSgn, topStr), ErrorMsg.dummySpan), top_tm);
+                    (top_n, env', topSgn, topStr)
+                end
+              | SOME (d' as (L'.DStr (_, top_n, topSgn, topStr), _)) =>
+                (top_n, E.declBinds env' d', topSgn, topStr)
+              | _ => raise Fail "Elaborate: Top impossible"                
+
+        val () = top_r := top_n
+
+        val (ds', env') = dopen env' {str = top_n, strs = [], sgn = topSgn}
+
+        fun elabDecl' x =
+            (resetKunif ();
+             resetCunif ();
+             elabDecl x)
+
+        val (file, (env'', _, gs)) = ListUtil.foldlMapConcat elabDecl' (env', D.empty, []) file
+
+        fun oneSummaryRound () =
+            if ErrorMsg.anyErrors () then
+                ()
+            else
+                let
+                    val delayed = !delayedUnifs
+                in
+                    delayedUnifs := [];
+                    app (fn (loc, env, k, s1, s2) =>
+                            unifySummaries env (loc, k, normalizeRecordSummary env s1, normalizeRecordSummary env s2))
+                        delayed
+                end
+
+        val checkConstraintErrors = ref (fn () => ())
+        fun stopHere () = not (!unifyMore) andalso ErrorMsg.anyErrors ()
+    in
+        oneSummaryRound ();
+
+        if stopHere () then
+            ()
+        else
+            let
+                fun solver (gs : constraint list) =
+                    let
+                        val (gs, solved) =
+                            ListUtil.foldlMapPartial
+                            (fn (g : constraint, solved) =>
+                                case g of
+                                    Disjoint (loc, env, denv, c1, c2) =>
+                                    (case D.prove env denv (c1, c2, loc) of
+                                         [] => (NONE, true)
+                                       | _ => (SOME g, solved))
+                                  | TypeClass (env, c, r, loc) =>
+                                    let
+                                        fun default () = (SOME g, solved)
+                                                         
+                                        fun resolver r c =
+                                            let
+                                                val c = normClassKey env c
+                                            in
+                                                case resolveClass env c of
+                                                    SOME e => (r := SOME e;
+                                                               (NONE, true))
+                                                  | NONE =>
+                                                    case #1 (hnormCon env c) of
+                                                        L'.CApp (f, x) =>
+                                                        (case (#1 (hnormCon env f), #1 (hnormCon env x)) of
+                                                             (L'.CKApp (f, _), L'.CRecord (k, xcs)) =>
+                                                             (case #1 (hnormCon env f) of
+                                                                  L'.CModProj (top_n', [], "folder") =>
+                                                                  if top_n' = top_n then
+                                                                      let
+                                                                          val e = (L'.EModProj (top_n, ["Folder"], "nil"), loc)
+                                                                          val e = (L'.EKApp (e, k), loc)
+                                                                                  
+                                                                          val (folder, _) = foldr (fn ((x, c), (folder, xcs)) =>
+                                                                                                      let
+                                                                                                          val e = (L'.EModProj (top_n, ["Folder"],
+                                                                                                                                "cons"), loc)
+                                                                                                          val e = (L'.EKApp (e, k), loc)
+                                                                                                          val e = (L'.ECApp (e,
+                                                                                                                             (L'.CRecord (k, xcs),
+                                                                                                                              loc)), loc)
+                                                                                                          val e = (L'.ECApp (e, x), loc)
+                                                                                                          val e = (L'.ECApp (e, c), loc)
+                                                                                                          val e = (L'.EApp (e, folder), loc)
+                                                                                                      in
+                                                                                                          (e, (x, c) :: xcs)
+                                                                                                      end)
+                                                                                                  (e, []) xcs
+                                                                      in
+                                                                          (r := SOME folder;
+                                                                           (NONE, true))
+                                                                      end
+                                                                  else
+                                                                      default ()
+                                                                | _ => default ())
+                                                           | _ => default ())
+
+                                                      | L'.TRecord c' =>
+                                                        (case #1 (hnormCon env c') of
+                                                             L'.CRecord (_, xts) =>
+                                                             let
+                                                                 val witnesses = map (fn (x, t) =>
+                                                                                         let
+                                                                                             val r = ref NONE
+                                                                                             val (opt, _) = resolver r t
+                                                                                         in
+                                                                                             case opt of
+                                                                                                 SOME _ => NONE
+                                                                                               | NONE =>
+                                                                                                 case !r of
+                                                                                                     NONE => NONE
+                                                                                                   | SOME e =>
+                                                                                                     SOME (x, e, t)
+                                                                                         end) xts
+                                                             in
+                                                                 if List.all Option.isSome witnesses then
+                                                                     (r := SOME (L'.ERecord (map valOf witnesses), loc);
+                                                                      (NONE, true))
+                                                                 else
+                                                                     (SOME g, solved)
+                                                             end
+                                                           | _ => (SOME g, solved))
+
+                                                      | _ => default ()
+                                            end
+                                    in
+                                        resolver r c
+                                    end)
+                            false gs
+                    in
+                        case (gs, solved) of
+                            ([], _) => ()
+                          | (_, true) => (oneSummaryRound (); solver gs)
+                          | _ =>
+                            checkConstraintErrors :=
+                            (fn () => app (fn Disjoint (loc, env, denv, c1, c2) =>
+                                              let
+                                                  val c1' = ElabOps.hnormCon env c1
+                                                  val c2' = ElabOps.hnormCon env c2
+
+                                                  fun isUnif (c, _) =
+                                                      case c of
+                                                          L'.CUnif _ => true
+                                                        | _ => false
+
+                                                  fun maybeAttr (c, _) =
+                                                      case c of
+                                                          L'.CRecord ((L'.KType, _), xts) => true
+                                                        | _ => false
+                                              in
+                                                  ErrorMsg.errorAt loc "Couldn't prove field name disjointness";
+                                                  eprefaces' [("Con 1", p_con env c1),
+                                                              ("Con 2", p_con env c2),
+                                                              ("Hnormed 1", p_con env c1'),
+                                                              ("Hnormed 2", p_con env c2')]
+
+                                              (*app (fn (loc, env, k, s1, s2) =>
+                                                        eprefaces' [("s1", p_summary env (normalizeRecordSummary env s1)),
+                                                                    ("s2", p_summary env (normalizeRecordSummary env s2))])
+                                                    (!delayedUnifs);*)
+                                              end
+                                            | TypeClass (env, c, r, loc) =>
+                                              let
+                                                  val c = normClassKey env c
+                                              in
+                                                  case resolveClass env c of
+                                                      SOME e => r := SOME e
+                                                    | NONE => expError env (Unresolvable (loc, c))
+                                              end)
+                                          gs)
+                    end
+            in
+                solver gs
+            end;
+
+        mayDelay := false;
+
+        if stopHere () then
+            ()
+        else
+            (app (fn (loc, env, k, s1, s2) =>
+                     unifySummaries env (loc, k, normalizeRecordSummary env s1, normalizeRecordSummary env s2)
+                     handle CUnify' (env', err) => (ErrorMsg.errorAt loc "Error in final record unification";
+                                                    cunifyError env' err;
+                                                    case !reducedSummaries of
+                                                        NONE => ()
+                                                      | SOME (s1, s2) =>
+                                                        (ErrorMsg.errorAt loc "Stuck unifying these records after canceling matching pieces:";
+                                                         eprefaces' [("Have", s1),
+                                                                     ("Need", s2)])))
+                 (!delayedUnifs);
+             delayedUnifs := []);
+
+        if stopHere () then
+            ()
+        else
+            if List.exists kunifsInDecl file then
+                case U.File.findDecl kunifsInDecl file of
+                    NONE => ()
+                  | SOME d => declError env'' (KunifsRemain [d])
+            else
+                ();
+        
+        if stopHere () then
+            ()
+        else
+            if List.exists cunifsInDecl file then
+                case U.File.findDecl cunifsInDecl file of
+                    NONE => ()
+                  | SOME d => declError env'' (CunifsRemain [d])
+            else
+                ();
+
+        if stopHere () then
+            ()
+        else
+            app (fn all as (env, _, _, loc) =>
+                    case exhaustive all of
+                        NONE => ()
+                      | SOME p => expError env (Inexhaustive (loc, p)))
+                (!delayedExhaustives);
+
+        if stopHere () then
+            ()
+        else
+            !checkConstraintErrors ();
+
+        (*preface ("file", p_file env' file);*)
+
+        if !dumpTypes orelse (!dumpTypesOnError andalso ErrorMsg.anyErrors ()) then
+            let
+                open L'
+                open Print.PD
+                open Print
+
+                fun p_con env c = ElabPrint.p_con env (ElabOps.reduceCon env c)
+
+                fun dumpDecl (d, env) =
+                    case #1 d of
+                        DCon (x, _, k, _) => (print (box [string x,
+                                                          space,
+                                                          string "::",
+                                                          space,
+                                                          p_kind env k,
+                                                          newline,
+                                                          newline]);
+                                              E.declBinds env d)
+                      | DVal (x, _, t, _) => (print (box [string x,
+                                                          space,
+                                                          string ":",
+                                                          space,
+                                                          p_con env t,
+                                                          newline,
+                                                          newline]);
+                                              E.declBinds env d)
+                      | DValRec vis => (app (fn (x, _, t, _) => print (box [string x,
+                                                                            space,
+                                                                            string ":",
+                                                                            space,
+                                                                            p_con env t,
+                                                                            newline,
+                                                                            newline])) vis;
+                                        E.declBinds env d)
+                      | DStr (x, _, _, str) => (print (box [string ("<" ^ x ^ ">"),
+                                                            newline,
+                                                            newline]);
+                                                dumpStr (str, env);
+                                                print (box [string ("</" ^ x ^ ">"),
+                                                            newline,
+                                                            newline]);
+                                                E.declBinds env d)
+                      | _ => E.declBinds env d
+
+                and dumpStr (str, env) =
+                    case #1 str of
+                        StrConst ds => ignore (foldl dumpDecl env ds)
+                      | _ => ()
+            in
+                ignore (foldl dumpDecl env' file)
+            end
+        else
+            ();
+
+        if ErrorMsg.anyErrors () then
+            ModDb.revert ()
+        else
+            ();
+
+        (*Print.preface("File", ElabPrint.p_file env file);*)
+
+        (L'.DFfiStr ("Basis", basis_n, sgn), ErrorMsg.dummySpan)
+        :: ds
+        @ (L'.DStr ("Top", top_n, topSgn, topStr), ErrorMsg.dummySpan)
+        :: ds' @ file
+    end
+    handle e => (ModDb.revert ();
+                 raise e)
+
+end
diff --git a/src/elisp/urweb-compat.el b/src/elisp/urweb-compat.el
new file mode 100644
index 0000000..b94c2f4
--- /dev/null
+++ b/src/elisp/urweb-compat.el
@@ -0,0 +1,111 @@
+;;; urweb-compat.el --- Compatibility functions for Emacs variants for urweb-mode
+
+;; Based on sml-mode:
+;; Copyright (C) 1999, 2000, 2004  Stefan Monnier <monnier@gnu.org>
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl)
+
+(unless (fboundp 'set-keymap-parents)
+  (defun set-keymap-parents (m parents)
+    (if (keymapp parents) (setq parents (list parents)))
+    (set-keymap-parent
+     m
+     (if (cdr parents)
+	 (reduce (lambda (m1 m2)
+		   (let ((m (copy-keymap m1)))
+		     (set-keymap-parent m m2) m))
+		 parents
+		 :from-end t)
+       (car parents)))))
+
+;; for XEmacs
+(when (fboundp 'temp-directory)
+  (defvar temporary-file-directory (temp-directory)))
+
+(unless (fboundp 'make-temp-file)
+  ;; Copied from Emacs-21's subr.el
+  (defun make-temp-file (prefix &optional dir-flag)
+  "Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary,
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file."
+  (let (file)
+    (while (condition-case ()
+	       (progn
+		 (setq file
+		       (make-temp-name
+			(expand-file-name prefix temporary-file-directory)))
+		 (if dir-flag
+		     (make-directory file)
+		   (write-region "" nil file nil 'silent))
+		 nil)
+	    (file-already-exists t))
+      ;; the file was somehow created by someone else between
+      ;; `make-temp-name' and `write-region', let's try again.
+      nil)
+    file)))
+
+
+
+(unless (fboundp 'regexp-opt)
+  (defun regexp-opt (strings &optional paren)
+    (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
+      (concat open (mapconcat 'regexp-quote strings "\\|") close))))
+
+
+;;;; 
+;;;; Custom
+;;;; 
+
+;; doesn't exist in Emacs < 20.1
+(unless (fboundp 'set-face-bold-p)
+  (defun set-face-bold-p (face v &optional f)
+    (when v (ignore-errors (make-face-bold face)))))
+(unless (fboundp 'set-face-italic-p)
+  (defun set-face-italic-p (face v &optional f)
+    (when v (ignore-errors (make-face-italic face)))))
+
+;; doesn't exist in Emacs < 20.1
+(ignore-errors (require 'custom))
+(unless (fboundp 'defgroup)
+  (defmacro defgroup (&rest rest) ()))
+(unless (fboundp 'defcustom)
+  (defmacro defcustom (sym val str &rest rest) `(defvar ,sym ,val ,str)))
+(unless (fboundp 'defface)
+  (defmacro defface (sym val str &rest rest)
+    `(defvar ,sym (make-face ',sym) ,str)))
+
+(defvar :group ':group)
+(defvar :type ':type)
+(defvar :copy ':copy)
+(defvar :dense ':dense)
+(defvar :inherit ':inherit)
+(defvar :suppress ':suppress)
+
+(provide 'urweb-compat)
+
+;;; urweb-compat.el ends here
diff --git a/src/elisp/urweb-defs.el b/src/elisp/urweb-defs.el
new file mode 100644
index 0000000..1b21cba
--- /dev/null
+++ b/src/elisp/urweb-defs.el
@@ -0,0 +1,206 @@
+;;; urweb-defs.el --- Various definitions for urweb-mode
+
+;; Based on sml-mode:
+;; Copyright (C) 1999,2000,2003  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'urweb-util)
+
+
+(defgroup urweb ()
+  "Editing Ur/Web code."
+  :group 'languages)
+
+(defvar urweb-outline-regexp
+  ;; `st' and `si' are to match structure and signature.
+  "\\|s[ti]\\|[ \t]*\\(let[ \t]+\\)?\\(fun\\|and\\)\\>"
+  "Regexp matching a major heading.
+This actually can't work without extending `outline-minor-mode' with the
+notion of \"the end of an outline\".")
+
+;;; 
+;;; Internal defines
+;;; 
+
+(defmap urweb-mode-map
+  ;; smarter cursor movement
+  '(("\C-c\C-i"	. urweb-mode-info))
+  "The keymap used in `urweb-mode'."
+  ;; :inherit urweb-bindings
+  :group 'urweb)
+
+(defsyntax urweb-mode-syntax-table
+  `((?\*   . ,(if urweb-builtin-nested-comments-flag ". 23n" ". 23"))
+    (?\(   . "()1")
+    (?\)   . ")(4")
+    ("._'" . "_")
+    (",;"  . ".")
+    ;; `!' is not really a prefix-char, oh well!
+    ("~#!" . "'")
+    ("%&$+-/:<=>?@`^|"	 . "."))
+  "The syntax table used in `urweb-mode'.")
+
+
+(easy-menu-define urweb-mode-menu urweb-mode-map "Menu used in `urweb-mode'."
+  '("Ur/Web"
+    ["Ur/Web mode help (brief)"       describe-mode t]
+    ["Ur/Web mode *info*"             urweb-mode-info t]
+    ))
+
+;; Make's sure they appear in the menu bar when urweb-mode-map is active.
+;; On the hook for XEmacs only -- see easy-menu-add in auc-menu.el.
+;; (defun urweb-mode-menu-bar ()
+;;   "Make sure menus appear in the menu bar as well as under mouse 3."
+;;   (and (eq major-mode 'urweb-mode)
+;;        (easy-menu-add urweb-mode-menu urweb-mode-map)))
+;; (add-hook 'urweb-mode-hook 'urweb-mode-menu-bar)
+
+;;
+;; regexps
+;;
+
+(defun urweb-syms-re (&rest syms)
+  (concat "\\<" (regexp-opt (flatten syms) t) "\\>"))
+
+;;
+
+(defconst urweb-module-head-syms
+  '("signature" "structure" "functor"))
+
+
+(defconst urweb-begin-syms
+  '("let" "struct" "sig")
+  "Symbols matching the `end' symbol.")
+
+(defconst urweb-begin-syms-re
+  (urweb-syms-re urweb-begin-syms)
+  "Symbols matching the `end' symbol.")
+
+;; (defconst urweb-user-begin-symbols-re
+;;   (urweb-syms-re "let" "abstype" "local" "struct" "sig" "in" "with")
+;;   "Symbols matching (loosely) the `end' symbol.")
+
+(defconst urweb-sexp-head-symbols-re
+  (urweb-syms-re "let" "struct" "sig" "in" "with"
+                 "if" "then" "else" "case" "of" "fn" "fun" "val" "and"
+                 "datatype" "type" "open" "include"
+                 urweb-module-head-syms
+                 "con" "map" "where" "extern" "constraint" "constraints"
+                 "table" "sequence" "class" "cookie" "style" "task" "policy")
+  "Symbols starting an sexp.")
+
+;; (defconst urweb-not-arg-start-re
+;;   (urweb-syms-re "in" "of" "end" "andalso")
+;;   "Symbols that can't be found at the head of an arg.")
+
+;; (defconst urweb-not-arg-re
+;;   (urweb-syms-re "in" "of" "end" "andalso")
+;;   "Symbols that should not be confused with an arg.")
+
+(defconst urweb-=-starter-syms
+  (list* "|" "val" "fun" "and" "datatype" "con" "type" "class"
+	 urweb-module-head-syms)
+  "Symbols that can be followed by a `='.")
+(defconst urweb-=-starter-re
+  (concat "\\S.|\\S.\\|" (urweb-syms-re (cdr urweb-=-starter-syms)))
+  "Symbols that can be followed by a `='.")
+
+(defconst urweb-indent-rule
+  (urweb-preproc-alist
+   `((,urweb-module-head-syms "d=" 0)
+     ("if" "else" 0)
+     (,urweb-=-starter-syms nil)
+     (("case" "datatype" "if" "then" "else"
+       "let" "open" "sig" "struct" "type" "val"
+       "con" "constraint" "table" "sequence" "class" "cookie"
+       "style" "task" "policy")))))
+
+(defconst urweb-starters-indent-after
+  (urweb-syms-re "let" "in" "struct" "sig")
+  "Indent after these.")
+
+(defconst urweb-delegate
+  (urweb-preproc-alist
+   `((("of" "else" "then" "with" "d=") . (not (urweb-bolp)))
+     ("in" . t)))
+  "Words which might delegate indentation to their parent.")
+
+(defcustom urweb-symbol-indent
+  '(("fn" . -3)
+    ("of" . 1)
+    ("|" . -2)
+    ("," . -2)
+    (";" . -2)
+    ;;("in" . 1)
+    ("d=" . 2))
+  "Special indentation alist for some symbols.
+An entry like (\"in\" . 1) indicates that a line starting with the
+symbol `in' should be indented one char further to the right.
+This is only used in a few specific cases, so it does not work
+for all symbols and in all lines starting with the given symbol."
+  :group 'urweb
+  :type '(repeat (cons string integer)))
+
+(defconst urweb-open-paren
+  (urweb-preproc-alist
+   `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>")))
+  "Symbols that should behave somewhat like opening parens.")
+
+(defconst urweb-close-paren
+  `(("in" "\\<let\\>")
+    ("end" ,urweb-begin-syms-re)
+    ("then" "\\<if\\>")
+    ("else" "\\<if\\>" (urweb-bolp))
+    ("of" "\\<case\\>")
+    ("</xml>" "<xml>")
+    ("d=" nil))
+  "Symbols that should behave somewhat like close parens.")
+
+(defconst urweb-agglomerate-re "\\<else[ \t]+if\\>"
+  "Regexp of compound symbols (pairs of symbols to be considered as one).")
+
+(defconst urweb-non-nested-of-starter-re
+  (urweb-syms-re "datatype")
+  "Symbols that can introduce an `of' that shouldn't behave like a paren.")
+
+(defconst urweb-starters-syms
+  (append urweb-module-head-syms
+	  '("datatype" "fun"
+	    "open" "type" "val" "and"
+	    "con" "constraint" "table" "sequence" "class" "cookie"
+            "style" "task" "policy"))
+  "The starters of new expressions.")
+
+(defconst urweb-exptrail-syms
+  '("if" "then" "else" "case" "of" "fn" "with" "map"))
+
+(defconst urweb-pipeheads
+   '("|" "of" "fun" "fn" "and" "datatype")
+   "A `|' corresponds to one of these.")
+
+
+(provide 'urweb-defs)
+
+;;; urweb-defs.el ends here
diff --git a/src/elisp/urweb-mode-startup.el b/src/elisp/urweb-mode-startup.el
new file mode 100644
index 0000000..4812599
--- /dev/null
+++ b/src/elisp/urweb-mode-startup.el
@@ -0,0 +1,20 @@
+
+;;; Generated autoloads from urweb-mode.el
+ (add-to-list 'load-path (file-name-directory load-file-name))
+
+(add-to-list (quote auto-mode-alist) (quote ("\\.ur\\(s\\)?\\'" . urweb-mode)))
+
+(autoload (quote urweb-mode) "urweb-mode" "\
+\\<urweb-mode-map>Major mode for editing Ur/Web code.
+This mode runs `urweb-mode-hook' just before exiting.
+\\{urweb-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil nil ("urweb-compat.el" "urweb-defs.el"
+;;;;;;  "urweb-util.el") (18072 34664 948142))
+
+;;;***
+
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
new file mode 100644
index 0000000..69b0e23
--- /dev/null
+++ b/src/elisp/urweb-mode.el
@@ -0,0 +1,930 @@
+;;; urweb-mode.el --- Major mode for editing (Standard) ML
+
+;; Based on sml-mode:
+;; Copyright (C) 1999,2000,2004  Stefan Monnier
+;; Copyright (C) 1994-1997  Matthew J. Morley
+;; Copyright (C) 1989       Lars Bo Nielsen
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+
+;; Author: Lars Bo Nielsen
+;;      Olin Shivers
+;;	Fritz Knabe (?)
+;;	Steven Gilmore (?)
+;;	Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
+;;	Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
+;;      (Stefan Monnier) monnier@cs.yale.edu
+;;      Adam Chlipala
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; HISTORY
+
+;; Still under construction: History obscure, needs a biographer as
+;; well as a M-x doctor. Change Log on request.
+
+;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
+
+;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
+;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
+;; and numerous bugs and bug-fixes.
+
+;;; DESCRIPTION
+
+;; See accompanying info file: urweb-mode.info
+
+;;; FOR YOUR .EMACS FILE
+
+;; If urweb-mode.el lives in some non-standard directory, you must tell
+;; emacs where to get it. This may or may not be necessary:
+
+;; (add-to-list 'load-path "~jones/lib/emacs/")
+
+;; Then to access the commands autoload urweb-mode with that command:
+
+;; (load "urweb-mode-startup")
+
+;; urweb-mode-hook is run whenever a new urweb-mode buffer is created.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'compile)
+(require 'urweb-util)
+(require 'urweb-move)
+(require 'urweb-defs)
+(condition-case nil (require 'skeleton) (error nil))
+
+;;; VARIABLES CONTROLLING INDENTATION
+
+(defcustom urweb-indent-level 4
+  "*Indentation of blocks in Ur/Web (see also `urweb-structure-indent')."
+  :group 'urweb
+  :type '(integer))
+
+(defcustom urweb-indent-args urweb-indent-level
+  "*Indentation of args placed on a separate line."
+  :group 'urweb
+  :type '(integer))
+
+(defcustom urweb-electric-semi-mode nil
+  "*If non-nil, `\;' will self insert, reindent the line, and do a newline.
+If nil, just insert a `\;'.  (To insert while t, do: \\[quoted-insert] \;)."
+  :group 'urweb
+  :type 'boolean)
+
+(defcustom urweb-rightalign-and t
+  "If non-nil, right-align `and' with its leader.
+If nil:					If t:
+	datatype a = A				datatype a = A
+	and b = B				     and b = B"
+  :group 'urweb
+  :type 'boolean)
+
+;;; OTHER GENERIC MODE VARIABLES
+
+(defvar urweb-mode-info "urweb-mode"
+  "*Where to find Info file for `urweb-mode'.
+The default assumes the info file \"urweb-mode.info\" is on Emacs' info
+directory path.  If it is not, either put the file on the standard path
+or set the variable `urweb-mode-info' to the exact location of this file
+
+  (setq urweb-mode-info \"/usr/me/lib/info/urweb-mode\")
+
+in your .emacs file. You can always set it interactively with the
+set-variable command.")
+
+(defvar urweb-mode-hook nil
+  "*Run upon entering `urweb-mode'.
+This is a good place to put your preferred key bindings.")
+
+;;; CODE FOR Ur/Web-MODE
+
+(defun urweb-mode-info ()
+  "Command to access the TeXinfo documentation for `urweb-mode'.
+See doc for the variable `urweb-mode-info'."
+  (interactive)
+  (require 'info)
+  (condition-case nil
+      (info urweb-mode-info)
+    (error (progn
+             (describe-variable 'urweb-mode-info)
+             (message "Can't find it... set this variable first!")))))
+
+
+;; font-lock setup
+
+(defconst urweb-keywords-regexp
+  (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints"
+	       "datatype" "else" "end" "extern" "fn" "map"
+	       "fun" "functor" "if" "include"
+	       "of" "open" "let" "in"
+	       "rec" "sequence" "sig" "signature" "cookie" "style" "task" "policy"
+	       "struct" "structure" "table" "view" "then" "type" "val" "where"
+	       "with" "ffi"
+
+               "Name" "Type" "Unit")
+  "A regexp that matches any non-SQL keywords of Ur/Web.")
+
+(defconst urweb-sql-keywords-regexp
+  (urweb-syms-re "SELECT" "DISTINCT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY"
+                 "HAVING" "LIMIT" "OFFSET" "ALL" "UNION" "INTERSECT" "EXCEPT"
+                 "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX"
+                 "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE"
+                 "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK"
+                 "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL"
+                 "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1"
+                 "IF" "THEN" "ELSE" "COALESCE" "LIKE" "RANDOM")
+  "A regexp that matches SQL keywords.")
+
+(defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>"
+  "A regexp that matches lowercase Ur/Web identifiers.")
+
+(defconst urweb-cident-regexp "\\<[A-Z][A-Za-z0-9_']*\\>"
+  "A regexp that matches uppercase Ur/Web identifiers.")
+
+;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; The font lock regular expressions.
+
+(defun urweb-in-xml ()
+  (save-excursion
+    (let (
+          (depth 0)
+          (finished nil)
+          (answer nil)
+          (bound (max 0 (- (point) 1024)))
+          )
+      (while (and (not finished)
+                  (re-search-backward "\\(\\([-{}]\\)\\|<\\(/?xml\\)?\\)"
+                                      bound t))
+        (let ((xml-tag (length (or (match-string 3) "")))
+              (ch (match-string 2)))
+         (cond
+          ((equal ch "{")
+           (if (> depth 0)
+               (decf depth)
+             (setq finished t)))
+          ((equal ch "}")
+           (incf depth))
+          ((= xml-tag 3)
+           (if (> depth 0)
+               (decf depth)
+             (progn
+               (setq answer t)
+               (setq finished t))))
+          ((= xml-tag 4)
+           (incf depth))
+
+          ((equal ch "-")
+           (if (looking-at "->")
+               (setq finished (= depth 0))))
+
+          ((and (= depth 0)
+                (not (looking-at "<xml")) ;; ignore <xml/>
+                (let ((face (get-text-property (point) 'face)))
+                  (funcall (if (listp face) #'member #'equal) 'font-lock-tag-face face)))
+           ;; previous code was highlighted as tag, seems we are in xml
+           (progn
+             (setq answer t)
+             (setq finished t)))
+
+          ((= depth 0)
+           ;; previous thing was a tag like, but not tag
+           ;; seems we are in usual code or comment
+           (setq finished t))
+          )))
+      answer)))
+
+(defun amAttribute (face)
+  (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<")))
+      nil
+    face))
+
+(defconst urweb-font-lock-keywords
+  `(;;(urweb-font-comments-and-strings)
+    ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*\\(/?>\\)"
+     (1 font-lock-tag-face)
+     (3 font-lock-tag-face))
+    ("\\(</\\sw+>\\)"
+     (1 font-lock-tag-face))
+    ("\\([^<>{}]+\\)"
+     (1 (if (urweb-in-xml)
+            font-lock-string-face
+          nil)))
+
+    ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
+     (1 font-lock-keyword-face)
+     (2 (amAttribute font-lock-function-name-face)))
+    ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
+     (1 font-lock-keyword-face)
+     (3 (amAttribute font-lock-type-def-face)))
+    ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|task\\|policy\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
+     (1 font-lock-keyword-face)
+     (3 (amAttribute font-lock-variable-name-face)))
+    ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
+     (1 font-lock-keyword-face)
+     (2 (amAttribute font-lock-module-def-face)))
+    ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
+     (1 font-lock-keyword-face)
+     (2 (amAttribute font-lock-interface-def-face)))
+
+    (,urweb-keywords-regexp . font-lock-keyword-face)
+    (,urweb-sql-keywords-regexp . font-lock-sql-face)
+    (,urweb-cident-regexp . font-lock-cvariable-face))
+  "Regexps matching standard Ur/Web keywords.")
+
+(defface font-lock-type-def-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight type definitions."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-type-def-face 'font-lock-type-def-face
+  "Face name to use for type definitions.")
+
+(defface font-lock-module-def-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight module definitions."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-module-def-face 'font-lock-module-def-face
+  "Face name to use for module definitions.")
+
+(defface font-lock-interface-def-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight interface definitions."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-interface-def-face 'font-lock-interface-def-face
+  "Face name to use for interface definitions.")
+
+(defface font-lock-sql-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight SQL keywords."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-sql-face 'font-lock-sql-face
+  "Face name to use for SQL keywords.")
+
+(defface font-lock-cvariable-face
+  '((t (:inherit font-lock-type-face)))
+  "Font Lock mode face used to highlight capitalized identifiers."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-cvariable-face 'font-lock-cvariable-face
+  "Face name to use for capitalized identifiers.")
+
+(defface font-lock-tag-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight XML tags."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-tag-face 'font-lock-tag-face
+  "Face name to use for XML tags.")
+
+(defface font-lock-attr-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight XML attributes."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-attr-face 'font-lock-attr-face
+  "Face name to use for XML attributes.")
+
+;;
+;; Code to handle nested comments and unusual string escape sequences
+;;
+
+(defsyntax urweb-syntax-prop-table
+  '((?\\ . ".") (?* . "."))
+  "Syntax table for text-properties")
+
+;; For Emacsen that have no built-in support for nested comments
+(defun urweb-get-depth-st ()
+  (save-excursion
+    (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
+	   (_ (backward-char))
+	   (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
+	   (pt (point)))
+      (when disp
+	(let* ((depth
+		(save-match-data
+		  (if (re-search-backward "\\*)\\|(\\*" nil t)
+		      (+ (or (get-char-property (point) 'comment-depth) 0)
+			 (case (char-after) (?\( 1) (?* 0))
+			 disp)
+		    0)))
+	       (depth (if (> depth 0) depth)))
+	  (put-text-property pt (1+ pt) 'comment-depth depth)
+	  (when depth urweb-syntax-prop-table))))))
+
+(defconst urweb-font-lock-syntactic-keywords
+  `(("^\\s-*\\(\\\\\\)" (1 ',urweb-syntax-prop-table))
+    ,@(unless urweb-builtin-nested-comments-flag
+	'(("(?\\(\\*\\))?" (1 (urweb-get-depth-st)))))))
+
+(defconst urweb-font-lock-defaults
+  '(urweb-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
+    (font-lock-syntactic-keywords . urweb-font-lock-syntactic-keywords)))
+
+;;;;
+;;;; Imenu support
+;;;;
+
+(defvar urweb-imenu-regexp
+  (concat "^[ \t]*\\(let[ \t]+\\)?"
+	  (regexp-opt (append urweb-module-head-syms
+			      '("and" "fun" "datatype" "type")) t)
+	  "\\>"))
+
+(defun urweb-imenu-create-index ()
+  (let (alist)
+    (goto-char (point-max))
+    (while (re-search-backward urweb-imenu-regexp nil t)
+      (save-excursion
+	(let ((kind (match-string 2))
+	      (column (progn (goto-char (match-beginning 2)) (current-column)))
+	      (location
+	       (progn (goto-char (match-end 0))
+		      (urweb-forward-spaces)
+		      (when (looking-at urweb-tyvarseq-re)
+			(goto-char (match-end 0)))
+		      (point)))
+	      (name (urweb-forward-sym)))
+	  ;; Eliminate trivial renamings.
+	  (when (or (not (member kind '("structure" "signature")))
+		    (progn (search-forward "=")
+			   (urweb-forward-spaces)
+			   (looking-at "sig\\|struct")))
+	    (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
+		  alist)))))
+    alist))
+
+;;; MORE CODE FOR URWEB-MODE
+
+;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode))
+
+;;;###autoload
+(defalias 'urweb-mode-derived-from
+  (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
+
+;;;###autoload
+(define-derived-mode urweb-mode urweb-mode-derived-from "Ur/Web"
+  "\\<urweb-mode-map>Major mode for editing Ur/Web code.
+This mode runs `urweb-mode-hook' just before exiting.
+\\{urweb-mode-map}"
+  (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
+  (set (make-local-variable 'font-lock-multiline) 'undecided)
+  (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
+  (set (make-local-variable 'imenu-create-index-function)
+       'urweb-imenu-create-index)
+  (set (make-local-variable 'add-log-current-defun-function)
+       'urweb-current-fun-name)
+  ;; Treat paragraph-separators in comments as paragraph-separators.
+  (set (make-local-variable 'paragraph-separate)
+       (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
+  ;; forward-sexp-function is an experimental variable in my hacked Emacs.
+  (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
+  ;; For XEmacs
+  (easy-menu-add urweb-mode-menu)
+
+  ;; Compatibility.  FIXME: we should use `-' in Emacs-CVS.
+  (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
+
+  (local-set-key (kbd "C-c C-c") 'compile)
+  (local-set-key (kbd "C-c /") 'urweb-close-matching-tag)
+
+  (urweb-mode-variables))
+
+(defun urweb-mode-variables ()
+  (set-syntax-table urweb-mode-syntax-table)
+  (setq local-abbrev-table urweb-mode-abbrev-table)
+  ;; A paragraph is separated by blank lines or ^L only.
+
+  (set (make-local-variable 'indent-line-function) 'urweb-indent-line)
+  (set (make-local-variable 'comment-start) "(* ")
+  (set (make-local-variable 'comment-end) " *)")
+  (set (make-local-variable 'comment-nested) t)
+  ;;(set (make-local-variable 'block-comment-start) "* ")
+  ;;(set (make-local-variable 'block-comment-end) "")
+  ;; (set (make-local-variable 'comment-column) 40)
+  (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
+
+(defun urweb-funname-of-and ()
+  "Name of the function this `and' defines, or nil if not a function.
+Point has to be right after the `and' symbol and is not preserved."
+  (urweb-forward-spaces)
+  (if (looking-at urweb-tyvarseq-re) (goto-char (match-end 0)))
+  (let ((sym (urweb-forward-sym)))
+    (urweb-forward-spaces)
+    (unless (or (member sym '(nil "d="))
+		(member (urweb-forward-sym) '("d=")))
+      sym)))
+
+;;; INDENTATION !!!
+
+(defun urweb-mark-function ()
+  "Synonym for `mark-paragraph' -- sorry.
+If anyone has a good algorithm for this..."
+  (interactive)
+  (mark-paragraph))
+
+(defun urweb-indent-line ()
+  "Indent current line of Ur/Web code."
+  (interactive)
+  (let ((savep (> (current-column) (current-indentation)))
+	(indent (max (or (ignore-errors (urweb-calculate-indentation)) 0) 0)))
+    (if savep
+	(save-excursion (indent-line-to indent))
+      (indent-line-to indent))))
+
+(defun urweb-back-to-outer-indent ()
+  "Unindents to the next outer level of indentation."
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward "\t ")
+    (let ((start-column (current-column))
+          (indent (current-column)))
+      (if (> start-column 0)
+          (progn
+            (save-excursion
+              (while (>= indent start-column)
+                (if (re-search-backward "^[^\n]" nil t)
+                    (setq indent (current-indentation))
+                  (setq indent 0))))
+            (backward-delete-char-untabify (- start-column indent)))))))
+
+(defun urweb-find-comment-indent ()
+  (save-excursion
+    (let ((depth 1))
+      (while (> depth 0)
+	(if (re-search-backward "(\\*\\|\\*)" nil t)
+	    (cond
+	     ;; FIXME: That's just a stop-gap.
+	     ((eq (get-text-property (point) 'face) 'font-lock-string-face))
+	     ((looking-at "*)") (incf depth))
+	     ((looking-at comment-start-skip) (decf depth)))
+	  (setq depth -1)))
+      (if (= depth 0)
+	  (1+ (current-column))
+	nil))))
+
+(defun urweb-empty-line ()
+  (save-excursion
+    (beginning-of-line)
+    (let ((start-pos (point)))
+      (end-of-line)
+      (not (re-search-backward "[^\n \t]" start-pos t)))))
+
+(defun urweb-seek-back ()
+  (while (urweb-empty-line) (previous-line 1)))
+
+(defun urweb-skip-matching-braces ()
+  "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code"
+  (beginning-of-line)
+  (let ((start-pos (point))
+        (depth 0))
+    (end-of-line)
+    (while (re-search-backward "[{}]" start-pos t)
+      (cond
+       ((looking-at "}")
+        (incf depth))
+       ((looking-at "{")
+        (decf depth))))
+    (while (and (> depth 0) (re-search-backward "[{}]" nil t)
+      (cond
+       ((looking-at "}")
+        (incf depth))
+       ((looking-at "{")
+        (decf depth)))))))
+
+(defun urweb-new-tags ()
+  "Decide if the previous line of XML introduced unclosed tags"
+  (save-excursion
+    (let ((start-pos (point))
+          (depth 0)
+          (done nil))
+      (previous-line 1)
+      (urweb-seek-back)
+      (urweb-skip-matching-braces)
+      (urweb-seek-back)
+      (beginning-of-line)
+      (while (and (not done) (search-forward "<" start-pos t))
+        (cond
+         ((or (looking-at " ") (looking-at "="))
+          nil)
+         ((looking-at "/")
+          (if (re-search-forward "[^\\sw]>" start-pos t)
+              (when (> depth 0) (decf depth))
+            (setq done t)))
+         (t
+          (if (re-search-forward "[^\\sw]>" start-pos t)
+              (if (not (save-excursion (backward-char 2) (looking-at "/")))
+                  (incf depth))
+            (setq done t)))))
+      (and (not done) (> depth 0)))))
+
+(defun urweb-tag-matching-indent ()
+  "Seek back to a matching opener tag and get its line's indent"
+  (save-excursion
+    (end-of-line)
+    (search-backward "</" nil t)
+    (urweb-tag-matcher)
+    (beginning-of-line)
+    (current-indentation)))
+
+(defun urweb-close-matching-tag ()
+  "Insert a closing XML tag for whatever tag is open at the point."
+  (interactive)
+  (assert (urweb-in-xml))
+  (save-excursion
+   (urweb-tag-matcher)
+   (re-search-forward "<\\([^ ={/>]+\\)" nil t))
+  (let ((tag (match-string-no-properties 1)))
+    (insert "</" tag ">")))
+
+(defconst urweb-sql-main-starters
+  '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE" "FROM" "SELECT1" "WHERE"))
+
+(defconst urweb-sql-starters
+  (append urweb-sql-main-starters
+          '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET"
+            "VALUES" "SET")))
+
+(defconst urweb-sql-main-starters-re
+  (urweb-syms-re urweb-sql-main-starters))
+(defconst urweb-sql-starters-re
+  (urweb-syms-re urweb-sql-starters))
+
+(defconst urweb-sql-main-starters-paren-re
+  (concat "(" urweb-sql-main-starters-re))
+
+(defun urweb-in-sql ()
+  "Check if the point is in a block of SQL syntax."
+  (save-excursion
+    (let ((start-pos (point))
+          (depth 0)
+          done
+          (good t))
+      (when (re-search-backward urweb-sql-main-starters-paren-re nil t)
+        (forward-char)
+        (while (and (not done) (re-search-forward "[()]" start-pos t))
+          (save-excursion
+            (backward-char)
+            (cond
+             ((looking-at ")")
+              (cond
+               ((= depth 0) (setq done t) (setq good nil))
+               (t (decf depth))))
+             ((looking-at "(")
+              (incf depth)))))
+        good))))
+
+(defun urweb-sql-depth ()
+  "Check if the point is in a block of SQL syntax.
+   Returns the paren nesting depth if so, and nil otherwise."
+  (save-excursion
+    (let ((depth 0)
+          done)
+      (while (and (not done)
+                  (re-search-backward "[()]" nil t))
+        (cond
+         ((looking-at ")")
+          (decf depth))
+         ((looking-at "(")
+          (if (looking-at urweb-sql-main-starters-paren-re)
+              (setq done t)
+            (incf depth)))))
+      (max 0 depth))))
+
+(defun urweb-calculate-indentation ()
+  (save-excursion
+    (beginning-of-line) (skip-chars-forward "\t ")
+    (urweb-with-ist
+     ;; Indentation for comments alone on a line, matches the
+     ;; proper indentation of the next line.
+     (when (looking-at "(\\*") (urweb-forward-spaces))
+     (let (data
+	   (sym (save-excursion (urweb-forward-sym))))
+       (or
+	;; Allow the user to override the indentation.
+	(when (looking-at (concat ".*" (regexp-quote comment-start)
+				  "[ \t]*fixindent[ \t]*"
+				  (regexp-quote comment-end)))
+	  (current-indentation))
+
+	;; Continued comment.
+	(and (looking-at "\\*") (urweb-find-comment-indent))
+
+        (and (urweb-in-xml)
+             (let ((prev-indent (save-excursion
+                                  (previous-line 1)
+                                  (urweb-seek-back)
+                                  (urweb-skip-matching-braces)
+                                  (urweb-seek-back)
+                                  (current-indentation))))
+               (cond
+                ((looking-at "</")
+                 (urweb-tag-matching-indent))
+                ((urweb-new-tags)
+                 (+ prev-indent 2))
+                (t
+                 prev-indent))))
+
+	;; Continued string ? (Added 890113 lbn)
+	(and (looking-at "\\\\")
+	     (save-excursion
+	       (if (save-excursion (previous-line 1)
+				   (beginning-of-line)
+				   (looking-at "[\t ]*\\\\"))
+		   (progn (previous-line 1) (current-indentation))
+		 (if (re-search-backward "[^\\\\]\"" nil t)
+		     (1+ (current-column))
+		   0))))
+
+	;; Closing parens.  Could be handled below with `urweb-indent-relative'?
+	(and (looking-at "\\s)")
+	     (save-excursion
+	       (skip-syntax-forward ")")
+	       (backward-sexp 1)
+	       (if (urweb-dangling-sym)
+		   (urweb-indent-default 'noindent)
+		 (current-column))))
+
+        (and (or (looking-at "FROM") (looking-at urweb-sql-starters-re))
+
+             (save-excursion
+               (and (re-search-backward urweb-sql-starters-re nil t)
+                    (if (looking-at urweb-sql-main-starters-re)
+                        (current-column)
+                      (current-indentation)))))
+
+        (and (urweb-in-sql)
+             (setq data (urweb-sql-depth))
+             (save-excursion
+               (re-search-backward urweb-sql-starters-re nil t)
+               (+ (current-column) 2 (* 2 data))))
+
+	(and (setq data (assoc sym urweb-close-paren))
+	     (urweb-indent-relative sym data))
+
+	(and (member sym urweb-starters-syms)
+	     (urweb-indent-starter sym))
+
+	(and (string= sym "|") (urweb-indent-pipe))
+
+	(urweb-indent-arg)
+	(urweb-indent-default))))))
+
+(defsubst urweb-bolp ()
+  (save-excursion (skip-chars-backward " \t|") (bolp)))
+
+(defun urweb-indent-starter (orig-sym)
+  "Return the indentation to use for a symbol in `urweb-starters-syms'.
+Point should be just before the symbol ORIG-SYM and is not preserved."
+  (let ((sym (unless (save-excursion (urweb-backward-arg))
+	       (urweb-backward-spaces)
+	       (urweb-backward-sym))))
+    (if (member sym '(";" "d=")) (setq sym nil))
+    (if sym (urweb-get-sym-indent sym)
+      ;; FIXME: this can take a *long* time !!
+      (setq sym (urweb-find-matching-starter urweb-starters-syms))
+      ;; Don't align with `and' because it might be specially indented.
+      (if (and (or (equal orig-sym "and") (not (equal sym "and")))
+	       (urweb-bolp))
+	  (+ (current-column)
+	     (if (and urweb-rightalign-and (equal orig-sym "and"))
+		 (- (length sym) 3) 0))
+	(urweb-indent-starter orig-sym)))))
+
+(defun urweb-indent-relative (sym data)
+  (save-excursion
+    (urweb-forward-sym) (urweb-backward-sexp nil)
+    (unless (second data) (urweb-backward-spaces) (urweb-backward-sym))
+    (+ (or (cdr (assoc sym urweb-symbol-indent)) 0)
+       (urweb-delegated-indent))))
+
+(defun urweb-indent-pipe ()
+  (let ((sym (urweb-find-matching-starter urweb-pipeheads
+					(urweb-op-prec "|" 'back))))
+    (when sym
+      (if (string= sym "|")
+	  (if (urweb-bolp) (current-column) (urweb-indent-pipe))
+	(let ((pipe-indent (or (cdr (assoc "|" urweb-symbol-indent)) -2)))
+	  (when (or (member sym '("datatype"))
+		    (and (equal sym "and")
+			 (save-excursion
+			   (forward-word 1)
+			   (not (urweb-funname-of-and)))))
+	    (re-search-forward "="))
+	  (urweb-forward-sym)
+	  (urweb-forward-spaces)
+	  (+ pipe-indent (current-column)))))))
+
+(defun urweb-find-forward (re)
+  (urweb-forward-spaces)
+  (while (and (not (looking-at re))
+	      (progn
+		(or (ignore-errors (forward-sexp 1) t) (forward-char 1))
+		(urweb-forward-spaces)
+		(not (looking-at re))))))
+
+(defun urweb-indent-arg ()
+  (and (save-excursion (ignore-errors (urweb-forward-arg)))
+       ;;(not (looking-at urweb-not-arg-re))
+       ;; looks like a function or an argument
+       (urweb-move-if (urweb-backward-arg))
+       ;; an argument
+       (if (save-excursion (not (urweb-backward-arg)))
+	   ;; a first argument
+	   (+ (current-column) urweb-indent-args)
+	 ;; not a first arg
+	 (while (and (/= (current-column) (current-indentation))
+		     (urweb-move-if (urweb-backward-arg))))
+	 (unless (save-excursion (urweb-backward-arg))
+	   ;; all earlier args are on the same line
+	   (urweb-forward-arg) (urweb-forward-spaces))
+	 (current-column))))
+
+(defun urweb-get-indent (data sym)
+  (let (d)
+    (cond
+     ((not (listp data)) data)
+     ((setq d (member sym data)) (cadr d))
+     ((and (consp data) (not (stringp (car data)))) (car data))
+     (t urweb-indent-level))))
+
+(defun urweb-dangling-sym ()
+  "Non-nil if the symbol after point is dangling.
+The symbol can be an Ur/Web symbol or an open-paren. \"Dangling\" means that
+it is not on its own line but is the last element on that line."
+  (save-excursion
+    (and (not (urweb-bolp))
+	 (< (urweb-point-after (end-of-line))
+	    (urweb-point-after (or (urweb-forward-sym) (skip-syntax-forward "("))
+			     (urweb-forward-spaces))))))
+
+(defun urweb-delegated-indent ()
+  (if (urweb-dangling-sym)
+      (urweb-indent-default 'noindent)
+    (urweb-move-if (backward-word 1)
+		 (looking-at urweb-agglomerate-re))
+    (current-column)))
+
+(defun urweb-get-sym-indent (sym &optional style)
+  "Find the indentation for the SYM we're `looking-at'.
+If indentation is delegated, point will move to the start of the parent.
+Optional argument STYLE is currently ignored."
+;;(assert (equal sym (save-excursion (urweb-forward-sym))))
+  (save-excursion
+    (let ((delegate (and (not (equal sym "end")) (assoc sym urweb-close-paren)))
+	  (head-sym sym))
+      (when (and delegate (not (eval (third delegate))))
+	;;(urweb-find-match-backward sym delegate)
+	(urweb-forward-sym) (urweb-backward-sexp nil)
+	(setq head-sym
+	      (if (second delegate)
+		  (save-excursion (urweb-forward-sym))
+		(urweb-backward-spaces) (urweb-backward-sym))))
+      (let ((idata (assoc head-sym urweb-indent-rule)))
+	(when idata
+	  ;;(if (or style (not delegate))
+	  ;; normal indentation
+	  (let ((indent (urweb-get-indent (cdr idata) sym)))
+	    (when indent (+ (urweb-delegated-indent) indent)))
+	  ;; delgate indentation to the parent
+	  ;;(urweb-forward-sym) (urweb-backward-sexp nil)
+	  ;;(let* ((parent-sym (save-excursion (urweb-forward-sym)))
+	  ;;     (parent-indent (cdr (assoc parent-sym urweb-indent-starters))))
+	  ;; check the special rules
+	  ;;(+ (urweb-delegated-indent)
+	  ;; (or (urweb-get-indent (cdr indent-data) 1 'strict)
+	  ;; (urweb-get-indent (cdr parent-indent) 1 'strict)
+	  ;; (urweb-get-indent (cdr indent-data) 0)
+	  ;; (urweb-get-indent (cdr parent-indent) 0))))))))
+	  )))))
+
+(defun urweb-indent-default (&optional noindent)
+  (condition-case nil
+      (progn
+        (let* ((sym-after (save-excursion (urweb-forward-sym)))
+               (_ (urweb-backward-spaces))
+               (sym-before (urweb-backward-sym))
+               (sym-indent (and sym-before (urweb-get-sym-indent sym-before)))
+               (indent-after (or (cdr (assoc sym-after urweb-symbol-indent)) 0)))
+          (when (equal sym-before "end")
+            ;; I don't understand what's really happening here, but when
+            ;; it's `end' clearly, we need to do something special.
+            (forward-word 1)
+            (setq sym-before nil sym-indent nil))
+          (cond
+           (sym-indent
+            ;; the previous sym is an indentation introducer: follow the rule
+            (if noindent
+                ;;(current-column)
+                sym-indent
+              (+ sym-indent indent-after)))
+           ;; If we're just after a hanging open paren.
+           ((and (eq (char-syntax (preceding-char)) ?\()
+                 (save-excursion (backward-char) (urweb-dangling-sym)))
+            (backward-char)
+            (urweb-indent-default))
+           (t
+            ;; default-default
+            (let* ((prec-after (urweb-op-prec sym-after 'back))
+                   (prec (or (urweb-op-prec sym-before 'back) prec-after 100)))
+              ;; go back until you hit a symbol that has a lower prec than the
+              ;; "current one", or until you backed over a sym that has the same prec
+              ;; but is at the beginning of a line.
+              (while (and (not (urweb-bolp))
+                          (while (urweb-move-if (urweb-backward-sexp (1- prec))))
+                          (not (urweb-bolp)))
+                (while (urweb-move-if (urweb-backward-sexp prec))))
+              (if noindent
+                  ;; the `noindent' case does back over an introductory symbol
+                  ;; such as `fun', ...
+                  (progn
+                    (urweb-move-if
+                     (urweb-backward-spaces)
+                     (member (urweb-backward-sym) urweb-starters-syms))
+                    (current-column))
+                ;; Use `indent-after' for cases such as when , or ; should be
+                ;; outdented so that their following terms are aligned.
+                (+ (if (progn
+                         (if (equal sym-after ";")
+                             (urweb-move-if
+                              (urweb-backward-spaces)
+                              (member (urweb-backward-sym) urweb-starters-syms)))
+                         (and sym-after (not (looking-at sym-after))))
+                       indent-after 0)
+                   (current-column))))))))
+    (error 0)))
+
+
+;; maybe `|' should be set to word-syntax in our temp syntax table ?
+(defun urweb-current-indentation ()
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward " \t|")
+    (current-column)))
+
+
+(defun urweb-find-matching-starter (syms &optional prec)
+  (let (sym)
+    (ignore-errors
+      (while
+	  (progn (urweb-backward-sexp prec)
+		 (setq sym (save-excursion (urweb-forward-sym)))
+		 (not (or (member sym syms) (bobp)))))
+      (if (member sym syms) sym))))
+
+(defun urweb-skip-siblings ()
+  (while (and (not (bobp)) (urweb-backward-arg))
+    (urweb-find-matching-starter urweb-starters-syms)))
+
+(defun urweb-beginning-of-defun ()
+  (let ((sym (urweb-find-matching-starter urweb-starters-syms)))
+    (if (member sym '("fun" "and" "functor" "signature" "structure"
+		      "datatype"))
+	(save-excursion (urweb-forward-sym) (urweb-forward-spaces)
+			(urweb-forward-sym))
+      ;; We're inside a "non function declaration": let's skip all other
+      ;; declarations that we find at the same level and try again.
+      (urweb-skip-siblings)
+      ;; Obviously, let's not try again if we're at bobp.
+      (unless (bobp) (urweb-beginning-of-defun)))))
+
+(defcustom urweb-max-name-components 3
+  "Maximum number of components to use for the current function name."
+  :group 'urweb
+  :type 'integer)
+
+(defun urweb-current-fun-name ()
+  (save-excursion
+    (let ((count urweb-max-name-components)
+	  fullname name)
+      (end-of-line)
+      (while (and (> count 0)
+		  (setq name (urweb-beginning-of-defun)))
+	(decf count)
+	(setq fullname (if fullname (concat name "." fullname) name))
+	;; Skip all other declarations that we find at the same level.
+	(urweb-skip-siblings))
+      fullname)))
+
+(provide 'urweb-mode)
+
+;;; urweb-mode.el ends here
diff --git a/src/elisp/urweb-move.el b/src/elisp/urweb-move.el
new file mode 100644
index 0000000..08cd19e
--- /dev/null
+++ b/src/elisp/urweb-move.el
@@ -0,0 +1,373 @@
+;;; urweb-move.el --- Buffer navigation functions for urweb-mode
+
+;; Based on urweb-mode:
+;; Copyright (C) 1999, 2000, 2004  Stefan Monnier <monnier@gnu.org>
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'urweb-util)
+(require 'urweb-defs)
+
+(defsyntax urweb-internal-syntax-table
+  '((?_  . "w")
+    (?'  . "w")
+    (?.  . "w"))
+  "Syntax table used for internal urweb-mode operation."
+  :copy urweb-mode-syntax-table)
+
+;;; 
+;;; various macros
+;;; 
+
+(defmacro urweb-with-ist (&rest r)
+  (let ((ost-sym (make-symbol "oldtable")))
+    `(let ((,ost-sym (syntax-table))
+	   (case-fold-search nil)
+	   (parse-sexp-lookup-properties t)
+	   (parse-sexp-ignore-comments t))
+       (unwind-protect
+	   (progn (set-syntax-table urweb-internal-syntax-table) . ,r)
+	 (set-syntax-table ,ost-sym)))))
+(def-edebug-spec urweb-with-ist t)
+
+(defmacro urweb-move-if (&rest body)
+  (let ((pt-sym (make-symbol "point"))
+	(res-sym (make-symbol "result")))
+    `(let ((,pt-sym (point))
+	   (,res-sym ,(cons 'progn body)))
+       (unless ,res-sym (goto-char ,pt-sym))
+       ,res-sym)))
+(def-edebug-spec urweb-move-if t)
+
+(defmacro urweb-point-after (&rest body)
+  `(save-excursion
+     ,@body
+     (point)))
+(def-edebug-spec urweb-point-after t)
+
+;;
+
+(defvar urweb-op-prec
+  (urweb-preproc-alist
+   '((("UNION" "INTERSECT" "EXCEPT") . 0)
+     (("AND" "OR") . 1)
+     ((">=" "<>" "<=" "=") . 4)
+     (("+" "-" "^") . 6)
+     (("*" "%") . 7)
+     (("NOT") 9)))
+  "Alist of Ur/Web infix operators and their precedence.")
+
+(defconst urweb-syntax-prec
+  (urweb-preproc-alist
+   `(("," . 20)
+     (("=>" "d=" "=of") . (65 . 40))
+     ("|" . (47 . 30))
+     (("case" "of" "fn") . 45)
+     (("if" "then" "else" ) . 50)
+     (";" . 53)
+     (("<-") . 55)
+     ("||" . 70)
+     ("&&" . 80)
+     ((":" ":>") . 90)
+     ("->" . 95)
+     ("with" . 100)
+     (,(cons "end" urweb-begin-syms) . 10000)))
+  "Alist of pseudo-precedence of syntactic elements.")
+
+(defun urweb-op-prec (op dir)
+  "Return the precedence of OP or nil if it's not an infix.
+DIR should be set to BACK if you want to precedence w.r.t the left side
+    and to FORW for the precedence w.r.t the right side.
+This assumes that we are `looking-at' the OP."
+  (when op
+    (let ((sprec (cdr (assoc op urweb-syntax-prec))))
+      (cond
+       ((consp sprec) (if (eq dir 'back) (car sprec) (cdr sprec)))
+       (sprec sprec)
+       (t
+	(let ((prec (cdr (assoc op urweb-op-prec))))
+	  (when prec (+ prec 100))))))))
+
+;;
+
+(defun urweb-forward-spaces () (forward-comment 100000))
+(defun urweb-backward-spaces () (forward-comment -100000))
+
+
+;;
+;; moving forward around matching symbols
+;;
+
+(defun urweb-looking-back-at (re)
+  (save-excursion
+    (when (= 0 (skip-syntax-backward "w_")) (backward-char))
+    (looking-at re)))
+
+(defun urweb-find-match-forward (this match)
+  "Only works for word matches."
+  (let ((level 1)
+	(forward-sexp-function nil)
+	(either (concat this "\\|" match)))
+    (while (> level 0)
+      (forward-sexp 1)
+      (while (not (or (eobp) (urweb-looking-back-at either)))
+	(condition-case () (forward-sexp 1) (error (forward-char 1))))
+      (setq level
+	    (cond
+	     ((and (eobp) (> level 1)) (error "Unbalanced"))
+	     ((urweb-looking-back-at this) (1+ level))
+	     ((urweb-looking-back-at match) (1- level))
+	     (t (error "Unbalanced")))))
+    t))
+
+(defun urweb-find-match-backward (this match)
+  (let ((level 1)
+	(forward-sexp-function nil)
+	(either (concat this "\\|" match)))
+    (while (> level 0)
+      (backward-sexp 1)
+      (while (not (or (bobp) (looking-at either)))
+	(condition-case () (backward-sexp 1) (error (backward-char 1))))
+      (setq level
+	    (cond
+	     ((and (bobp) (> level 1)) (error "Unbalanced"))
+	     ((looking-at this) (1+ level))
+	     ((looking-at match) (1- level))
+	     (t (error "Unbalanced")))))
+    t))
+
+;;; 
+;;; read a symbol, including the special "op <sym>" case
+;;; 
+
+(defmacro urweb-move-read (&rest body)
+  (let ((pt-sym (make-symbol "point")))
+    `(let ((,pt-sym (point)))
+       ,@body
+       (when (/= (point) ,pt-sym)
+	 (buffer-substring-no-properties (point) ,pt-sym)))))
+(def-edebug-spec urweb-move-read t)
+
+(defun urweb-poly-equal-p ()
+  (< (urweb-point-after (re-search-backward urweb-=-starter-re nil 'move))
+     (urweb-point-after (re-search-backward "=" nil 'move))))
+
+(defun urweb-nested-of-p ()
+  (< (urweb-point-after
+      (re-search-backward urweb-non-nested-of-starter-re nil 'move))
+     (urweb-point-after (re-search-backward "\\<case\\>" nil 'move))))
+
+(defun urweb-forward-sym-1 ()
+  (or (/= 0 (skip-syntax-forward "'w_"))
+      (/= 0 (skip-syntax-forward ".'"))))
+(defun urweb-forward-sym ()
+  (interactive)
+  (let ((sym (urweb-move-read (urweb-forward-sym-1))))
+    (cond
+     ((equal "op" sym)
+      (urweb-forward-spaces)
+      (concat "op " (or (urweb-move-read (urweb-forward-sym-1)) "")))
+     ((equal sym "=")
+      (save-excursion
+	(urweb-backward-sym-1)
+	(if (urweb-poly-equal-p) "=" "d=")))
+     ((equal sym "of")
+      (save-excursion
+	(urweb-backward-sym-1)
+	(if (urweb-nested-of-p) "of" "=of")))
+     ;; ((equal sym "datatype")
+     ;;  (save-excursion
+     ;; 	(urweb-backward-sym-1)
+     ;; 	(urweb-backward-spaces)
+     ;; 	(if (eq (preceding-char) ?=) "=datatype" sym)))
+     (t sym))))
+
+(defun urweb-backward-sym-1 ()
+  (or (/= 0 (skip-syntax-backward ".'"))
+      (/= 0 (skip-syntax-backward "'w_"))))
+(defun urweb-backward-sym ()
+  (interactive)
+  (let ((sym (urweb-move-read (urweb-backward-sym-1))))
+    (let ((result
+           (when sym
+             ;; FIXME: what should we do if `sym' = "op" ?
+             (let ((point (point)))
+               (urweb-backward-spaces)
+               (if (equal "op" (urweb-move-read (urweb-backward-sym-1)))
+                   (concat "op " sym)
+                 (goto-char point)
+                 (cond
+                  ((string= sym "=") (if (urweb-poly-equal-p) "=" "d="))
+                  ((string= sym "of") (if (urweb-nested-of-p) "of" "=of"))
+                  ;; ((string= sym "datatype")
+                  ;;  (save-excursion (urweb-backward-spaces)
+                  ;; 		    (if (eq (preceding-char) ?=) "=datatype" sym)))
+                  (t sym)))))))
+      (if (looking-at ">")
+          (substring result 1 nil)
+        result))))
+;;       (if (save-excursion (backward-char 5) (looking-at "</xml>"))
+;;           (progn
+;;             (backward-char 5)
+;;             (urweb-tag-matcher)
+;;             (backward-char)
+;;             (urweb-backward-sym))
+;;         result))))
+
+(defun urweb-tag-matcher ()
+  "Seek back to a matching opener tag"
+  (let ((depth 0)
+        (done nil))
+    (while (and (not done) (search-backward ">" nil t))
+      (cond
+       ((save-excursion (backward-char 1) (looking-at " "))
+        nil)
+       ((save-excursion (backward-char 1) (looking-at "/"))
+        (when (not (re-search-backward "<[^ =]" nil t))
+          (setq done t)))
+       (t
+        (if (re-search-backward "<[^ =]" nil t)
+            (if (looking-at "</")
+                (incf depth)
+              (if (= depth 0)
+                  (setq done t)
+                (decf depth)))
+          (setq done t)))))))
+
+(defun urweb-backward-sexp (prec)
+  "Move one sexp backward if possible, or one char else.
+Returns t if the move indeed moved through one sexp and nil if not.
+PREC is the precedence currently looked for."
+  (let ((result (let ((parse-sexp-lookup-properties t)
+                      (parse-sexp-ignore-comments t))
+                  (urweb-backward-spaces)
+                  (let* ((op (urweb-backward-sym))
+                         (op-prec (urweb-op-prec op 'back))
+                         match)
+                  (cond
+                   ((not op)
+                    (let ((point (point)))
+                      (ignore-errors (let ((forward-sexp-function nil)) (backward-sexp 1)))
+                      (if (/= point (point)) t (ignore-errors (backward-char 1)) nil)))
+                   ;; stop as soon as precedence is smaller than `prec'
+                   ((and prec op-prec (>= prec op-prec)) nil)
+                   ;; special rules for nested constructs like if..then..else
+                   ((and (or (not prec) (and prec op-prec))
+                         (setq match (second (assoc op urweb-close-paren))))
+                    (urweb-find-match-backward (concat "\\<" op "\\>") match))
+                   ;; don't back over open-parens
+                   ((assoc op urweb-open-paren) nil)
+                   ;; infix ops precedence
+                   ((and prec op-prec) (< prec op-prec))
+                   ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
+                   (op-prec (while (urweb-move-if (urweb-backward-sexp op-prec))) t)
+                   ;; special symbols indicating we're getting out of a nesting level
+                   ((string-match urweb-sexp-head-symbols-re op) nil)
+                   ;; if the op was not alphanum, then we still have to do the backward-sexp
+                   ;; this reproduces the usual backward-sexp, but it might be bogus
+                   ;; in this case since !@$% is a perfectly fine symbol
+                   (t t))))))
+    (if (save-excursion (backward-char 5) (looking-at "</xml>"))
+      (progn
+        (backward-char 5)
+        (urweb-tag-matcher)
+        (backward-char)
+        (urweb-backward-sexp prec))
+      result)))
+
+(defun urweb-forward-sexp (prec)
+  "Moves one sexp forward if possible, or one char else.
+Returns T if the move indeed moved through one sexp and NIL if not."
+  (let ((parse-sexp-lookup-properties t)
+	(parse-sexp-ignore-comments t))
+    (urweb-forward-spaces)
+    (let* ((op (urweb-forward-sym))
+	   (op-prec (urweb-op-prec op 'forw))
+	   match)
+      (cond
+       ((not op)
+	(let ((point (point)))
+	  (ignore-errors (let ((forward-sexp-function nil)) (forward-sexp 1)))
+	  (if (/= point (point)) t (forward-char 1) nil)))
+       ;; stop as soon as precedence is smaller than `prec'
+       ((and prec op-prec (>= prec op-prec)) nil)
+       ;; special rules for nested constructs like if..then..else
+       ((and (or (not prec) (and prec op-prec))
+	     (setq match (cdr (assoc op urweb-open-paren))))
+	(urweb-find-match-forward (first match) (second match)))
+       ;; don't forw over close-parens
+       ((assoc op urweb-close-paren) nil)
+       ;; infix ops precedence
+       ((and prec op-prec) (< prec op-prec))
+       ;; [ prec = nil ]  a new operator, let's skip the sexps until the next
+       (op-prec (while (urweb-move-if (urweb-forward-sexp op-prec))) t)
+       ;; special symbols indicating we're getting out of a nesting level
+       ((string-match urweb-sexp-head-symbols-re op) nil)
+       ;; if the op was not alphanum, then we still have to do the backward-sexp
+       ;; this reproduces the usual backward-sexp, but it might be bogus
+       ;; in this case since !@$% is a perfectly fine symbol
+       (t t))))) ;(or (string-match "\\sw" op) (urweb-backward-sexp prec))
+
+(defun urweb-in-word-p ()
+  (and (eq ?w (char-syntax (or (char-before) ? )))
+       (eq ?w (char-syntax (or (char-after) ? )))))
+
+(defun urweb-user-backward-sexp (&optional count)
+  "Like `backward-sexp' but tailored to the Ur/Web syntax."
+  (interactive "p")
+  (unless count (setq count 1))
+  (urweb-with-ist
+   (let ((point (point)))
+     (if (< count 0) (urweb-user-forward-sexp (- count))
+       (when (urweb-in-word-p) (forward-word 1))
+       (dotimes (i count)
+	 (unless (urweb-backward-sexp nil)
+	   (goto-char point)
+	   (error "Containing expression ends prematurely")))))))
+
+
+(defun urweb-user-forward-sexp (&optional count)
+  "Like `forward-sexp' but tailored to the Ur/Web syntax."
+  (interactive "p")
+  (unless count (setq count 1))
+  (urweb-with-ist
+   (let ((point (point)))
+     (if (< count 0) (urweb-user-backward-sexp (- count))
+       (when (urweb-in-word-p) (backward-word 1))
+       (dotimes (i count)
+	 (unless (urweb-forward-sexp nil)
+	   (goto-char point)
+	   (error "Containing expression ends prematurely")))))))
+
+;;(defun urweb-forward-thing ()
+;;  (if (= ?w (char-syntax (char-after))) (forward-word 1) (forward-char 1)))
+
+(defun urweb-backward-arg () (interactive) (urweb-backward-sexp 1000))
+(defun urweb-forward-arg () (interactive) (urweb-forward-sexp 1000))
+
+
+(provide 'urweb-move)
+
+;;; urweb-move.el ends here
diff --git a/src/elisp/urweb-util.el b/src/elisp/urweb-util.el
new file mode 100644
index 0000000..55a1e27
--- /dev/null
+++ b/src/elisp/urweb-util.el
@@ -0,0 +1,123 @@
+;;; urweb-util.el --- Utility functions for urweb-mode
+
+;; Based on sml-mode:
+;; Copyright (C) 1999-2000  Stefan Monnier <monnier@cs.yale.edu>
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl)				;for `reduce'
+(require 'urweb-compat)
+
+;;
+
+(defun flatten (ls &optional acc)
+  (if (null ls) acc
+    (let ((rest (flatten (cdr ls) acc))
+	  (head (car ls)))
+      (if (listp head)
+	  (flatten head rest)
+	(cons head rest)))))
+
+(defun urweb-preproc-alist (al)
+  "Expand an alist AL where keys can be lists of keys into a normal one."
+  (reduce (lambda (x al)
+	    (let ((k (car x))
+		  (v (cdr x)))
+	      (if (consp k)
+		  (append (mapcar (lambda (y) (cons y v)) k) al)
+		(cons x al))))
+	  al
+	  :initial-value nil
+	  :from-end t))
+
+;;; 
+;;; defmap
+;;; 
+
+(defun custom-create-map (m bs args)
+  (let (inherit dense suppress)
+    (while args
+      (let ((key (first args))
+	    (val (second args)))
+	(cond
+	 ((eq key :dense) (setq dense val))
+	 ((eq key :inherit) (setq inherit val))
+	 ((eq key :group) )
+	 ;;((eq key :suppress) (setq suppress val))
+	 (t (message "Uknown argument %s in defmap" key))))
+      (setq args (cddr args)))
+    (unless (keymapp m)
+      (setq bs (append m bs))
+      (setq m (if dense (make-keymap) (make-sparse-keymap))))
+    (dolist (b bs)
+      (let ((keys (car b))
+	    (binding (cdr b)))
+	(dolist (key (if (consp keys) keys (list keys)))
+	  (cond
+	   ((symbolp key)
+	    (substitute-key-definition key binding m global-map))
+	   ((null binding)
+	    (unless (keymapp (lookup-key m key)) (define-key m key binding)))
+	   ((let ((o (lookup-key m key)))
+	      (or (null o) (numberp o) (eq o 'undefined)))
+	    (define-key m key binding))))))
+    (cond
+     ((keymapp inherit) (set-keymap-parent m inherit))
+     ((consp inherit) (set-keymap-parents m inherit)))
+    m))
+
+(defmacro defmap (m bs doc &rest args)
+  `(defconst ,m
+     (custom-create-map (if (boundp ',m) ,m) ,bs ,(cons 'list args))
+     ,doc))
+
+;; defsyntax ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun custom-create-syntax (css args)
+  (let ((st (make-syntax-table (cadr (memq :copy args)))))
+    (dolist (cs css)
+      (let ((char (car cs))
+	    (syntax (cdr cs)))
+	(if (sequencep char)
+	    (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
+	  (modify-syntax-entry char syntax st))))
+    st))
+
+(defmacro defsyntax (st css doc &rest args)
+  `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) ,doc))
+
+;;;; 
+;;;; Compatibility info
+;;;; 
+
+(defvar urweb-builtin-nested-comments-flag
+  (ignore-errors
+    (not (equal (let ((st (make-syntax-table)))
+		  (modify-syntax-entry ?\* ". 23n" st) st)
+		(let ((st (make-syntax-table)))
+		  (modify-syntax-entry ?\* ". 23" st) st))))
+  "Non-nil means this Emacs understands the `n' in syntax entries.")
+
+(provide 'urweb-util)
+
+;;; urweb-util.el ends here
diff --git a/src/errormsg.sig b/src/errormsg.sig
new file mode 100644
index 0000000..9242584
--- /dev/null
+++ b/src/errormsg.sig
@@ -0,0 +1,56 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ERROR_MSG = sig
+
+    type pos = {line : int,
+                char : int}
+           
+    type span = {file : string,
+                 first : pos,
+                 last : pos}
+
+    type 'a located = 'a * span
+
+    val posToString : pos -> string
+    val spanToString : span -> string
+
+    val dummyPos : pos
+    val dummySpan : span
+
+    val resetPositioning : string -> unit
+    val newline : int -> unit
+    val lastLineStart : unit -> int
+    val posOf : int -> pos
+    val spanOf : int * int -> span
+
+    val resetErrors : unit -> unit
+    val anyErrors : unit -> bool
+    val error : string -> unit
+    val errorAt : span -> string -> unit
+    val errorAt' : int * int -> string -> unit
+end
diff --git a/src/errormsg.sml b/src/errormsg.sml
new file mode 100644
index 0000000..8f3c93b
--- /dev/null
+++ b/src/errormsg.sml
@@ -0,0 +1,107 @@
+(* Copyright (c) 2008, 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ErrorMsg :> ERROR_MSG = struct
+
+type pos = {line : int,
+            char : int}
+
+type span = {file : string,
+             first : pos,
+             last : pos}
+
+type 'a located = 'a * span
+
+
+fun posToString {line, char} =
+    String.concat [Int.toString line, ":", Int.toString char]
+
+fun spanToString {file, first, last} =
+    String.concat [file, ":", posToString first, "-", posToString last]
+
+val dummyPos = {line = 0,
+                char = 0}
+val dummySpan = {file = "",
+                 first = dummyPos,
+                 last = dummyPos}
+
+
+val file = ref ""
+val numLines = ref 1
+val lines : int list ref = ref []
+
+fun resetPositioning fname = (file := fname;
+                              numLines := 1;
+                              lines := [])
+
+fun newline pos = (numLines := !numLines + 1;
+                   lines := pos :: !lines)
+
+fun lastLineStart () =
+    case !lines of
+        [] => 0
+      | n :: _ => n+1
+
+fun posOf n =
+    let
+        fun search lineNum lines =
+            case lines of
+                [] => {line = 1,
+                       char = n}
+              | bound :: rest =>
+                if n > bound then
+                    {line = lineNum,
+                     char = n - bound - 1}
+                else
+                    search (lineNum - 1) rest
+    in
+        search (!numLines) (!lines)
+    end
+
+fun spanOf (pos1, pos2) = {file = !file,
+                           first = posOf pos1,
+                           last = posOf pos2}
+
+
+val errors = ref false
+
+fun resetErrors () = errors := false
+fun anyErrors () = !errors
+fun error s = (TextIO.output (TextIO.stdErr, s);
+               TextIO.output1 (TextIO.stdErr, #"\n");
+               errors := true)
+
+fun errorAt (span : span) s = (TextIO.output (TextIO.stdErr, #file span);
+                               TextIO.output (TextIO.stdErr, ":");
+                               TextIO.output (TextIO.stdErr, posToString (#first span));
+                               TextIO.output (TextIO.stdErr, ": (to ");
+                               TextIO.output (TextIO.stdErr, posToString (#last span));
+                               TextIO.output (TextIO.stdErr, ") ");
+                               error s)
+fun errorAt' span s = errorAt (spanOf span) s
+
+end
diff --git a/src/especialize.sig b/src/especialize.sig
new file mode 100644
index 0000000..135e3a0
--- /dev/null
+++ b/src/especialize.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature ESPECIALIZE = sig
+
+    val specialize : Core.file -> Core.file
+
+    val functionInside : IntBinarySet.set -> Core.con -> bool
+
+end
diff --git a/src/especialize.sml b/src/especialize.sml
new file mode 100644
index 0000000..7cf145c
--- /dev/null
+++ b/src/especialize.sml
@@ -0,0 +1,717 @@
+(* Copyright (c) 2008-2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ESpecialize :> ESPECIALIZE = struct
+
+open Core
+
+structure E = CoreEnv
+structure U = CoreUtil
+
+type skey = exp
+
+structure K = struct
+type ord_key = con list * exp list
+fun compare ((cs1, es1), (cs2, es2)) = Order.join (Order.joinL U.Con.compare (cs1, cs2),
+                                                   fn () => Order.joinL U.Exp.compare (es1, es2))
+end
+
+structure KM = BinaryMapFn(K)
+structure IM = IntBinaryMap
+structure IS = IntBinarySet
+
+val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs,
+                            con = fn (_, _, xs) => xs,
+                            exp = fn (bound, e, xs) =>
+                                     case e of
+                                         ERel x =>
+                                         if x >= bound then
+                                             IS.add (xs, x - bound)
+                                         else
+                                             xs
+                                       | _ => xs,
+                            bind = fn (bound, b) =>
+                                      case b of
+                                          U.Exp.RelE _ => bound + 1
+                                        | _ => bound}
+                           0 IS.empty
+
+fun isPolyT (t, _) =
+    case t of
+        TFun (_, ran) => isPolyT ran
+      | TCFun _ => true
+      | TKFun _ => true
+      | _ => false
+
+fun isPoly (d, _) =
+    case d of
+        DVal (_, _, t, _, _) => isPolyT t
+      | DValRec vis => List.exists (isPolyT o #3) vis
+      | _ => false
+
+fun positionOf (v : int, ls) =
+    let
+        fun pof (pos, ls) =
+            case ls of
+                [] => raise Fail "Defunc.positionOf"
+              | v' :: ls' =>
+                if v = v' then
+                    pos
+                else
+                    pof (pos + 1, ls')
+    in
+        pof (0, ls)
+    end
+
+fun squish fvs =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel x =>
+                                         if x >= bound then
+                                             ERel (positionOf (x - bound, fvs) + bound)
+                                         else
+                                             e
+                                       | _ => e,
+                bind = fn (bound, b) =>
+                          case b of
+                              U.Exp.RelE _ => bound + 1
+                            | _ => bound}
+               0
+
+type func = {
+     name : string,
+     args : int KM.map,
+     body : exp,
+     typ : con,
+     tag : string,
+     constArgs : int (* What length prefix of the arguments never vary across recursive calls? *)
+}
+
+type state = {
+     maxName : int,
+     funcs : func IM.map,
+     decls : (string * int * con * exp * string) list,
+     specialized : IS.set
+}
+
+fun default (_, x, st) = (x, st)
+
+fun functionInside known =
+    U.Con.exists {kind = fn _ => false,
+                  con = fn TFun _ => true
+                         | TCFun _ => true
+                         | CFfi ("Basis", "transaction") => true
+                         | CFfi ("Basis", "eq") => true
+                         | CFfi ("Basis", "num") => true
+                         | CFfi ("Basis", "ord") => true
+                         | CFfi ("Basis", "show") => true
+                         | CFfi ("Basis", "read") => true
+                         | CFfi ("Basis", "sql_injectable_prim") => true
+                         | CFfi ("Basis", "sql_injectable") => true
+                         | CNamed n => IS.member (known, n)
+                         | _ => false}
+
+fun getApp (e, _) =
+    case e of
+        ENamed f => SOME (f, [])
+      | EApp (e1, e2) =>
+        (case getApp e1 of
+             NONE => NONE
+           | SOME (f, xs) => SOME (f, xs @ [e2]))
+      | _ => NONE
+
+val getApp = fn e => case getApp e of
+                         v as SOME (_, _ :: _) => v
+                       | _ => NONE
+
+val maxInt = Option.getOpt (Int.maxInt, 9999)
+
+fun calcConstArgs enclosingFunctions e =
+    let
+        fun ca depth e =
+            case #1 e of
+                EPrim _ => maxInt
+              | ERel _ => maxInt
+              | ENamed n => if IS.member (enclosingFunctions, n) then 0 else maxInt
+              | ECon (_, _, _, NONE) => maxInt
+              | ECon (_, _, _, SOME e) => ca depth e
+              | EFfi _ => maxInt
+              | EFfiApp (_, _, ecs) => foldl (fn ((e, _), d) => Int.min (ca depth e, d)) maxInt ecs
+              | EApp (e1, e2) =>
+                let
+                    fun default () = Int.min (ca depth e1, ca depth e2)
+                in
+                    case getApp e of
+                        NONE => default ()
+                      | SOME (f, args) =>
+                        if not (IS.member (enclosingFunctions, f)) then
+                            default ()
+                        else
+                            let
+                                fun visitArgs (count, args) =
+                                    case args of
+                                        [] => count
+                                      | arg :: args' =>
+                                        let
+                                            fun default () = foldl (fn (e, d) => Int.min (ca depth e, d)) count args
+                                        in
+                                            case #1 arg of
+                                                ERel n =>
+                                                if n = depth - 1 - count then
+                                                    visitArgs (count + 1, args')
+                                                else
+                                                    default ()
+                                              | _ => default ()
+                                        end
+                            in
+                                visitArgs (0, args)
+                            end
+                end
+              | EAbs (_, _, _, e1) => ca (depth + 1) e1
+              | ECApp (e1, _) => ca depth e1
+              | ECAbs (_, _, e1) => ca depth e1
+              | EKAbs (_, e1) => ca depth e1
+              | EKApp (e1, _) => ca depth e1
+              | ERecord xets => foldl (fn ((_, e, _), d) => Int.min (ca depth e, d)) maxInt xets
+              | EField (e1, _, _) => ca depth e1
+              | EConcat (e1, _, e2, _) => Int.min (ca depth e1, ca depth e2)
+              | ECut (e1, _, _) => ca depth e1
+              | ECutMulti (e1, _, _) => ca depth e1
+              | ECase (e1, pes, _) => foldl (fn ((p, e), d) => Int.min (ca (depth + E.patBindsN p) e, d)) (ca depth e1) pes
+              | EWrite e1 => ca depth e1
+              | EClosure (_, es) => foldl (fn (e, d) => Int.min (ca depth e, d)) maxInt es
+              | ELet (_, _, e1, e2) => Int.min (ca depth e1, ca (depth + 1) e2)
+              | EServerCall (_, es, _, _) => foldl (fn (e, d) => Int.min (ca depth e, d)) maxInt es
+
+        fun enterAbs depth e =
+            case #1 e of
+                EAbs (_, _, _, e1) => enterAbs (depth + 1) e1
+              | _ => ca depth e
+    in
+        enterAbs 0 e
+    end
+
+
+fun optionExists p opt =
+    case opt of
+	NONE => false
+      | SOME v => p v
+
+fun specialize' (funcs, specialized) file =
+    let
+	val known = foldl (fn (d, known) =>
+			      case #1 d of
+				  DCon (_, n, _, c) =>
+				  if functionInside known c then
+				      IS.add (known, n)
+				  else
+				      known
+				| DDatatype dts =>
+				  if List.exists (List.exists (optionExists (functionInside known) o #3) o #4) dts then
+				      foldl (fn (dt, known) => IS.add (known, #2 dt)) known dts
+				  else
+				      known
+				| _ => known)
+		    IS.empty file
+
+        fun bind (env, b) =
+            case b of
+                U.Decl.RelE xt => xt :: env
+              | _ => env
+
+        fun exp (env, e as (_, loc), st : state) =
+            let
+                (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty
+                                                                     (e, ErrorMsg.dummySpan))]*)
+
+                fun default () =
+                    case #1 e of
+                        EPrim _ => (e, st)
+                      | ERel _ => (e, st)
+                      | ENamed _ => (e, st)
+                      | ECon (_, _, _, NONE) => (e, st)
+                      | ECon (dk, pc, cs, SOME e) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((ECon (dk, pc, cs, SOME e), loc), st)
+                        end
+                      | EFfi _ => (e, st)
+                      | EFfiApp (m, x, es) =>
+                        let
+                            val (es, st) = ListUtil.foldlMap (fn ((e, t), st) =>
+                                                                 let
+                                                                     val (e, st) = exp (env, e, st)
+                                                                 in
+                                                                     ((e, t), st)
+                                                                 end) st es
+                        in
+                            ((EFfiApp (m, x, es), loc), st)
+                        end
+                      | EApp (e1, e2) =>
+                        let
+                            val (e1, st) = exp (env, e1, st)
+                            val (e2, st) = exp (env, e2, st)
+                        in
+                            ((EApp (e1, e2), loc), st)
+                        end
+                      | EAbs (x, d, r, e) =>
+                        let
+                            val (e, st) = exp ((x, d) :: env, e, st)
+                        in
+                            ((EAbs (x, d, r, e), loc), st)
+                        end
+                      | ECApp (e, c) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((ECApp (e, c), loc), st)
+                        end
+                      | ECAbs _ => (e, st)
+                      | EKAbs _ => (e, st)
+                      | EKApp (e, k) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((EKApp (e, k), loc), st)
+                        end
+                      | ERecord fs =>
+                        let
+                            val (fs, st) = ListUtil.foldlMap (fn ((c1, e, c2), st) =>
+                                                                 let
+                                                                     val (e, st) = exp (env, e, st)
+                                                                 in
+                                                                     ((c1, e, c2), st)
+                                                                 end) st fs
+                        in
+                            ((ERecord fs, loc), st)
+                        end
+                      | EField (e, c, cs) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((EField (e, c, cs), loc), st)
+                        end
+                      | EConcat (e1, c1, e2, c2) =>
+                        let
+                            val (e1, st) = exp (env, e1, st)
+                            val (e2, st) = exp (env, e2, st)
+                        in
+                            ((EConcat (e1, c1, e2, c2), loc), st)
+                        end
+                      | ECut (e, c, cs) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((ECut (e, c, cs), loc), st)
+                        end
+                      | ECutMulti (e, c, cs) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((ECutMulti (e, c, cs), loc), st)
+                        end
+
+                      | ECase (e, pes, cs) =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                            val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
+                                                                  let
+                                                                      val (e, st) = exp (E.patBindsL p @ env, e, st)
+                                                                  in
+                                                                      ((p, e), st)
+                                                                  end) st pes
+                        in
+                            ((ECase (e, pes, cs), loc), st)
+                        end
+
+                      | EWrite e =>
+                        let
+                            val (e, st) = exp (env, e, st)
+                        in
+                            ((EWrite e, loc), st)
+                        end
+                      | EClosure (n, es) =>
+                        let
+                            val (es, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st es
+                        in
+                            ((EClosure (n, es), loc), st)
+                        end
+                      | ELet (x, t, e1, e2) =>
+                        let
+                            val (e1, st) = exp (env, e1, st)
+                            val (e2, st) = exp ((x, t) :: env, e2, st)
+                        in
+                            ((ELet (x, t, e1, e2), loc), st)
+                        end
+                      | EServerCall (n, es, t, fm) =>
+                        let
+                            val (es, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st es
+                        in
+                            ((EServerCall (n, es, t, fm), loc), st)
+                        end
+            in
+                case getApp e of
+                    NONE => default ()
+                  | SOME (f, xs) =>
+                    case IM.find (#funcs st, f) of
+                        NONE => ((*print ("No find: " ^ Int.toString f ^ "\n");*) default ())
+                      | SOME {name, args, body, typ, tag, constArgs} =>
+                        let
+                            val (xs, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st xs
+
+                            (*val () = Print.prefaces "Consider" [("e", CorePrint.p_exp CoreEnv.empty e)]*)
+
+                            val loc = ErrorMsg.dummySpan
+
+                            val oldXs = xs
+
+                            fun findSplit av (initialPart, constArgs, xs, typ, fxs, fvs) =
+                                let
+                                    fun default () =
+                                        if initialPart then
+                                            ([], oldXs, IS.empty)
+                                        else
+                                            (rev fxs, xs, fvs)
+                                in
+                                    case (#1 typ, xs) of
+                                        (TFun (dom, ran), e :: xs') =>
+                                        if constArgs > 0 then
+                                            let
+                                                val fi = functionInside known dom
+                                            in
+                                                if initialPart orelse fi then
+                                                    findSplit av (not fi andalso initialPart,
+                                                                  constArgs - 1,
+                                                                  xs',
+                                                                  ran,
+                                                                  e :: fxs,
+                                                                  IS.union (fvs, freeVars e))
+                                                else
+                                                    default ()
+                                            end
+                                        else
+                                            default ()
+                                      | _ => default ()
+                                end
+
+                            val (fxs, xs, fvs) = findSplit true (true, constArgs, xs, typ, [], IS.empty)
+
+                            val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs)
+                            val fxs' = map (squish (IS.listItems fvs)) fxs
+
+                            val p_bool = Print.PD.string o Bool.toString
+                        in
+                            (*Print.prefaces "Func" [("name", Print.PD.string name),
+                                                   ("e", CorePrint.p_exp CoreEnv.empty e),
+                                                   ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*)
+                            if List.all (fn (ERel _, _) => true
+                                          | _ => false) fxs' then
+                                default ()
+                            else
+                                case KM.find (args, (vts, fxs')) of
+                                    SOME f' =>
+                                    let
+                                        val e = (ENamed f', loc)
+                                        val e = IS.foldr (fn (arg, e) => (EApp (e, (ERel arg, loc)), loc))
+                                                         e fvs
+                                        val e = foldl (fn (arg, e) => (EApp (e, arg), loc))
+                                                      e xs
+                                    in
+                                        (*Print.prefaces "Brand new (reuse)"
+                                                       [("e'", CorePrint.p_exp CoreEnv.empty e)];*)
+                                        (e, st)
+                                    end
+                                  | NONE =>
+                                    let
+                                        (*val () = Print.prefaces "New one"
+                                                 [("name", Print.PD.string name),
+                                                  ("f", Print.PD.string (Int.toString f)),
+                                                  ("|fvs|", Print.PD.string (Int.toString (IS.numItems fvs))),
+                                                  ("|fxs|", Print.PD.string (Int.toString (length fxs))),
+                                                  ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'),
+                                                  ("spec", Print.PD.string (Bool.toString (IS.member (#specialized st, f))))]*)
+
+                                        (*val () = Print.prefaces ("Yes(" ^ name ^ ")")
+                                                                [("fxs'",
+                                                                  Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')]*)
+
+                                        (*val () = Print.prefaces name
+                                                                [("Available", Print.PD.string (Int.toString constArgs)),
+                                                                 ("Used", Print.PD.string (Int.toString (length fxs'))),
+                                                                 ("fxs'",
+                                                                  Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')]*)
+
+                                        fun subBody (body, typ, fxs') =
+                                            case (#1 body, #1 typ, fxs') of
+                                                (_, _, []) => SOME (body, typ)
+                                              | (EAbs (_, _, _, body'), TFun (_, typ'), x :: fxs'') =>
+                                                let
+                                                    val body'' = E.subExpInExp (0, x) body'
+                                                in
+                                                    subBody (body'',
+                                                             typ',
+                                                             fxs'')
+                                                end
+                                              | _ => NONE
+                                    in
+                                        case subBody (body, typ, fxs') of
+                                            NONE => default ()
+                                          | SOME (body', typ') =>
+                                            let
+                                                val f' = #maxName st
+                                                val args = KM.insert (args, (vts, fxs'), f')
+                                                val funcs = IM.insert (#funcs st, f, {name = name,
+                                                                                      args = args,
+                                                                                      body = body,
+                                                                                      typ = typ,
+                                                                                      tag = tag,
+                                                                                      constArgs = calcConstArgs (IS.singleton f) body})
+
+                                                val st = {
+                                                    maxName = f' + 1,
+                                                    funcs = funcs,
+                                                    decls = #decls st,
+                                                    specialized = IS.add (#specialized st, f')
+                                                }
+
+                                                (*val () = Print.prefaces "specExp"
+                                                                        [("f", CorePrint.p_exp env (ENamed f, loc)),
+                                                                         ("f'", CorePrint.p_exp env (ENamed f', loc)),
+                                                                         ("xs", Print.p_list (CorePrint.p_exp env) xs),
+                                                                         ("fxs'", Print.p_list
+                                                                                      (CorePrint.p_exp E.empty) fxs'),
+                                                                         ("e", CorePrint.p_exp env (e, loc))]*)
+                                                val (body', typ') = IS.foldl (fn (n, (body', typ')) =>
+                                                                                 let
+                                                                                     val (x, xt) = List.nth (env, n)
+                                                                                 in
+                                                                                     ((EAbs (x, xt, typ', body'),
+                                                                                       loc),
+                                                                                      (TFun (xt, typ'), loc))
+                                                                                 end)
+                                                                             (body', typ') fvs
+                                                (*val () = print ("NEW: " ^ name ^ "__" ^ Int.toString f' ^ "\n")*)
+                                                val body' = ReduceLocal.reduceExp body'
+                                                (*val () = Print.preface ("PRE", CorePrint.p_exp CoreEnv.empty body')*)
+                                                val (body', st) = exp (env, body', st)
+
+                                                val e' = (ENamed f', loc)
+                                                val e' = IS.foldr (fn (arg, e) => (EApp (e, (ERel arg, loc)), loc))
+                                                                  e' fvs
+                                                val e' = foldl (fn (arg, e) => (EApp (e, arg), loc))
+                                                               e' xs
+
+                                                (*val () = Print.prefaces "Brand new"
+                                                                        [("e'", CorePrint.p_exp CoreEnv.empty e'),
+                                                                         ("e", CorePrint.p_exp CoreEnv.empty e),
+                                                                         ("body'", CorePrint.p_exp CoreEnv.empty body')]*)
+                                            in
+                                                (e',
+                                                 {maxName = #maxName st,
+                                                  funcs = #funcs st,
+                                                  decls = (name, f', typ', body', tag) :: #decls st,
+                                                  specialized = #specialized st})
+                                            end
+                                    end
+                        end
+            end
+
+        fun doDecl (d, (st : state, changed)) =
+            let
+                (*val befor = Time.now ()*)
+
+                val funcs = #funcs st
+                val funcs = 
+                    case #1 d of
+                        DValRec vis =>
+                        let
+                            val fs = foldl (fn ((_, n, _, _, _), fs) => IS.add (fs, n)) IS.empty vis
+                            val constArgs = foldl (fn ((_, _, _, e, _), constArgs) =>
+                                                      Int.min (constArgs, calcConstArgs fs e))
+                                                  maxInt vis
+                        in
+                            (*Print.prefaces "ConstArgs" [("d", CorePrint.p_decl CoreEnv.empty d),
+                                                        ("ca", Print.PD.string (Int.toString constArgs))];*)
+                            foldl (fn ((x, n, c, e, tag), funcs) =>
+                                      IM.insert (funcs, n, {name = x,
+                                                            args = KM.empty,
+                                                            body = e,
+                                                            typ = c,
+                                                            tag = tag,
+                                                            constArgs = constArgs}))
+                                  funcs vis
+                        end
+                      | _ => funcs
+
+                val st = {maxName = #maxName st,
+                          funcs = funcs,
+                          decls = [],
+                          specialized = #specialized st}
+
+                (*val () = Print.prefaces "decl" [("d", CorePrint.p_decl CoreEnv.empty d)]*)
+
+                val (d', st) =
+                    if isPoly d then
+                        (d, st)
+                    else
+                        case #1 d of
+                            DVal (x, n, t, e, s) =>
+                            let
+                                (*val () = Print.preface ("Visiting", Print.box [Print.PD.string (x ^ "__" ^ Int.toString n),
+                                                                                                Print.space,
+                                                                                                Print.PD.string ":",
+                                                                                                Print.space,
+                                                                                                CorePrint.p_con CoreEnv.empty t])*)
+
+                                val (e, st) = exp ([], e, st)
+                            in
+                                ((DVal (x, n, t, e, s), #2 d), st)
+                            end
+                          | DValRec vis =>
+                            let
+                                (*val () = Print.preface ("Visiting", Print.p_list (fn vi =>
+                                                                                     Print.box [Print.PD.string (#1 vi ^ "__"
+                                                                                                                 ^ Int.toString
+                                                                                                                       (#2 vi)),
+                                                                                                Print.space,
+                                                                                                Print.PD.string ":",
+                                                                                                Print.space,
+                                                                                                CorePrint.p_con CoreEnv.empty (#3 vi)])
+                                                                                 vis)*)
+
+                                val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>
+                                                                      let
+                                                                          val (e, st) = exp ([], e, st)
+                                                                      in
+                                                                          ((x, n, t, e, s), st)
+                                                                      end) st vis
+                            in
+                                ((DValRec vis, #2 d), st)
+                            end
+                          | DTable (s, n, t, s1, e1, t1, e2, t2) =>
+                            let
+                                val (e1, st) = exp ([], e1, st)
+                                val (e2, st) = exp ([], e2, st)
+                            in
+                                ((DTable (s, n, t, s1, e1, t2, e2, t2), #2 d), st)
+                            end
+                          | DView (x, n, s, e, t) =>
+                            let
+                                val (e, st) = exp ([], e, st)
+                            in
+                                ((DView (x, n, s, e, t), #2 d), st)
+                            end
+                          | DTask (e1, e2) =>
+                            let
+                                val (e1, st) = exp ([], e1, st)
+                                val (e2, st) = exp ([], e2, st)
+                            in
+                                ((DTask (e1, e2), #2 d), st)
+                            end
+                          | _ => (d, st)
+
+                (*val () = print "/decl\n"*)
+
+                val funcs = #funcs st
+                val funcs =
+                    case #1 d of
+                        DVal (x, n, c, e as (EAbs _, _), tag) =>
+                        ((*Print.prefaces "ConstArgs[2]" [("d", CorePrint.p_decl CoreEnv.empty d),
+                                                     ("ca", Print.PD.string (Int.toString (calcConstArgs (IS.singleton n) e)))];*)
+                        IM.insert (funcs, n, {name = x,
+                                              args = KM.empty,
+                                              body = e,
+                                              typ = c,
+                                              tag = tag,
+                                              constArgs = calcConstArgs (IS.singleton n) e}))
+                      | DVal (_, n, _, (ENamed n', _), _) =>
+                        (case IM.find (funcs, n') of
+                             NONE => funcs
+                           | SOME v => IM.insert (funcs, n, v))
+                      | _ => funcs
+
+                val (changed, ds) =
+                    case #decls st of
+                        [] => (changed, [d'])
+                      | vis =>
+                        (true, case d' of
+                                   (DValRec vis', _) => [(DValRec (vis @ vis'), ErrorMsg.dummySpan)]
+                                 | _ => [(DValRec vis, ErrorMsg.dummySpan), d'])
+            in
+                (*Print.prefaces "doDecl" [("d", CorePrint.p_decl E.empty d),
+                                         ("d'", CorePrint.p_decl E.empty d')];*)
+                (ds, ({maxName = #maxName st,
+                       funcs = funcs,
+                       decls = [],
+                       specialized = #specialized st}, changed))
+            end
+
+        (*val () = Print.preface ("RESET", CorePrint.p_file CoreEnv.empty file)*)
+        val (ds, (st, changed)) = ListUtil.foldlMapConcat doDecl
+                                                            ({maxName = U.File.maxName file + 1,
+                                                              funcs = funcs,
+                                                              decls = [],
+                                                              specialized = specialized},
+                                                             false)
+                                                            file
+    in
+        (*print ("Changed = " ^ Bool.toString changed ^ "\n");*)
+        (changed, ds, #funcs st, #specialized st)
+    end
+
+fun specializeL (funcs, specialized) file =
+    let
+        val file = ReduceLocal.reduce file
+        (*val file = ReduceLocal.reduce file*)
+        val (changed, file, funcs, specialized) = specialize' (funcs, specialized) file
+        (*val file = ReduceLocal.reduce file
+        val file = CoreUntangle.untangle file
+        val file = Shake.shake file*)
+    in
+        (*print "Round over\n";*)
+        if changed then
+            let
+                (*val file = ReduceLocal.reduce file*)
+                (*val () = Print.prefaces "Pre-untangle" [("file", CorePrint.p_file CoreEnv.empty file)]*)
+                val file = CoreUntangle.untangle file
+                (*val () = Print.prefaces "Post-untangle" [("file", CorePrint.p_file CoreEnv.empty file)]*)
+                val file = Shake.shake file
+            in
+                (*print "Again!\n";*)
+                (*Print.prefaces "Again" [("file", CorePrint.p_file CoreEnv.empty file)];*)
+                specializeL (funcs, specialized) file
+            end
+        else
+            file
+    end
+
+val specialize = specializeL (IM.empty, IS.empty)
+
+end
diff --git a/src/expl.sml b/src/expl.sml
new file mode 100644
index 0000000..994c05c
--- /dev/null
+++ b/src/expl.sml
@@ -0,0 +1,166 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Expl = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype kind' =
+         KType
+       | KArrow of kind * kind
+       | KName
+       | KUnit
+       | KTuple of kind list
+       | KRecord of kind
+
+       | KRel of int
+       | KFun of string * kind
+
+withtype kind = kind' located
+
+datatype con' =
+         TFun of con * con
+       | TCFun of string * kind * con
+       | TRecord of con
+
+       | CRel of int
+       | CNamed of int
+       | CModProj of int * string list * string
+       | CApp of con * con
+       | CAbs of string * kind * con
+
+       | CKAbs of string * con
+       | CKApp of con * kind
+       | TKFun of string * con
+
+       | CName of string
+
+       | CRecord of kind * (con * con) list
+       | CConcat of con * con
+       | CMap of kind * kind
+
+       | CUnit
+
+       | CTuple of con list
+       | CProj of con * int
+
+withtype con = con' located
+
+datatype datatype_kind = datatype DatatypeKind.datatype_kind
+
+datatype patCon =
+         PConVar of int
+       | PConProj of int * string list * string
+
+datatype pat' =
+         PVar of string * con
+       | PPrim of Prim.t
+       | PCon of datatype_kind * patCon * con list * pat option
+       | PRecord of (string * pat * con) list
+
+withtype pat = pat' located
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | EModProj of int * string list * string
+       | EApp of exp * exp
+       | EAbs of string * con * con * exp
+       | ECApp of exp * con
+       | ECAbs of string * kind * exp
+
+       | EKAbs of string * exp
+       | EKApp of exp * kind
+
+       | ERecord of (con * exp * con) list
+       | EField of exp * con * { field : con, rest : con }
+       | EConcat of exp * con * exp * con
+       | ECut of exp * con * { field : con, rest : con }
+       | ECutMulti of exp * con * { rest : con }
+
+       | ECase of exp * (pat * exp) list * { disc : con, result : con }
+
+       | EWrite of exp
+
+       | ELet of string * con * exp * exp
+
+withtype exp = exp' located
+
+datatype sgn_item' =
+         SgiConAbs of string * int * kind
+       | SgiCon of string * int * kind * con
+       | SgiDatatype of (string * int * string list * (string * int * con option) list) list
+       | SgiDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
+       | SgiVal of string * int * con
+       | SgiSgn of string * int * sgn
+       | SgiStr of string * int * sgn
+
+and sgn' =
+    SgnConst of sgn_item list
+  | SgnVar of int
+  | SgnFun of string * int * sgn * sgn
+  | SgnWhere of sgn * string list * string * con
+  | SgnProj of int * string list * string
+
+withtype sgn_item = sgn_item' located
+and sgn = sgn' located
+
+datatype decl' =
+         DCon of string * int * kind * con
+       | DDatatype of (string * int * string list * (string * int * con option) list) list
+       | DDatatypeImp of string * int * int * string list * string * string list * (string * int * con option) list
+       | DVal of string * int * con * exp
+       | DValRec of (string * int * con * exp) list
+       | DSgn of string * int * sgn
+       | DStr of string * int * sgn * str
+       | DFfiStr of string * int * sgn
+       | DExport of int * sgn * str
+       | DTable of int * string * int * con * exp * con * exp * con
+       | DSequence of int * string * int
+       | DView of int * string * int * exp * con
+       | DDatabase of string
+       | DCookie of int * string * int * con
+       | DStyle of int * string * int
+       | DTask of exp * exp
+       | DPolicy of exp
+       | DOnError of int * string list * string
+       | DFfi of string * int * Source.ffi_mode list * con
+
+     and str' =
+         StrConst of decl list
+       | StrVar of int
+       | StrProj of str * string
+       | StrFun of string * int * sgn * sgn * str
+       | StrApp of str * str
+
+withtype decl = decl' located
+     and str = str' located
+
+type file = decl list
+
+end
diff --git a/src/expl_env.sig b/src/expl_env.sig
new file mode 100644
index 0000000..89594d0
--- /dev/null
+++ b/src/expl_env.sig
@@ -0,0 +1,71 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EXPL_ENV = sig
+
+    exception SynUnif
+    val liftConInCon : int -> Expl.con -> Expl.con
+
+    type env
+
+    val empty : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+
+    datatype 'a var =
+             NotBound
+           | Rel of int * 'a
+           | Named of int * 'a
+
+    val pushKRel : env -> string -> env
+    val lookupKRel : env -> int -> string
+
+    val pushCRel : env -> string -> Expl.kind -> env
+    val lookupCRel : env -> int -> string * Expl.kind
+
+    val pushCNamed : env -> string -> int -> Expl.kind -> Expl.con option -> env
+    val lookupCNamed : env -> int -> string * Expl.kind * Expl.con option
+
+    val pushERel : env -> string -> Expl.con -> env
+    val lookupERel : env -> int -> string * Expl.con
+
+    val pushENamed : env -> string -> int -> Expl.con -> env
+    val lookupENamed : env -> int -> string * Expl.con
+
+    val pushSgnNamed : env -> string -> int -> Expl.sgn -> env
+    val lookupSgnNamed : env -> int -> string * Expl.sgn
+
+    val pushStrNamed : env -> string -> int -> Expl.sgn -> env
+    val lookupStrNamed : env -> int -> string * Expl.sgn
+
+    val declBinds : env -> Expl.decl -> env
+    val sgiBinds : env -> Expl.sgn_item -> env
+
+    val patBinds : env -> Expl.pat -> env
+
+end
diff --git a/src/expl_env.sml b/src/expl_env.sml
new file mode 100644
index 0000000..f7f51be
--- /dev/null
+++ b/src/expl_env.sml
@@ -0,0 +1,413 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ExplEnv :> EXPL_ENV = struct
+
+open Expl
+
+structure U = ExplUtil
+
+structure IM = IntBinaryMap
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+exception UnboundRel of int
+exception UnboundNamed of int
+
+
+(* AST utility functions *)
+
+exception SynUnif
+
+val liftKindInKind =
+    U.Kind.mapB {kind = fn bound => fn k =>
+                                       case k of
+                                           KRel xn =>
+                                           if xn < bound then
+                                               k
+                                           else
+                                               KRel (xn + 1)
+                                         | _ => k,
+                 bind = fn (bound, _) => bound + 1}
+
+val liftKindInCon =
+    U.Con.mapB {kind = fn bound => fn k =>
+                                      case k of
+                                          KRel xn =>
+                                          if xn < bound then
+                                              k
+                                          else
+                                              KRel (xn + 1)
+                                        | _ => k,
+                con = fn _ => fn c => c,
+                bind = fn (bound, U.Con.RelK _) => bound + 1
+                        | (bound, _) => bound}
+
+val liftConInCon =
+    U.Con.mapB {kind = fn _ => fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       (*| CUnif _ => raise SynUnif*)
+                                       | _ => c,
+                bind = fn (bound, U.Con.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
+val lift = liftConInCon 0
+
+
+(* Back to environments *)
+
+datatype 'a var' =
+         Rel' of int * 'a
+       | Named' of int * 'a
+
+datatype 'a var =
+         NotBound
+       | Rel of int * 'a
+       | Named of int * 'a
+
+type env = {
+     relK : string list,
+
+     relC : (string * kind) list,
+     namedC : (string * kind * con option) IM.map,
+
+     relE : (string * con) list,
+     namedE : (string * con) IM.map,
+
+     sgn : (string * sgn) IM.map,
+
+     str : (string * sgn) IM.map
+}
+
+val namedCounter = ref 0
+
+val empty = {
+    relK = [],
+
+    relC = [],
+    namedC = IM.empty,
+
+    relE = [],
+    namedE = IM.empty,
+
+    sgn = IM.empty,
+
+    str = IM.empty
+}
+
+fun pushKRel (env : env) x =
+    {relK = x :: #relK env,
+
+     relC = map (fn (x, k) => (x, liftKindInKind 0 k)) (#relC env),
+     namedC = #namedC env,
+
+     relE = map (fn (x, c) => (x, liftKindInCon 0 c)) (#relE env),
+     namedE = #namedE env,
+
+     sgn = #sgn env,
+
+     str = #str env
+    }
+
+fun lookupKRel (env : env) n =
+    (List.nth (#relK env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushCRel (env : env) x k =
+    {relK = #relK env,
+
+     relC = (x, k) :: #relC env,
+     namedC = IM.map (fn (x, k, co) => (x, k, Option.map lift co)) (#namedC env),
+
+     relE = map (fn (x, c) => (x, lift c)) (#relE env),
+     namedE = IM.map (fn (x, c) => (x, lift c)) (#namedE env),
+
+     sgn = #sgn env,
+
+     str = #str env
+    }
+
+fun lookupCRel (env : env) n =
+    (List.nth (#relC env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushCNamed (env : env) x n k co =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = IM.insert (#namedC env, n, (x, k, co)),
+
+     relE = #relE env,
+     namedE = #namedE env,
+
+     sgn = #sgn env,
+     
+     str = #str env}
+
+fun lookupCNamed (env : env) n =
+    case IM.find (#namedC env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushERel (env : env) x t =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     relE = (x, t) :: #relE env,
+     namedE = #namedE env,
+
+     sgn = #sgn env,
+
+     str = #str env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushENamed (env : env) x n t =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t)),
+
+     sgn = #sgn env,
+     
+     str = #str env}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushSgnNamed (env : env) x n sgis =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     relE = #relE env,
+     namedE = #namedE env,
+
+     sgn = IM.insert (#sgn env, n, (x, sgis)),
+     
+     str = #str env}
+
+fun lookupSgnNamed (env : env) n =
+    case IM.find (#sgn env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushStrNamed (env : env) x n sgis =
+    {relK = #relK env,
+
+     relC = #relC env,
+     namedC = #namedC env,
+
+     relE = #relE env,
+     namedE = #namedE env,
+
+     sgn = #sgn env,
+
+     str = IM.insert (#str env, n, (x, sgis))}
+
+fun lookupStrNamed (env : env) n =
+    case IM.find (#str env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun declBinds env (d, loc) =
+    case d of
+        DCon (x, n, k, c) => pushCNamed env x n k (SOME c)
+      | DDatatype dts =>
+        let
+            fun doOne ((x, n, xs, xncs), env) =
+                let
+                    val k = (KType, loc) 
+                    val nxs = length xs
+                    val (tb, kb) = ListUtil.foldli (fn (i, x', (tb, kb)) =>
+                                                       ((CApp (tb, (CRel (nxs - i - 1), loc)), loc),
+                                                        (KArrow (k, kb), loc)))
+                                                   ((CNamed n, loc), k) xs
+                                   
+                    val env = pushCNamed env x n kb NONE
+                in
+                    foldl (fn ((x', n', to), env) =>
+                              let
+                                  val t =
+                                      case to of
+                                          NONE => tb
+                                        | SOME t => (TFun (t, tb), loc)
+                                  val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                              in
+                                  pushENamed env x' n' t
+                              end)
+                          env xncs
+                end
+        in
+            foldl doOne env dts
+        end
+      | DDatatypeImp (x, n, m, ms, x', xs, xncs) =>
+        let
+            val t = (CModProj (m, ms, x'), loc)
+            val env = pushCNamed env x n (KType, loc) (SOME t)
+
+            val t = (CNamed n, loc)
+        in
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
+        end
+      | DVal (x, n, t, _) => pushENamed env x n t
+      | DValRec vis => foldl (fn ((x, n, t, _), env) => pushENamed env x n t) env vis
+      | DSgn (x, n, sgn) => pushSgnNamed env x n sgn
+      | DStr (x, n, sgn, _) => pushStrNamed env x n sgn
+      | DFfiStr (x, n, sgn) => pushStrNamed env x n sgn
+      | DExport _ => env
+      | DTable (tn, x, n, c, _, pc, _, cc) =>
+        let
+            val ct = (CModProj (tn, [], "sql_table"), loc)
+            val ct = (CApp (ct, c), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
+        in
+            pushENamed env x n ct
+        end
+      | DSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
+        in
+            pushENamed env x n t
+        end
+      | DView (tn, x, n, _, c) =>
+        let
+            val ct = (CModProj (tn, [], "sql_view"), loc)
+            val ct = (CApp (ct, c), loc)
+        in
+            pushENamed env x n ct
+        end
+      | DDatabase _ => env
+      | DCookie (tn, x, n, c) =>
+        let
+            val t = (CApp ((CModProj (tn, [], "http_cookie"), loc), c), loc)
+        in
+            pushENamed env x n t
+        end
+      | DStyle (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "css_class"), loc)
+        in
+            pushENamed env x n t
+        end
+      | DTask _ => env
+      | DPolicy _ => env
+      | DOnError _ => env
+      | DFfi (x, n, _, t) => pushENamed env x n t
+
+fun sgiBinds env (sgi, loc) =
+    case sgi of
+        SgiConAbs (x, n, k) => pushCNamed env x n k NONE
+      | SgiCon (x, n, k, c) => pushCNamed env x n k (SOME c)
+      | SgiDatatype dts =>
+        let
+            fun doOne ((x, n, xs, xncs), env) =
+                let
+                    val k = (KType, loc)
+                    val k' = foldr (fn (_, k') => (KArrow (k, k'), loc)) k xs
+
+                    val env = pushCNamed env x n k' NONE
+                in
+                    foldl (fn ((x', n', to), env) =>
+                              let
+                                  val t =
+                                      case to of
+                                          NONE => (CNamed n, loc)
+                                        | SOME t => (TFun (t, (CNamed n, loc)), loc)
+
+                                  val k = (KType, loc)
+                                  val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                              in
+                                  pushENamed env x' n' t
+                              end)
+                          env xncs
+                end
+        in
+            foldl doOne env dts
+        end
+      | SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
+        let
+            val t = (CModProj (m1, ms, x'), loc)
+            val env = pushCNamed env x n (KType, loc) (SOME t)
+
+            val t = (CNamed n, loc)
+        in
+            foldl (fn ((x', n', to), env) =>
+                      let
+                          val t =
+                              case to of
+                                  NONE => (CNamed n, loc)
+                                | SOME t => (TFun (t, (CNamed n, loc)), loc)
+                          val k = (KType, loc)
+                          val t = foldr (fn (x, t) => (TCFun (x, k, t), loc)) t xs
+                      in
+                          pushENamed env x' n' t
+                      end)
+                  env xncs
+        end
+      | SgiVal (x, n, t) => pushENamed env x n t
+      | SgiSgn (x, n, sgn) => pushSgnNamed env x n sgn
+      | SgiStr (x, n, sgn) => pushStrNamed env x n sgn
+
+fun patBinds env (p, loc) =
+    case p of
+        PVar (x, t) => pushERel env x t
+      | PPrim _ => env
+      | PCon (_, _, _, NONE) => env
+      | PCon (_, _, _, SOME p) => patBinds env p
+      | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+
+end
diff --git a/src/expl_print.sig b/src/expl_print.sig
new file mode 100644
index 0000000..3b07401
--- /dev/null
+++ b/src/expl_print.sig
@@ -0,0 +1,39 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EXPL_PRINT = sig
+    val p_kind : ExplEnv.env -> Expl.kind Print.printer
+    val p_con : ExplEnv.env -> Expl.con Print.printer
+    val p_exp : ExplEnv.env -> Expl.exp Print.printer
+    val p_decl : ExplEnv.env -> Expl.decl Print.printer
+    val p_sgn_item : ExplEnv.env -> Expl.sgn_item Print.printer
+    val p_str : ExplEnv.env -> Expl.str Print.printer
+    val p_file : ExplEnv.env -> Expl.file Print.printer
+
+    val debug : bool ref
+end
+
diff --git a/src/expl_print.sml b/src/expl_print.sml
new file mode 100644
index 0000000..10ea605
--- /dev/null
+++ b/src/expl_print.sml
@@ -0,0 +1,794 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing elaborated Ur/Web *)
+
+structure ExplPrint :> EXPL_PRINT = struct
+
+open Print.PD
+open Print
+
+open Expl
+
+structure E = ExplEnv
+
+val debug = ref false
+
+fun p_kind' par env (k, _) =
+    case k of
+        KType => string "Type"
+      | KArrow (k1, k2) => parenIf par (box [p_kind' true env k1,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_kind env k2])
+      | KName => string "Name"
+      | KRecord k => box [string "{", p_kind env k, string "}"]
+      | KUnit => string "Unit"
+      | KTuple ks => box [string "(",
+                          p_list_sep (box [space, string "*", space]) (p_kind env) ks,
+                          string ")"]
+
+      | KRel n => ((if !debug then
+                         string (E.lookupKRel env n ^ "_" ^ Int.toString n)
+                     else
+                         string (E.lookupKRel env n))
+                    handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | KFun (x, k) => box [string x,
+                            space,
+                            string "-->",
+                            space,
+                            p_kind (E.pushKRel env x) k]
+
+and p_kind env = p_kind' false env
+
+fun p_con' par env (c, _) =
+    case c of
+        TFun (t1, t2) => parenIf par (box [p_con' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_con env t2])
+      | TCFun (x, k, c) => parenIf par (box [string x,
+                                             space,
+                                             string "::",
+                                             space,
+                                             p_kind env k,
+                                             space,
+                                             string "->",
+                                             space,
+                                                p_con (E.pushCRel env x k) c])
+      | TRecord (CRecord (_, xcs), _) => box [string "{",
+                                              p_list (fn (x, c) =>
+                                                         box [p_name env x,
+                                                              space,
+                                                              string ":",
+                                                              space,
+                                                              p_con env c]) xcs,
+                                              string "}"]
+      | TRecord c => box [string "$",
+                          p_con' true env c]
+
+      | CRel n =>
+        ((if !debug then
+              string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCRel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | CNamed n =>
+        ((if !debug then
+              string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupCNamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | CModProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                      handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString m1
+
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1s :: ms @ [x])
+        end
+
+      | CApp (c1, c2) => parenIf par (box [p_con env c1,
+                                           space,
+                                           p_con' true env c2])
+      | CAbs (x, k, c) => parenIf par (box [string "fn",
+                                            space,
+                                            string x,
+                                            space,
+                                            string "::",
+                                            space,
+                                            p_kind env k,
+                                            space,
+                                            string "=>",
+                                            space,
+                                            p_con (E.pushCRel env x k) c])
+
+      | CName s => box [string "#", string s]
+
+      | CRecord (k, xcs) =>
+        if !debug then
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_con env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]::",
+                              p_kind env k])
+        else
+            parenIf par (box [string "[",
+                              p_list (fn (x, c) =>
+                                         box [p_con env x,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_con env c]) xcs,
+                              string "]"])
+      | CConcat (c1, c2) => parenIf par (box [p_con' true env c1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_con env c2])
+      | CMap _ => string "map"
+      | CUnit => string "()"
+
+      | CTuple cs => box [string "(",
+                          p_list (p_con env) cs,
+                          string ")"]
+      | CProj (c, n) => box [p_con env c,
+                             string ".",
+                             string (Int.toString n)]
+
+      | CKAbs (x, c) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_con (E.pushKRel env x) c]
+      | CKApp (c, k) => box [p_con env c,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+      | TKFun (x, c) => box [string x,
+                             space,
+                             string "-->",
+                             space,
+                             p_con (E.pushKRel env x) c]
+        
+and p_con env = p_con' false env
+
+and p_name env (all as (c, _)) =
+    case c of
+        CName s => string s
+      | _ => p_con env all
+
+fun p_patCon env pc =
+    case pc of
+        PConVar n =>
+        ((if !debug then
+              string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupENamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | PConProj (m1, ms, x) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+                  
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1x :: ms @ [x])
+        end
+
+fun p_pat' par env (p, _) =
+    case p of
+        PVar (s, _) => string s
+      | PPrim p => Prim.p_t p
+      | PCon (_, pc, _, NONE) => p_patCon env pc
+      | PCon (_, pc, cs, SOME p) =>
+        if !debug then
+            parenIf par (box [p_patCon env pc,
+                              string "[",
+                              p_list (p_con env) cs,
+                              string "]",
+                              space,
+                              p_pat' true env p])
+        else
+            parenIf par (box [p_patCon env pc,
+                              space,
+                              p_pat' true env p])
+
+      | PRecord xps =>
+        box [string "{",
+             p_list_sep (box [string ",", space]) (fn (x, p, t) =>
+                                                      box [string x,
+                                                           space,
+                                                           string "=",
+                                                           space,
+                                                           p_pat env p,
+                                                           if !debug then
+                                                               box [space,
+                                                                    string ":",
+                                                                    space,
+                                                                    p_con env t]
+                                                           else
+                                                               box []]) xps,
+             string "}"]
+
+and p_pat x = p_pat' false x
+
+fun p_exp' par env (e, loc) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n =>
+        ((if !debug then
+              string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupERel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n))
+      | ENamed n =>
+        ((if !debug then
+              string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+          else
+              string (#1 (E.lookupENamed env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+      | EModProj (m1, ms, x) =>
+        let
+            val (m1x, sgn) = E.lookupStrNamed env m1
+                handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
+
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1s :: ms @ [x])
+        end
+                                         
+      | EApp (e1, e2) => parenIf par (box [p_exp env e1,
+                                           space,
+                                           p_exp' true env e2])
+      | EAbs (x, t, _, e) => parenIf par (box [string "fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               string ":",
+                                               space,
+                                               p_con env t,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_exp (E.pushERel env x t) e])
+      | ECApp (e, c) => parenIf par (box [p_exp env e,
+                                          space,
+                                          string "[",
+                                          p_con env c,
+                                          string "]"])
+      | ECAbs (x, k, e) => parenIf par (box [string "fn",
+                                             space,
+                                             string x,
+                                             space,
+                                             string "::",
+                                             space,
+                                             p_kind env k,
+                                             space,
+                                             string "=>",
+                                             space,
+                                             p_exp (E.pushCRel env x k) e])
+
+      | ERecord xes => box [string "{",
+                            p_list (fn (x, e, _) =>
+                                       box [p_name env x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_exp env e]) xes,
+                            string "}"]
+      | EField (e, c, {field, rest}) =>
+        if !debug then
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c,
+                 space,
+                 string "[",
+                 p_con env field,
+                 space,
+                 string " in ",
+                 space,
+                 p_con env rest,
+                 string "]"]
+        else
+            box [p_exp' true env e,
+                 string ".",
+                 p_con' true env c]
+      | EConcat (e1, c1, e2, c2) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e1,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c1,
+                              space,
+                              string "++",
+                              space,
+                              p_exp' true env e2,
+                              space,
+                              string ":",
+                              space,
+                              p_con env c2]
+                     else
+                         box [p_exp' true env e1,
+                              space,
+                              string "with",
+                              space,
+                              p_exp' true env e2])
+      | ECut (e, c, {field, rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env field,
+                              space,
+                              string " in ",
+                              space,
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "--",
+                              space,
+                              p_con' true env c])
+      | ECutMulti (e, c, {rest}) =>
+        parenIf par (if !debug then
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c,
+                              space,
+                              string "[",
+                              p_con env rest,
+                              string "]"]
+                     else
+                         box [p_exp' true env e,
+                              space,
+                              string "---",
+                              space,
+                              p_con' true env c])
+
+      | EWrite e => box [string "write(",
+                         p_exp env e,
+                         string ")"]
+
+      | ECase (e, pes, {disc, result}) =>
+        parenIf par (box [string "case",
+                          space,
+                          p_exp env e,
+                          space,
+                          if !debug then
+                              box [string "in",
+                                   space,
+                                   p_con env disc,
+                                   space,
+                                   string "return",
+                                   space,
+                                   p_con env result,
+                                   space]
+                          else
+                              box [],
+                          string "of",
+                          space,
+                          p_list_sep (box [space, string "|", space])
+                                     (fn (p, e) => box [p_pat env p,
+                                                        space,
+                                                        string "=>",
+                                                        space,
+                                                        p_exp (E.patBinds env p) e]) pes])
+
+      | ELet (x, t, e1, e2) => box [string "let",
+                                    space,
+                                    string x,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_con env t,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp env e1,
+                                    space,
+                                    string "in",
+                                    newline,
+                                    p_exp (E.pushERel env x t) e2]
+
+      | EKAbs (x, e) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_exp (E.pushKRel env x) e]
+      | EKApp (e, k) => box [p_exp env e,
+                             string "[[",
+                             p_kind env k,
+                             string "]]"]
+                                    
+
+and p_exp env = p_exp' false env
+
+fun p_named x n =
+    if !debug then
+        box [string x,
+             string "__",
+             string (Int.toString n)]
+    else
+        string x
+
+fun p_datatype env (x, n, xs, cons) =
+    let
+        val k = (KType, ErrorMsg.dummySpan)
+        val env = E.pushCNamed env x n k NONE
+        val env = foldl (fn (x, env) => E.pushCRel env x k) env xs
+    in
+        box [string x,
+             p_list_sep (box []) (fn x => box [space, string x]) xs,
+             space,
+             string "=",
+             space,
+             p_list_sep (box [space, string "|", space])
+                        (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
+                                            else string x
+                          | (x, n, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
+                                                   else string x, space, string "of", space, p_con env t])
+                        cons]
+    end
+
+fun p_sgn_item env (sgiAll as (sgi, _)) =
+    case sgi of
+        SgiConAbs (x, n, k) => box [string "con",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind env k]
+      | SgiCon (x, n, k, c) => box [string "con",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind env k,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_con env c]
+      | SgiDatatype x => box [string "datatype",
+                              space,
+                              p_list_sep (box [space, string "and", space]) (p_datatype (E.sgiBinds env sgiAll)) x]
+      | SgiDatatypeImp (x, _, m1, ms, x', _, _) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+        in
+            box [string "datatype",
+                 space,
+                 string x,
+                 space,
+                 string "=",
+                 space,
+                 string "datatype",
+                 space,
+                 p_list_sep (string ".") string (m1x :: ms @ [x'])]
+        end
+      | SgiVal (x, n, c) => box [string "val",
+                                 space,
+                                 p_named x n,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_con env c]
+      | SgiStr (x, n, sgn) => box [string "structure",
+                                   space,
+                                   p_named x n,
+                                   space,
+                                   string ":",
+                                   space,
+                                   p_sgn env sgn]
+      | SgiSgn (x, n, sgn) => box [string "signature",
+                                   space,
+                                   p_named x n,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_sgn env sgn]
+
+and p_sgn env (sgn, loc) =
+    case sgn of
+        SgnConst sgis => box [string "sig",
+                              newline,
+                              let
+                                  val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) =>
+                                                                         (p_sgn_item env sgi,
+                                                                          E.sgiBinds env sgi))
+                                                                     env sgis
+                              in
+                                  p_list_sep newline (fn x => x) psgis
+                              end,
+                              newline,
+                              string "end"]
+      | SgnVar n => string ((#1 (E.lookupSgnNamed env n))
+                            handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n)
+      | SgnFun (x, n, sgn, sgn') => box [string "functor",
+                                         space,
+                                         string "(",
+                                         p_named x n,
+                                         space,
+                                         string ":",
+                                         space,
+                                         p_sgn env sgn,
+                                         string ")",
+                                         space,
+                                         string ":",
+                                         space,
+                                         p_sgn (E.pushStrNamed env x n sgn) sgn']
+      | SgnWhere (sgn, ms, x, c) => box [p_sgn env sgn,
+                                     space,
+                                     string "where",
+                                     space,
+                                     string "con",
+                                     space,
+                                     p_list_sep (string ".") string (ms @ [x]),
+                                     space,
+                                     string "=",
+                                     space,
+                                     p_con env c]
+      | SgnProj (m1, ms, x) =>
+        let
+            val (m1x, sgn) = E.lookupStrNamed env m1
+                handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
+                             
+            val m1s = if !debug then
+                          m1x ^ "__" ^ Int.toString m1
+                      else
+                          m1x
+        in
+            p_list_sep (string ".") string (m1x :: ms @ [x])
+        end
+
+fun p_vali env (x, n, t, e) = box [p_named x n,
+                                   space,
+                                   string ":",
+                                   space,
+                                   p_con env t,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_exp env e]
+
+fun p_decl env (dAll as (d, _) : decl) =
+    case d of
+        DCon (x, n, k, c) => box [string "con",
+                                  space,
+                                  p_named x n,
+                                  space,
+                                  string "::",
+                                  space,
+                                  p_kind env k,
+                                  space,
+                                  string "=",
+                                  space,
+                                  p_con env c]
+      | DDatatype x => box [string "datatype",
+                            space,
+                            p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
+      | DDatatypeImp (x, _, m1, ms, x', _, _) =>
+        let
+            val m1x = #1 (E.lookupStrNamed env m1)
+                handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
+        in
+            box [string "datatype",
+                 space,
+                 string x,
+                 space,
+                 string "=",
+                 space,
+                 string "datatype",
+                 space,
+                 p_list_sep (string ".") string (m1x :: ms @ [x'])]
+        end
+      | DVal vi => box [string "val",
+                        space,
+                        p_vali env vi]
+      | DValRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
+        end
+                             
+      | DSgn (x, n, sgn) => box [string "signature",
+                                 space,
+                                 p_named x n,
+                                 space,
+                                 string "=",
+                                 space,
+                                 p_sgn env sgn]
+      | DStr (x, n, sgn, str) => box [string "structure",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn env sgn,
+                                      space,
+                                      string "=",
+                                      space,
+                                      p_str env str]
+      | DFfiStr (x, n, sgn) => box [string "extern",
+                                    space,
+                                    string "structure",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_sgn env sgn]
+      | DExport (_, sgn, str) => box [string "export",
+                                      space,
+                                      p_str env str,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn env sgn]
+      | DTable (_, x, n, c, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp env ce]
+      | DSequence (_, x, n) => box [string "sequence",
+                                    space,
+                                    p_named x n]
+      | DView (_, x, n, e, _) => box [string "view",
+                                      space,
+                                      p_named x n,
+                                      space,
+                                      string "as",
+                                      space,
+                                      p_exp env e]
+      | DDatabase s => box [string "database",
+                            space,
+                            string s]
+      | DCookie (_, x, n, c) => box [string "cookie",
+                                     space,
+                                     p_named x n,
+                                     space,
+                                     string ":",
+                                     space,
+                                     p_con env c]
+      | DStyle (_, x, n) => box [string "style",
+                                 space,
+                                 p_named x n]
+      | DTask (e1, e2) => box [string "task",
+                               space,
+                               p_exp env e1,
+                               space,
+                               string "=",
+                               space,
+                               p_exp env e2]
+      | DPolicy e1 => box [string "policy",
+                           space,
+                           p_exp env e1]
+      | DOnError _ => string "ONERROR"
+      | DFfi _ => string "FFI"
+
+and p_str env (str, _) =
+    case str of
+        StrConst ds => box [string "struct",
+                            newline,
+                            p_file env ds,
+                            newline,
+                            string "end"]
+      | StrVar n =>
+        let
+            val x = #1 (E.lookupStrNamed env n)
+                    handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n
+
+            val s = if !debug then
+                        x ^ "__" ^ Int.toString n
+                    else
+                        x
+        in
+            string s
+        end
+      | StrProj (str, s) => box [p_str env str,
+                                 string ".",
+                                 string s]
+      | StrFun (x, n, sgn, sgn', str) =>
+        let
+            val env' = E.pushStrNamed env x n sgn
+        in
+            box [string "functor",
+                 space,
+                 string "(",
+                 p_named x n,
+                 space,
+                 string ":",
+                 space,
+                 p_sgn env sgn,
+                 string ")",
+                 space,
+                 string ":",
+                 space,
+                 p_sgn env' sgn',
+                 space,
+                 string "=>",
+                 space,
+                 p_str env' str]
+        end
+      | StrApp (str1, str2) => box [p_str env str1,
+                                    string "(",
+                                    p_str env str2,
+                                    string ")"]
+
+and p_file env file =
+    let
+        val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
+                                             (p_decl env d,
+                                              E.declBinds env d))
+                                         env file
+    in
+        p_list_sep newline (fn x => x) pds
+    end
+
+end
diff --git a/src/expl_rename.sig b/src/expl_rename.sig
new file mode 100644
index 0000000..1aff315
--- /dev/null
+++ b/src/expl_rename.sig
@@ -0,0 +1,41 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* To simplify Corify, it helps to apply a particular kind of renaming to functor
+ * bodies, so that nested functors refer only to fresh names.  The payoff is that
+ * we can then implement applications of those nested functors by evaluating their
+ * bodies in arbitrary later contexts, even where identifiers defined in the
+ * outer functor body may have been shadowed. *)
+
+signature EXPL_RENAME = sig
+
+    val rename : {NextId : int,
+                  FormalName : string,
+                  FormalId : int,
+                  Body : Expl.str} -> int * Expl.str
+
+end
diff --git a/src/expl_rename.sml b/src/expl_rename.sml
new file mode 100644
index 0000000..bdcf1aa
--- /dev/null
+++ b/src/expl_rename.sml
@@ -0,0 +1,454 @@
+(* Copyright (c) 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ExplRename :> EXPL_RENAME = struct
+
+open Expl
+structure E = ExplEnv
+
+structure IM = IntBinaryMap
+
+structure St :> sig
+    type t
+
+    val create : int -> t
+    val next : t -> int
+
+    val bind : t * int -> t * int
+    val lookup: t * int -> int option
+end = struct
+
+type t = {next : int,
+          renaming : int IM.map}
+
+fun create next = {next = next,
+                   renaming = IM.empty}
+
+fun next (t : t) = #next t
+
+fun bind ({next, renaming}, n) =
+    ({next = next + 1,
+      renaming = IM.insert (renaming, n, next)}, next)
+
+fun lookup ({next, renaming}, n) =
+    IM.find (renaming, n)
+
+end
+
+fun renameCon st (all as (c, loc)) =
+    case c of
+        TFun (c1, c2) => (TFun (renameCon st c1, renameCon st c2), loc)
+      | TCFun (x, k, c) => (TCFun (x, k, renameCon st c), loc)
+      | TRecord c => (TRecord (renameCon st c), loc)
+      | CRel _ => all
+      | CNamed n =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (CNamed n', loc))
+      | CModProj (n, ms, x) =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (CModProj (n', ms, x), loc))
+      | CApp (c1, c2) => (CApp (renameCon st c1, renameCon st c2), loc)
+      | CAbs (x, k, c) => (CAbs (x, k, renameCon st c), loc)
+      | CKAbs (x, c) => (CKAbs (x, renameCon st c), loc)
+      | CKApp (c, k) => (CKApp (renameCon st c, k), loc)
+      | TKFun (x, c) => (TKFun (x, renameCon st c), loc)
+      | CName _ => all
+      | CRecord (k, xcs) => (CRecord (k, map (fn (x, c) => (renameCon st x, renameCon st c)) xcs), loc)
+      | CConcat (c1, c2) => (CConcat (renameCon st c1, renameCon st c2), loc)
+      | CMap _ => all
+      | CUnit => all
+      | CTuple cs => (CTuple (map (renameCon st) cs), loc)
+      | CProj (c, n) => (CProj (renameCon st c, n), loc)
+
+fun renamePatCon st pc =
+    case pc of
+        PConVar n =>
+        (case St.lookup (st, n) of
+             NONE => pc
+           | SOME n' => PConVar n')
+      | PConProj (n, ms, x) =>
+        (case St.lookup (st, n) of
+             NONE => pc
+           | SOME n' => PConProj (n', ms, x))
+
+fun renamePat st (all as (p, loc)) =
+    case p of
+        PVar (x, c) => (PVar (x, renameCon st c), loc)
+      | PPrim _ => all
+      | PCon (dk, pc, cs, po) => (PCon (dk, renamePatCon st pc,
+                                        map (renameCon st) cs,
+                                        Option.map (renamePat st) po), loc)
+      | PRecord xpcs => (PRecord (map (fn (x, p, c) =>
+                                          (x, renamePat st p, renameCon st c)) xpcs), loc)
+
+fun renameExp st (all as (e, loc)) =
+    case e of
+        EPrim _ => all
+      | ERel _ => all
+      | ENamed n =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (ENamed n', loc))
+      | EModProj (n, ms, x) =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (EModProj (n', ms, x), loc))
+      | EApp (e1, e2) => (EApp (renameExp st e1, renameExp st e2), loc)
+      | EAbs (x, dom, ran, e) => (EAbs (x, renameCon st dom, renameCon st ran, renameExp st e), loc)
+      | ECApp (e, c) => (ECApp (renameExp st e, renameCon st c), loc)
+      | ECAbs (x, k, e) => (ECAbs (x, k, renameExp st e), loc)
+      | EKAbs (x, e) => (EKAbs (x, renameExp st e), loc)
+      | EKApp (e, k) => (EKApp (renameExp st e, k), loc)
+      | ERecord xecs => (ERecord (map (fn (x, e, c) => (renameCon st x,
+                                                        renameExp st e,
+                                                        renameCon st c)) xecs), loc)
+      | EField (e, c, {field, rest}) => (EField (renameExp st e,
+                                                 renameCon st c,
+                                                 {field = renameCon st field,
+                                                  rest = renameCon st rest}), loc)
+      | EConcat (e1, c1, e2, c2) => (EConcat (renameExp st e1,
+                                              renameCon st c1,
+                                              renameExp st e2,
+                                              renameCon st c2), loc)
+      | ECut (e, c, {field, rest}) => (ECut (renameExp st e,
+                                             renameCon st c,
+                                             {field = renameCon st field,
+                                              rest = renameCon st rest}), loc)
+      | ECutMulti (e, c, {rest}) => (ECutMulti (renameExp st e,
+                                                renameCon st c,
+                                                {rest = renameCon st rest}), loc)
+      | ECase (e, pes, {disc, result}) => (ECase (renameExp st e,
+                                                  map (fn (p, e) => (renamePat st p, renameExp st e)) pes,
+                                                  {disc = renameCon st disc,
+                                                   result = renameCon st result}), loc)
+      | EWrite e => (EWrite (renameExp st e), loc)
+      | ELet (x, c1, e1, e2) => (ELet (x, renameCon st c1,
+                                      renameExp st e1,
+                                      renameExp st e2), loc)
+
+fun renameSitem st (all as (si, loc)) =
+    case si of
+        SgiConAbs _ => all
+      | SgiCon (x, n, k, c) => (SgiCon (x, n, k, renameCon st c), loc)
+      | SgiDatatype dts => (SgiDatatype (map (fn (x, n, xs, cns) =>
+                                                 (x, n, xs,
+                                                  map (fn (x, n, co) =>
+                                                          (x, n, Option.map (renameCon st) co)) cns)) dts),
+                            loc)
+      | SgiDatatypeImp (x, n, n', xs, x', xs', cns) =>
+        (SgiDatatypeImp (x, n, n', xs, x', xs',
+                         map (fn (x, n, co) =>
+                                 (x, n, Option.map (renameCon st) co)) cns), loc)
+      | SgiVal (x, n, c) => (SgiVal (x, n, renameCon st c), loc)
+      | SgiSgn (x, n, sg) => (SgiSgn (x, n, renameSgn st sg), loc)
+      | SgiStr (x, n, sg) => (SgiStr (x, n, renameSgn st sg), loc)
+
+and renameSgn st (all as (sg, loc)) =
+    case sg of
+        SgnConst sis => (SgnConst (map (renameSitem st) sis), loc)
+      | SgnVar n =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (SgnVar n', loc))
+      | SgnFun (x, n, dom, ran) => (SgnFun (x, n, renameSgn st dom, renameSgn st ran), loc)
+      | SgnWhere (sg, xs, s, c) => (SgnWhere (renameSgn st sg, xs, s, renameCon st c), loc)
+      | SgnProj (n, ms, x) =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (SgnProj (n', ms, x), loc))
+
+fun renameDecl st (all as (d, loc)) =
+    case d of
+        DCon (x, n, k, c) => (DCon (x, n, k, renameCon st c), loc)
+      | DDatatype dts => (DDatatype (map (fn (x, n, xs, cns) =>
+                                             (x, n, xs,
+                                              map (fn (x, n, co) =>
+                                                      (x, n, Option.map (renameCon st) co)) cns)) dts),
+                          loc)
+      | DDatatypeImp (x, n, n', xs, x', xs', cns) =>
+        (DDatatypeImp (x, n, n', xs, x', xs',
+                       map (fn (x, n, co) =>
+                               (x, n, Option.map (renameCon st) co)) cns), loc)
+      | DVal (x, n, c, e) => (DVal (x, n, renameCon st c, renameExp st e), loc)
+      | DValRec vis => (DValRec (map (fn (x, n, c, e) => (x, n, renameCon st c, renameExp st e)) vis), loc)
+      | DSgn (x, n, sg) => (DSgn (x, n, renameSgn st sg), loc)
+      | DStr (x, n, sg, str) => (DStr (x, n, renameSgn st sg, renameStr st str), loc)
+      | DFfiStr (x, n, sg) => (DFfiStr (x, n, renameSgn st sg), loc)
+      | DExport (n, sg, str) =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (DExport (n', renameSgn st sg, renameStr st str), loc))
+      | DTable (n, x, m, c1, e1, c2, e2, c3) =>
+        (DTable (n, x, m, renameCon st c1, renameExp st e1, renameCon st c2,
+                 renameExp st e2, renameCon st c3), loc)
+      | DSequence _ => all
+      | DView (n, x, n', e, c) => (DView (n, x, n', renameExp st e, renameCon st c), loc)
+      | DDatabase _ => all
+      | DCookie (n, x, n', c) => (DCookie (n, x, n', renameCon st c), loc)
+      | DStyle _ => all
+      | DTask (e1, e2) => (DTask (renameExp st e1, renameExp st e2), loc)
+      | DPolicy e => (DPolicy (renameExp st e), loc)
+      | DOnError (n, xs, x) =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (DOnError (n', xs, x), loc))
+      | DFfi (x, n, modes, t) => (DFfi (x, n, modes, renameCon st t), loc)
+
+and renameStr st (all as (str, loc)) =
+    case str of
+        StrConst ds => (StrConst (map (renameDecl st) ds), loc)
+      | StrVar n =>
+        (case St.lookup (st, n) of
+             NONE => all
+           | SOME n' => (StrVar n', loc))
+      | StrProj (str, x) => (StrProj (renameStr st str, x), loc)
+      | StrFun (x, n, dom, ran, str) => (StrFun (x, n, renameSgn st dom,
+                                                 renameSgn st ran,
+                                                 renameStr st str), loc)
+      | StrApp (str1, str2) => (StrApp (renameStr st str1, renameStr st str2), loc)
+
+
+
+fun fromArity (n, loc) =
+    case n of
+        0 => (KType, loc)
+      | _ => (KArrow ((KType, loc), fromArity (n - 1, loc)), loc)
+
+fun dupDecl (all as (d, loc), st) =
+    case d of
+        DCon (x, n, k, c) =>
+        let
+            val (st, n') = St.bind (st, n)
+        in
+            ([(DCon (x, n, k, renameCon st c), loc),
+              (DCon (x, n', k, (CNamed n, loc)), loc)],
+             st)
+        end
+      | DDatatype dts =>
+        let
+            val d = (DDatatype (map (fn (x, n, xs, cns) =>
+                                        (x, n, xs,
+                                         map (fn (x, n, co) =>
+                                                 (x, n, Option.map (renameCon st) co)) cns)) dts),
+                     loc)
+
+            val (dts', st) = ListUtil.foldlMap (fn ((x, n, xs, cns), st) =>
+                                                   let
+                                                       val (st, n') = St.bind (st, n)
+
+                                                       val (cns', st) = ListUtil.foldlMap
+                                                                            (fn ((x, n, _), st) =>
+                                                                                let
+                                                                                    val (st, n') =
+                                                                                        St.bind (st, n)
+                                                                                in
+                                                                                    ((x, n, n'), st)
+                                                                                end) st cns
+                                                   in
+                                                       ((x, n, length xs, n', cns'), st)
+                                                   end) st dts
+
+            val env = E.declBinds E.empty d
+        in
+            (d
+             :: map (fn (x, n, arity, n', _) =>
+                        (DCon (x, n', fromArity (arity, loc), (CNamed n, loc)), loc)) dts'
+             @ ListUtil.mapConcat (fn (_, _, _, _, cns') =>
+                                      map (fn (x, n, n') =>
+                                              (DVal (x, n', #2 (E.lookupENamed env n), (ENamed n, loc)),
+                                               loc)) cns') dts',
+             st)
+        end
+      | DDatatypeImp (x, n, n', xs, x', xs', cns) =>
+        let
+            val d = (DDatatypeImp (x, n, n', xs, x', xs',
+                                   map (fn (x, n, co) =>
+                                           (x, n, Option.map (renameCon st) co)) cns), loc)
+
+            val (cns', st) = ListUtil.foldlMap
+                                 (fn ((x, n, _), st) =>
+                                     let
+                                         val (st, n') =
+                                             St.bind (st, n)
+                                     in
+                                         ((x, n, n'), st)
+                                     end) st cns
+
+            val (st, n') = St.bind (st, n)
+
+            val env = E.declBinds E.empty d
+        in
+            (d
+             :: (DCon (x, n', fromArity (length xs, loc), (CNamed n, loc)), loc)
+             :: map (fn (x, n, n') =>
+                        (DVal (x, n', #2 (E.lookupENamed env n), (ENamed n, loc)),
+                         loc)) cns',
+             st)
+        end
+      | DVal (x, n, c, e) =>
+        let
+            val (st, n') = St.bind (st, n)
+            val c' = renameCon st c
+        in
+            ([(DVal (x, n, c', renameExp st e), loc),
+              (DVal (x, n', c', (ENamed n, loc)), loc)],
+             st)
+        end
+      | DValRec vis =>
+        let
+            val d = (DValRec (map (fn (x, n, c, e) => (x, n, renameCon st c, renameExp st e)) vis), loc)
+
+            val (vis', st) = ListUtil.foldlMap (fn ((x, n, _, _), st) =>
+                                                   let
+                                                       val (st, n') = St.bind (st, n)
+                                                   in
+                                                       ((x, n, n'), st)
+                                                   end) st vis
+
+            val env = E.declBinds E.empty d
+        in
+            (d
+             :: map (fn (x, n, n') => (DVal (x, n', #2 (E.lookupENamed env n), (ENamed n, loc)), loc)) vis',
+             st)
+        end
+      | DSgn (x, n, sg) =>
+        let
+            val (st, n') = St.bind (st, n)
+        in
+            ([(DSgn (x, n, renameSgn st sg), loc),
+              (DSgn (x, n', (SgnVar n, loc)), loc)],
+             st)
+        end
+      | DStr (x, n, sg, str) =>
+        let
+            val (st, n') = St.bind (st, n)
+            val sg' = renameSgn st sg
+        in
+            ([(DStr (x, n, sg', renameStr st str), loc),
+              (DStr (x, n', sg', (StrVar n, loc)), loc)],
+             st)
+        end
+      | DFfiStr (x, n, sg) => ([(DFfiStr (x, n, renameSgn st sg), loc)], st)
+      | DExport (n, sg, str) =>
+        (case St.lookup (st, n) of
+             NONE => ([all], st)
+           | SOME n' => ([(DExport (n', renameSgn st sg, renameStr st str), loc)], st))
+      | DTable (n, x, m, c1, e1, c2, e2, c3) =>
+        let
+            val (st, m') = St.bind (st, m)
+
+            val d = (DTable (n, x, m, renameCon st c1, renameExp st e1, renameCon st c2,
+                             renameExp st e2, renameCon st c3), loc)
+
+            val env = E.declBinds E.empty d
+        in
+            ([d, (DVal (x, m', #2 (E.lookupENamed env m), (ENamed m, loc)), loc)], st)
+        end
+      | DSequence (n, x, m) =>
+        let
+            val (st, m') = St.bind (st, m)
+
+            val env = E.declBinds E.empty all
+        in
+            ([all, (DVal (x, m', #2 (E.lookupENamed env m), (ENamed m, loc)), loc)], st)
+        end
+      | DView (n, x, m, e, c) =>
+        let
+            val (st, m') = St.bind (st, m)
+
+            val d = (DView (n, x, m, renameExp st e, renameCon st c), loc)
+
+            val env = E.declBinds E.empty d
+        in
+            ([d, (DVal (x, m', #2 (E.lookupENamed env m), (ENamed m, loc)), loc)], st)
+        end
+      | DDatabase _ => ([all], st)
+      | DCookie (n, x, m, c) =>
+        let
+            val (st, m') = St.bind (st, m)
+
+            val d = (DCookie (n, x, m, renameCon st c), loc)
+
+            val env = E.declBinds E.empty d
+        in
+            ([d, (DVal (x, m', #2 (E.lookupENamed env m), (ENamed m, loc)), loc)], st)
+        end
+      | DStyle (n, x, m) =>
+        let
+            val (st, m') = St.bind (st, m)
+
+            val env = E.declBinds E.empty all
+        in
+            ([all, (DVal (x, m', #2 (E.lookupENamed env m), (ENamed m, loc)), loc)], st)
+        end
+      | DTask (e1, e2) => ([(DTask (renameExp st e1, renameExp st e2), loc)], st)
+      | DPolicy e => ([(DPolicy (renameExp st e), loc)], st)
+      | DOnError (n, xs, x) =>
+        (case St.lookup (st, n) of
+             NONE => ([all], st)
+           | SOME n' => ([(DOnError (n', xs, x), loc)], st))
+      | DFfi (x, n, modes, t) =>
+        let
+            val (st, n') = St.bind (st, n)
+            val t' = renameCon st t
+        in
+            ([(DFfi (x, n, modes, t'), loc),
+              (DVal (x, n', t', (ENamed n, loc)), loc)],
+             st)
+        end
+
+fun rename {NextId, FormalName, FormalId, Body = all as (str, loc)} =
+    case str of
+        StrConst ds =>
+        let
+            val st = St.create NextId
+            val (st, n) = St.bind (st, FormalId)
+                     
+            val (ds, st) = ListUtil.foldlMapConcat dupDecl st ds
+
+            (* Revenge of the functor parameter renamer!
+             * See comment in elaborate.sml for the start of the saga.
+             * We need to alpha-rename the argument to allow sufficient shadowing in the body. *)
+
+            fun mungeName m =
+                if List.exists (fn (DStr (x, _, _, _), _) => x = m
+                                 | _ => false) ds then
+                    mungeName ("?" ^ m)
+                else
+                    m
+
+            val FormalName = mungeName FormalName
+
+            val ds = (DStr (FormalName, n, (SgnConst [], loc), (StrVar FormalId, loc)), loc) :: ds
+        in
+            (St.next st, (StrConst ds, loc))
+        end
+      | _ => (NextId, all)
+
+end
diff --git a/src/expl_util.sig b/src/expl_util.sig
new file mode 100644
index 0000000..3e5c333
--- /dev/null
+++ b/src/expl_util.sig
@@ -0,0 +1,119 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EXPL_UTIL = sig
+
+structure Kind : sig
+    val mapfoldB : {kind : ('context, Expl.kind', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * string -> 'context}
+                   -> ('context, Expl.kind, 'state, 'abort) Search.mapfolderB
+    val mapfold : (Expl.kind', 'state, 'abort) Search.mapfolder
+                  -> (Expl.kind, 'state, 'abort) Search.mapfolder
+    val exists : (Expl.kind' -> bool) -> Expl.kind -> bool
+    val mapB : {kind : 'context -> Expl.kind' -> Expl.kind',
+                bind : 'context * string -> 'context}
+               -> 'context -> (Expl.kind -> Expl.kind)
+end
+
+structure Con : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Expl.kind
+           | NamedC of string * Expl.kind
+
+    val mapfoldB : {kind : ('context, Expl.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Expl.con', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Expl.con, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Expl.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Expl.con', 'state, 'abort) Search.mapfolder}
+                  -> (Expl.con, 'state, 'abort) Search.mapfolder
+
+    val mapB : {kind : 'context -> Expl.kind' -> Expl.kind',
+                con : 'context -> Expl.con' -> Expl.con',
+                bind : 'context * binder -> 'context}
+               -> 'context -> (Expl.con -> Expl.con)
+    val map : {kind : Expl.kind' -> Expl.kind',
+               con : Expl.con' -> Expl.con'}
+              -> Expl.con -> Expl.con
+    val exists : {kind : Expl.kind' -> bool,
+                  con : Expl.con' -> bool} -> Expl.con -> bool
+end
+
+structure Exp : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Expl.kind
+           | NamedC of string * Expl.kind
+           | RelE of string * Expl.con
+           | NamedE of string * Expl.con
+
+    val mapfoldB : {kind : ('context, Expl.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Expl.con', 'state, 'abort) Search.mapfolderB,
+                    exp : ('context, Expl.exp', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Expl.exp, 'state, 'abort) Search.mapfolderB
+    val mapfold : {kind : (Expl.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Expl.con', 'state, 'abort) Search.mapfolder,
+                   exp : (Expl.exp', 'state, 'abort) Search.mapfolder}
+                  -> (Expl.exp, 'state, 'abort) Search.mapfolder
+    val exists : {kind : Expl.kind' -> bool,
+                  con : Expl.con' -> bool,
+                  exp : Expl.exp' -> bool} -> Expl.exp -> bool
+end
+
+structure Sgn : sig
+    datatype binder =
+             RelK of string
+           | RelC of string * Expl.kind
+           | NamedC of string * Expl.kind
+           | Sgn of string * Expl.sgn
+           | Str of string * Expl.sgn
+
+    val mapfoldB : {kind : ('context, Expl.kind', 'state, 'abort) Search.mapfolderB,
+                    con : ('context, Expl.con', 'state, 'abort) Search.mapfolderB,
+                    sgn_item : ('context, Expl.sgn_item', 'state, 'abort) Search.mapfolderB,
+                    sgn : ('context, Expl.sgn', 'state, 'abort) Search.mapfolderB,
+                    bind : 'context * binder -> 'context}
+                   -> ('context, Expl.sgn, 'state, 'abort) Search.mapfolderB
+
+
+    val mapfold : {kind : (Expl.kind', 'state, 'abort) Search.mapfolder,
+                   con : (Expl.con', 'state, 'abort) Search.mapfolder,
+                   sgn_item : (Expl.sgn_item', 'state, 'abort) Search.mapfolder,
+                   sgn : (Expl.sgn', 'state, 'abort) Search.mapfolder}
+                  -> (Expl.sgn, 'state, 'abort) Search.mapfolder
+
+    val map : {kind : Expl.kind' -> Expl.kind',
+               con : Expl.con' -> Expl.con',
+               sgn_item : Expl.sgn_item' -> Expl.sgn_item',
+               sgn : Expl.sgn' -> Expl.sgn'}
+              -> Expl.sgn -> Expl.sgn
+
+end
+
+end
diff --git a/src/expl_util.sml b/src/expl_util.sml
new file mode 100644
index 0000000..ff55823
--- /dev/null
+++ b/src/expl_util.sml
@@ -0,0 +1,557 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ExplUtil :> EXPL_UTIL = struct
+
+open Expl
+
+structure S = Search
+
+structure Kind = struct
+
+fun mapfoldB {kind, bind} =
+    let
+        fun mfk ctx k acc =
+            S.bindP (mfk' ctx k acc, kind ctx)
+
+        and mfk' ctx (kAll as (k, loc)) =
+            case k of
+                KType => S.return2 kAll
+
+              | KArrow (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                      fn k1' =>
+                         S.map2 (mfk ctx k2,
+                              fn k2' =>
+                                 (KArrow (k1', k2'), loc)))
+
+              | KName => S.return2 kAll
+
+              | KRecord k =>
+                S.map2 (mfk ctx k,
+                        fn k' =>
+                           (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
+
+              | KTuple ks =>
+                S.map2 (ListUtil.mapfold (mfk ctx) ks,
+                        fn ks' =>
+                           (KTuple ks', loc))
+
+              | KRel _ => S.return2 kAll
+              | KFun (x, k) =>
+                S.map2 (mfk (bind (ctx, x)) k,
+                        fn k' =>
+                           (KFun (x, k'), loc))
+    in
+        mfk
+    end
+
+fun mapfold fk =
+    mapfoldB {kind = fn () => fk,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, bind} ctx k =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   bind = bind} ctx k () of
+        S.Continue (k, ()) => k
+      | S.Return _ => raise Fail "ExplUtil.Kind.mapB: Impossible"
+
+fun exists f k =
+    case mapfold (fn k => fn () =>
+                             if f k then
+                                 S.Return ()
+                             else
+                                 S.Continue (k, ())) k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure Con = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Expl.kind
+       | NamedC of string * Expl.kind
+
+fun mapfoldB {kind = fk, con = fc, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun mfc ctx c acc =
+            S.bindP (mfc' ctx c acc, fc ctx)
+
+        and mfc' ctx (cAll as (c, loc)) =
+            case c of
+                TFun (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (TFun (c1', c2'), loc)))
+              | TCFun (x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (TCFun (x, k', c'), loc)))
+              | TRecord c =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (TRecord c', loc))
+
+              | CRel _ => S.return2 cAll
+              | CNamed _ => S.return2 cAll
+              | CModProj _ => S.return2 cAll
+              | CApp (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CApp (c1', c2'), loc)))
+              | CAbs (x, k, c) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfc (bind (ctx, RelC (x, k))) c,
+                              fn c' =>
+                                 (CAbs (x, k', c'), loc)))
+
+              | CName _ => S.return2 cAll
+
+              | CRecord (k, xcs) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (ListUtil.mapfold (fn (x, c) =>
+                                                      S.bind2 (mfc ctx x,
+                                                            fn x' =>
+                                                               S.map2 (mfc ctx c,
+                                                                    fn c' =>
+                                                                       (x', c'))))
+                                 xcs,
+                              fn xcs' =>
+                                 (CRecord (k', xcs'), loc)))
+              | CConcat (c1, c2) =>
+                S.bind2 (mfc ctx c1,
+                      fn c1' =>
+                         S.map2 (mfc ctx c2,
+                              fn c2' =>
+                                 (CConcat (c1', c2'), loc)))
+              | CMap (k1, k2) =>
+                S.bind2 (mfk ctx k1,
+                         fn k1' =>
+                            S.map2 (mfk ctx k2,
+                                    fn k2' =>
+                                       (CMap (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
+
+              | CTuple cs =>
+                S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                        fn cs' =>
+                           (CTuple cs', loc))
+
+              | CProj (c, n) =>
+                S.map2 (mfc ctx c,
+                        fn c' =>
+                           (CProj (c', n), loc))
+
+              | CKAbs (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (CKAbs (x, c'), loc))
+              | CKApp (c, k) =>
+                S.bind2 (mfc ctx c,
+                      fn c' =>
+                         S.map2 (mfk ctx k,
+                                 fn k' =>
+                                    (CKApp (c', k'), loc)))
+              | TKFun (x, c) =>
+                S.map2 (mfc (bind (ctx, RelK x)) c,
+                        fn c' =>
+                           (TKFun (x, c'), loc))
+    in
+        mfc
+    end
+
+fun mapfold {kind = fk, con = fc} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {kind, con, bind} ctx c =
+    case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
+                   con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
+                   bind = bind} ctx c () of
+        S.Continue (c, ()) => c
+      | S.Return _ => raise Fail "ExplUtil.Con.mapB: Impossible"
+
+fun map {kind, con} s =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ())} s () of
+        S.Return () => raise Fail "ExplUtil.Con.map: Impossible"
+      | S.Continue (s, ()) => s
+
+fun exists {kind, con} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure Exp = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Expl.kind
+       | NamedC of string * Expl.kind
+       | RelE of string * Expl.con
+       | NamedE of string * Expl.con
+
+fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
+    let
+        val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val mfc = Con.mapfoldB {kind = fk, con = fc, bind = bind'}
+
+        fun mfe ctx e acc =
+            S.bindP (mfe' ctx e acc, fe ctx)
+
+        and mfe' ctx (eAll as (e, loc)) =
+            case e of
+                EPrim _ => S.return2 eAll
+              | ERel _ => S.return2 eAll
+              | ENamed _ => S.return2 eAll
+              | EModProj _ => S.return2 eAll
+              | EApp (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EApp (e1', e2'), loc)))
+              | EAbs (x, dom, ran, e) =>
+                S.bind2 (mfc ctx dom,
+                      fn dom' =>
+                         S.bind2 (mfc ctx ran,
+                                  fn ran' =>
+                                     S.map2 (mfe (bind (ctx, RelE (x, dom'))) e,
+                                          fn e' =>
+                                             (EAbs (x, dom', ran', e'), loc))))
+                         
+              | ECApp (e, c) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.map2 (mfc ctx c,
+                              fn c' =>
+                                 (ECApp (e', c'), loc)))
+              | ECAbs (x, k, e) =>
+                S.bind2 (mfk ctx k,
+                      fn k' =>
+                         S.map2 (mfe (bind (ctx, RelC (x, k))) e,
+                              fn e' =>
+                                 (ECAbs (x, k', e'), loc)))
+
+              | ERecord xes =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfc ctx x,
+                                                   fn x' =>
+                                                      S.bind2 (mfe ctx e,
+                                                           fn e' =>
+                                                              S.map2 (mfc ctx t,
+                                                                   fn t' =>
+                                                                      (x', e', t')))))
+                                         xes,
+                     fn xes' =>
+                        (ERecord xes', loc))
+              | EField (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (EField (e', c', {field = field', rest = rest'}), loc)))))
+              | EConcat (e1, c1, e2, c2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.bind2 (mfc ctx c1,
+                              fn c1' =>
+                                 S.bind2 (mfe ctx e2,
+                                       fn e2' =>
+                                          S.map2 (mfc ctx c2,
+                                               fn c2' =>
+                                                  (EConcat (e1', c1', e2', c2'),
+                                                   loc)))))
+              | ECut (e, c, {field, rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.bind2 (mfc ctx field,
+                                          fn field' =>
+                                             S.map2 (mfc ctx rest,
+                                                  fn rest' =>
+                                                     (ECut (e', c', {field = field', rest = rest'}), loc)))))
+              | ECutMulti (e, c, {rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.map2 (mfc ctx rest,
+                                      fn rest' =>
+                                         (ECutMulti (e', c', {rest = rest'}), loc))))
+
+              | EWrite e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (EWrite e', loc))
+
+              | ECase (e, pes, {disc, result}) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.bind2 (ListUtil.mapfold (fn (p, e) =>
+                                                         S.map2 (mfe ctx e,
+                                                              fn e' => (p, e'))) pes,
+                                    fn pes' =>
+                                       S.bind2 (mfc ctx disc,
+                                                fn disc' =>
+                                                   S.map2 (mfc ctx result,
+                                                        fn result' =>
+                                                           (ECase (e', pes', {disc = disc', result = result'}), loc)))))
+
+              | ELet (x, t, e1, e2) =>
+                S.bind2 (mfc ctx t,
+                         fn t' =>
+                            S.bind2 (mfe ctx e1,
+                                  fn e1' =>
+                                     S.map2 (mfe (bind (ctx, RelE (x, t))) e2,
+                                          fn e2' =>
+                                             (ELet (x, t', e1', e2'), loc))))
+
+              | EKAbs (x, e) =>
+                S.map2 (mfe (bind (ctx, RelK x)) e,
+                        fn e' =>
+                           (EKAbs (x, e'), loc))
+              | EKApp (e, k) =>
+                S.bind2 (mfe ctx e,
+                        fn e' =>
+                           S.map2 (mfk ctx k,
+                                   fn k' =>
+                                      (EKApp (e', k'), loc)))
+    in
+        mfe
+    end
+
+fun mapfold {kind = fk, con = fc, exp = fe} =
+    mapfoldB {kind = fn () => fk,
+              con = fn () => fc,
+              exp = fn () => fe,
+              bind = fn ((), _) => ()} ()
+
+fun exists {kind, con, exp} k =
+    case mapfold {kind = fn k => fn () =>
+                                    if kind k then
+                                        S.Return ()
+                                    else
+                                        S.Continue (k, ()),
+                  con = fn c => fn () =>
+                                    if con c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure Sgn = struct
+
+datatype binder =
+         RelK of string
+       | RelC of string * Expl.kind
+       | NamedC of string * Expl.kind
+       | Str of string * Expl.sgn
+       | Sgn of string * Expl.sgn
+
+fun mapfoldB {kind, con, sgn_item, sgn, bind} =
+    let
+        fun bind' (ctx, b) =
+            let
+                val b' = case b of
+                             Con.RelK x => RelK x
+                           | Con.RelC x => RelC x
+                           | Con.NamedC x => NamedC x
+            in
+                bind (ctx, b')
+            end
+        val con = Con.mapfoldB {kind = kind, con = con, bind = bind'}
+
+        val kind = Kind.mapfoldB {kind = kind, bind = fn (ctx, x) => bind (ctx, RelK x)}
+
+        fun sgi ctx si acc =
+            S.bindP (sgi' ctx si acc, sgn_item ctx)
+
+        and sgi' ctx (siAll as (si, loc)) =
+            case si of
+                SgiConAbs (x, n, k) =>
+                S.map2 (kind ctx k,
+                     fn k' =>
+                        (SgiConAbs (x, n, k'), loc))
+              | SgiCon (x, n, k, c) =>
+                S.bind2 (kind ctx k,
+                     fn k' =>
+                        S.map2 (con ctx c,
+                             fn c' =>
+                                (SgiCon (x, n, k', c'), loc)))
+              | SgiDatatype dts =>
+                S.map2 (ListUtil.mapfold (fn (x, n, xs, xncs) =>
+                                             S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                                          case c of
+                                                                              NONE => S.return2 (x, n, c)
+                                                                            | SOME c =>
+                                                                              S.map2 (con ctx c,
+                                                                                   fn c' => (x, n, SOME c'))) xncs,
+                                                  fn xncs' => (x, n, xs, xncs'))) dts,
+                        fn dts' =>
+                           (SgiDatatype dts', loc))
+              | SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+                S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                             case c of
+                                                 NONE => S.return2 (x, n, c)
+                                               | SOME c =>
+                                                 S.map2 (con ctx c,
+                                                      fn c' => (x, n, SOME c'))) xncs,
+                        fn xncs' =>
+                           (SgiDatatypeImp (x, n, m1, ms, s, xs, xncs'), loc))
+              | SgiVal (x, n, c) =>
+                S.map2 (con ctx c,
+                     fn c' =>
+                        (SgiVal (x, n, c'), loc))
+              | SgiStr (x, n, s) =>
+                S.map2 (sg ctx s,
+                     fn s' =>
+                        (SgiStr (x, n, s'), loc))
+              | SgiSgn (x, n, s) =>
+                S.map2 (sg ctx s,
+                     fn s' =>
+                        (SgiSgn (x, n, s'), loc))
+
+        and sg ctx s acc =
+            S.bindP (sg' ctx s acc, sgn ctx)
+
+        and sg' ctx (sAll as (s, loc)) =
+            case s of
+                SgnConst sgis =>
+                S.map2 (ListUtil.mapfoldB (fn (ctx, si)  =>
+                                              (case #1 si of
+                                                   SgiConAbs (x, _, k) =>
+                                                   bind (ctx, NamedC (x, k))
+                                                 | SgiCon (x, _, k, _) =>
+                                                   bind (ctx, NamedC (x, k))
+                                                 | SgiDatatype dts =>
+                                                   foldl (fn ((x, _, ks, _), ctx) =>
+                                                             let
+                                                                 val k' = (KType, loc)
+                                                                 val k = foldl (fn (_, k) => (KArrow (k', k), loc))
+                                                                               k' ks
+                                                             in
+                                                                 bind (ctx, NamedC (x, k))
+                                                             end) ctx dts
+                                                 | SgiDatatypeImp (x, _, _, _, _, _, _) =>
+                                                   bind (ctx, NamedC (x, (KType, loc)))
+                                                 | SgiVal _ => ctx
+                                                 | SgiStr (x, _, sgn) =>
+                                                   bind (ctx, Str (x, sgn))
+                                                 | SgiSgn (x, _, sgn) =>
+                                                   bind (ctx, Sgn (x, sgn)),
+                                               sgi ctx si)) ctx sgis,
+                     fn sgis' =>
+                        (SgnConst sgis', loc))
+                
+              | SgnVar _ => S.return2 sAll
+
+              | SgnFun (m, n, s1, s2) =>
+                S.bind2 (sg ctx s1,
+                         fn s1' =>
+                            S.map2 (sg (bind (ctx, Str (m, s1'))) s2,
+                                    fn s2' =>
+                                       (SgnFun (m, n, s1', s2'), loc)))
+              | SgnWhere (sgn, ms, x, c) =>
+                S.bind2 (sg ctx sgn,
+                      fn sgn' =>
+                         S.map2 (con ctx c,
+                              fn c' =>
+                                 (SgnWhere (sgn', ms, x, c'), loc)))
+              | SgnProj _ => S.return2 sAll
+    in
+        sg
+    end
+
+fun mapfold {kind, con, sgn_item, sgn} =
+    mapfoldB {kind = fn () => kind,
+              con = fn () => con,
+              sgn_item = fn () => sgn_item,
+              sgn = fn () => sgn,
+              bind = fn ((), _) => ()} ()
+
+fun map {kind, con, sgn_item, sgn} s =
+    case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
+                  con = fn c => fn () => S.Continue (con c, ()),
+                  sgn_item = fn si => fn () => S.Continue (sgn_item si, ()),
+                  sgn = fn s => fn () => S.Continue (sgn s, ())} s () of
+        S.Return () => raise Fail "Expl_util.Sgn.map"
+      | S.Continue (s, ()) => s
+
+end
+
+end
diff --git a/src/explify.sig b/src/explify.sig
new file mode 100644
index 0000000..f839b3e
--- /dev/null
+++ b/src/explify.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EXPLIFY = sig
+
+    val explify : Elab.file -> Expl.file
+
+end
diff --git a/src/explify.sml b/src/explify.sml
new file mode 100644
index 0000000..e2a317a
--- /dev/null
+++ b/src/explify.sml
@@ -0,0 +1,213 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Explify :> EXPLIFY = struct
+
+structure EM = ErrorMsg
+structure L = Elab
+structure L' = Expl
+
+fun explifyKind (k, loc) =
+    case k of
+        L.KType => (L'.KType, loc)
+      | L.KArrow (k1, k2) => (L'.KArrow (explifyKind k1, explifyKind k2), loc)
+      | L.KName => (L'.KName, loc)
+      | L.KRecord k => (L'.KRecord (explifyKind k), loc)
+
+      | L.KUnit => (L'.KUnit, loc)
+      | L.KTuple ks => (L'.KTuple (map explifyKind ks), loc)
+
+      | L.KError => raise Fail ("explifyKind: KError at " ^ EM.spanToString loc)
+      | L.KUnif (_, _, ref (L.KKnown k)) => explifyKind k
+      | L.KUnif _ => raise Fail ("explifyKind: KUnif at " ^ EM.spanToString loc)
+      | L.KTupleUnif (loc, _, ref (L.KKnown k)) => explifyKind k
+      | L.KTupleUnif _ => raise Fail ("explifyKind: KTupleUnif at " ^ EM.spanToString loc)
+
+      | L.KRel n => (L'.KRel n, loc)
+      | L.KFun (x, k) => (L'.KFun (x, explifyKind k), loc)
+
+fun explifyCon (c, loc) =
+    case c of
+        L.TFun (t1, t2) => (L'.TFun (explifyCon t1, explifyCon t2), loc)
+      | L.TCFun (_, x, k, t) => (L'.TCFun (x, explifyKind k, explifyCon t), loc)
+      | L.TDisjoint (_, _, t) => explifyCon t
+      | L.TRecord c => (L'.TRecord (explifyCon c), loc)
+
+      | L.CRel n => (L'.CRel n, loc)
+      | L.CNamed n => (L'.CNamed n, loc)
+      | L.CModProj (m, ms, x) => (L'.CModProj (m, ms, x), loc)
+
+      | L.CApp (c1, c2) => (L'.CApp (explifyCon c1, explifyCon c2), loc)
+      | L.CAbs (x, k, c) => (L'.CAbs (x, explifyKind k, explifyCon c), loc)
+
+      | L.CName s => (L'.CName s, loc)
+
+      | L.CRecord (k, xcs) => (L'.CRecord (explifyKind k, map (fn (c1, c2) => (explifyCon c1, explifyCon c2)) xcs), loc)
+      | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc)
+      | L.CMap (dom, ran) => (L'.CMap (explifyKind dom, explifyKind ran), loc)
+
+      | L.CUnit => (L'.CUnit, loc)
+
+      | L.CTuple cs => (L'.CTuple (map explifyCon cs), loc)
+      | L.CProj (c, n) => (L'.CProj (explifyCon c, n), loc)
+
+      | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc)
+      | L.CUnif (nl, _, _, _, ref (L.Known c)) => explifyCon (ElabEnv.mliftConInCon nl c)
+      | L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc)
+
+      | L.CKAbs (x, c) => (L'.CKAbs (x, explifyCon c), loc)
+      | L.CKApp (c, k) => (L'.CKApp (explifyCon c, explifyKind k), loc)
+      | L.TKFun (x, c) => (L'.TKFun (x, explifyCon c), loc)
+
+fun explifyPatCon pc =
+    case pc of
+        L.PConVar n => L'.PConVar n
+      | L.PConProj x => L'.PConProj x
+
+fun explifyPat (p, loc) =
+    case p of
+        L.PVar (x, t) => (L'.PVar (x, explifyCon t), loc)
+      | L.PPrim p => (L'.PPrim p, loc)
+      | L.PCon (dk, pc, cs, po) => (L'.PCon (dk, explifyPatCon pc, map explifyCon cs, Option.map explifyPat po), loc)
+      | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, explifyPat p, explifyCon t)) xps), loc)
+
+fun explifyExp (e, loc) =
+    case e of
+        L.EPrim p => (L'.EPrim p, loc)
+      | L.ERel n => (L'.ERel n, loc)
+      | L.ENamed n => (L'.ENamed n, loc)
+      | L.EModProj (m, ms, x) => (L'.EModProj (m, ms, x), loc)
+      | L.EApp (e1, e2) => (L'.EApp (explifyExp e1, explifyExp e2), loc)
+      | L.EAbs (x, dom, ran, e1) => (L'.EAbs (x, explifyCon dom, explifyCon ran, explifyExp e1), loc)
+      | L.ECApp (e1, c) => (L'.ECApp (explifyExp e1, explifyCon c), loc)
+      | L.ECAbs (_, x, k, e1) => (L'.ECAbs (x, explifyKind k, explifyExp e1), loc)
+
+      | L.ERecord xes => (L'.ERecord (map (fn (c, e, t) => (explifyCon c, explifyExp e, explifyCon t)) xes), loc)
+      | L.EField (e1, c, {field, rest}) => (L'.EField (explifyExp e1, explifyCon c,
+                                                       {field = explifyCon field, rest = explifyCon rest}), loc)
+      | L.EConcat (e1, c1, e2, c2) => (L'.EConcat (explifyExp e1, explifyCon c1, explifyExp e2, explifyCon c2),
+                                       loc)
+      | L.ECut (e1, c, {field, rest}) => (L'.ECut (explifyExp e1, explifyCon c,
+                                                     {field = explifyCon field, rest = explifyCon rest}), loc)
+      | L.ECutMulti (e1, c, {rest}) => (L'.ECutMulti (explifyExp e1, explifyCon c,
+                                                      {rest = explifyCon rest}), loc)
+      | L.ECase (e, pes, {disc, result}) =>
+        (L'.ECase (explifyExp e,
+                   map (fn (p, e) => (explifyPat p, explifyExp e)) pes,
+                   {disc = explifyCon disc, result = explifyCon result}), loc)
+
+      | L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc)
+      | L.EUnif (ref (SOME e)) => explifyExp e
+      | L.EUnif _ => raise Fail ("explifyExp: Undetermined EUnif at " ^ EM.spanToString loc)
+
+      | L.ELet (des, e, t) =>
+        foldr (fn ((de, loc), e) =>
+                  case de of
+                      L.EDValRec _ => raise Fail "explifyExp: Local 'val rec' remains"
+                    | L.EDVal ((L.PVar (x, _), _), t', e') => (L'.ELet (x, explifyCon t', explifyExp e', e), loc)
+                    | L.EDVal (p, t', e') => (L'.ECase (explifyExp e',
+                                                        [(explifyPat p, e)],
+                                                        {disc = explifyCon t', result = explifyCon t}), loc))
+        (explifyExp e) des
+
+      | L.EKAbs (x, e) => (L'.EKAbs (x, explifyExp e), loc)
+      | L.EKApp (e, k) => (L'.EKApp (explifyExp e, explifyKind k), loc)
+
+fun explifySgi (sgi, loc) =
+    case sgi of
+        L.SgiConAbs (x, n, k) => SOME (L'.SgiConAbs (x, n, explifyKind k), loc)
+      | L.SgiCon (x, n, k, c) => SOME (L'.SgiCon (x, n, explifyKind k, explifyCon c), loc)
+      | L.SgiDatatype dts => SOME (L'.SgiDatatype (map (fn (x, n, xs, xncs) =>
+                                                           (x, n, xs,
+                                                            map (fn (x, n, co) =>
+                                                                    (x, n, Option.map explifyCon co)) xncs)) dts), loc)
+      | L.SgiDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+        SOME (L'.SgiDatatypeImp (x, n, m1, ms, s, xs, map (fn (x, n, co) =>
+                                                              (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.SgiVal (x, n, c) => SOME (L'.SgiVal (x, n, explifyCon c), loc)
+      | L.SgiStr (_, x, n, sgn) => SOME (L'.SgiStr (x, n, explifySgn sgn), loc)
+      | L.SgiSgn (x, n, sgn) => SOME (L'.SgiSgn (x, n, explifySgn sgn), loc)
+      | L.SgiConstraint _ => NONE
+      | L.SgiClassAbs (x, n, k) => SOME (L'.SgiConAbs (x, n, (L'.KArrow (explifyKind k, (L'.KType, loc)), loc)), loc)
+      | L.SgiClass (x, n, k, c) => SOME (L'.SgiCon (x, n, (L'.KArrow (explifyKind k, (L'.KType, loc)), loc),
+                                                    explifyCon c), loc)
+
+and explifySgn (sgn, loc) =
+    case sgn of
+        L.SgnConst sgis => (L'.SgnConst (List.mapPartial explifySgi sgis), loc)
+      | L.SgnVar n => (L'.SgnVar n, loc)
+      | L.SgnFun (m, n, dom, ran) => (L'.SgnFun (m, n, explifySgn dom, explifySgn ran), loc)
+      | L.SgnWhere (sgn, ms, x, c) => (L'.SgnWhere (explifySgn sgn, ms, x, explifyCon c), loc)
+      | L.SgnProj x => (L'.SgnProj x, loc)
+      | L.SgnError => raise Fail ("explifySgn: SgnError at " ^ EM.spanToString loc)
+
+fun explifyDecl (d, loc : EM.span) =
+    case d of
+        L.DCon (x, n, k, c) => SOME (L'.DCon (x, n, explifyKind k, explifyCon c), loc)
+      | L.DDatatype dts => SOME (L'.DDatatype (map (fn (x, n, xs, xncs) =>
+                                                       (x, n, xs,
+                                                        map (fn (x, n, co) =>
+                                                                (x, n, Option.map explifyCon co)) xncs)) dts), loc)
+      | L.DDatatypeImp (x, n, m1, ms, s, xs, xncs) =>
+        SOME (L'.DDatatypeImp (x, n, m1, ms, s, xs,
+                               map (fn (x, n, co) =>
+                                       (x, n, Option.map explifyCon co)) xncs), loc)
+      | L.DVal (x, n, t, e) => SOME (L'.DVal (x, n, explifyCon t, explifyExp e), loc)
+      | L.DValRec vis => SOME (L'.DValRec (map (fn (x, n, t, e) => (x, n, explifyCon t, explifyExp e)) vis), loc)
+
+      | L.DSgn (x, n, sgn) => SOME (L'.DSgn (x, n, explifySgn sgn), loc)
+      | L.DStr (x, n, sgn, str) => SOME (L'.DStr (x, n, explifySgn sgn, explifyStr str), loc)
+      | L.DFfiStr (x, n, sgn) => SOME (L'.DFfiStr (x, n, explifySgn sgn), loc)
+      | L.DConstraint (c1, c2) => NONE
+      | L.DExport (en, sgn, str) => SOME (L'.DExport (en, explifySgn sgn, explifyStr str), loc)
+      | L.DTable (nt, x, n, c, pe, pc, ce, cc) =>
+        SOME (L'.DTable (nt, x, n, explifyCon c,
+                         explifyExp pe, explifyCon pc,
+                         explifyExp ce, explifyCon cc), loc)
+      | L.DView (nt, x, n, e, c) =>
+        SOME (L'.DView (nt, x, n, explifyExp e, explifyCon c), loc)
+      | L.DSequence (nt, x, n) => SOME (L'.DSequence (nt, x, n), loc)
+      | 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.DTask (e1, e2) => SOME (L'.DTask (explifyExp e1, explifyExp e2), loc)
+      | L.DPolicy e1 => SOME (L'.DPolicy (explifyExp e1), loc)
+      | L.DOnError v => SOME (L'.DOnError v, loc)
+      | L.DFfi (x, n, modes, t) => SOME (L'.DFfi (x, n, modes, explifyCon t), loc)
+
+and explifyStr (str, loc) =
+    case str of
+        L.StrConst ds => (L'.StrConst (List.mapPartial explifyDecl ds), loc)
+      | L.StrVar n => (L'.StrVar n, loc)
+      | L.StrProj (str, s) => (L'.StrProj (explifyStr str, s), loc)
+      | L.StrFun (m, n, dom, ran, str) => (L'.StrFun (m, n, explifySgn dom, explifySgn ran, explifyStr str), loc)
+      | L.StrApp (str1, str2) => (L'.StrApp (explifyStr str1, explifyStr str2), loc)
+      | L.StrError => raise Fail ("explifyStr: StrError at " ^ EM.spanToString loc)
+
+val explify = List.mapPartial explifyDecl
+
+end
diff --git a/src/export.sig b/src/export.sig
new file mode 100644
index 0000000..881459c
--- /dev/null
+++ b/src/export.sig
@@ -0,0 +1,44 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature EXPORT = sig
+
+datatype effect =
+         ReadOnly
+       | ReadCookieWrite
+       | ReadWrite
+
+datatype export_kind =
+         Link of effect
+       | Action of effect
+       | Rpc of effect
+       | Extern of effect
+
+val p_effect : effect Print.printer
+val p_export_kind : export_kind Print.printer
+
+end
diff --git a/src/export.sml b/src/export.sml
new file mode 100644
index 0000000..a99d0b7
--- /dev/null
+++ b/src/export.sml
@@ -0,0 +1,57 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Export :> EXPORT = struct
+
+open Print.PD
+open Print
+
+datatype effect =
+         ReadOnly
+       | ReadCookieWrite
+       | ReadWrite
+
+datatype export_kind =
+         Link of effect
+       | Action of effect
+       | Rpc of effect
+       | Extern of effect
+
+fun p_effect ef =
+    case ef of
+        ReadOnly => string "r"
+      | ReadCookieWrite => string "rcw"
+      | ReadWrite => string "rw"
+
+fun p_export_kind ck =
+    case ck of
+        Link ef => box [string "link(", p_effect ef, string ")"]
+      | Action ef => box [string "action(", p_effect ef, string ")"]
+      | Rpc ef => box [string "rpc(", p_effect ef, string ")"]
+      | Extern ef => box [string "extern(", p_effect ef, string ")"]
+
+end
diff --git a/src/fastcgi.sig b/src/fastcgi.sig
new file mode 100644
index 0000000..c37fe68
--- /dev/null
+++ b/src/fastcgi.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature FASTCGI = sig
+
+end
diff --git a/src/fastcgi.sml b/src/fastcgi.sml
new file mode 100644
index 0000000..bf2a2a1
--- /dev/null
+++ b/src/fastcgi.sml
@@ -0,0 +1,53 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Fastcgi :> FASTCGI = struct
+
+open Settings
+open Print.PD Print
+
+val () = addProtocol {name = "fastcgi",
+                      compile = "",
+                      linkStatic = "liburweb_fastcgi.a",
+                      linkDynamic = "-lurweb_fastcgi",
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "uw_setup_limits();",
+                                           newline,
+                                           string "}",
+                                           newline]}
+
+end
diff --git a/src/fileio.sig b/src/fileio.sig
new file mode 100644
index 0000000..37b3b52
--- /dev/null
+++ b/src/fileio.sig
@@ -0,0 +1,9 @@
+signature FILE_IO = sig
+
+    (* When was a source file last modified (excluding files produced after [getResetTime])? *)
+    val mostRecentModTime : unit -> Time.time
+
+    val txtOpenIn : string -> TextIO.instream
+    val binOpenIn : string -> BinIO.instream
+
+end
diff --git a/src/fileio.sml b/src/fileio.sml
new file mode 100644
index 0000000..cab9d8a
--- /dev/null
+++ b/src/fileio.sml
@@ -0,0 +1,39 @@
+structure FileIO :> FILE_IO = struct
+
+val mostRecentModTimeRef = ref (Time.zeroTime)
+
+fun checkFileModTime fname =
+  let
+      val mtime = OS.FileSys.modTime fname
+      val mostRecentMod = !mostRecentModTimeRef
+      val resetTime = Globals.getResetTime ()
+      fun lessThan (a, b) = LargeInt.compare (Time.toSeconds a, Time.toSeconds b) = LESS
+      infix lessThan
+  in
+      if mostRecentMod lessThan mtime andalso mtime lessThan resetTime
+      then mostRecentModTimeRef := mtime
+      else ()
+  end
+
+fun mostRecentModTime () =
+  if Time.compare (!mostRecentModTimeRef, Time.zeroTime) = EQUAL
+  then Globals.getResetTime ()
+  else !mostRecentModTimeRef
+
+fun txtOpenIn fname =
+  let
+      val inf = TextIO.openIn fname
+      val () = checkFileModTime fname
+  in
+      inf
+  end
+
+fun binOpenIn fname =
+  let
+      val inf = BinIO.openIn fname
+      val () = checkFileModTime fname
+  in
+      inf
+  end
+
+end
diff --git a/src/fuse.sig b/src/fuse.sig
new file mode 100644
index 0000000..3ad45ac
--- /dev/null
+++ b/src/fuse.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature FUSE = sig
+
+    val fuse : Mono.file -> Mono.file
+
+end
diff --git a/src/fuse.sml b/src/fuse.sml
new file mode 100644
index 0000000..5193e59
--- /dev/null
+++ b/src/fuse.sml
@@ -0,0 +1,152 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Fuse :> FUSE = struct
+
+open Mono
+structure U = MonoUtil
+
+structure IM = IntBinaryMap
+
+fun returnsString (t, loc) =
+    let
+        fun rs (t, loc) =
+            case t of
+                TFfi ("Basis", "string") => SOME ([], (TRecord [], loc))
+              | TFun (dom, ran) =>
+                (case rs ran of
+                     NONE => NONE
+                   | SOME (args, ran') => SOME (dom :: args, (TFun (dom, ran'), loc)))
+              | _ => NONE
+    in
+        case t of
+            TFun (dom, ran) =>
+            (case rs ran of
+                 NONE => NONE
+               | SOME (args, ran') => SOME (dom :: args, (TFun (dom, ran'), loc)))
+          | _ => NONE
+    end
+
+fun fuse file =
+    let
+        fun doDecl (d as (_, loc), (funcs, maxName)) =
+            let
+                exception GetBody
+
+                fun doVi ((x, n, t, e, s), funcs, maxName) =
+                    case returnsString t of
+                        NONE => (NONE, funcs, maxName)
+                      | SOME (args, t') =>
+                        let
+                            fun getBody (e, args) =
+                                case (#1 e, args) of
+                                    (_, []) => (e, [])
+                                  | (EAbs (x, t, _, e), _ :: args) =>
+                                    let
+                                        val (body, args') = getBody (e, args)
+                                    in
+                                        (body, (x, t) :: args')
+                                    end
+                                  | _ => raise GetBody
+
+                            val (body, args) = getBody (e, args)
+                            val body = MonoOpt.optExp (EWrite body, loc)
+                            val (body, _) = foldr (fn ((x, dom), (body, ran)) =>
+                                                      ((EAbs (x, dom, ran, body), loc),
+                                                       (TFun (dom, ran), loc)))
+                                                  (body, (TRecord [], loc)) args
+                        in
+                            (SOME (x, maxName, t', body, s),
+                             IM.insert (funcs, n, maxName),
+                             maxName + 1)
+                        end
+                        handle GetBody => (NONE, funcs, maxName)
+
+                val (d, funcs, maxName) =
+                    case #1 d of
+                        DVal vi =>
+                        let
+                            val (vi', funcs, maxName) = doVi (vi, funcs, maxName)
+                        in
+                            (case vi' of
+                                 NONE => d
+                               | SOME vi' => (DValRec [vi, vi'], loc),
+                             funcs, maxName)
+                        end
+                      | DValRec vis =>
+                        let
+                            val (vis', funcs, maxName) =
+                                foldl (fn (vi, (vis', funcs, maxName)) =>
+                                          let
+                                              val (vi', funcs, maxName) = doVi (vi, funcs, maxName)
+                                          in
+                                              (case vi' of
+                                                   NONE => vis'
+                                                 | SOME vi' => vi' :: vis',
+                                               funcs, maxName)
+                                          end)
+                                ([], funcs, maxName) vis
+                        in
+                            ((DValRec (vis @ vis'), loc), funcs, maxName)
+                        end
+                      | _ => (d, funcs, maxName)
+
+                fun exp e =
+                    case e of
+                        EWrite e' =>
+                        let
+                            fun unravel (e, loc) =
+                                case e of
+                                    ENamed n =>
+                                    (case IM.find (funcs, n) of
+                                         NONE => NONE
+                                       | SOME n' => SOME (ENamed n', loc))
+                                  | EApp (e1, e2) =>
+                                    (case unravel e1 of
+                                         NONE => NONE
+                                       | SOME e1 => SOME (EApp (e1, e2), loc))
+                                  | _ => NONE
+                        in
+                            case unravel e' of
+                                NONE => e
+                              | SOME (e', _) => e'
+                        end
+                      | _ => e
+            in
+                (U.Decl.map {typ = fn x => x,
+                             exp = exp,
+                             decl = fn x => x} 
+                            d,
+                 (funcs, maxName))
+            end
+
+        val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#1 file)
+    in
+        (ds, #2 file)
+    end
+
+end
diff --git a/src/globals.sig b/src/globals.sig
new file mode 100644
index 0000000..0cff65b
--- /dev/null
+++ b/src/globals.sig
@@ -0,0 +1,7 @@
+signature GLOBALS = sig
+
+    (* When was the Ur/Web compiler started or reset? *)
+    val setResetTime : unit -> unit
+    val getResetTime : unit -> Time.time
+
+end
diff --git a/src/globals.sml b/src/globals.sml
new file mode 100644
index 0000000..fafc043
--- /dev/null
+++ b/src/globals.sml
@@ -0,0 +1,7 @@
+structure Globals :> GLOBALS = struct
+
+val resetTime = ref (Time.zeroTime)
+fun setResetTime () = resetTime := Time.now ()
+fun getResetTime () = !resetTime
+
+end
diff --git a/src/http.sig b/src/http.sig
new file mode 100644
index 0000000..a9c13e8
--- /dev/null
+++ b/src/http.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature HTTP = sig
+
+end
diff --git a/src/http.sml b/src/http.sml
new file mode 100644
index 0000000..64dbb06
--- /dev/null
+++ b/src/http.sml
@@ -0,0 +1,55 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Http :> HTTP = struct
+
+open Settings
+open Print.PD Print
+
+val () = addProtocol {name = "http",
+                      compile = "",
+                      linkStatic = "liburweb_http.a",
+                      linkDynamic = "-lurweb_http",
+                      persistent = true,
+                      code = fn () => box [string "void uw_global_custom() {",
+                                           newline,
+                                           case getSigFile () of
+                                               NONE => box []
+                                             | SOME sf => box [string "extern char *uw_sig_file;",
+                                                               newline,
+                                                               string "uw_sig_file = \"",
+                                                               string sf,
+                                                               string "\";",
+                                                               newline],
+                                           string "uw_setup_limits();",
+                                           newline,
+                                           string "}",
+                                           newline]}
+
+val () = setProtocol "http"
+
+end
diff --git a/src/iflow.sig b/src/iflow.sig
new file mode 100644
index 0000000..3e624bb
--- /dev/null
+++ b/src/iflow.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature IFLOW = sig
+
+    val check : Mono.file -> unit
+
+    val debug : bool ref
+
+end
diff --git a/src/iflow.sml b/src/iflow.sml
new file mode 100644
index 0000000..5e8d697
--- /dev/null
+++ b/src/iflow.sml
@@ -0,0 +1,2184 @@
+(* Copyright (c) 2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Iflow :> IFLOW = struct
+
+open Mono
+open Sql
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+
+val writers = ["htmlifyInt_w",
+               "htmlifyFloat_w",
+               "htmlifyString_w",
+               "htmlifyBool_w",
+               "htmlifyTime_w",
+               "attrifyInt_w",
+               "attrifyFloat_w",
+               "attrifyString_w",
+               "attrifyChar_w",
+               "urlifyInt_w",
+               "urlifyFloat_w",
+               "urlifyString_w",
+               "urlifyBool_w",
+               "set_cookie"]
+
+val writers = SS.addList (SS.empty, writers)
+
+local
+    open Print
+    val string = PD.string
+in
+
+fun p_func f =
+    string (case f of
+                DtCon0 s => s
+              | DtCon1 s => s
+              | UnCon s => "un" ^ s
+              | Other s => s)
+
+fun p_exp e =
+    case e of
+        Const p => Prim.p_t p
+      | Var n => string ("x" ^ Int.toString n)
+      | Lvar n => string ("X" ^ Int.toString n)
+      | Func (f, es) => box [p_func f,
+                             string "(",
+                             p_list p_exp es,
+                             string ")"]
+      | Recd xes => box [string "{",
+                         p_list (fn (x, e) => box [string x,
+                                                   space,
+                                                   string "=",
+                                                   space,
+                                                   p_exp e]) xes,
+                         string "}"]
+      | Proj (e, x) => box [p_exp e,
+                            string ("." ^ x)]
+
+fun p_bop s es =
+    case es of
+        [e1, e2] => box [p_exp e1,
+                         space,
+                         string s,
+                         space,
+                         p_exp e2]
+      | _ => raise Fail "Iflow.p_bop"
+
+fun p_reln r es =
+    case r of
+        Known =>
+        (case es of
+             [e] => box [string "known(",
+                         p_exp e,
+                         string ")"]
+           | _ => raise Fail "Iflow.p_reln: Known")
+      | Sql s => box [string (s ^ "("),
+                      p_list p_exp es,
+                      string ")"]
+      | PCon0 s => box [string (s ^ "("),
+                        p_list p_exp es,
+                        string ")"]
+      | PCon1 s => box [string (s ^ "("),
+                        p_list p_exp es,
+                        string ")"]
+      | Cmp Eq => p_bop "=" es
+      | Cmp Ne => p_bop "<>" es
+      | Cmp Lt => p_bop "<" es
+      | Cmp Le => p_bop "<=" es
+      | Cmp Gt => p_bop ">" es
+      | Cmp Ge => p_bop ">=" es
+
+fun p_prop p =
+    case p of
+        True => string "True"
+      | False => string "False"
+      | Unknown => string "??"
+      | Lop (And, p1, p2) => box [string "(",
+                                  p_prop p1,
+                                  string ")",
+                                  space,
+                                  string "&&",
+                                  space,
+                                  string "(",
+                                  p_prop p2,
+                                  string ")"]
+      | Lop (Or, p1, p2) => box [string "(",
+                                 p_prop p1,
+                                 string ")",
+                                 space,
+                                 string "||",
+                                 space,
+                                 string "(",
+                                 p_prop p2,
+                                 string ")"]
+      | Reln (r, es) => p_reln r es
+      | Cond (e, p) => box [string "(",
+                            p_exp e,
+                            space,
+                            string "==",
+                            space,
+                            p_prop p,
+                            string ")"]
+
+end
+
+fun isKnown e =
+    case e of
+        Const _ => true
+      | Func (_, es) => List.all isKnown es
+      | Recd xes => List.all (isKnown o #2) xes
+      | Proj (e, _) => isKnown e
+      | _ => false
+
+fun simplify unif =
+    let
+        fun simplify e =
+            case e of
+                Const _ => e
+              | Var _ => e
+              | Lvar n =>
+                (case IM.find (unif, n) of
+                     NONE => e
+                   | SOME e => simplify e)
+              | Func (f, es) => Func (f, map simplify es)
+              | Recd xes => Recd (map (fn (x, e) => (x, simplify e)) xes)
+              | Proj (e, s) => Proj (simplify e, s)
+    in
+        simplify
+    end
+
+datatype atom =
+         AReln of reln * exp list
+       | ACond of exp * prop
+
+fun p_atom a =
+    p_prop (case a of
+                AReln x => Reln x
+              | ACond x => Cond x)
+
+(* Congruence closure *)
+structure Cc :> sig
+    type database
+
+    exception Contradiction
+
+    val database : unit -> database
+    val clear : database -> unit
+
+    val assert : database * atom -> unit
+    val check : database * atom -> bool
+
+    val p_database : database Print.printer
+
+    val builtFrom : database * {Base : exp list, Derived : exp} -> bool
+
+    val p_repOf : database -> exp Print.printer
+end = struct
+
+local
+    val count = ref 0
+in
+fun nodeId () =
+    let
+        val n = !count
+    in
+        count := n + 1;
+        n
+    end
+end
+
+exception Contradiction
+exception Undetermined
+
+structure CM = BinaryMapFn(struct
+                           type ord_key = Prim.t
+                           val compare = Prim.compare
+                           end)
+
+datatype node = Node of {Id : int,
+                         Rep : node ref option ref,
+                         Cons : node ref SM.map ref,
+                         Variety : variety,
+                         Known : bool ref,
+                         Ge : Int64.int option ref}
+
+     and variety =
+         Dt0 of string
+       | Dt1 of string * node ref
+       | Prim of Prim.t
+       | Recrd of node ref SM.map ref * bool
+       | Nothing
+
+type representative = node ref
+
+type database = {Vars : representative IM.map ref,
+                 Consts : representative CM.map ref,
+                 Con0s : representative SM.map ref,
+                 Records : (representative SM.map * representative) list ref,
+                 Funcs : ((string * representative list) * representative) list ref}
+
+fun database () = {Vars = ref IM.empty,
+                   Consts = ref CM.empty,
+                   Con0s = ref SM.empty,
+                   Records = ref [],
+                   Funcs = ref []}
+
+fun clear (t : database) = (#Vars t := IM.empty;
+                            #Consts t := CM.empty;
+                            #Con0s t := SM.empty;
+                            #Records t := [];
+                            #Funcs t := [])
+
+fun unNode n =
+    case !n of
+        Node r => r
+
+open Print
+val string = PD.string
+val newline = PD.newline
+
+fun p_rep n =
+    case !(#Rep (unNode n)) of
+        SOME n => p_rep n
+      | NONE =>
+        box [string (Int.toString (#Id (unNode n)) ^ ":"),
+             space,
+             case #Variety (unNode n) of
+                 Nothing => string "?"
+               | Dt0 s => string ("Dt0(" ^ s ^ ")")
+               | Dt1 (s, n) => box[string ("Dt1(" ^ s ^ ","),
+                                   space,
+                                   p_rep n,
+                                   string ")"]
+               | Prim p => Prim.p_t p
+               | Recrd (ref m, b) => box [string "{",
+                                          p_list (fn (x, n) => box [string x,
+                                                                    space,
+                                                                    string "=",
+                                                                    space,
+                                                                    p_rep n]) (SM.listItemsi m),
+                                          string "}",
+                                          if b then
+                                              box [space,
+                                                   string "(complete)"]
+                                          else
+                                              box []],
+             if !(#Known (unNode n)) then
+                 string " (known)"
+             else
+                 box [],
+             case !(#Ge (unNode n)) of
+                 NONE => box []
+               | SOME n => string (" (>= " ^ Int64.toString n ^ ")")]
+
+fun p_database (db : database) =
+    box [string "Vars:",
+         newline,
+         p_list_sep newline (fn (i, n) => box [string ("x" ^ Int.toString i),
+                                               space,
+                                               string "=",
+                                               space,
+                                               p_rep n]) (IM.listItemsi (!(#Vars db)))]
+
+fun repOf (n : representative) : representative =
+    case !(#Rep (unNode n)) of
+        NONE => n
+      | SOME r =>
+        let
+            val r = repOf r
+        in
+            #Rep (unNode n) := SOME r;
+            r
+        end
+
+fun markKnown r =
+    let
+        val r = repOf r
+    in
+        (*Print.preface ("markKnown", p_rep r);*)
+        if !(#Known (unNode r)) then
+            ()(*TextIO.print "Already known\n"*)
+        else
+            (#Known (unNode r) := true;
+             SM.app markKnown (!(#Cons (unNode r)));
+             case #Variety (unNode r) of
+                 Dt1 (_, r) => markKnown r
+               | Recrd (xes, _) => SM.app markKnown (!xes)
+               | _ => ())
+    end
+
+fun representative (db : database, e) =
+    let
+        fun rep e =
+            case e of
+                Const p => (case CM.find (!(#Consts db), p) of
+                                SOME r => repOf r
+                              | NONE =>
+                                let
+                                    val r = ref (Node {Id = nodeId (),
+                                                       Rep = ref NONE,
+                                                       Cons = ref SM.empty,
+                                                       Variety = Prim p,
+                                                       Known = ref true,
+                                                       Ge = ref (case p of
+                                                                     Prim.Int n => SOME n
+                                                                   | _ => NONE)})
+                                in
+                                    #Consts db := CM.insert (!(#Consts db), p, r);
+                                    r
+                                end)
+              | Var n => (case IM.find (!(#Vars db), n) of
+                              SOME r => repOf r
+                            | NONE =>
+                              let
+                                  val r = ref (Node {Id = nodeId (),
+                                                     Rep = ref NONE,
+                                                     Cons = ref SM.empty,
+                                                     Variety = Nothing,
+                                                     Known = ref false,
+                                                     Ge = ref NONE})
+                              in
+                                  #Vars db := IM.insert (!(#Vars db), n, r);
+                                  r
+                              end)
+              | Lvar _ => raise Undetermined
+              | Func (DtCon0 f, []) => (case SM.find (!(#Con0s db), f) of
+                                            SOME r => repOf r
+                                          | NONE =>
+                                            let
+                                                val r = ref (Node {Id = nodeId (),
+                                                                   Rep = ref NONE,
+                                                                   Cons = ref SM.empty,
+                                                                   Variety = Dt0 f,
+                                                                   Known = ref true,
+                                                                   Ge = ref NONE})
+                                            in
+                                                #Con0s db := SM.insert (!(#Con0s db), f, r);
+                                                r
+                                            end)
+              | Func (DtCon0 _, _) => raise Fail "Iflow.rep: DtCon0"
+              | Func (DtCon1 f, [e]) =>
+                let
+                    val r = rep e
+                in
+                    case SM.find (!(#Cons (unNode r)), f) of
+                        SOME r => repOf r
+                      | NONE =>
+                        let
+                            val r' = ref (Node {Id = nodeId (),
+                                                Rep = ref NONE,
+                                                Cons = ref SM.empty,
+                                                Variety = Dt1 (f, r),
+                                                Known = ref (!(#Known (unNode r))),
+                                                Ge = ref NONE})
+                        in
+                            #Cons (unNode r) := SM.insert (!(#Cons (unNode r)), f, r');
+                            r'
+                        end
+                end
+              | Func (DtCon1 _, _) => raise Fail "Iflow.rep: DtCon1"
+              | Func (UnCon f, [e]) =>
+                let
+                    val r = rep e
+                in
+                    case #Variety (unNode r) of
+                        Dt1 (f', n) => if f' = f then
+                                           repOf n
+                                       else
+                                           raise Contradiction
+                      | Nothing =>
+                        let
+                            val cons = ref SM.empty
+                            val r' = ref (Node {Id = nodeId (),
+                                                Rep = ref NONE,
+                                                Cons = cons,
+                                                Variety = Nothing,
+                                                Known = ref (!(#Known (unNode r))),
+                                                Ge = ref NONE})
+
+                            val r'' = ref (Node {Id = nodeId (),
+                                                 Rep = ref NONE,
+                                                 Cons = #Cons (unNode r),
+                                                 Variety = Dt1 (f, r'),
+                                                 Known = #Known (unNode r),
+                                                 Ge = ref NONE})
+                        in
+                            cons := SM.insert (!cons, f, r'');
+                            #Rep (unNode r) := SOME r'';
+                            r'
+                        end
+                      | _ => raise Contradiction
+                end
+              | Func (UnCon _, _) => raise Fail "Iflow.rep: UnCon"
+              | Func (Other f, es) =>
+                let
+                    val rs = map rep es
+                in
+                    case List.find (fn (x : string * representative list, _) => x = (f, rs)) (!(#Funcs db)) of
+                        NONE =>
+                        let
+                            val r = ref (Node {Id = nodeId (),
+                                               Rep = ref NONE,
+                                               Cons = ref SM.empty,
+                                               Variety = Nothing,
+                                               Known = ref (f = "allow"),
+                                               Ge = ref NONE})
+                        in
+                            #Funcs db := ((f, rs), r) :: (!(#Funcs db));
+                            r
+                        end
+                      | SOME (_, r) => repOf r
+                end
+              | Recd xes =>
+                let
+                    val xes = map (fn (x, e) => (x, rep e)) xes
+                    val len = length xes
+                in
+                    case List.find (fn (xes', _) =>
+                                       SM.numItems xes' = len
+                                       andalso List.all (fn (x, n) =>
+                                                            case SM.find (xes', x) of
+                                                                NONE => false
+                                                             | SOME n' => n = repOf n') xes)
+                         (!(#Records db)) of
+                        SOME (_, r) => repOf r
+                      | NONE =>
+                        let
+                            val xes = foldl SM.insert' SM.empty xes
+
+                            val r' = ref (Node {Id = nodeId (),
+                                                Rep = ref NONE,
+                                                Cons = ref SM.empty,
+                                                Variety = Recrd (ref xes, true),
+                                                Known = ref false,
+                                                Ge = ref NONE})
+                        in
+                            #Records db := (xes, r') :: (!(#Records db));
+                            r'
+                        end
+                end
+              | Proj (e, f) =>
+                let
+                    val r = rep e
+                in
+                    case #Variety (unNode r) of
+                        Recrd (xes, _) =>
+                        (case SM.find (!xes, f) of
+                             SOME r => repOf r
+                           | NONE => let
+                                  val r = ref (Node {Id = nodeId (),
+                                                     Rep = ref NONE,
+                                                     Cons = ref SM.empty,
+                                                     Variety = Nothing,
+                                                     Known = ref (!(#Known (unNode r))),
+                                                     Ge = ref NONE})
+                              in
+                                 xes := SM.insert (!xes, f, r);
+                                 r
+                              end)
+                      | Nothing =>
+                        let
+                            val r' = ref (Node {Id = nodeId (),
+                                                Rep = ref NONE,
+                                                Cons = ref SM.empty,
+                                                Variety = Nothing,
+                                                Known = ref (!(#Known (unNode r))),
+                                                Ge = ref NONE})
+
+                            val r'' = ref (Node {Id = nodeId (),
+                                                 Rep = ref NONE,
+                                                 Cons = #Cons (unNode r),
+                                                 Variety = Recrd (ref (SM.insert (SM.empty, f, r')), false),
+                                                 Known = #Known (unNode r),
+                                                 Ge = ref NONE})
+                        in
+                            #Rep (unNode r) := SOME r'';
+                            r'
+                        end
+                      | _ => raise Contradiction
+                end
+    in
+        rep e
+    end
+
+fun p_repOf db e = p_rep (representative (db, e))
+
+fun assert (db, a) =
+    let
+        fun markEq (r1, r2) =
+            let
+                val r1 = repOf r1
+                val r2 = repOf r2
+            in
+                if r1 = r2 then
+                    ()
+                else case (#Variety (unNode r1), #Variety (unNode r2)) of
+                         (Prim p1, Prim p2) => if Prim.equal (p1, p2) then
+                                                   ()
+                                               else
+                                                   raise Contradiction
+                       | (Dt0 f1, Dt0 f2) => if f1 = f2 then
+                                                 ()
+                                             else
+                                                 raise Contradiction
+                       | (Dt1 (f1, r1), Dt1 (f2, r2)) => if f1 = f2 then
+                                                             markEq (r1, r2)
+                                                         else
+                                                             raise Contradiction
+                       | (Recrd (xes1, _), Recrd (xes2, _)) =>
+                         let
+                             fun unif (xes1, xes2) =
+                                 SM.appi (fn (x, r1) =>
+                                             case SM.find (!xes2, x) of
+                                                 NONE => xes2 := SM.insert (!xes2, x, r1)
+                                               | SOME r2 => markEq (r1, r2)) (!xes1)
+                         in
+                             unif (xes1, xes2);
+                             unif (xes2, xes1)
+                         end
+                       | (Nothing, _) => mergeNodes (r1, r2)
+                       | (_, Nothing) => mergeNodes (r2, r1)
+                       | _ => raise Contradiction
+            end
+
+        and mergeNodes (r1, r2) =
+            (#Rep (unNode r1) := SOME r2;
+             if !(#Known (unNode r1)) then
+                 markKnown r2
+             else
+                 ();
+             if !(#Known (unNode r2)) then
+                 markKnown r1
+             else
+                 ();
+             #Cons (unNode r2) := SM.unionWith #1 (!(#Cons (unNode r2)), !(#Cons (unNode r1)));
+
+             case !(#Ge (unNode r1)) of
+                 NONE => ()
+               | SOME n1 =>
+                 case !(#Ge (unNode r2)) of
+                     NONE => #Ge (unNode r2) := SOME n1
+                   | SOME n2 => #Ge (unNode r2) := SOME (Int64.max (n1, n2));
+
+             compactFuncs ())
+
+        and compactFuncs () =
+            let
+                fun loop funcs =
+                    case funcs of
+                        [] => []
+                      | (fr as ((f, rs), r)) :: rest =>
+                        let
+                            val rest = List.filter (fn ((f' : string, rs'), r') =>
+                                                       if f' = f
+                                                          andalso ListPair.allEq (fn (r1, r2) =>
+                                                                                     repOf r1 = repOf r2)
+                                                                                 (rs, rs') then
+                                                           (markEq (r, r');
+                                                            false)
+                                                       else
+                                                           true) rest
+                        in
+                            fr :: loop rest
+                        end
+            in
+                #Funcs db := loop (!(#Funcs db))
+            end
+    in
+        case a of
+            ACond _ => ()
+          | AReln x =>
+            case x of
+                (Known, [e]) =>
+                ((*Print.prefaces "Before" [("e", p_exp e),
+                                            ("db", p_database db)];*)
+                 markKnown (representative (db, e))(*;
+                                                        Print.prefaces "After" [("e", p_exp e),
+                                                                                ("db", p_database db)]*))
+              | (PCon0 f, [e]) =>
+                let
+                    val r = representative (db, e)
+                in
+                    case #Variety (unNode r) of
+                        Dt0 f' => if f = f' then
+                                      ()
+                                  else
+                                      raise Contradiction
+                      | Nothing =>
+                        (case SM.find (!(#Con0s db), f) of
+                             SOME r' => markEq (r, r')
+                           | NONE =>
+                             let
+                                 val r' = ref (Node {Id = nodeId (),
+                                                     Rep = ref NONE,
+                                                     Cons = ref SM.empty,
+                                                     Variety = Dt0 f,
+                                                     Known = ref false,
+                                                     Ge = ref NONE})
+                             in
+                                 #Rep (unNode r) := SOME r';
+                                 #Con0s db := SM.insert (!(#Con0s db), f, r')
+                             end)
+                      | _ => raise Contradiction
+                end
+              | (PCon1 f, [e]) =>
+                let
+                    val r = representative (db, e)
+                in
+                    case #Variety (unNode r) of
+                        Dt1 (f', e') => if f = f' then
+                                            ()
+                                        else
+                                            raise Contradiction
+                      | Nothing =>
+                        let
+                            val cons = ref SM.empty
+
+                            val r'' = ref (Node {Id = nodeId (),
+                                                 Rep = ref NONE,
+                                                 Cons = cons,
+                                                 Variety = Nothing,
+                                                 Known = ref (!(#Known (unNode r))),
+                                                 Ge = ref NONE})
+
+                            val r' = ref (Node {Id = nodeId (),
+                                                Rep = ref NONE,
+                                                Cons = ref SM.empty,
+                                                Variety = Dt1 (f, r''),
+                                                Known = #Known (unNode r),
+                                                Ge = ref NONE})
+                        in
+                            cons := SM.insert (!cons, f, r');
+                            #Rep (unNode r) := SOME r'
+                        end
+                      | _ => raise Contradiction
+                end
+              | (Cmp Eq, [e1, e2]) =>
+                markEq (representative (db, e1), representative (db, e2))
+              | (Cmp Ge, [e1, e2]) =>
+                let
+                    val r1 = representative (db, e1)
+                    val r2 = representative (db, e2)
+                in
+                    case !(#Ge (unNode (repOf r2))) of
+                        NONE => ()
+                      | SOME n2 =>
+                        case !(#Ge (unNode (repOf r1))) of
+                            NONE => #Ge (unNode (repOf r1)) := SOME n2
+                          | SOME n1 => #Ge (unNode (repOf r1)) := SOME (Int64.max (n1, n2))
+                end
+              | _ => ()
+    end handle Undetermined => ()
+
+fun check (db, a) =
+    (case a of
+         ACond _ => false
+       | AReln x =>
+         case x of
+             (Known, [e]) =>
+             let
+                 fun isKnown r =
+                     let
+                         val r = repOf r
+                     in
+                         !(#Known (unNode r))
+                         orelse case #Variety (unNode r) of
+                                    Dt1 (_, r) => isKnown r
+                                  | Recrd (xes, true) => List.all isKnown (SM.listItems (!xes))
+                                  | _ => false
+                     end
+
+                 val r = representative (db, e)
+             in
+                 isKnown r
+             end
+           | (PCon0 f, [e]) =>
+             (case #Variety (unNode (representative (db, e))) of
+                  Dt0 f' => f' = f
+                | _ => false)
+           | (PCon1 f, [e]) =>
+             (case #Variety (unNode (representative (db, e))) of
+                  Dt1 (f', _) => f' = f
+                | _ => false)
+           | (Cmp Eq, [e1, e2]) =>
+             let
+                 val r1 = representative (db, e1)
+                 val r2 = representative (db, e2)
+             in
+                 repOf r1 = repOf r2
+             end
+           | (Cmp Ge, [e1, e2]) =>
+             let
+                 val r1 = representative (db, e1)
+                 val r2 = representative (db, e2)
+             in
+                 case (!(#Ge (unNode (repOf r1))), #Variety (unNode (repOf r2))) of
+                     (SOME n1, Prim (Prim.Int n2)) => Int64.>= (n1, n2)
+                   | _ => false
+             end
+           | _ => false)
+    handle Undetermined => false
+
+fun builtFrom (db, {Base = bs, Derived = d}) =
+    let
+        val bs = map (fn b => representative (db, b)) bs
+
+        fun loop d =
+            let
+                val d = repOf d
+            in
+                !(#Known (unNode d))
+                orelse List.exists (fn b => repOf b = d) bs
+                orelse (case #Variety (unNode d) of
+                            Dt0 _ => true
+                          | Dt1 (_, d) => loop d
+                          | Prim _ => true
+                          | Recrd (xes, _) => List.all loop (SM.listItems (!xes))
+                          | Nothing => false)
+                orelse List.exists (fn r => List.exists (fn b => repOf b = repOf r) bs)
+                                   (SM.listItems (!(#Cons (unNode d))))
+            end
+
+        fun decomp e =
+            case e of
+                Func (Other _, es) => List.all decomp es
+              | _ => loop (representative (db, e))
+    in
+        decomp d
+    end handle Undetermined => false
+
+end
+
+val tabs = ref (SM.empty : (string list * string list list) SM.map)
+
+fun patCon pc =
+    case pc of
+        PConVar n => "C" ^ Int.toString n
+      | PConFfi {mod = m, datatyp = d, con = c, ...} => m ^ "." ^ d ^ "." ^ c
+
+type check = exp * ErrorMsg.span
+
+structure St :> sig
+    val reset : unit -> unit
+
+    type stashed
+    val stash : unit -> stashed
+    val reinstate : stashed -> unit
+
+    type stashedPath
+    val stashPath : unit -> stashedPath
+    val reinstatePath : stashedPath -> unit
+
+    val nextVar : unit -> int
+
+    val assert : atom list -> unit
+
+    val addPath : check -> unit
+
+    val allowSend : atom list * exp list -> unit
+    val send : check -> unit
+
+    val allowInsert : atom list -> unit
+    val insert : ErrorMsg.span -> unit
+
+    val allowDelete : atom list -> unit
+    val delete : ErrorMsg.span -> unit
+
+    val allowUpdate : atom list -> unit
+    val update : ErrorMsg.span -> unit
+
+    val havocReln : reln -> unit
+    val havocCookie : string -> unit
+
+    val check : atom -> bool
+
+    val debug : unit -> unit
+end = struct
+
+val hnames = ref 1
+
+type hyps = int * atom list * bool ref
+
+val db = Cc.database ()
+val path = ref ([] : ((int * atom list) * check) option ref list)
+val hyps = ref (0, [] : atom list, ref false)
+val nvar = ref 0
+
+fun setHyps (n', hs) =
+    let
+        val (n, _, _) = !hyps
+    in
+        if n' = n then
+            ()
+        else
+            (hyps := (n', hs, ref false);
+             Cc.clear db;
+             app (fn a => Cc.assert (db, a)) hs)
+    end
+
+fun useKeys () =
+    let
+        val changed = ref false
+
+        fun findKeys (hyps, acc) =
+            case hyps of
+                [] => rev acc
+              | (a as AReln (Sql tab, [r1])) :: hyps =>
+                (case SM.find (!tabs, tab) of
+                     NONE => findKeys (hyps, a :: acc)
+                   | SOME (_, []) => findKeys (hyps, a :: acc)
+                   | SOME (_, ks) =>
+                     let
+                         fun finder (hyps, acc) =
+                             case hyps of
+                                 [] => rev acc
+                               | (a as AReln (Sql tab', [r2])) :: hyps =>
+                                 if tab' = tab andalso
+                                    List.exists (List.all (fn f =>
+                                                              let
+                                                                  val r =
+                                                                      Cc.check (db,
+                                                                                AReln (Cmp Eq, [Proj (r1, f),
+                                                                                            Proj (r2, f)]))
+                                                              in
+                                                                  (*Print.prefaces "Fs"
+                                                                                   [("tab",
+                                                                                     Print.PD.string tab),
+                                                                                    ("r1",
+                                                                                     p_exp (Proj (r1, f))),
+                                                                                    ("r2",
+                                                                                     p_exp (Proj (r2, f))),
+                                                                                    ("r",
+                                                                                     Print.PD.string
+                                                                                         (Bool.toString r))];*)
+                                                                  r
+                                                              end)) ks then
+                                     (changed := true;
+                                      Cc.assert (db, AReln (Cmp Eq, [r1, r2]));
+                                      finder (hyps, acc))
+                                 else
+                                     finder (hyps, a :: acc)
+                               | a :: hyps => finder (hyps, a :: acc)
+
+                         val hyps = finder (hyps, [])
+                     in
+                         findKeys (hyps, a :: acc)
+                     end)
+              | a :: hyps => findKeys (hyps, a :: acc)
+
+        fun loop hs =
+            let
+                val hs = findKeys (hs, [])
+            in
+                if !changed then
+                    (changed := false;
+                     loop hs)
+                else
+                    ()
+            end
+
+        val (_, hs, _) = !hyps
+    in
+        (*print "useKeys\n";*)
+        loop hs
+    end
+
+fun complete () =
+    let
+        val (_, _, bf) = !hyps
+    in
+        if !bf then
+            ()
+        else
+            (bf := true;
+             useKeys ())
+    end
+
+type stashed = int * ((int * atom list) * check) option ref list * (int * atom list)
+fun stash () = (!nvar, !path, (#1 (!hyps), #2 (!hyps)))
+fun reinstate (nv, p, h) =
+    (nvar := nv;
+     path := p;
+     setHyps h)
+
+type stashedPath = ((int * atom list) * check) option ref list
+fun stashPath () = !path
+fun reinstatePath p = path := p
+
+fun nextVar () =
+    let
+        val n = !nvar
+    in
+        nvar := n + 1;
+        n
+    end
+
+fun assert ats =
+    let
+        val n = !hnames
+        val (_, hs, _) = !hyps
+    in
+        hnames := n + 1;
+        hyps := (n, ats @ hs, ref false);
+        app (fn a => Cc.assert (db, a)) ats
+    end
+
+fun addPath c = path := ref (SOME ((#1 (!hyps), #2 (!hyps)), c)) :: !path
+
+val sendable = ref ([] : (atom list * exp list) list)
+
+fun checkGoals goals k =
+    let
+        fun checkGoals goals unifs =
+            case goals of
+                [] => k unifs
+              | AReln (Sql tab, [Lvar lv]) :: goals =>
+                let
+                    val saved = stash ()
+                    val (_, hyps, _) = !hyps
+
+                    fun tryAll unifs hyps =
+                        case hyps of
+                            [] => false
+                          | AReln (Sql tab', [e]) :: hyps =>
+                            (tab' = tab andalso
+                             checkGoals goals (IM.insert (unifs, lv, e)))
+                            orelse tryAll unifs hyps
+                          | _ :: hyps => tryAll unifs hyps
+                in
+                    tryAll unifs hyps
+                end
+              | (g as AReln (r, es)) :: goals =>
+                (complete ();
+                 (if Cc.check (db, AReln (r, map (simplify unifs) es)) then
+                      true
+                  else
+                      ((*Print.preface ("Fail", p_atom (AReln (r, map (simplify unifs) es)));*)
+                       false))
+                 andalso checkGoals goals unifs)
+              | ACond _ :: _ => false
+    in
+        checkGoals goals IM.empty
+    end
+
+fun buildable (e, loc) =
+    let
+        fun doPols pols acc =
+            case pols of
+                [] =>
+                let
+                    val b = Cc.builtFrom (db, {Base = acc, Derived = e})
+                in
+                    (*Print.prefaces "buildable" [("Base", Print.p_list p_exp acc),
+                                                ("Derived", p_exp e),
+                                                ("Hyps", Print.p_list p_atom (#2 (!hyps))),
+                                                ("Good", Print.PD.string (Bool.toString b))];*)
+                    b
+                end
+              | (goals, es) :: pols =>
+                checkGoals goals (fn unifs => doPols pols (map (simplify unifs) es @ acc))
+                orelse doPols pols acc
+    in
+        if doPols (!sendable) [] then
+            ()
+        else
+            let
+                val (_, hs, _) = !hyps
+            in
+                ErrorMsg.errorAt loc "The information flow policy may be violated here.";
+                Print.prefaces "Situation" [("User learns", p_exp e),
+                                            ("Hypotheses", Print.p_list p_atom hs),
+                                            ("E-graph", Cc.p_database db)]
+            end
+    end
+
+fun checkPaths () =
+    let
+        val (n, hs, _) = !hyps
+        val hs = (n, hs)
+    in
+        app (fn r =>
+                case !r of
+                    NONE => ()
+                  | SOME (hs, e) =>
+                    (r := NONE;
+                     setHyps hs;
+                     buildable e)) (!path);
+        setHyps hs
+    end
+
+fun allowSend v = ((*Print.prefaces "Allow" [("goals", Print.p_list p_atom (#1 v)),
+                                           ("exps", Print.p_list p_exp (#2 v))];*)
+                   sendable := v :: !sendable)
+
+fun send (e, loc) = ((*Print.preface ("Send[" ^ Bool.toString uk ^ "]", p_exp e);*)
+                     complete ();
+                     checkPaths ();
+                     if isKnown e then
+                         ()
+                     else
+                         buildable (e, loc))
+
+fun doable pols (loc : ErrorMsg.span) =
+    let
+        val pols = !pols
+    in
+        complete ();
+        if List.exists (fn goals =>
+                           if checkGoals goals (fn _ => true) then
+                               ((*Print.prefaces "Match" [("goals", Print.p_list p_atom goals),
+                                                        ("hyps", Print.p_list p_atom (#2 (!hyps)))];*)
+                                true)
+                           else
+                               ((*Print.prefaces "No match" [("goals", Print.p_list p_atom goals)(*,
+                                                           ("hyps", Print.p_list p_atom (#2 (!hyps)))*)];*)
+                                false)) pols then
+            ()
+        else
+            let
+                val (_, hs, _) = !hyps
+            in
+                ErrorMsg.errorAt loc "The database update policy may be violated here.";
+                Print.prefaces "Situation" [("Hypotheses", Print.p_list p_atom hs)(*,
+                                            ("E-graph", Cc.p_database db)*)]
+            end
+    end
+
+val insertable = ref ([] : atom list list)
+fun allowInsert v = insertable := v :: !insertable
+val insert = doable insertable
+
+val updatable = ref ([] : atom list list)
+fun allowUpdate v = updatable := v :: !updatable
+val update = doable updatable
+
+val deletable = ref ([] : atom list list)
+fun allowDelete v = deletable := v :: !deletable
+val delete = doable deletable
+
+fun reset () = (Cc.clear db;
+                path := [];
+                hyps := (0, [], ref false);
+                nvar := 0;
+                sendable := [];
+                insertable := [];
+                updatable := [];
+                deletable := [])
+
+fun havocReln r =
+    let
+        val n = !hnames
+        val (_, hs, _) = !hyps
+    in
+        hnames := n + 1;
+        hyps := (n, List.filter (fn AReln (r', _) => r' <> r | _ => true) hs, ref false)
+    end
+
+fun havocCookie cname =
+    let
+        val cname = "cookie/" ^ cname
+        val n = !hnames
+        val (_, hs, _) = !hyps
+    in
+        hnames := n + 1;
+        hyps := (n, List.filter (fn AReln (Cmp Eq, [_, Func (Other f, [])]) => f <> cname | _ => true) hs, ref false)
+    end
+
+fun check a = Cc.check (db, a)
+
+fun debug () =
+    let
+        val (_, hs, _) = !hyps
+    in
+        Print.preface ("Hyps", Print.p_list p_atom hs)
+    end
+
+end
+
+
+fun removeDups (ls : (string * string) list) =
+    case ls of
+        [] => []
+      | x :: ls =>
+        let
+            val ls = removeDups ls
+        in
+            if List.exists (fn x' => x' = x) ls then
+                ls
+            else
+                x :: ls
+        end
+
+fun deinj env e =
+    case #1 e of
+        ERel n => SOME (List.nth (env, n))
+      | EField (e, f) =>
+        (case deinj env e of
+             NONE => NONE
+           | SOME e => SOME (Proj (e, f)))
+      | EApp ((EFfi mf, _), e) =>
+        if Settings.isEffectful mf orelse Settings.isBenignEffectful mf then
+            NONE
+        else (case deinj env e of
+                  NONE => NONE
+                | SOME e => SOME (Func (Other (#1 mf ^ "." ^ #2 mf), [e])))
+      | _ => NONE
+
+fun expIn rv env rvOf =
+    let
+        fun expIn e =
+            let
+                fun default () = inl (rv ())
+            in
+                case e of
+                    SqConst p => inl (Const p)
+                  | SqTrue => inl (Func (DtCon0 "Basis.bool.True", []))
+                  | SqFalse => inl (Func (DtCon0 "Basis.bool.False", []))
+                  | Null => inl (Func (DtCon0 "None", []))
+                  | SqNot e =>
+                    inr (case expIn e of
+                             inl e => Reln (Cmp Eq, [e, Func (DtCon0 "Basis.bool.False", [])])
+                           | inr _ => Unknown)
+                  | Field (v, f) => inl (Proj (rvOf v, f))
+                  | Computed _ => default ()
+                  | Binop (bo, e1, e2) =>
+                    let
+                        val e1 = expIn e1
+                        val e2 = expIn e2
+                    in
+                        inr (case (bo, e1, e2) of
+                                 (RCmp c, inl e1, inl e2) => Reln (Cmp c, [e1, e2])
+                               | (RLop l, v1, v2) =>
+                                 let
+                                     fun pin v =
+                                         case v of
+                                             inl e => Reln (Cmp Eq, [e, Func (DtCon0 "Basis.bool.True", [])])
+                                           | inr p => p
+                                 in
+                                     Lop (l, pin v1, pin v2)
+                                 end
+                               | _ => Unknown)
+                    end
+                  | SqKnown e =>
+                    (case expIn e of
+                         inl e => inr (Reln (Known, [e]))
+                       | _ => inr Unknown)
+                  | Inj e =>
+                    inl (case deinj env e of
+                             NONE => rv ()
+                           | SOME e => e)
+                  | SqFunc (f, e) =>
+                    (case expIn e of
+                         inl e => inl (Func (Other f, [e]))
+                       | _ => default ())
+
+                  | Unmodeled => inl (Func (Other "allow", [rv ()]))
+            end
+    in
+        expIn
+    end
+
+fun decomp {Save = save, Restore = restore, Add = add} =
+    let
+        fun go p k =
+            case p of
+                True => (k () handle Cc.Contradiction => ())
+              | False => ()
+              | Unknown => ()
+              | Lop (And, p1, p2) => go p1 (fn () => go p2 k)
+              | Lop (Or, p1, p2) =>
+                let
+                    val saved = save ()
+                in
+                    go p1 k;
+                    restore saved;
+                    go p2 k
+                end
+              | Reln x => (add (AReln x); k ())
+              | Cond x => (add (ACond x); k ())
+    in
+        go
+    end
+
+datatype queryMode =
+         SomeCol of {New : (string * exp) option, Old : (string * exp) option, Outs : exp list} -> unit
+       | AllCols of exp -> unit
+
+type 'a doQuery = {
+     Env : exp list,
+     NextVar : unit -> exp,
+     Add : atom -> unit,
+     Save : unit -> 'a,
+     Restore : 'a -> unit,
+     Cont : queryMode
+}
+
+fun doQuery (arg : 'a doQuery) (e as (_, loc)) =
+    let
+        fun default () = (ErrorMsg.errorAt loc "Information flow checker can't parse SQL query";
+                          Print.preface ("Query", MonoPrint.p_exp MonoEnv.empty e))
+    in
+        case parse query e of
+            NONE => default ()
+          | SOME q =>
+            let
+                fun doQuery q =
+                    case q of
+                        Query1 r =>
+                        let
+                            val new = ref NONE
+                            val old = ref NONE
+
+                            val rvs = map (fn Table (tab, v) =>
+                                              let
+                                                  val nv = #NextVar arg ()
+                                              in
+                                                  case v of
+                                                      "New" => new := SOME (tab, nv)
+                                                    | "Old" => old := SOME (tab, nv)
+                                                    | _ => ();
+                                                  (v, nv)
+                                              end
+                                            | _ => raise Fail "Iflow: not ready for joins or nesteds") (#From r)
+
+                            fun rvOf v =
+                                case List.find (fn (v', _) => v' = v) rvs of
+                                    NONE => raise Fail "Iflow.queryProp: Bad table variable"
+                                  | SOME (_, e) => e
+
+                            val expIn = expIn (#NextVar arg) (#Env arg) rvOf
+
+                            val saved = #Save arg ()
+                            fun addFrom () = app (fn Table (t, v) => #Add arg (AReln (Sql t, [rvOf v]))
+                                                   | _ => raise Fail "Iflow: not ready for joins or nesteds") (#From r)
+
+                            fun usedFields e =
+                                case e of
+                                    SqConst _ => []
+                                  | SqTrue => []
+                                  | SqFalse => []
+                                  | Null => []
+                                  | SqNot e => usedFields e
+                                  | Field (v, f) => [(false, Proj (rvOf v, f))]
+                                  | Computed _ => []
+                                  | Binop (_, e1, e2) => usedFields e1 @ usedFields e2
+                                  | SqKnown _ => []
+                                  | Inj e =>
+                                    (case deinj (#Env arg) e of
+                                         NONE => (ErrorMsg.errorAt loc "Expression injected into SQL is too complicated";
+                                                  [])
+                                       | SOME e => [(true, e)])
+                                  | SqFunc (_, e) => usedFields e
+                                  | Unmodeled => []
+
+                            fun normal' () =
+                                case #Cont arg of
+                                    SomeCol k =>
+                                    let
+                                        val sis = map (fn si =>
+                                                          case si of
+                                                              SqField (v, f) => Proj (rvOf v, f)
+                                                            | SqExp (e, f) =>
+                                                              case expIn e of
+                                                                  inr _ => #NextVar arg ()
+                                                                | inl e => e) (#Select r)
+                                    in
+                                        k {New = !new, Old = !old, Outs = sis}
+                                    end
+                                  | AllCols k =>
+                                    let
+                                        val (ts, es) =
+                                            foldl (fn (si, (ts, es)) =>
+                                                      case si of
+                                                          SqField (v, f) =>
+                                                          let
+                                                              val fs = getOpt (SM.find (ts, v), SM.empty)
+                                                          in
+                                                              (SM.insert (ts, v, SM.insert (fs, f, Proj (rvOf v, f))), es)
+                                                          end
+                                                        | SqExp (e, f) =>
+                                                          let
+                                                              val e =
+                                                                  case expIn e of
+                                                                      inr _ => #NextVar arg ()
+                                                                    | inl e => e
+                                                          in
+                                                              (ts, SM.insert (es, f, e))
+                                                          end)
+                                                  (SM.empty, SM.empty) (#Select r)
+                                    in
+                                        k (Recd (map (fn (t, fs) => (t, Recd (SM.listItemsi fs)))
+                                                     (SM.listItemsi ts)
+                                                 @ SM.listItemsi es))
+                                    end
+
+                            fun doWhere final =
+                                (addFrom ();
+                                 case #Where r of
+                                     NONE => final ()
+                                   | SOME e =>
+                                     let
+                                         val p = case expIn e of
+                                                     inl e => Reln (Cmp Eq, [e, Func (DtCon0 "Basis.bool.True", [])])
+                                                   | inr p => p
+
+                                         val saved = #Save arg ()
+                                     in
+                                         decomp {Save = #Save arg, Restore = #Restore arg, Add = #Add arg}
+                                                p (fn () => final () handle Cc.Contradiction => ());
+                                         #Restore arg saved
+                                     end)
+                                handle Cc.Contradiction => ()
+
+                            fun normal () = doWhere normal'
+                        in
+                            (case #Select r of
+                                 [SqExp (Binop (RCmp bo, Count, SqConst (Prim.Int 0)), f)] =>
+                                 (case bo of
+                                      Gt =>
+                                      (case #Cont arg of
+                                           SomeCol _ => ()
+                                         | AllCols k =>
+                                           let
+                                               fun answer e = k (Recd [(f, e)])
+
+                                               val saved = #Save arg ()
+                                               val () = (answer (Func (DtCon0 "Basis.bool.False", [])))
+                                                        handle Cc.Contradiction => ()
+                                           in
+                                               #Restore arg saved;
+                                               (*print "True time!\n";*)
+                                               doWhere (fn () => answer (Func (DtCon0 "Basis.bool.True", [])));
+                                               #Restore arg saved
+                                           end)
+                                    | _ => normal ())
+                               | _ => normal ())
+                            before #Restore arg saved
+                        end
+                      | Union (q1, q2) =>
+                        let
+                            val saved = #Save arg ()
+                        in
+                            doQuery q1;
+                            #Restore arg saved;
+                            doQuery q2;
+                            #Restore arg saved
+                        end
+            in
+                doQuery q
+            end
+    end
+
+fun evalPat env e (pt, _) =
+    case pt of
+        PVar _ => e :: env
+      | PPrim _ => env
+      | PCon (_, pc, NONE) => (St.assert [AReln (PCon0 (patCon pc), [e])]; env)
+      | PCon (_, pc, SOME pt) =>
+        let
+            val env = evalPat env (Func (UnCon (patCon pc), [e])) pt
+        in
+            St.assert [AReln (PCon1 (patCon pc), [e])];
+            env
+        end
+      | PRecord xpts =>
+        foldl (fn ((x, pt, _), env) => evalPat env (Proj (e, x)) pt) env xpts
+      | PNone _ => (St.assert [AReln (PCon0 "None", [e])]; env)
+      | PSome (_, pt) =>
+        let
+            val env = evalPat env (Func (UnCon "Some", [e])) pt
+        in
+            St.assert [AReln (PCon1 "Some", [e])];
+            env
+        end
+
+datatype arg_mode = Fixed | Decreasing | Arbitrary
+type rfun = {args : arg_mode list, tables : SS.set, cookies : SS.set, body : Mono.exp}
+val rfuns = ref (IM.empty : rfun IM.map)
+
+fun evalExp env (e as (_, loc)) k =
+    let
+        (*val () = St.debug ()*)
+        (*val () = Print.preface ("evalExp", MonoPrint.p_exp MonoEnv.empty e)*)
+
+        fun default () = k (Var (St.nextVar ()))
+
+        fun doFfi (m, s, es) =
+            if m = "Basis" andalso SS.member (writers, s) then
+                let
+                    fun doArgs es =
+                        case es of
+                            [] =>
+                            (if s = "set_cookie" then
+                                 case es of
+                                     [_, (cname, _), _, _, _] =>
+                                     (case #1 cname of
+                                          EPrim (Prim.String (_, cname)) =>
+                                          St.havocCookie cname
+                                        | _ => ())
+                                   | _ => ()
+                             else
+                                 ();
+                             k (Recd []))
+                          | (e, _) :: es =>
+                            evalExp env e (fn e => (St.send (e, loc); doArgs es))
+                in
+                    doArgs es
+                end
+            else if Settings.isEffectful (m, s) andalso not (Settings.isBenignEffectful (m, s)) then
+                default ()
+            else
+                let
+                    fun doArgs (es, acc) =
+                        case es of
+                            [] => k (Func (Other (m ^ "." ^ s), rev acc))
+                          | (e, _) :: es =>
+                            evalExp env e (fn e => doArgs (es, e :: acc))
+                in
+                    doArgs (es, [])
+                end
+    in
+        case #1 e of
+            EPrim p => k (Const p)
+          | ERel n => k (List.nth (env, n))
+          | ENamed _ => default ()
+          | ECon (_, pc, NONE) => k (Func (DtCon0 (patCon pc), []))
+          | ECon (_, pc, SOME e) => evalExp env e (fn e => k (Func (DtCon1 (patCon pc), [e])))
+          | ENone _ => k (Func (DtCon0 "None", []))
+          | ESome (_, e) => evalExp env e (fn e => k (Func (DtCon1 "Some", [e])))
+          | EFfi _ => default ()
+
+          | EFfiApp ("Basis", "rand", []) =>
+            let
+                val e = Var (St.nextVar ())
+            in
+                St.assert [AReln (Known, [e])];
+                k e
+            end
+          | EFfiApp x => doFfi x
+          | EApp ((EFfi (m, s), _), e) => doFfi (m, s, [(e, (TRecord [], loc))])
+
+          | EApp (e1 as (EError _, _), _) => evalExp env e1 k
+
+          | EApp (e1, e2) =>
+            let
+                fun adefault () = (ErrorMsg.errorAt loc "Excessively fancy function call";
+                                   Print.preface ("Call", MonoPrint.p_exp MonoEnv.empty e);
+                                   default ())
+
+                fun doArgs (e, args) =
+                    case #1 e of
+                        EApp (e1, e2) => doArgs (e1, e2 :: args)
+                      | ENamed n =>
+                        (case IM.find (!rfuns, n) of
+                             NONE => adefault ()
+                           | SOME rf =>
+                             if length (#args rf) <> length args then
+                                 adefault ()
+                             else
+                                 let
+                                     val () = (SS.app (St.havocReln o Sql) (#tables rf);
+                                               SS.app St.havocCookie (#cookies rf))
+                                     val saved = St.stash ()
+
+                                     fun doArgs (args, modes, env') =
+                                         case (args, modes) of
+                                             ([], []) => (evalExp env' (#body rf) (fn _ => ());
+                                                          St.reinstate saved;
+                                                          default ())
+
+                                           | (arg :: args, mode :: modes) =>
+                                             evalExp env arg (fn arg =>
+                                                                 let
+                                                                     val v = case mode of
+                                                                                 Arbitrary => Var (St.nextVar ())
+                                                                               | Fixed => arg
+                                                                               | Decreasing =>
+                                                                                 let
+                                                                                     val v = Var (St.nextVar ())
+                                                                                 in
+                                                                                     if St.check (AReln (Known, [arg])) then
+                                                                                         St.assert [(AReln (Known, [v]))]
+                                                                                     else
+                                                                                         ();
+                                                                                     v
+                                                                                 end
+                                                                 in
+                                                                     doArgs (args, modes, v :: env')
+                                                                 end)
+                                           | _ => raise Fail "Iflow.doArgs: Impossible"
+                                 in
+                                     doArgs (args, #args rf, [])
+                                 end)
+                          | _ => adefault ()
+            in
+                doArgs (e, [])
+            end
+
+          | EAbs _ => default ()
+          | EUnop (s, e1) => evalExp env e1 (fn e1 => k (Func (Other s, [e1])))
+          | EBinop (_, s, e1, e2) => evalExp env e1 (fn e1 => evalExp env e2 (fn e2 => k (Func (Other s, [e1, e2]))))
+          | ERecord xets =>
+            let
+                fun doFields (xes, acc) =
+                    case xes of
+                        [] => k (Recd (rev acc))
+                      | (x, e, _) :: xes =>
+                        evalExp env e (fn e => doFields (xes, (x, e) :: acc))
+            in
+                doFields (xets, [])
+            end
+          | EField (e, s) => evalExp env e (fn e => k (Proj (e, s)))
+          | ECase (e, pes, {result = res, ...}) =>
+            evalExp env e (fn e =>
+                              if List.all (fn (_, (EWrite (EPrim _, _), _)) => true
+                                            | _ => false) pes then
+                                  (St.send (e, loc);
+                                   k (Recd []))
+                              else
+                                  (St.addPath (e, loc);
+                                   app (fn (p, pe) =>
+                                           let
+                                               val saved = St.stash ()
+                                           in
+                                               let
+                                                   val env = evalPat env e p
+                                               in
+                                                   evalExp env pe k;
+                                                   St.reinstate saved
+                                               end
+                                               handle Cc.Contradiction => St.reinstate saved
+                                           end) pes))
+          | EStrcat (e1, e2) =>
+            evalExp env e1 (fn e1 =>
+                evalExp env e2 (fn e2 =>
+                                   k (Func (Other "cat", [e1, e2]))))
+          | EError (e, _) => evalExp env e (fn e => St.send (e, loc))
+          | EReturnBlob {blob = NONE, ...} => raise Fail "Iflow doesn't support blob optimization"
+          | EReturnBlob {blob = SOME b, mimeType = m, ...} =>
+            evalExp env b (fn b =>
+                              (St.send (b, loc);
+                               evalExp env m
+                               (fn m => St.send (m, loc))))
+          | ERedirect (e, _) =>
+            evalExp env e (fn e => St.send (e, loc))
+          | EWrite e =>
+            evalExp env e (fn e => (St.send (e, loc);
+                                    k (Recd [])))
+          | ESeq (e1, e2) =>
+            let
+                val path = St.stashPath ()
+            in
+                evalExp env e1 (fn _ => (St.reinstatePath path; evalExp env e2 k))
+            end
+          | ELet (_, _, e1, e2) =>
+            evalExp env e1 (fn e1 => evalExp (e1 :: env) e2 k)
+          | EClosure (n, es) =>
+            let
+                fun doArgs (es, acc) =
+                    case es of
+                        [] => k (Func (Other ("Cl" ^ Int.toString n), rev acc))
+                      | e :: es =>
+                        evalExp env e (fn e => doArgs (es, e :: acc))
+            in
+                doArgs (es, [])
+            end
+
+          | EQuery {query = q, body = b, initial = i, state = state, ...} =>
+            evalExp env i (fn i =>
+                              let
+                                  val r = Var (St.nextVar ())
+                                  val acc = Var (St.nextVar ())
+
+                                  val (ts, cs) = MonoUtil.Exp.fold {typ = fn (_, st) => st,
+                                                                   exp = fn (e, st as (cs, ts)) =>
+                                                                            case e of
+                                                                                EDml (e, _) =>
+                                                                                (case parse dml e of
+                                                                                     NONE => st
+                                                                                   | SOME c =>
+                                                                                     case c of
+                                                                                         Insert _ => st
+                                                                                       | Delete (tab, _) =>
+                                                                                         (cs, SS.add (ts, tab))
+                                                                                       | Update (tab, _, _) =>
+                                                                                         (cs, SS.add (ts, tab)))
+                                                                              | EFfiApp ("Basis", "set_cookie",
+                                                                                         [_, ((EPrim (Prim.String (_, cname)), _), _),
+                                                                                          _, _, _]) =>
+                                                                                (SS.add (cs, cname), ts)
+                                                                              | _ => st}
+                                                                  (SS.empty, SS.empty) b
+                              in
+                                  case (#1 state, SS.isEmpty ts, SS.isEmpty cs) of
+                                          (TRecord [], true, true) => ()
+                                        | _ =>
+                                          let
+                                              val saved = St.stash ()
+                                          in
+                                              (k i)
+                                              handle Cc.Contradiction => ();
+                                              St.reinstate saved
+                                          end;
+
+                                  SS.app (St.havocReln o Sql) ts;
+                                  SS.app St.havocCookie cs;
+
+                                  doQuery {Env = env,
+                                           NextVar = Var o St.nextVar,
+                                           Add = fn a => St.assert [a],
+                                           Save = St.stash,
+                                           Restore = St.reinstate,
+                                           Cont = AllCols (fn x =>
+                                                              (St.assert [AReln (Cmp Eq, [r, x])];
+                                                               evalExp (acc :: r :: env) b k))} q
+                              end)
+          | EDml (e, _) =>
+            (case parse dml e of
+                 NONE => (print ("Warning: Information flow checker can't parse DML command at "
+                                 ^ ErrorMsg.spanToString loc ^ "\n");
+                          default ())
+               | SOME d =>
+                 case d of
+                     Insert (tab, es) =>
+                     let
+                         val new = St.nextVar ()
+
+                         val expIn = expIn (Var o St.nextVar) env
+                                           (fn _ => raise Fail "Iflow.evalExp: Bad field expression in INSERT [1]")
+
+                         val es = map (fn (x, e) =>
+                                          case expIn e of
+                                              inl e => (x, e)
+                                            | inr _ => raise Fail "Iflow.evalExp: Bad field expression in INSERT [2]")
+                                  es
+
+                         val saved = St.stash ()
+                     in
+                         St.assert [AReln (Sql (tab ^ "$New"), [Recd es])];
+                         St.insert loc;
+                         St.reinstate saved;
+                         St.assert [AReln (Sql tab, [Recd es])];
+                         k (Recd [])
+                     end
+                   | Delete (tab, e) =>
+                     let
+                         val old = St.nextVar ()
+
+                         val expIn = expIn (Var o St.nextVar) env
+                                           (fn "T" => Var old
+                                             | _ => raise Fail "Iflow.evalExp: Bad field expression in DELETE")
+
+                         val p = case expIn e of
+                                     inl e => raise Fail "Iflow.evalExp: DELETE with non-boolean"
+                                   | inr p => p
+
+                         val saved = St.stash ()
+                     in
+                         St.assert [AReln (Sql (tab ^ "$Old"), [Var old]),
+                                    AReln (Sql (tab), [Var old])];
+                         decomp {Save = St.stash,
+                                 Restore = St.reinstate,
+                                 Add = fn a => St.assert [a]} p
+                                (fn () => (St.delete loc;
+                                           St.reinstate saved;
+                                           St.havocReln (Sql tab);
+                                           k (Recd []))
+                                    handle Cc.Contradiction => ())
+                     end
+                   | Update (tab, fs, e) =>
+                     let
+                         val new = St.nextVar ()
+                         val old = St.nextVar ()
+
+                         val expIn = expIn (Var o St.nextVar) env
+                                           (fn "T" => Var old
+                                             | _ => raise Fail "Iflow.evalExp: Bad field expression in UPDATE")
+
+                         val fs = map
+                                      (fn (x, e) =>
+                                          (x, case expIn e of
+                                                  inl e => e
+                                                | inr _ => raise Fail
+                                                                     ("Iflow.evalExp: Selecting "
+                                                                      ^ "boolean expression")))
+                                      fs
+
+                         val fs' = case SM.find (!tabs, tab) of
+                                       NONE => raise Fail "Iflow.evalExp: Updating unknown table"
+                                     | SOME (fs', _) => fs'
+
+                         val fs = foldl (fn (f, fs) =>
+                                            if List.exists (fn (f', _) => f' = f) fs then
+                                                fs
+                                            else
+                                                (f, Proj (Var old, f)) :: fs) fs fs'
+
+                         val p = case expIn e of
+                                           inl e => raise Fail "Iflow.evalExp: UPDATE with non-boolean"
+                                         | inr p => p
+                         val saved = St.stash ()
+                     in
+                         St.assert [AReln (Sql (tab ^ "$New"), [Recd fs]),
+                                    AReln (Sql (tab ^ "$Old"), [Var old]),
+                                    AReln (Sql tab, [Var old])];
+                         decomp {Save = St.stash,
+                                 Restore = St.reinstate,
+                                 Add = fn a => St.assert [a]} p
+                                (fn () => (St.update loc;
+                                           St.reinstate saved;
+                                           St.havocReln (Sql tab);
+                                           k (Recd []))
+                                    handle Cc.Contradiction => ())
+                     end)
+
+          | ENextval (EPrim (Prim.String (_, seq)), _) =>
+            let
+                val nv = St.nextVar ()
+            in
+                St.assert [AReln (Sql (String.extract (seq, 3, NONE)), [Var nv])];
+                k (Var nv)
+            end
+          | ENextval _ => default ()
+          | ESetval _ => default ()
+
+          | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String (_, cname)), _), _)]), _), _, _) =>
+            let
+                val e = Var (St.nextVar ())
+                val e' = Func (Other ("cookie/" ^ cname), [])
+            in
+                St.assert [AReln (Known, [e]), AReln (Cmp Eq, [e, e'])];
+                k e
+            end
+
+          | EUnurlify _ => default ()
+          | EJavaScript _ => default ()
+          | ESignalReturn _ => default ()
+          | ESignalBind _ => default ()
+          | ESignalSource _ => default ()
+          | EServerCall _ => default ()
+          | ERecv _ => default ()
+          | ESleep _ => default ()
+          | ESpawn _ => default ()
+    end
+
+datatype var_source = Input of int | SubInput of int | Unknown
+
+structure U = MonoUtil
+
+fun mliftExpInExp by =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + by)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+fun nameSubexps k (e : Mono.exp) =
+    let
+        fun numParams (e : Mono.exp) =
+            case #1 e of
+                EStrcat (e1, e2) => numParams e1 + numParams e2
+              | EPrim (Prim.String _) => 0
+              | _ => 1
+
+        val nps = numParams e
+
+        fun getParams (e : Mono.exp) x =
+            case #1 e of
+                EStrcat (e1, e2) =>
+                let
+                    val (ps1, e1') = getParams e1 x
+                    val (ps2, e2') = getParams e2 (x - length ps1)
+                in
+                    (ps2 @ ps1, (EStrcat (e1', e2'), #2 e))
+                end
+              | EPrim (Prim.String _) => ([], e)
+              | _ =>
+                let
+                    val (e', k) =
+                        case #1 e of
+                            EFfiApp (m, f, [(e', t)]) =>
+                            if Settings.isEffectful (m, f) orelse Settings.isBenignEffectful (m, f) then
+                                (e, fn x => x)
+                            else
+                                (e', fn e' => (EFfiApp (m, f, [(e', t)]), #2 e))
+                          | ECase (e', ps as
+                                          [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
+                                            (EPrim (Prim.String (_, "TRUE")), _)),
+                                           ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
+                                            (EPrim (Prim.String (_, "FALSE")), _))], q) =>
+                            (e', fn e' => (ECase (e', ps, q), #2 e))
+                          | _ => (e, fn x => x)
+                in
+                    ([e'], k (ERel x, #2 e))
+                end
+
+        val (ps, e') = getParams e (nps - 1)
+
+        val string = (TFfi ("Basis", "string"), #2 e)
+
+        val (e', _) = foldl (fn (p, (e', liftBy)) =>
+                                ((ELet ("p" ^ Int.toString liftBy,
+                                        string,
+                                        mliftExpInExp liftBy 0 p,
+                                        e'), #2 e), liftBy - 1)) (k (nps, e'), nps - 1) ps
+    in
+        #1 e'
+    end
+
+val namer = MonoUtil.File.map {typ = fn t => t,
+                               exp = fn e =>
+                                        case e of
+                                            EDml (e, fm) =>
+                                            nameSubexps (fn (_, e') => (EDml (e', fm), #2 e)) e
+                                          | EQuery {exps, tables, state, query, body, initial} =>
+                                            nameSubexps (fn (liftBy, e') =>
+                                                            (EQuery {exps = exps,
+                                                                     tables = tables,
+                                                                     state = state,
+                                                                     query = e',
+                                                                     body = mliftExpInExp liftBy 2 body,
+                                                                     initial = mliftExpInExp liftBy 0 initial},
+                                                             #2 query)) query
+                                          | _ => e,
+                                     decl = fn d => d}
+
+fun check (file : file) =
+    let
+        val () = (St.reset ();
+                  rfuns := IM.empty)
+
+        (*val () = Print.preface ("FilePre", MonoPrint.p_file MonoEnv.empty file)*)
+        val file = MonoReduce.reduce file
+        val file = MonoOpt.optimize file
+        val file = Fuse.fuse file
+        val file = MonoOpt.optimize file
+        val file = MonoShake.shake file
+        val file = namer file
+        (*val () = Print.preface ("File", MonoPrint.p_file MonoEnv.empty file)*)
+
+        val exptd = foldl (fn ((d, _), exptd) =>
+                              case d of
+                                  DExport (_, _, n, _, _, _) => IS.add (exptd, n)
+                                | _ => exptd) IS.empty (#1 file)
+
+        fun decl (d, loc) =
+            case d of
+                DTable (tab, fs, pk, _) =>
+                let
+                    val ks =
+                        case #1 pk of
+                            EPrim (Prim.String (_, s)) =>
+                            (case String.tokens (fn ch => ch = #"," orelse ch = #" ") s of
+                                 [] => []
+                               | pk => [pk])
+                          | _ => []
+                in
+                    if size tab >= 3 then
+                        tabs := SM.insert (!tabs, String.extract (tab, 3, NONE),
+                                           (map #1 fs,
+                                            map (map (fn s => str (Char.toUpper (String.sub (s, 3)))
+                                                              ^ String.extract (s, 4, NONE))) ks))
+                    else
+                        raise Fail "Table name does not begin with uw_"
+                end
+              | DVal (x, n, _, e, _) =>
+                let
+                    (*val () = print ("\n=== " ^ x ^ " ===\n\n");*)
+
+                    val isExptd = IS.member (exptd, n)
+
+                    val saved = St.stash ()
+
+                    fun deAbs (e, env, ps) =
+                        case #1 e of
+                            EAbs (_, _, _, e) =>
+                            let
+                                val nv = Var (St.nextVar ())
+                            in
+                                deAbs (e, nv :: env,
+                                       if isExptd then
+                                           AReln (Known, [nv]) :: ps
+                                       else
+                                           ps)
+                            end
+                          | _ => (e, env, ps)
+
+                    val (e, env, ps) = deAbs (e, [], [])
+                in
+                    St.assert ps;
+                    (evalExp env e (fn _ => ()) handle Cc.Contradiction => ());
+                    St.reinstate saved
+                end
+
+              | DValRec [(x, n, _, e, _)] =>
+                let
+                    val tables = ref SS.empty
+                    val cookies = ref SS.empty
+
+                    fun deAbs (e, env, modes) =
+                        case #1 e of
+                            EAbs (_, _, _, e) => deAbs (e, Input (length env) :: env, ref Fixed :: modes)
+                          | _ => (e, env, rev modes)
+
+                    val (e, env, modes) = deAbs (e, [], [])
+
+                    fun doExp env (e as (_, loc)) =
+                        case #1 e of
+                            EPrim _ => e
+                          | ERel _ => e
+                          | ENamed _ => e
+                          | ECon (_, _, NONE) => e
+                          | ECon (dk, pc, SOME e) => (ECon (dk, pc, SOME (doExp env e)), loc)
+                          | ENone _ => e
+                          | ESome (t, e) => (ESome (t, doExp env e), loc)
+                          | EFfi _ => e
+                          | EFfiApp (m, f, es) =>
+                            (case (m, f, es) of
+                                 ("Basis", "set_cookie", [_, ((EPrim (Prim.String (_, cname)), _), _), _, _, _]) =>
+                                 cookies := SS.add (!cookies, cname)
+                               | _ => ();
+                             (EFfiApp (m, f, map (fn (e, t) => (doExp env e, t)) es), loc))
+
+                          | EApp (e1, e2) =>
+                            let
+                                fun default () = (EApp (doExp env e1, doExp env e2), loc)
+
+                                fun explore (e, args) =
+                                    case #1 e of
+                                        EApp (e1, e2) => explore (e1, e2 :: args)
+                                      | ENamed n' =>
+                                        if n' = n then
+                                            let
+                                                fun doArgs (pos, args, modes) =
+                                                    case (args, modes) of
+                                                        ((e1, _) :: args, m1 :: modes) =>
+                                                        (case e1 of
+                                                             ERel n =>
+                                                             (case List.nth (env, n) of
+                                                                  Input pos' =>
+                                                                  if pos' = pos then
+                                                                      ()
+                                                                  else
+                                                                      m1 := Arbitrary
+                                                                | SubInput pos' =>
+                                                                  if pos' = pos then
+                                                                      if !m1 = Arbitrary then
+                                                                          ()
+                                                                      else
+                                                                          m1 := Decreasing
+                                                                  else
+                                                                      m1 := Arbitrary
+                                                                | Unknown => m1 := Arbitrary)
+                                                           | _ => m1 := Arbitrary;
+                                                         doArgs (pos + 1, args, modes))
+                                                      | (_ :: _, []) => ()
+                                                      | ([], ms) => app (fn m => m := Arbitrary) ms
+                                            in
+                                                doArgs (0, args, modes);
+                                                (EFfi ("Basis", "?"), loc)
+                                            end
+                                        else
+                                            default ()
+                                      | _ => default ()
+                            in
+                                explore (e, [])
+                            end
+                          | EAbs (x, t1, t2, e) => (EAbs (x, t1, t2, doExp (Unknown :: env) e), loc)
+                          | EUnop (uo, e1) => (EUnop (uo, doExp env e1), loc)
+                          | EBinop (bi, bo, e1, e2) => (EBinop (bi, bo, doExp env e1, doExp env e2), loc)
+                          | ERecord xets => (ERecord (map (fn (x, e, t) => (x, doExp env e, t)) xets), loc)
+                          | EField (e1, f) => (EField (doExp env e1, f), loc)
+                          | ECase (e, pes, ts) =>
+                            let
+                                val source =
+                                    case #1 e of
+                                        ERel n =>
+                                        (case List.nth (env, n) of
+                                             Input n => SOME n
+                                           | SubInput n => SOME n
+                                           | Unknown => NONE)
+                                      | _ => NONE
+
+                                fun doV v =
+                                    let
+                                        fun doPat (p, env) =
+                                            case #1 p of
+                                                PVar _ => v :: env
+                                              | PPrim _ => env
+                                              | PCon (_, _, NONE) => env
+                                              | PCon (_, _, SOME p) => doPat (p, env)
+                                              | PRecord xpts => foldl (fn ((_, p, _), env) => doPat (p, env)) env xpts
+                                              | PNone _ => env
+                                              | PSome (_, p) => doPat (p, env)
+                                    in
+                                        (ECase (e, map (fn (p, e) => (p, doExp (doPat (p, env)) e)) pes, ts), loc)
+                                    end
+                            in
+                                case source of
+                                    NONE => doV Unknown
+                                  | SOME inp => doV (SubInput inp)
+                            end
+                          | EStrcat (e1, e2) => (EStrcat (doExp env e1, doExp env e2), loc)
+                          | EError (e1, t) => (EError (doExp env e1, t), loc)
+                          | EReturnBlob {blob = NONE, mimeType = m, t} =>
+                            (EReturnBlob {blob = NONE, mimeType = doExp env m, t = t}, loc)
+                          | EReturnBlob {blob = SOME b, mimeType = m, t} =>
+                            (EReturnBlob {blob = SOME (doExp env b), mimeType = doExp env m, t = t}, loc)
+                          | ERedirect (e1, t) => (ERedirect (doExp env e1, t), loc)
+                          | EWrite e1 => (EWrite (doExp env e1), loc)
+                          | ESeq (e1, e2) => (ESeq (doExp env e1, doExp env e2), loc)
+                          | ELet (x, t, e1, e2) => (ELet (x, t, doExp env e1, doExp (Unknown :: env) e2), loc)
+                          | EClosure (n, es) => (EClosure (n, map (doExp env) es), loc)
+                          | EQuery {exps, tables, state, query, body, initial} =>
+                            (EQuery {exps = exps, tables = tables, state = state,
+                                     query = doExp env query,
+                                     body = doExp (Unknown :: Unknown :: env) body,
+                                     initial = doExp env initial}, loc)
+                          | EDml (e1, mode) =>
+                            (case parse dml e1 of
+                                 NONE => ()
+                               | SOME c =>
+                                 case c of
+                                     Insert _ => ()
+                                   | Delete (tab, _) =>
+                                     tables := SS.add (!tables, tab)
+                                   | Update (tab, _, _) =>
+                                     tables := SS.add (!tables, tab);
+                             (EDml (doExp env e1, mode), loc))
+                          | ENextval e1 => (ENextval (doExp env e1), loc)
+                          | ESetval (e1, e2) => (ESetval (doExp env e1, doExp env e2), loc)
+                          | EUnurlify (e1, t, b) => (EUnurlify (doExp env e1, t, b), loc)
+                          | EJavaScript (m, e) => (EJavaScript (m, doExp env e), loc)
+                          | ESignalReturn _ => e
+                          | ESignalBind _ => e
+                          | ESignalSource _ => e
+                          | EServerCall _ => e
+                          | ERecv _ => e
+                          | ESleep _ => e
+                          | ESpawn _ => e
+
+                    val e = doExp env e
+                in
+                    rfuns := IM.insert (!rfuns, n, {tables = !tables, cookies = !cookies,
+                                                    args = map (fn r => !r) modes, body = e})
+                end
+
+              | DValRec _ => ErrorMsg.errorAt loc "Iflow can't check mutually-recursive functions yet."
+
+              | DPolicy pol =>
+                let
+                    val rvN = ref 0
+                    fun rv () =
+                        let
+                            val n = !rvN
+                        in
+                            rvN := n + 1;
+                            Lvar n
+                        end
+
+                    val atoms = ref ([] : atom list)
+                    fun doQ k = doQuery {Env = [],
+                                         NextVar = rv,
+                                         Add = fn a => atoms := a :: !atoms,
+                                         Save = fn () => !atoms,
+                                         Restore = fn ls => atoms := ls,
+                                         Cont = SomeCol (fn r => k (rev (!atoms), r))}
+
+                    fun untab (tab, nams) = List.filter (fn AReln (Sql tab', [Lvar lv]) =>
+                                                            tab' <> tab
+                                                            orelse List.all (fn Lvar lv' => lv' <> lv
+                                                                              | _ => false) nams
+                                                          | _ => true)
+                in
+                    case pol of
+                        PolClient e =>
+                        doQ (fn (ats, {Outs = es, ...}) => St.allowSend (ats, es)) e
+                      | PolInsert e =>
+                        doQ (fn (ats, {New = SOME (tab, new), ...}) =>
+                                St.allowInsert (AReln (Sql (tab ^ "$New"), [new]) :: untab (tab, [new]) ats)
+                              | _ => raise Fail "Iflow: No New in mayInsert policy") e
+                      | PolDelete e =>
+                        doQ (fn (ats, {Old = SOME (tab, old), ...}) =>
+                                St.allowDelete (AReln (Sql (tab ^ "$Old"), [old]) :: untab (tab, [old]) ats)
+                              | _ => raise Fail "Iflow: No Old in mayDelete policy") e
+                      | PolUpdate e =>
+                        doQ (fn (ats, {New = SOME (tab, new), Old = SOME (_, old), ...}) =>
+                                St.allowUpdate (AReln (Sql (tab ^ "$Old"), [old])
+                                                :: AReln (Sql (tab ^ "$New"), [new])
+                                                :: untab (tab, [new, old]) ats)
+                              | _ => raise Fail "Iflow: No New or Old in mayUpdate policy") e
+                      | PolSequence e =>
+                        (case #1 e of
+                             EPrim (Prim.String (_, seq)) =>
+                             let
+                                 val p = AReln (Sql (String.extract (seq, 3, NONE)), [Lvar 0])
+                                 val outs = [Lvar 0]
+                             in
+                                 St.allowSend ([p], outs)
+                             end
+                           | _ => ())
+                end
+
+              | _ => ()
+    in
+        app decl (#1 file)
+    end
+
+val check = fn file =>
+               let
+                   val oldInline = Settings.getMonoInline ()
+                   val oldFull = !MonoReduce.fullMode
+               in
+                   (Settings.setMonoInline (case Int.maxInt of
+                                                NONE => 1000000
+                                              | SOME n => n);
+                    MonoReduce.fullMode := true;
+                    check file;
+                    Settings.setMonoInline oldInline)
+                   handle ex => (Settings.setMonoInline oldInline;
+                                 MonoReduce.fullMode := oldFull;
+                                 raise ex)
+               end
+
+end
diff --git a/src/jscomp.sig b/src/jscomp.sig
new file mode 100644
index 0000000..5b8723b
--- /dev/null
+++ b/src/jscomp.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature JSCOMP = sig
+
+    val process : Mono.file -> Mono.file
+
+    val explainEmbed : bool ref
+    (* Output verbose error messages about inability to embed server-side
+     * values in client-side code? *)
+
+end
diff --git a/src/jscomp.sml b/src/jscomp.sml
new file mode 100644
index 0000000..dedcb55
--- /dev/null
+++ b/src/jscomp.sml
@@ -0,0 +1,1369 @@
+(* Copyright (c) 2008-2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure JsComp :> JSCOMP = struct
+
+open Mono
+
+structure EM = ErrorMsg
+structure E = MonoEnv
+structure U = MonoUtil
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+structure TM = BinaryMapFn(struct
+                           type ord_key = typ
+                           val compare = U.Typ.compare
+                           end)
+
+val explainEmbed = ref false
+
+type state = {
+     decls : (string * int * (string * int * typ option) list) list,
+     script : string list,
+     included : IS.set,
+     injectors : int IM.map,
+     listInjectors : int TM.map,
+     decoders : int IM.map,
+     maxName : int
+}
+
+fun strcat loc es =
+    case es of
+        [] => (EPrim (Prim.String (Prim.Normal, "")), loc)
+      | [x] => x
+      | x :: es' => (EStrcat (x, strcat loc es'), loc)
+
+exception CantEmbed of typ
+
+fun inString {needle, haystack} = String.isSubstring needle haystack
+
+fun process (file : file) =
+    let
+        val (someTs, nameds) =
+            foldl (fn ((DVal (_, n, t, e, _), _), (someTs, nameds)) => (someTs, IM.insert (nameds, n, e))
+                    | ((DValRec vis, _), (someTs, nameds)) =>
+                      (someTs, foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e))
+                                     nameds vis)
+                    | ((DDatatype dts, _), state as (someTs, nameds)) =>
+                      (foldl (fn ((_, _, cs), someTs) =>
+                                 if ElabUtil.classifyDatatype cs = Option then
+                                     foldl (fn ((_, n, SOME t), someTs) => IM.insert (someTs, n, t)
+                                             | (_, someTs) => someTs) someTs cs
+                                 else
+                                     someTs) someTs dts,
+                       nameds)
+                    | (_, state) => state)
+                  (IM.empty, IM.empty) (#1 file)
+
+        fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc)
+
+        fun isNullable (t, _) =
+            case t of
+                TOption _ => true
+              | TList _ => true
+              | TDatatype (_, ref (Option, _)) => true
+              | TRecord [] => true
+              | _ => false
+
+        fun quoteExp loc (t : typ) (e, st) =
+            case #1 t of
+                TSource => ((EFfiApp ("Basis", "htmlifySource", [(e, t)]), loc), st)
+
+              | TRecord [] => (str loc "null", st)
+              | TRecord [(x, t)] =>
+                let
+                    val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
+                in
+                    (strcat loc [str loc ("{_" ^ x ^ ":"),
+                                 e,
+                                 str loc "}"], st)
+                end
+              | TRecord ((x, t) :: xts) =>
+                let
+                    val (e', st) = quoteExp loc t ((EField (e, x), loc), st)
+                    val (es, st) = ListUtil.foldlMap
+                                   (fn ((x, t), st) =>
+                                       let
+                                           val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
+                                       in
+                                           (strcat loc [str loc (",_" ^ x ^ ":"), e], st)
+                                       end)
+                                   st xts
+                in
+                    (strcat loc (str loc ("{_" ^ x ^ ":")
+                                 :: e'
+                                 :: es
+                                 @ [str loc "}"]), st)
+                end
+
+              | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [(e, t)]), loc), st)
+              | TFfi ("Basis", "char") => ((EFfiApp ("Basis", "jsifyChar", [(e, t)]), loc), st)
+              | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [(e, t)]), loc), st)
+              | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [(e, t)]), loc), st)
+              | TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [(e, t)]), loc), st)
+              | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [(e, t)]), loc), st)
+
+              | TFfi ("Basis", "bool") => ((ECase (e,
+                                                   [((PCon (Enum, PConFfi {mod = "Basis",
+                                                                           datatyp = "bool",
+                                                                           con = "True",
+                                                                           arg = NONE}, NONE), loc),
+                                                     str loc "true"),
+                                                    ((PCon (Enum, PConFfi {mod = "Basis",
+                                                                           datatyp = "bool",
+                                                                           con = "False",
+                                                                           arg = NONE}, NONE), loc),
+                                                     str loc "false")],
+                                                   {disc = (TFfi ("Basis", "bool"), loc),
+                                                    result = (TFfi ("Basis", "string"), loc)}), loc),
+                                           st)
+
+              | TOption t =>
+                let
+                    val (e', st) = quoteExp loc t ((ERel 0, loc), st)
+                in
+                    (case #1 e' of
+                        EPrim (Prim.String (_, "ERROR")) => raise Fail "UHOH"
+                      | _ =>
+                        (ECase (e,
+                                [((PNone t, loc),
+                                  str loc "null"),
+                                 ((PSome (t, (PVar ("x", t), loc)), loc),
+                                  if isNullable t then
+                                      strcat loc [str loc "{v:", e', str loc "}"]
+                                  else
+                                      e')],
+                                {disc = (TOption t, loc),
+                                 result = (TFfi ("Basis", "string"), loc)}), loc),
+                     st)
+                end
+
+              | TList t' =>
+                (case TM.find (#listInjectors st, t') of
+                     SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
+                   | NONE =>
+                     let
+                         val rt = (TRecord [("1", t'), ("2", t)], loc)
+
+                         val n' = #maxName st
+                         val st = {decls = #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   listInjectors = TM.insert (#listInjectors st, t', n'),
+                                   decoders = #decoders st,
+                                   maxName = n' + 1}
+
+                         val s = (TFfi ("Basis", "string"), loc)
+                         val (e', st) = quoteExp loc t' ((EField ((ERel 0, loc), "1"), loc), st)
+
+                         val body = (ECase ((ERel 0, loc),
+                                            [((PNone rt, loc),
+                                              str loc "null"),
+                                             ((PSome (rt, (PVar ("x", rt), loc)), loc),
+                                              strcat loc [str loc "{_1:",
+                                                          e',
+                                                          str loc ",_2:",
+                                                          (EApp ((ENamed n', loc),
+                                                                 (EField ((ERel 0, loc), "2"), loc)), loc),
+                                                          str loc "}"])],
+                                            {disc = t, result = s}), loc)
+                         val body = (EAbs ("x", t, s, body), loc)
+
+                         val st = {decls = ("jsify", n', (TFun (t, s), loc),
+                                            body, "jsify") :: #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   listInjectors = #listInjectors st,
+                                   decoders= #decoders st,
+                                   maxName = #maxName st}
+
+
+                     in
+                         ((EApp ((ENamed n', loc), e), loc), st)
+                     end)
+
+              | TDatatype (n, ref (dk, cs)) =>
+                (case IM.find (#injectors st, n) of
+                     SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
+                   | NONE =>
+                     let
+                         val n' = #maxName st
+                         val st = {decls = #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = IM.insert (#injectors st, n, n'),
+                                   listInjectors = #listInjectors st,
+                                   decoders = #decoders st,
+                                   maxName = n' + 1}
+
+                         val (pes, st) = ListUtil.foldlMap
+                                             (fn ((_, cn, NONE), st) =>
+                                                 (((PCon (dk, PConVar cn, NONE), loc),
+                                                   case dk of
+                                                       Option => str loc "null"
+                                                     | _ => str loc (Int.toString cn)),
+                                                  st)
+                                               | ((_, cn, SOME t), st) =>
+                                                 let
+                                                     val (e, st) = quoteExp loc t ((ERel 0, loc), st)
+                                                 in
+                                                     (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
+                                                       case dk of
+                                                           Option =>
+                                                           if isNullable t then
+                                                               strcat loc [str loc "{v:",
+                                                                           e,
+                                                                           str loc "}"]
+                                                           else
+                                                               e
+                                                         | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
+                                                                                     ^ ",v:"),
+                                                                            e,
+                                                                            str loc "}"]),
+                                                      st)
+                                                 end)
+                                             st cs
+
+                         val s = (TFfi ("Basis", "string"), loc)
+                         val body = (ECase ((ERel 0, loc), pes,
+                                            {disc = t, result = s}), loc)
+                         val body = (EAbs ("x", t, s, body), loc)
+
+                         val st = {decls = ("jsify", n', (TFun (t, s), loc),
+                                            body, "jsify") :: #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   listInjectors = #listInjectors st,
+                                   decoders= #decoders st,
+                                   maxName = #maxName st}
+                     in
+                         ((EApp ((ENamed n', loc), e), loc), st)
+                     end)
+
+              | _ => (if !explainEmbed then
+                          Print.prefaces "Can't embed" [("loc", Print.PD.string (ErrorMsg.spanToString loc)),
+                                                        ("e", MonoPrint.p_exp MonoEnv.empty e),
+                                                        ("t", MonoPrint.p_typ MonoEnv.empty t)]
+                      else
+                          ();
+                      raise CantEmbed t)
+
+        fun unurlifyExp loc (t : typ, st) =
+            case #1 t of
+                TRecord [] => ("(i++,null)", st)
+              | TFfi ("Basis", "unit") => ("(i++,null)", st)
+              | TRecord [(x, t)] =>
+                let
+                    val (e, st) = unurlifyExp loc (t, st)
+                in
+                    ("{_" ^ x ^ ":" ^ e ^ "}",
+                     st)
+                end
+              | TRecord ((x, t) :: xts) =>
+                let
+                    val (e', st) = unurlifyExp loc (t, st)
+                    val (es, st) = ListUtil.foldlMap
+                                       (fn ((x, t), st) =>
+                                           let
+                                               val (e, st) = unurlifyExp loc (t, st)
+                                           in
+                                               (",_" ^ x ^ ":" ^ e, st)
+                                           end)
+                                       st xts
+                in
+                    (String.concat ("{_"
+                                    :: x
+                                    :: ":"
+                                    :: e'
+                                    :: es
+                                    @ ["}"]), st)
+                end
+
+              | TFfi ("Basis", "string") => ("uu(t[i++])", st)
+              | TFfi ("Basis", "char") => ("uu(t[i++])", st)
+              | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
+              | TFfi ("Basis", "time") => ("parseInt(t[i++])", st)
+              | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
+              | TFfi ("Basis", "channel") => ("(t[i++].length > 0 ? parseInt(t[i-1]) : null)", st)
+
+              | TFfi ("Basis", "bool") => ("t[i++] == \"1\"", st)
+
+              | TSource => ("parseSource(t[i++], t[i++])", st)
+
+              | TOption t =>
+                let
+                    val (e, st) = unurlifyExp loc (t, st)
+                    val e = if isNullable t then
+                                "{v:" ^ e ^ "}"
+                            else
+                                e
+                in
+                    ("(t[i++]==\"Some\"?" ^ e ^ ":null)", st)
+                end
+
+              | TList t =>
+                let
+                    val (e, st) = unurlifyExp loc (t, st)
+                in
+                    ("uul(function(){return t[i++];},function(){return " ^ e ^ "})", st)
+                end
+
+              | TDatatype (n, ref (dk, cs)) =>
+                (case IM.find (#decoders st, n) of
+                     SOME n' => ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
+                   | NONE =>
+                     let
+                         val n' = #maxName st
+                         val st = {decls = #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   listInjectors = #listInjectors st,
+                                   decoders = IM.insert (#decoders st, n, n'),
+                                   maxName = n' + 1}
+
+                         val (e, st) = foldl (fn ((x, cn, NONE), (e, st)) =>
+                                                 ("x==\"" ^ x ^ "\"?"
+                                                   ^ (case dk of
+                                                          Option => "null"
+                                                        | _ => Int.toString cn)
+                                                  ^ ":" ^ e,
+                                                  st)
+                                               | ((x, cn, SOME t), (e, st)) =>
+                                                 let
+                                                     val (e', st) = unurlifyExp loc (t, st)
+                                                 in
+                                                     ("x==\"" ^ x ^ "\"?"
+                                                       ^ (case dk of
+                                                              Option =>
+                                                              if isNullable t then
+                                                                  "{v:" ^ e' ^ "}"
+                                                              else
+                                                                  e'
+                                                            | _ => "{n:" ^ Int.toString cn ^ ",v:" ^ e' ^ "}")
+                                                      ^ ":" ^ e,
+                                                      st)
+                                                 end)
+                                             ("pf(\"" ^ ErrorMsg.spanToString loc ^ "\")", st) cs
+
+                         val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r="
+                                    ^ e ^ ";return {_1:i,_2:r}}\n\n"
+
+                         val st = {decls = #decls st,
+                                   script = body :: #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   listInjectors = #listInjectors st,
+                                   decoders = #decoders st,
+                                   maxName = #maxName st}
+                     in
+                         ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
+                     end)
+
+              | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript";
+                      Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)];
+                      ("ERROR", st))
+
+        fun padWith (ch, s, len) =
+            if size s < len then
+                padWith (ch, String.str ch ^ s, len - 1)
+            else
+                s
+
+        val foundJavaScript = ref false
+
+        fun jsExp mode outer =
+            let
+                val len = length outer
+
+                fun jsE inner (e as (_, loc), st) =
+                    let
+                        (*val () = Print.prefaces "jsExp" [("e", MonoPrint.p_exp MonoEnv.empty e),
+                                                         ("loc", Print.PD.string (ErrorMsg.spanToString loc))]*)
+
+                        val str = str loc
+
+                        fun patCon pc =
+                            case pc of
+                                PConVar n => str (Int.toString n)
+                              | PConFfi {mod = "Basis", con = "True", ...} => str "true"
+                              | PConFfi {mod = "Basis", con = "False", ...} => str "false"
+                              | PConFfi {con, ...} => str ("\"" ^ con ^ "\"")
+
+                        fun unsupported s =
+                            (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
+                             Print.preface ("Code", MonoPrint.p_exp MonoEnv.empty e);
+                             (str "ERROR", st))
+
+                        val strcat = strcat loc
+
+                        fun jsPrim p =
+                            let
+                                fun jsChar ch =
+                                    case ch of
+                                        #"'" =>
+                                        if mode = Attribute then
+                                            "\\047"
+                                        else
+                                            "'"
+                                      | #"\"" => "\\\""
+                                      | #"<" => "\\074"
+                                      | #"\\" => "\\\\"
+                                      | #"\n" => "\\n"
+                                      | #"\r" => "\\r"
+                                      | #"\t" => "\\t"
+                                      | ch =>
+                                        if Char.isPrint ch orelse ord ch >= 128 then
+                                            String.str ch
+                                        else
+                                            "\\" ^ padWith (#"0",
+                                                            Int.fmt StringCvt.OCT (ord ch),
+                                                            3)
+                            in
+                                case p of
+                                    Prim.String (_, s) =>
+                                    str ("\"" ^ String.translate jsChar s ^ "\"")
+                                  | Prim.Char ch => str ("\"" ^ jsChar ch ^ "\"")
+                                  | _ => str (Prim.toString p)
+                            end
+
+                        fun jsPat (p, _) =
+                            case p of
+                                PVar _ => str "{/*hoho*/c:\"v\"}"
+                              | PPrim p => strcat [str "{c:\"c\",v:",
+                                                   jsPrim p,
+                                                   str "}"]
+                              | PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE) =>
+                                str "{c:\"c\",v:true}"
+                              | PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE) =>
+                                str "{c:\"c\",v:false}"
+                              | PCon (Option, _, NONE) =>
+                                str "{c:\"c\",v:null}"
+                              | PCon (Option, PConVar n, SOME p) =>
+                                (case IM.find (someTs, n) of
+                                     NONE => raise Fail "Jscomp: Not in someTs"
+                                   | SOME t =>
+                                     strcat [str ("{c:\"s\",n:"
+                                                  ^ (if isNullable t then
+                                                         "true"
+                                                     else
+                                                         "false")
+                                                  ^ ",p:"),
+                                             jsPat p,
+                                             str "}"])
+                              | PCon (_, pc, NONE) => strcat [str "{c:\"c\",v:",
+                                                              patCon pc,
+                                                              str "}"]
+                              | PCon (_, pc, SOME p) => strcat [str "{c:\"1\",n:",
+                                                                patCon pc,
+                                                                str ",p:",
+                                                                jsPat p,
+                                                                str "}"]
+                              | PRecord xps => strcat [str "{c:\"r\",l:",
+                                                       foldr (fn ((x, p, _), e) =>
+                                                                 strcat [str ("cons({n:\"" ^ x ^ "\",p:"),
+                                                                         jsPat p,
+                                                                         str "},",
+                                                                         e,
+                                                                         str ")"])
+                                                             (str "null") xps,
+                                                       str "}"]
+                              | PNone _ => str "{c:\"c\",v:null}"
+                              | PSome (t, p) => strcat [str ("{c:\"s\",n:"
+                                                             ^ (if isNullable t then
+                                                                    "true"
+                                                                else
+                                                                    "false")
+                                                             ^ ",p:"),
+                                                        jsPat p,
+                                                        str "}"]
+
+                        val jsifyString = String.translate (fn #"\"" => "\\\""
+                                                             | #"\\" => "\\\\"
+                                                             | ch => String.str ch)
+
+                        fun jsifyStringMulti (n, s) =
+                            case n of
+                                0 => s
+                              | _ => jsifyStringMulti (n - 1, jsifyString s)
+
+                        fun deStrcat level (all as (e, loc)) =
+                            case e of
+                                EPrim (Prim.String (_, s)) => jsifyStringMulti (level, s)
+                              | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
+                              | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\""
+                              | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code";
+                                      Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
+                                      "")
+
+                        val quoteExp = quoteExp loc
+                    in
+                        (*Print.prefaces "jsE" [("e", MonoPrint.p_exp MonoEnv.empty e),
+                                              ("inner", Print.PD.string (Int.toString inner))];*)
+
+                        case #1 e of
+                            EPrim p => (strcat [str "{c:\"c\",v:",
+                                                jsPrim p,
+                                                str "}"],
+                                        st)
+                          | ERel n =>
+                            if n < inner then
+                                (str ("{c:\"v\",n:" ^ Int.toString n ^ "}"), st)
+                            else
+                                let
+                                    val n = n - inner
+                                    (*val () = Print.prefaces "quote" [("t", MonoPrint.p_typ MonoEnv.empty
+                                                                           (List.nth (outer, n)))]*)
+                                    val (e, st) = quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
+                                in
+                                    (strcat [str "{c:\"c\",v:",
+                                             e,
+                                             str "}"], st)
+                                end
+
+                          | ENamed n =>
+                            let
+                                val st =
+                                    if IS.member (#included st, n) then
+                                        st
+                                    else
+                                        case IM.find (nameds, n) of
+                                            NONE => raise Fail "Jscomp: Unbound ENamed"
+                                          | SOME e =>
+                                            let
+                                                val st = {decls = #decls st,
+                                                          script = #script st,
+                                                          included = IS.add (#included st, n),
+                                                          injectors = #injectors st,
+                                                          listInjectors = #listInjectors st,
+                                                          decoders = #decoders st,
+                                                          maxName = #maxName st}
+
+                                                val old = e
+                                                val (e, st) = jsExp mode [] (e, st)
+                                                val e = deStrcat 0 e
+                                                val e = String.translate (fn #"'" => "\\'"
+                                                                           | #"\\" => "\\\\"
+                                                                           | ch => String.str ch) e
+
+                                                val sc = "urfuncs[" ^ Int.toString n ^ "] = {c:\"t\",f:'"
+                                                         ^ e ^ "'};\n"
+                                            in
+                                                (*Print.prefaces "jsify'" [("old", MonoPrint.p_exp MonoEnv.empty old),
+                                                                         ("new", MonoPrint.p_exp MonoEnv.empty new)];*)
+                                                {decls = #decls st,
+                                                 script = sc :: #script st,
+                                                 included = #included st,
+                                                 injectors = #injectors st,
+                                                 listInjectors = #listInjectors st,
+                                                 decoders= #decoders st,
+                                                 maxName = #maxName st}
+                                            end
+                            in
+                                (str ("{c:\"n\",n:" ^ Int.toString n ^ "}"), st)
+                            end
+
+                          | ECon (Option, _, NONE) => (str "{c:\"c\",v:null}", st)
+                          | ECon (Option, PConVar n, SOME e) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                case IM.find (someTs, n) of
+                                    NONE => raise Fail "Jscomp: Not in someTs [2]"
+                                  | SOME t =>
+                                    (if isNullable t then
+                                         strcat [str "{c:\"s\",v:",
+                                                 e,
+                                                 str "}"]
+                                     else
+                                         e, st)
+                            end
+
+                          | ECon (_, pc, NONE) => (strcat [str "{c:\"c\",v:",
+                                                           patCon pc,
+                                                           str "}"],
+                                                   st)
+                          | ECon (_, pc, SOME e) =>
+                            let
+                                val (s, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"1\",n:",
+                                         patCon pc,
+                                         str ",v:",
+                                         s,
+                                         str "}"], st)
+                            end
+
+                          | ENone _ => (str "{c:\"c\",v:null}", st)
+                          | ESome (t, e) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (if isNullable t then
+                                     strcat [str "{c:\"s\",v:", e, str "}"]
+                                 else
+                                     e, st)
+                            end
+
+                          | EFfi k =>
+                            let
+                                val name = case Settings.jsFunc k of
+                                               NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k
+                                                                        ^ " in JavaScript");
+                                                        "ERROR")
+                                             | SOME s => s
+                            in
+                                (str ("{c:\"c\",v:" ^ name ^ "}"), st)
+                            end
+                          | EFfiApp ("Basis", "sigString", [_]) => (strcat [str "{c:\"c\",v:\"",
+                                                                            e,
+                                                                            str "\"}"], st)
+                          | EFfiApp (m, x, args) =>
+                            let
+                                val name = case Settings.jsFunc (m, x) of
+                                               NONE => (EM.errorAt loc ("Unsupported FFI function "
+                                                                        ^ m ^ "." ^ x ^ " in JavaScript");
+                                                        "ERROR")
+                                             | SOME s => s
+
+                                val (e, st) = foldr (fn ((e, _), (acc, st)) =>
+                                                        let
+                                                            val (e, st) = jsE inner (e, st)
+                                                        in
+                                                            (strcat [str "cons(",
+                                                                     e,
+                                                                     str ",",
+                                                                     acc,
+                                                                     str ")"],
+                                                             st)
+                                                        end)
+                                              (str "null", st) args
+                            in
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:"),
+                                         e,
+                                         str "}"],
+                                 st)
+                            end
+
+                          | EApp (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "{c:\"a\",f:",
+                                         e1,
+                                         str ",x:",
+                                         e2,
+                                         str "}"], st)
+                            end
+                          | EAbs (_, _, _, e) =>
+                            let
+                                val (e, st) = jsE (inner + 1) (e, st)
+                            in
+                                (strcat [str "{c:\"l\",b:",
+                                         e,
+                                         str "}"], st)
+                            end
+
+                          | EUnop (s, e) =>
+                            let
+                                val name = case s of
+                                               "!" => "not"
+                                             | "-" => "neg"
+                                             | _ => raise Fail ("Jscomp: Unknown unary operator " ^ s)
+
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:cons("),
+                                         e,
+                                         str ",null)}"],
+                                 st)
+                            end
+                          | EBinop (bi, s, e1, e2) =>
+                            let
+                                val name = case s of
+                                               "==" => "eq"
+                                             | "!strcmp" => "eq"
+                                             | "+" => "plus"
+                                             | "-" => "minus"
+                                             | "*" => "times"
+                                             | "/" => (case bi of Int => "divInt" | NotInt => "div")
+                                             | "%" => (case bi of Int => "modInt" | NotInt => "mod")
+                                             | "fdiv" => "div"
+                                             | "fmod" => "mod"
+                                             | "<" => "lt"
+                                             | "<=" => "le"
+                                             | "strcmp" => "strcmp"
+                                             | "powl" => "pow"
+                                             | "powf" => "pow"
+                                             | _ => raise Fail ("Jscomp: Unknown binary operator " ^ s)
+
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:cons("),
+                                         e1,
+                                         str ",cons(",
+                                         e2,
+                                         str ",null))}"],
+                                 st)
+                            end
+
+                          | ERecord [] => (str "{c:\"c\",v:null}", st)
+                          | ERecord xes =>
+                            let
+                                val (es, st) =
+                                    foldr (fn ((x, e, _), (es, st)) =>
+                                              let
+                                                  val (e, st) = jsE inner (e, st)
+                                              in
+                                                  (strcat [str ("cons({n:\"" ^ x ^ "\",v:"),
+                                                           e,
+                                                           str "},",
+                                                           es,
+                                                           str ")"],
+                                                   st)
+                                              end)
+                                          (str "null", st) xes
+                            in
+                                (strcat [str "{c:\"r\",l:",
+                                         es,
+                                         str "}"],
+                                 st)
+                            end
+                          | EField (e', x) =>
+                            let
+                                fun default () =
+                                    let
+                                        val (e', st) = jsE inner (e', st)
+                                    in
+                                        (strcat [str "{c:\".\",r:",
+                                                 e',
+                                                 str (",f:\"" ^ x ^ "\"}")], st)
+                                    end
+
+                                fun seek (e, xs) =
+                                    case #1 e of
+                                        ERel n =>
+                                        if n < inner then
+                                            default ()
+                                        else
+                                            let
+                                                val n = n - inner
+                                                val t = List.nth (outer, n)
+                                                val t = foldl (fn (x, (TRecord xts, _)) =>
+                                                                  (case List.find (fn (x', _) => x' = x) xts of
+                                                                       NONE => raise Fail "Jscomp: Bad seek [1]"
+                                                                     | SOME (_, t) => t)
+                                                                | _ => raise Fail "Jscomp: Bad seek [2]")
+                                                              t xs
+
+                                                val e = (ERel n, loc)
+                                                val e = foldl (fn (x, e) => (EField (e, x), loc)) e xs
+                                                val (e, st) = quoteExp t (e, st)
+                                            in
+                                                (strcat [str "{c:\"c\",v:",
+                                                         e,
+                                                         str "}"],
+                                                 st)
+                                            end
+                                      | EField (e', x) => seek (e', x :: xs)
+                                      | _ => default ()
+                            in
+                                seek (e', [x])
+                            end
+
+                          | ECase (e', pes, _) =>
+                            let
+                                val (e', st) = jsE inner (e', st)
+
+                                val (ps, st) =
+                                    foldr (fn ((p, e), (ps, st)) =>
+                                              let
+                                                  val (e, st) = jsE (inner + E.patBindsN p) (e, st)
+                                              in
+                                                  (strcat [str "cons({p:",
+                                                           jsPat p,
+                                                           str ",b:",
+                                                           e,
+                                                           str "},",
+                                                           ps,
+                                                           str ")"],
+                                                   st)
+                                              end)
+                                          (str "null", st) pes
+                            in
+                                (strcat [str "{c:\"m\",e:",
+                                         e',
+                                         str ",p:",
+                                         ps,
+                                         str "}"], st)
+                            end
+
+                          | EStrcat (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "{c:\"f\",f:cat,a:cons(", e1, str ",cons(", e2, str ",null))}"], st)
+                            end
+
+                          | EError (e, _) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:er,a:cons(", e, str ",null)}"],
+                                 st)
+                            end
+
+                          | ESeq (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "{c:\";\",e1:", e1, str ",e2:", e2, str "}"], st)
+                            end
+                          | ELet (_, _, e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE (inner + 1) (e2, st)
+                            in
+                                (strcat [str "{c:\"=\",e1:",
+                                         e1,
+                                         str ",e2:",
+                                         e2,
+                                         str "}"], st)
+                            end
+
+                          | EJavaScript (Source _, e) =>
+                            (foundJavaScript := true;
+                             jsE inner (e, st))
+                          | EJavaScript (_, e) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                foundJavaScript := true;
+                                (strcat [str "{c:\"e\",e:",
+                                         e,
+                                         str "}"],
+                                 st)
+                            end
+
+                          | EWrite _ => unsupported "EWrite"
+                          | EClosure _ => unsupported "EClosure"
+                          | EQuery _ => unsupported "Query"
+                          | EDml _ => unsupported "DML"
+                          | ENextval _ => unsupported "Nextval"
+                          | ESetval _ => unsupported "Nextval"
+                          | EReturnBlob _ => unsupported "EReturnBlob"
+
+                          | ERedirect (e, _) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:redirect,a:cons(",
+                                         e,
+                                         str ",null)}"],
+                                 st)
+                            end
+
+                          | EUnurlify (_, _, true) => unsupported "EUnurlify"
+
+                          | EUnurlify (e, t, false) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                                val (e', st) = unurlifyExp loc (t, st)
+                            in
+                                (strcat [str ("{c:\"f\",f:unurlify,a:cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ e' ^ "}},cons("),
+                                         e,
+                                         str ",null))}"],
+                                 st)
+                            end
+
+                          | ESignalReturn e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:sr,a:cons(",
+                                         e,
+                                         str ",null)}"],
+                                 st)
+                            end
+                          | ESignalBind (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "{c:\"f\",f:sb,a:cons(",
+                                         e1,
+                                         str ",cons(",
+                                         e2,
+                                         str ",null))}"],
+                                 st)
+                            end
+                          | ESignalSource e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:ss,a:cons(",
+                                         e,
+                                         str ",null)}"],
+                                 st)
+                            end
+
+                          | EServerCall (e, t, eff, fm) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                                val (unurl, st) = unurlifyExp loc (t, st)
+                                val lastArg = case fm of
+                                                  None => "null"
+                                                | Error =>
+                                                  let
+                                                      val isN = if isNullable t then
+                                                                    "true"
+                                                                else
+                                                                    "false"
+                                                  in
+                                                    "cons({c:\"c\",v:" ^ isN ^ "},null)"
+                                                  end
+                            in
+                                (strcat [str ("{c:\"f\",f:rc,a:cons({c:\"c\",v:\""
+                                              ^ Settings.getUrlPrefix ()
+                                              ^ "\"},cons("),
+                                         e,
+                                         str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ unurl ^ "}},cons({c:\"K\"},cons({c:\"c\",v:"
+                                              ^ (case eff of
+                                                     ReadCookieWrite => "true"
+                                                   | _ => "false")
+                                              ^ "}," ^ lastArg ^ ")))))}")],
+                                 st)
+                            end
+
+                          | ERecv (e, t) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                                val (unurl, st) = unurlifyExp loc (t, st)
+                            in
+                                (strcat [str ("{c:\"f\",f:rv,a:cons("),
+                                         e,
+                                         str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ unurl ^ "}},cons({c:\"K\"},null)))}")],
+                                 st)
+                            end
+
+                          | ESleep e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:sl,a:cons(",
+                                         e,
+                                         str ",cons({c:\"K\"},null))}"],
+                                 st)
+                            end
+
+                          | ESpawn e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{c:\"f\",f:sp,a:cons(",
+                                         e,
+                                         str ",null)}"],
+                                 st)
+                            end
+                    end
+            in
+                jsE 0
+            end
+
+        fun patBinds ((p, _), env) =
+            case p of
+                PVar (_, t) => t :: env
+              | PPrim _ => env
+              | PCon (_, _, NONE) => env
+              | PCon (_, _, SOME p) => patBinds (p, env)
+              | PRecord xpts => foldl (fn ((_, p, _), env) => patBinds (p, env)) env xpts
+              | PNone _ => env
+              | PSome (_, p) => patBinds (p, env)
+
+        fun exp outer (e as (_, loc), st) =
+            ((*Print.preface ("exp", MonoPrint.p_exp MonoEnv.empty e);*)
+             case #1 e of
+                 EPrim p =>
+                 (case p of
+                      Prim.String (_, s) => if inString {needle = "<script", haystack = s} then
+                                                foundJavaScript := true
+                                            else
+                                                ()
+                    | _ => ();
+                  (e, st))
+               | ERel _ => (e, st)
+               | ENamed _ => (e, st)
+               | ECon (_, _, NONE) => (e, st)
+               | ECon (dk, pc, SOME e) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((ECon (dk, pc, SOME e), loc), st)
+                 end
+               | ENone _ => (e, st)
+               | ESome (t, e) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((ESome (t, e), loc), st)
+                 end
+               | EFfi _ => (e, st)
+               | EFfiApp (m, x, es) =>
+                 let
+                     val (es, st) = ListUtil.foldlMap (fn ((e, t), st) =>
+                                                          let
+                                                              val (e, st) = exp outer (e, st)
+                                                          in
+                                                              ((e, t), st)
+                                                          end) st es
+                 in
+                     ((EFfiApp (m, x, es), loc), st)
+                 end
+               | EApp (e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((EApp (e1, e2), loc), st)
+                 end
+               | EAbs (x, dom, ran, e) =>
+                 let
+                     val (e, st) = exp (dom :: outer) (e, st)
+                 in
+                     ((EAbs (x, dom, ran, e), loc), st)
+                 end
+
+               | EUnop (s, e) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EUnop (s, e), loc), st)
+                 end
+               | EBinop (bi, s, e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((EBinop (bi, s, e1, e2), loc), st)
+                 end
+
+               | ERecord xets =>
+                 let
+                     val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) =>
+                                                            let
+                                                                val (e, st) = exp outer (e, st)
+                                                            in
+                                                                ((x, e, t), st)
+                                                            end) st xets
+                 in
+                     ((ERecord xets, loc), st)
+                 end
+               | EField (e, s) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EField (e, s), loc), st)
+                 end
+
+               | ECase (e, pes, ts) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                     val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
+                                                           let
+                                                               val (e, st) = exp (patBinds (p, outer)) (e, st)
+                                                           in
+                                                               ((p, e), st)
+                                                           end) st pes
+                 in
+                     ((ECase (e, pes, ts), loc), st)
+                 end
+
+               | EStrcat (e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((EStrcat (e1, e2), loc), st)
+                 end
+
+               | EError (e, t) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EError (e, t), loc), st)
+                 end
+               | EReturnBlob {blob = NONE, mimeType, t} =>
+                 let
+                     val (mimeType, st) = exp outer (mimeType, st)
+                 in
+                     ((EReturnBlob {blob = NONE, mimeType = mimeType, t = t}, loc), st)
+                 end
+               | EReturnBlob {blob = SOME blob, mimeType, t} =>
+                 let
+                     val (blob, st) = exp outer (blob, st)
+                     val (mimeType, st) = exp outer (mimeType, st)
+                 in
+                     ((EReturnBlob {blob = SOME blob, mimeType = mimeType, t = t}, loc), st)
+                 end
+               | ERedirect (e, t) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((ERedirect (e, t), loc), st)
+                 end
+
+               | EWrite e =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EWrite e, loc), st)
+                 end
+               | ESeq (e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((ESeq (e1, e2), loc), st)
+                 end
+               | ELet (x, t, e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp (t :: outer) (e2, st)
+                 in
+                     ((ELet (x, t, e1, e2), loc), st)
+                 end
+
+               | EClosure (n, es) =>
+                 let
+                     val (es, st) = ListUtil.foldlMap (exp outer) st es
+                 in
+                     ((EClosure (n, es), loc), st)
+                 end
+
+               | EQuery {exps, tables, state, query, body, initial} =>
+                 let
+                     val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables
+                     val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row
+                     val row = (TRecord row, loc)
+
+                     val (query, st) = exp outer (query, st)
+                     val (body, st) = exp (state :: row :: outer) (body, st)
+                     val (initial, st) = exp outer (initial, st)
+                 in
+                     ((EQuery {exps = exps, tables = tables, state = state,
+                               query = query, body = body, initial = initial}, loc), st)
+                 end
+               | EDml (e, mode) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EDml (e, mode), loc), st)
+                 end
+               | ENextval e =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 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, b) =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((EUnurlify (e, t, b), loc), st)
+                 end
+
+               | EJavaScript (m as Source t, e') =>
+                 (foundJavaScript := true;
+                  let
+                      val (x', st) = jsExp m (t :: outer) ((ERel 0, loc), st)
+                  in
+                      ((ELet ("x", t, e', x'), loc), st)
+                  end
+                  handle CantEmbed _ =>
+                         (jsExp m outer (e', st)
+                          handle CantEmbed t => ((*ErrorMsg.errorAt loc "Unable to embed type in JavaScript";
+                                                  Print.preface ("Type",
+                                                                 MonoPrint.p_typ MonoEnv.empty t);*)
+                                                 (e, st))))
+
+               | EJavaScript (m, e') =>
+                 (foundJavaScript := true;
+                  jsExp m outer (e', st)
+                  handle CantEmbed t => ((*ErrorMsg.errorAt loc "Unable to embed type in JavaScript";
+                                         Print.preface ("Type",
+                                                        MonoPrint.p_typ MonoEnv.empty t);*)
+                                         (e, st)))
+
+               | ESignalReturn e =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((ESignalReturn e, loc), st)
+                 end
+               | ESignalBind (e1, e2) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                     val (e2, st) = exp outer (e2, st)
+                 in
+                     ((ESignalBind (e1, e2), loc), st)
+                 end
+               | ESignalSource e =>
+                 let
+                     val (e, st) = exp outer (e, st)
+                 in
+                     ((ESignalSource e, loc), st)
+                 end
+
+               | EServerCall (e1, t, ef, fm) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                 in
+                     ((EServerCall (e1, t, ef, fm), loc), st)
+                 end
+               | ERecv (e1, t) =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                 in
+                     ((ERecv (e1, t), loc), st)
+                 end
+               | ESleep e1 =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                 in
+                     ((ESleep e1, loc), st)
+                 end
+               | ESpawn e1 =>
+                 let
+                     val (e1, st) = exp outer (e1, st)
+                 in
+                     ((ESpawn e1, loc), st)
+                 end)
+
+        fun decl (d as (_, loc), st) =
+            case #1 d of
+                DVal (x, n, t, e, s) =>
+                let
+                    val (e, st) = exp [] (e, st)
+                in
+                    ((DVal (x, n, t, e, s), loc), st)
+                end
+              | DValRec vis =>
+                let
+                    val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>
+                                                          let
+                                                              val (e, st) = exp [] (e, st)
+                                                          in
+                                                              ((x, n, t, e, s), st)
+                                                          end) st vis
+                in
+                    ((DValRec vis, loc), st)
+                end
+              | _ => (d, st)
+
+        fun doDecl (d, st) =
+            let
+                (*val () = Print.preface ("doDecl", MonoPrint.p_decl MonoEnv.empty d)*)
+                val (d, st) = decl (d, st)
+
+                val ds =
+                    case #decls st of
+                        [] => [d]
+                      | vis => [(DValRec vis, #2 d), d]
+            in
+                (ds,
+                 {decls = [],
+                  script = #script st,
+                  included = #included st,
+                  injectors = #injectors st,
+                  listInjectors = #listInjectors st,
+                  decoders = #decoders st,
+                  maxName = #maxName st})
+            end
+
+        val (ds, st) = ListUtil.foldlMapConcat doDecl
+                       {decls = [],
+                        script = [],
+                        included = IS.empty,
+                        injectors = IM.empty,
+                        listInjectors = TM.empty,
+                        decoders = IM.empty,
+                        maxName = U.File.maxName file + 1}
+                       (#1 file)
+
+        val inf = FileIO.txtOpenIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
+        fun lines acc =
+            case TextIO.inputLine inf of
+                NONE => String.concat (rev acc)
+              | SOME line => lines (line :: acc)
+        val lines = lines []
+
+        val urlRules = foldr (fn (r, s) =>
+                                 "cons({allow:"
+                                 ^ (if #action r = Settings.Allow then "true" else "false")
+                                 ^ ",prefix:"
+                                 ^ (if #kind r = Settings.Prefix then "true" else "false")
+                                 ^ ",pattern:\""
+                                 ^ #pattern r
+                                 ^ "\"},"
+                                 ^ s
+                                 ^ ")") "null" (Settings.getUrlRules ())
+
+        val urlRules = "urlRules = " ^ urlRules ^ ";\n\n"
+
+        val script =
+            if !foundJavaScript then
+                String.concatWith "" ((lines ^ urlRules ^ String.concat (rev (#script st))
+                                       ^ "\ntime_format = \"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\";\n")
+                                      :: map (fn r => "\n// " ^ #Filename r ^ "\n\n" ^ #Content r ^ "\n") (Settings.listJsFiles ()))
+            else
+                ""
+    in
+        TextIO.closeIn inf;
+        ((DJavaScript script, ErrorMsg.dummySpan) :: ds, #2 file)
+    end
+
+end
diff --git a/src/list_key_fn.sml b/src/list_key_fn.sml
new file mode 100644
index 0000000..ec2bd26
--- /dev/null
+++ b/src/list_key_fn.sml
@@ -0,0 +1,14 @@
+functor ListKeyFn(K : ORD_KEY)
+        : ORD_KEY where type ord_key = K.ord_key list = struct
+
+type ord_key = K.ord_key list
+
+val rec compare =
+ fn ([], []) => EQUAL
+  | ([], _) => LESS
+  | (_, []) => GREATER
+  | (x::xs, y::ys) => case K.compare (x, y) of
+                              EQUAL => compare (xs, ys)
+                            | ord => ord
+
+end
diff --git a/src/list_util.sig b/src/list_util.sig
new file mode 100644
index 0000000..6e1cd5a
--- /dev/null
+++ b/src/list_util.sig
@@ -0,0 +1,59 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature LIST_UTIL = sig
+
+    val mapConcat : ('a -> 'b list) -> 'a list -> 'b list
+
+    val mapfold : ('data, 'state, 'abort) Search.mapfolder
+                  -> ('data list, 'state, 'abort) Search.mapfolder
+    val mapfoldB : ('context * 'data -> 'context * ('state -> ('data * 'state, 'abort) Search.result))
+                   -> ('context, 'data list, 'state, 'abort) Search.mapfolderB
+
+    val foldlMap : ('data1 * 'state -> 'data2 * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
+    val foldlMapPartial : ('data1 * 'state -> 'data2 option * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
+    val foldlMapiPartial : (int * 'data1 * 'state -> 'data2 option * 'state)
+                           -> 'state -> 'data1 list -> 'data2 list * 'state
+    val foldlMapConcat : ('data1 * 'state -> 'data2 list * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
+    val foldlMapAbort : ('data1 * 'state -> ('data2 * 'state) option)
+                        -> 'state -> 'data1 list -> ('data2 list * 'state) option
+
+    val search : ('a -> 'b option) -> 'a list -> 'b option
+    val searchi : (int * 'a -> 'b option) -> 'a list -> 'b option
+
+    val mapi : (int * 'a -> 'b) -> 'a list -> 'b list
+    val mapiPartial : (int * 'a -> 'b option) -> 'a list -> 'b list
+    val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
+    val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
+
+    val foldliMap : (int * 'data1 * 'state -> 'data2 * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
+
+    val appi : (int * 'a -> unit) -> 'a list -> unit
+
+    val appn : (int -> unit) -> int -> unit
+
+end
diff --git a/src/list_util.sml b/src/list_util.sml
new file mode 100644
index 0000000..03c9549
--- /dev/null
+++ b/src/list_util.sml
@@ -0,0 +1,260 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ListUtil :> LIST_UTIL = struct
+
+structure S = Search
+
+fun mapConcat f =
+    let
+        fun mc acc ls =
+            case ls of
+                [] => rev acc
+              | h :: t => mc (List.revAppend (f h, acc)) t
+    in
+        mc []
+    end
+
+fun mapfold f =
+    let
+        fun mf ls s =
+            case ls of
+                nil => S.Continue (nil, s)
+              | h :: t =>
+                case f h s of
+                    S.Return x => S.Return x
+                  | S.Continue (h', s) =>
+                    case mf t s of
+                        S.Return x => S.Return x
+                      | S.Continue (t', s) => S.Continue (h' :: t', s)
+    in
+        mf
+    end
+
+fun mapfoldB f =
+    let
+        fun mf ctx ls s =
+            case ls of
+                nil => S.Continue (nil, s)
+              | h :: t =>
+                let
+                    val (ctx, r) = f (ctx, h)
+                in
+                    case r s of
+                        S.Return x => S.Return x
+                      | S.Continue (h', s) =>
+                        case mf ctx t s of
+                            S.Return x => S.Return x
+                          | S.Continue (t', s) => S.Continue (h' :: t', s)
+                end
+    in
+        mf
+    end
+
+fun foldlMap f s =
+    let
+        fun fm (ls', s) ls =
+            case ls of
+                nil => (rev ls', s)
+              | h :: t =>
+                let
+                    val (h', s') = f (h, s)
+                in
+                    fm (h' :: ls', s') t
+                end
+    in
+        fm ([], s)
+    end
+
+fun foldlMapConcat f s =
+    let
+        fun fm (ls', s) ls =
+            case ls of
+                nil => (rev ls', s)
+              | h :: t =>
+                let
+                    val (h', s') = f (h, s)
+                in
+                    fm (List.revAppend (h', ls'), s') t
+                end
+    in
+        fm ([], s)
+    end
+
+fun foldlMapPartial f s =
+    let
+        fun fm (ls', s) ls =
+            case ls of
+                nil => (rev ls', s)
+              | h :: t =>
+                let
+                    val (h', s') = f (h, s)
+                    val ls' = case h' of
+                                  NONE => ls'
+                                | SOME h' => h' :: ls'
+                in
+                    fm (ls', s') t
+                end
+    in
+        fm ([], s)
+    end
+
+fun foldlMapiPartial f s =
+    let
+        fun fm (n, ls', s) ls =
+            case ls of
+                nil => (rev ls', s)
+              | h :: t =>
+                let
+                    val (h', s') = f (n, h, s)
+                    val ls' = case h' of
+                                  NONE => ls'
+                                | SOME h' => h' :: ls'
+                in
+                    fm (n + 1, ls', s') t
+                end
+    in
+        fm (0, [], s)
+    end
+
+fun foldlMapAbort f s =
+    let
+        fun fm (ls', s) ls =
+            case ls of
+                nil => SOME (rev ls', s)
+              | h :: t =>
+                case f (h, s) of
+                    NONE => NONE
+                  | SOME (h', s') => fm (h' :: ls', s') t
+    in
+        fm ([], s)
+    end
+
+fun search f =
+    let
+        fun s ls =
+            case ls of
+                [] => NONE
+              | h :: t =>
+                case f h of
+                    NONE => s t
+                  | v => v
+    in
+        s
+    end
+
+fun searchi f =
+    let
+        fun s n ls =
+            case ls of
+                [] => NONE
+              | h :: t =>
+                case f (n, h) of
+                    NONE => s (n + 1) t
+                  | v => v
+    in
+        s 0
+    end
+
+fun mapi f =
+    let
+        fun m i acc ls =
+            case ls of
+                [] => rev acc
+              | h :: t => m (i + 1) (f (i, h) :: acc) t
+    in
+        m 0 []
+    end
+
+fun mapiPartial f =
+    let
+        fun m i acc ls =
+            case ls of
+                [] => rev acc
+              | h :: t =>
+                m (i + 1) (case f (i, h) of
+                               NONE => acc
+                             | SOME v => v :: acc) t
+    in
+        m 0 []
+    end
+
+fun appi f =
+    let
+        fun m i ls =
+            case ls of
+                [] => ()
+              | h :: t => (f (i, h); m (i + 1) t)
+    in
+        m 0
+    end
+
+fun foldli f =
+    let
+        fun m i acc ls =
+            case ls of
+                [] => acc
+              | h :: t => m (i + 1) (f (i, h, acc)) t
+    in
+        m 0
+    end
+
+fun foldri f i ls =
+    let
+        val len = length ls
+    in
+        foldli (fn (n, x, s) => f (len - n - 1, x, s)) i (rev ls)
+    end
+
+fun foldliMap f s =
+    let
+        fun fm (n, ls', s) ls =
+            case ls of
+                nil => (rev ls', s)
+              | h :: t =>
+                let
+                    val (h', s') = f (n, h, s)
+                in
+                    fm (n + 1, h' :: ls', s') t
+                end
+    in
+        fm (0, [], s)
+    end
+
+fun appn f n =
+    let
+        fun iter m =
+            if m >= n then
+                ()
+            else
+                (f m;
+                 iter (m + 1))
+    in
+        iter 0
+    end
+
+end
diff --git a/src/lru_cache.sml b/src/lru_cache.sml
new file mode 100644
index 0000000..f582bf6
--- /dev/null
+++ b/src/lru_cache.sml
@@ -0,0 +1,207 @@
+structure LruCache : sig
+    val cache : Cache.cache
+end = struct
+
+
+(* Mono *)
+
+open Mono
+
+val dummyLoc = ErrorMsg.dummySpan
+val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
+val optionStringTyp = (TOption stringTyp, dummyLoc)
+fun withTyp typ = map (fn exp => (exp, typ))
+
+fun ffiAppCache' (func, index, argTyps) =
+    EFfiApp ("Sqlcache", func ^ Int.toString index, argTyps)
+
+fun check (index, keys) =
+    ffiAppCache' ("check", index, withTyp stringTyp keys)
+
+fun store (index, keys, value) =
+    ffiAppCache' ("store", index, (value, stringTyp) :: withTyp stringTyp keys)
+
+fun flush (index, keys) =
+    ffiAppCache' ("flush", index, withTyp optionStringTyp keys)
+
+fun lock (index, write) =
+    ffiAppCache' ((if write then "w" else "r") ^ "lock", index, [])
+
+
+(* Cjr *)
+
+open Print
+open Print.PD
+
+fun setupQuery {index, params} =
+    let
+
+        val i = Int.toString index
+
+        fun paramRepeat itemi sep =
+            let
+                fun f n =
+                    if n < 0 then ""
+                    else if n = 0 then itemi (Int.toString 0)
+                    else f (n-1) ^ sep ^ itemi (Int.toString n)
+            in
+                f (params - 1)
+            end
+
+        fun paramRepeatRev itemi sep =
+            let
+                fun f n =
+                    if n < 0 then ""
+                    else if n = 0 then itemi (Int.toString 0)
+                    else itemi (Int.toString n) ^ sep ^ f (n-1)
+            in
+                f (params - 1)
+            end
+
+        fun paramRepeatInit itemi sep =
+            if params = 0 then "" else sep ^ paramRepeat itemi sep
+
+        val typedArgs = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", "
+
+        val revArgs = paramRepeatRev (fn p => "p" ^ p) ", "
+
+        val argNums = List.tabulate (params, fn i => "p" ^ Int.toString i)
+    in
+        Print.box
+            [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"),
+             newline,
+             string "  .lockIn = PTHREAD_RWLOCK_INITIALIZER,",
+             newline,
+             string "  .lockOut = PTHREAD_RWLOCK_INITIALIZER,",
+             newline,
+             string "  .table = NULL,",
+             newline,
+             string ("  .numKeys = " ^ Int.toString params ^ ","),
+             newline,
+             string "  .timeInvalid = 0,",
+             newline,
+             string "  .timeNow = 0};",
+             newline,
+             string ("static uw_Sqlcache_Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"),
+             newline,
+             newline,
+
+             string ("static void uw_Sqlcache_rlock" ^ i ^ "(uw_context ctx) {"),
+             newline,
+             string ("  uw_Sqlcache_rlock(ctx, cache" ^ i ^ ");"),
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string ("static void uw_Sqlcache_wlock" ^ i ^ "(uw_context ctx) {"),
+             newline,
+             string ("  uw_Sqlcache_wlock(ctx, cache" ^ i ^ ");"),
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string ("static uw_Basis_string uw_Sqlcache_check" ^ i),
+             string ("(uw_context ctx" ^ typedArgs ^ ") {"),
+             newline,
+             string ("  char *ks[] = {" ^ revArgs ^ "};"),
+             newline,
+             string ("  uw_Sqlcache_Value *v = uw_Sqlcache_check(ctx, cache" ^ i ^ ", ks);"),
+             newline,
+             (* If the output is null, it means we had too much recursion, so it's a miss. *)
+             string "  if (v && v->output != NULL) {",
+             newline,
+             (*string ("    puts(\"SQLCACHE: hit " ^ i ^ ".\");"),
+             newline,*)
+             string "    uw_write(ctx, v->output);",
+             newline,
+             string "    uw_write_script(ctx, v->scriptOutput);",
+             newline,
+             string "    return v->result;",
+             newline,
+             string "  } else {",
+             newline,
+             (*string ("    printf(\"SQLCACHE: miss " ^ i ^ " " ^ String.concatWith ", " (List.tabulate (params, fn _ => "%s")) ^ ".\\n\""),
+             (case argNums of
+                  [] => Print.box []
+                 | _ => Print.box [string ", ",
+                                   p_list string argNums]),
+             string ");",
+             newline,*)
+             string "    uw_recordingStart(ctx);",
+             newline,
+             string "    return NULL;",
+             newline,
+             string "  }",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string ("static uw_unit uw_Sqlcache_store" ^ i),
+             string ("(uw_context ctx, uw_Basis_string s" ^ typedArgs ^ ") {"),
+             newline,
+             string ("  char *ks[] = {" ^ revArgs ^ "};"),
+             newline,
+             string ("  uw_Sqlcache_Value *v = malloc(sizeof(uw_Sqlcache_Value));"),
+             newline,
+             string "  v->result = strdup(s);",
+             newline,
+             string "  v->output = uw_recordingRead(ctx);",
+             newline,
+             string "  v->scriptOutput = uw_recordingReadScript(ctx);",
+             newline,
+             (*string ("  puts(\"SQLCACHE: stored " ^ i ^ ".\");"),
+             newline,*)
+             string ("  uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"),
+             newline,
+             string "  return uw_unit_v;",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string ("static uw_unit uw_Sqlcache_flush" ^ i),
+             string ("(uw_context ctx" ^ typedArgs ^ ") {"),
+             newline,
+             string ("  char *ks[] = {" ^ revArgs ^ "};"),
+             newline,
+             string ("  uw_Sqlcache_flush(ctx, cache" ^ i ^ ", ks);"),
+             newline,
+             (*string ("  puts(\"SQLCACHE: flushed " ^ i ^ ".\");"),
+             newline,*)
+             string "  return uw_unit_v;",
+             newline,
+             string "}",
+             newline,
+             newline]
+    end
+
+val setupGlobal = string "/* No global setup for LRU cache. */"
+
+
+(* Bundled up. *)
+
+(* For now, use the toy implementation if there are no arguments. *)
+fun toyIfNoKeys numKeys implLru implToy args =
+    if numKeys args = 0
+    then implToy args
+    else implLru args
+
+val cache =
+    (* let *)
+    (*     val {check = toyCheck, *)
+    (*          store = toyStore, *)
+    (*          flush = toyFlush, *)
+    (*          setupQuery = toySetupQuery, *)
+    (*          ...} = ToyCache.cache *)
+    (* in *)
+        (* {check = toyIfNoKeys (length o #2) check toyCheck, *)
+        (*  store = toyIfNoKeys (length o #2) store toyStore, *)
+        (*  flush = toyIfNoKeys (length o #2) flush toyFlush, *)
+    {check = check, store = store, flush = flush, lock = lock,
+     setupQuery = setupQuery, setupGlobal = setupGlobal}
+    (* end *)
+
+end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
new file mode 100644
index 0000000..2caa43f
--- /dev/null
+++ b/src/main.mlton.sml
@@ -0,0 +1,383 @@
+(* Copyright (c) 2008-2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+val socket = ".urweb_daemon"
+
+(* Encapsulate main invocation handler in a function, possibly to be called multiple times within a daemon. *)
+
+exception Code of OS.Process.status
+
+fun oneRun args =
+    let
+        val timing = ref false
+        val tc = ref false
+        val sources = ref ([] : string list)
+        val demo = ref (NONE : (string * bool) option)
+        val tutorial = ref false
+        val css = ref false
+
+        val () = (Compiler.debug := false;
+                  Elaborate.verbose := false;
+                  Elaborate.dumpTypes := false;
+                  Elaborate.dumpTypesOnError := false;
+                  Elaborate.unifyMore := false;
+                  Compiler.dumpSource := false;
+                  Compiler.doIflow := false;
+                  Demo.noEmacs := false;
+                  Settings.setDebug false)
+
+        val () = Compiler.beforeC := MLton.GC.pack
+
+        fun printVersion () = (print (Config.versionString ^ "\n");
+		               raise Code OS.Process.success)
+        fun printNumericVersion () = (print (Config.versionNumber ^ "\n");
+			              raise Code OS.Process.success)
+        fun printCCompiler () = (print (Settings.getCCompiler () ^ "\n");
+			         raise Code OS.Process.success)
+        fun printCInclude () = (print (Config.includ ^ "\n");
+			        raise Code OS.Process.success)
+
+        fun doArgs args =
+            case args of
+                [] => ()
+              | "-version" :: rest =>
+                  printVersion ()
+              | "-numeric-version" :: rest =>
+                  printNumericVersion ()
+              | "-css" :: rest =>
+                (css := true;
+                 doArgs rest)
+              | "-print-ccompiler" :: rest =>
+                  printCCompiler ()
+              | "-print-cinclude" :: rest =>
+                  printCInclude ()
+              | "-ccompiler" :: ccomp :: rest =>
+                (Settings.setCCompiler ccomp;
+                 doArgs rest)
+              | "-demo" :: prefix :: rest =>
+                (demo := SOME (prefix, false);
+                 doArgs rest)
+              | "-guided-demo" :: prefix :: rest =>
+                (demo := SOME (prefix, true);
+                 doArgs rest)
+              | "-tutorial" :: rest =>
+                (tutorial := true;
+                 doArgs rest)
+              | "-protocol" :: name :: rest =>
+                (Settings.setProtocol name;
+                 doArgs rest)
+              | "-prefix" :: prefix :: rest =>
+                (Settings.setUrlPrefix prefix;
+                 doArgs rest)
+              | "-db" :: s :: rest =>
+                (Settings.setDbstring (SOME s);
+                 doArgs rest)
+              | "-dbms" :: name :: rest =>
+                (Settings.setDbms name;
+                 doArgs rest)
+              | "-debug" :: rest =>
+                (Settings.setDebug true;
+                 doArgs rest)
+              | "-verbose" :: rest =>
+                (Compiler.debug := true;
+                 Elaborate.verbose := true;
+                 doArgs rest)
+              | "-timing" :: rest =>
+                (timing := true;
+                 doArgs rest)
+              | "-tc" :: rest =>
+                (tc := true;
+                 doArgs rest)
+              | "-dumpTypes" :: rest =>
+                (Elaborate.dumpTypes := true;
+                 doArgs rest)
+              | "-dumpTypesOnError" :: rest =>
+                (Elaborate.dumpTypesOnError := true;
+                 doArgs rest)
+              | "-unifyMore" :: rest =>
+                (Elaborate.unifyMore := true;
+                 doArgs rest)
+              | "-dumpSource" :: rest =>
+                (Compiler.dumpSource := true;
+                 doArgs rest)
+              | "-dumpVerboseSource" :: rest =>
+                (Compiler.dumpSource := true;
+                 ElabPrint.debug := true;
+                 ExplPrint.debug := true;
+                 CorePrint.debug := true;
+                 MonoPrint.debug := true;
+                 doArgs rest)
+              | "-output" :: s :: rest =>
+                (Settings.setExe (SOME s);
+                 doArgs rest)
+              | "-js" :: s :: rest =>
+		(Settings.setOutputJsFile (SOME s);
+		 doArgs rest)
+              | "-sql" :: s :: rest =>
+                (Settings.setSql (SOME s);
+                 doArgs rest)
+              | "-static" :: rest =>
+                (Settings.setStaticLinking true;
+                 doArgs rest)
+              | "-stop" :: phase :: rest =>
+                (Compiler.setStop phase;
+                 doArgs rest)
+              | "-path" :: name :: path :: rest =>
+                (Compiler.addPath (name, path);
+                 doArgs rest)
+              | "-root" :: name :: root :: rest =>
+                (Compiler.addModuleRoot (root, name);
+                 doArgs rest)
+              | "-boot" :: rest =>
+                (Compiler.enableBoot ();
+                 Settings.setBootLinking true;
+                 doArgs rest)
+              | "-sigfile" :: name :: rest =>
+                (Settings.setSigFile (SOME name);
+                 doArgs rest)
+              | "-iflow" :: rest =>
+                (Compiler.doIflow := true;
+                 doArgs rest)
+              | "-sqlcache" :: rest =>
+                (Settings.setSqlcache true;
+                 doArgs rest)
+              | "-heuristic" :: h :: rest =>
+                (Sqlcache.setHeuristic h;
+                 doArgs rest)
+              | "-moduleOf" :: fname :: _ =>
+                (print (Compiler.moduleOf fname ^ "\n");
+                 raise Code OS.Process.success)
+              | "-noEmacs" :: rest =>
+                (Demo.noEmacs := true;
+                 doArgs rest)
+              | "-limit" :: class :: num :: rest =>
+                (case Int.fromString num of
+                     NONE => raise Fail ("Invalid limit number '" ^ num ^ "'")
+                   | SOME n =>
+                     if n < 0 then
+                         raise Fail ("Invalid limit number '" ^ num ^ "'")
+                     else
+                         Settings.addLimit (class, n);
+                 doArgs rest)
+              | "-explainEmbed" :: rest =>
+                (JsComp.explainEmbed := true;
+                 doArgs rest)
+              | arg :: rest =>
+                (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
+                     raise Fail ("Unknown flag " ^ arg)
+                 else
+                     sources := arg :: !sources;
+                 doArgs rest)
+
+        val () = case args of
+                     ["daemon", "stop"] => OS.Process.exit OS.Process.success
+                   | _ => ()
+
+        val () = doArgs args
+
+        val job =
+            case !sources of
+                [file] => file
+              | files =>
+                if List.exists (fn s => s <> "-version") args then
+                    raise Fail ("Zero or multiple input files specified; only one is allowed.\nFiles: "
+                                ^ String.concatWith ", " files)
+                else
+                    printVersion ()
+    in
+        case (!css, !demo, !tutorial) of
+            (true, _, _) =>
+            (case Compiler.run Compiler.toCss job of
+                 NONE => OS.Process.failure
+               | SOME {Overall = ov, Classes = cl} =>
+                 (app (print o Css.inheritableToString) ov;
+                  print "\n";
+                  app (fn (x, (ins, ots)) =>
+                          (print x;
+                           print " ";
+                           app (print o Css.inheritableToString) ins;
+                           app (print o Css.othersToString) ots;
+                           print "\n")) cl;
+                  OS.Process.success))
+          | (_, SOME (prefix, guided), _) =>
+            if Demo.make' {prefix = prefix, dirname = job, guided = guided} then
+                OS.Process.success
+            else
+                OS.Process.failure
+          | (_, _, true) => (Tutorial.make job;
+                             OS.Process.success)
+          | _ =>
+            if !tc then
+                (Compiler.check Compiler.toElaborate job;
+                 if ErrorMsg.anyErrors () then
+                     OS.Process.failure
+                 else
+                     OS.Process.success)
+            else if !timing then
+                (Compiler.time Compiler.toCjrize job;
+                 OS.Process.success)
+            else
+                (if Compiler.compile job then
+                     OS.Process.success
+                 else
+                     OS.Process.failure)
+    end handle Code n => n
+
+fun send (sock, s) =
+    let
+        val n = Socket.sendVec (sock, Word8VectorSlice.full (MLton.Word8Vector.fromPoly (Vector.map (Word8.fromInt o ord) (MLton.CharVector.toPoly s))))
+    in
+        if n >= size s then
+            ()
+        else
+            send (sock, String.extract (s, n, NONE))
+    end
+
+val () = (Globals.setResetTime ();
+          case CommandLine.arguments () of
+             ["daemon", "start"] =>
+             (case Posix.Process.fork () of
+                  SOME _ => ()
+                | NONE =>
+                  let
+                      val () = Elaborate.incremental := true
+                      val listen = UnixSock.Strm.socket ()
+
+                      fun loop () =
+                          let
+                              val (sock, _) = Socket.accept listen
+
+                              fun loop' (buf, args) =
+                                  let
+                                      val s = if CharVector.exists (fn ch => ch = #"\n") buf then
+                                                  ""
+                                              else
+                                                  MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly (Socket.recvVec (sock, 1024))))
+                                      val s = buf ^ s
+                                      val (befor, after) = Substring.splitl (fn ch => ch <> #"\n") (Substring.full s)
+                                  in
+                                      if Substring.isEmpty after then
+                                          loop' (s, args)
+                                      else
+                                          let
+                                              val cmd = Substring.string befor
+                                              val rest = Substring.string (Substring.slice (after, 1, NONE))
+                                          in
+                                              case cmd of
+                                                  "" =>
+                                                  (case args of
+                                                       ["stop", "daemon"] =>
+                                                       (((Socket.close listen;
+                                                          OS.FileSys.remove socket) handle OS.SysErr _ => ());
+                                                        OS.Process.exit OS.Process.success)
+                                                     | _ =>
+                                                       let
+                                                           val success = (oneRun (rev args))
+                                                               handle ex => (print "unhandled exception:\n";
+                                                                             print (General.exnMessage ex ^ "\n");
+                                                                             OS.Process.failure)
+                                                       in
+                                                           TextIO.flushOut TextIO.stdOut;
+                                                           TextIO.flushOut TextIO.stdErr;
+                                                           send (sock, if OS.Process.isSuccess success then
+                                                                           "\001"
+                                                                       else
+                                                                           "\002")
+                                                       end)
+                                                | _ => loop' (rest, cmd :: args)
+                                          end
+                                  end handle OS.SysErr _ => ()
+
+                              fun redirect old =
+                                  Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
+                                                 new = old}
+
+                              val oldStdout = Posix.IO.dup Posix.FileSys.stdout
+                              val oldStderr = Posix.IO.dup Posix.FileSys.stderr
+                          in
+                              (* Redirect the daemon's output to the socket. *)
+                              redirect Posix.FileSys.stdout;
+                              redirect Posix.FileSys.stderr;
+
+                              loop' ("", []);
+                              Socket.close sock;
+
+                              Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
+                              Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
+                              Posix.IO.close oldStdout;
+                              Posix.IO.close oldStderr;
+
+                              Settings.reset ();
+                              MLton.GC.pack ();
+                              loop ()
+                          end
+                  in
+                      OS.Process.atExit (fn () => OS.FileSys.remove socket);
+                      Socket.bind (listen, UnixSock.toAddr socket);
+                      Socket.listen (listen, 1);
+                      loop ()
+                  end)
+           | args =>
+             let
+                 val sock = UnixSock.Strm.socket ()
+
+                 fun wait () =
+                     let
+                         val v = Socket.recvVec (sock, 1024)
+                     in
+                         if Word8Vector.length v = 0 then
+                             OS.Process.failure
+                         else
+                             let
+                                 val s = MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly v))
+                                 val last = Word8Vector.sub (v, Word8Vector.length v - 1)
+                                 val (rc, s) = if last = Word8.fromInt 1 then
+                                                   (SOME OS.Process.success, String.substring (s, 0, size s - 1))
+                                               else if last = Word8.fromInt 2 then
+                                                   (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
+                                               else
+                                                   (NONE, s)
+                             in
+                                 print s;
+                                 case rc of
+                                     NONE => wait ()
+                                   | SOME rc => rc
+                             end
+                     end handle OS.SysErr _ => OS.Process.failure
+             in
+                 if Socket.connectNB (sock, UnixSock.toAddr socket)
+                    orelse not (List.null (#wrs (Socket.select {rds = [],
+                                                                wrs = [Socket.sockDesc sock],
+                                                                exs = [],
+                                                                timeout = SOME (Time.fromSeconds 1)}))) then
+                     (app (fn arg => send (sock, arg ^ "\n")) args;
+                      send (sock, "\n");
+                      OS.Process.exit (wait ()))
+                 else
+                     (OS.FileSys.remove socket;
+                      raise OS.SysErr ("", NONE))
+             end handle OS.SysErr _ => OS.Process.exit (oneRun args))
diff --git a/src/marshalcheck.sig b/src/marshalcheck.sig
new file mode 100644
index 0000000..fe16345
--- /dev/null
+++ b/src/marshalcheck.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MARSHAL_CHECK = sig
+
+    val check : Core.file -> unit
+
+end
diff --git a/src/marshalcheck.sml b/src/marshalcheck.sml
new file mode 100644
index 0000000..8d7edd1
--- /dev/null
+++ b/src/marshalcheck.sml
@@ -0,0 +1,132 @@
+(* Copyright (c) 2009-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MarshalCheck :> MARSHAL_CHECK = struct
+
+open Core
+
+structure U = CoreUtil
+structure E = ErrorMsg
+
+structure PK = struct
+open Order
+type ord_key = string * string
+fun compare ((m1, x1), (m2, x2)) =
+    join (String.compare (m1, m2),
+          fn () => String.compare (x1, x2))
+end
+
+structure PS = BinarySetFn(PK)
+structure PS = struct
+open PS
+fun toString' (m, x) = m ^ "." ^ x
+fun toString set =
+    case PS.listItems set of
+        [] => "{}"
+      | [x] => toString' x
+      | x :: xs => List.foldl (fn (x, s) => s ^ ", " ^ toString' x) (toString' x) xs
+end
+
+structure IM = IntBinaryMap
+
+fun check file =
+    let
+        fun kind (_, st) = st
+
+        fun con cmap (c, st) =
+            case c of
+                CFfi mx =>
+                if Settings.mayClientToServer mx then
+                    st
+                else
+                    PS.add (st, mx)
+              | CNamed n =>
+                (case IM.find (cmap, n) of
+                     NONE => st
+                   | SOME st' => PS.union (st, st'))
+              | _ => st
+
+        fun sins cmap = U.Con.fold {kind = kind, con = con cmap} PS.empty
+    in
+        ignore (foldl (fn ((d, _), (cmap, emap)) =>
+                          case d of
+                              DCon (_, n, _, c) => (IM.insert (cmap, n, sins cmap c), emap)
+                            | DDatatype dts =>
+                              (foldl (fn ((_, n, _, xncs), cmap) =>
+                                         IM.insert (cmap, n, foldl (fn ((_, _, co), s) =>
+                                                                       case co of
+                                                                           NONE => s
+                                                                         | SOME c => PS.union (s, sins cmap c))
+                                                                   PS.empty xncs)) cmap dts,
+                               emap)
+
+                            | DVal (_, n, t, _, tag) => (cmap, IM.insert (emap, n, (t, tag)))
+                            | DValRec vis => (cmap,
+                                              foldl (fn ((_, n, t, _, tag), emap) => IM.insert (emap, n, (t, tag)))
+                                                    emap vis)
+
+                            | DExport (_, n, _) =>
+                              (case IM.find (emap, n) of
+                                   NONE => raise Fail "MarshalCheck: Unknown export"
+                                 | SOME (t, tag) =>
+                                   let
+                                       fun makeS (t, _) =
+                                           case t of
+                                               TFun (dom, ran) =>
+                                               (case #1 dom of
+                                                    CFfi ("Basis", "postBody") => makeS ran
+                                                  | CApp ((CFfi ("Basis", "option"), _), (CFfi ("Basis", "queryString"), _)) => makeS ran
+                                                  | _ => PS.union (sins cmap dom, makeS ran))
+                                             | _ => PS.empty
+                                       val s = makeS t
+                                   in
+                                       if PS.isEmpty s then
+                                           ()
+                                       else
+                                           E.error ("Input to exported function '"
+                                                    ^ tag ^ "' involves one or more types that are disallowed for page handler inputs: "
+                                                    ^ PS.toString s);
+                                       (cmap, emap)
+                                   end)
+
+                            | DCookie (_, _, t, tag) =>
+                              let
+                                  val s = sins cmap t
+                              in
+                                  if PS.isEmpty s then
+                                      ()
+                                  else
+                                      E.error ("Cookie '" ^ tag ^ "' includes one or more types that are disallowed for cookies: "
+                                               ^ PS.toString s);
+                                  (cmap, emap)
+                              end
+
+                            | _ => (cmap, emap))
+                      (IM.empty, IM.empty) file)
+    end
+
+end
diff --git a/src/mod_db.sig b/src/mod_db.sig
new file mode 100644
index 0000000..8f78f2c
--- /dev/null
+++ b/src/mod_db.sig
@@ -0,0 +1,42 @@
+(* Copyright (c) 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Cache of module code, with dependency information *)
+
+signature MOD_DB = sig
+    val reset : unit -> unit
+
+    val insert : Elab.decl * Time.time -> unit
+    (* Here's a declaration, including the modification timestamp of the file it came from.
+     * We might invalidate other declarations that depend on this one, if the timestamp has changed. *)
+
+    val lookup : Source.decl -> Elab.decl option
+
+    (* Allow undoing to snapshots after failed compilations. *)
+    val snapshot : unit -> unit
+    val revert : unit -> unit
+end
diff --git a/src/mod_db.sml b/src/mod_db.sml
new file mode 100644
index 0000000..2d6b285
--- /dev/null
+++ b/src/mod_db.sml
@@ -0,0 +1,153 @@
+(* Copyright (c) 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Cache of module code, with dependency information *)
+
+structure ModDb :> MOD_DB = struct
+
+open Elab
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+structure IM = IntBinaryMap
+
+type oneMod = {Decl : decl,
+               When : Time.time,
+               Deps : SS.set}
+
+val byName = ref (SM.empty : oneMod SM.map)
+val byId = ref (IM.empty : string IM.map)
+
+fun reset () = (byName := SM.empty;
+                byId := IM.empty)
+
+fun insert (d, tm) =
+    let
+        val xn =
+            case #1 d of
+                DStr (x, n, _, _) => SOME (x, n)
+              | DFfiStr (x, n, _) => SOME (x, n)
+              | _ => NONE
+    in
+        case xn of
+            NONE => ()
+          | SOME (x, n) =>
+            let
+                val skipIt =
+                    case SM.find (!byName, x) of
+                        NONE => false
+                      | SOME r => #When r = tm
+            in
+                if skipIt then
+                    ()
+                else
+                    let
+                        fun doMod (n', deps) =
+                            case IM.find (!byId, n') of
+                                NONE => deps
+                              | SOME x' =>
+                                SS.union (deps,
+                                          SS.add (case SM.find (!byName, x') of
+                                                      NONE => SS.empty
+                                                    | SOME {Deps = ds, ...} => ds, x'))
+
+                        val deps = ElabUtil.Decl.fold {kind = #2,
+                                                       con = fn (c, deps) =>
+                                                                case c of
+                                                                    CModProj (n', _, _) => doMod (n', deps)
+                                                                  | _ => deps,
+                                                       exp = fn (e, deps) =>
+                                                                case e of
+                                                                    EModProj (n', _, _) => doMod (n', deps)
+                                                                  | _ => deps,
+                                                       sgn_item = #2,
+                                                       sgn = fn (sg, deps) =>
+                                                                case sg of
+                                                                    SgnProj (n', _, _) => doMod (n', deps)
+                                                                  | _ => deps,
+                                                       str = fn (st, deps) =>
+                                                                case st of
+                                                                    StrVar n' => doMod (n', deps)
+                                                                  | _ => deps,
+                                                       decl = fn (d, deps) =>
+                                                                 case d of
+                                                                     DDatatypeImp (_, _, n', _, _, _, _) => doMod (n', deps)
+                                                                   | _ => deps}
+                                                      SS.empty d
+                    in
+                        byName := SM.insert (SM.filter (fn r => if SS.member (#Deps r, x) then
+                                                                    case #1 (#Decl r) of
+                                                                        DStr (_, n', _, _) =>
+                                                                        (byId := #1 (IM.remove (!byId, n'));
+                                                                         false)
+                                                                      | DFfiStr (_, n', _) =>
+                                                                        (byId := #1 (IM.remove (!byId, n'));
+                                                                         false)
+                                                                      | _ => raise Fail "ModDb: Impossible decl"
+                                                                else
+                                                                    true) (!byName),
+                                             x,
+                                             {Decl = d,
+                                              When = tm,
+                                              Deps = deps});
+                        byId := IM.insert (!byId, n, x)
+                    end
+            end
+    end
+
+fun lookup (d : Source.decl) =
+    case #1 d of
+        Source.DStr (x, _, SOME tm, _, _) =>
+        (case SM.find (!byName, x) of
+             NONE => NONE
+           | SOME r =>
+             if tm = #When r then
+                 SOME (#Decl r)
+             else
+                 NONE)
+      | Source.DFfiStr (x, _, SOME tm) =>
+        (case SM.find (!byName, x) of
+             NONE => NONE
+           | SOME r =>
+             if tm = #When r then
+                 SOME (#Decl r)
+             else
+                 NONE)
+      | _ => NONE
+
+val byNameBackup = ref (!byName)
+val byIdBackup = ref (!byId)
+
+fun snapshot () = (byNameBackup := !byName; byIdBackup := !byId)
+fun revert () = (byName := !byNameBackup; byId := !byIdBackup)
+
+end
diff --git a/src/mono.sml b/src/mono.sml
new file mode 100644
index 0000000..cdadded
--- /dev/null
+++ b/src/mono.sml
@@ -0,0 +1,171 @@
+(* Copyright (c) 2008-2010, 2013-2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Mono = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype datatype_kind = datatype DatatypeKind.datatype_kind
+
+datatype typ' =
+         TFun of typ * typ
+       | TRecord of (string * typ) list
+       | TDatatype of int * (datatype_kind * (string * int * typ option) list) ref
+       | TFfi of string * string
+       | TOption of typ
+       | TList of typ
+       | TSource
+       | TSignal of typ
+
+withtype typ = typ' located
+
+datatype patCon =
+         PConVar of int (* constructor identifier *)
+       | PConFfi of {mod : string, datatyp : string, con : string, arg : typ option}
+
+datatype pat' =
+         PVar of string * typ
+       | PPrim of Prim.t
+       | PCon of datatype_kind * patCon * pat option
+       | PRecord of (string * pat * typ) list
+       | PNone of typ
+       | PSome of typ * pat
+
+withtype pat = pat' located
+
+datatype javascript_mode =
+         Attribute
+       | Script
+       | Source of typ
+
+datatype effect = datatype Export.effect
+datatype export_kind = datatype Export.export_kind
+
+datatype failure_mode = datatype Settings.failure_mode
+
+datatype binop_intness = Int | NotInt
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int   (* deBruijn index *)
+       | ENamed of int (* named variable *)
+       | ECon of datatype_kind * patCon * exp option
+       | ENone of typ
+       | ESome of typ * exp
+       | EFfi of string * string
+       | EFfiApp of string * string * (exp * typ) list
+       | EApp of exp * exp
+       | EAbs of string * typ * typ * exp
+
+       | EUnop of string * exp
+       | EBinop of binop_intness * string * exp * exp
+
+       | ERecord of (string * exp * typ) list
+       | EField of exp * string
+
+       | ECase of exp * (pat * exp) list * { disc : typ, result : typ }
+
+       | EStrcat of exp * exp
+
+       | EError of exp * typ
+       | EReturnBlob of {blob : exp option, mimeType : exp, t : typ}
+       | ERedirect of exp * typ
+
+       | EWrite of exp
+       | ESeq of exp * exp
+       | ELet of string * typ * exp * exp
+
+       | EClosure of int * exp list
+
+       | EQuery of { exps : (string * typ) list, (* name of computed field, type of field*)
+                     tables : (string * (string * typ) list) list,
+                     state : typ,
+                     query : exp, (* exp of string type containing sql query *)
+                     body : exp,
+                     initial : exp }
+       | EDml of exp * failure_mode
+       | ENextval of exp
+       | ESetval of exp * exp
+
+       | EUnurlify of exp * typ * bool
+
+       | EJavaScript of javascript_mode * exp
+
+       | ESignalReturn of exp
+       | ESignalBind of exp * exp
+       | ESignalSource of exp
+
+       | EServerCall of exp * typ * effect * failure_mode
+       | ERecv of exp * typ
+       | ESleep of exp
+       | ESpawn of exp
+
+withtype exp = exp' located
+
+datatype policy =
+         PolClient of exp
+       | PolInsert of exp
+       | PolDelete of exp
+       | PolUpdate of exp
+       | PolSequence of exp
+
+datatype decl' =
+         DDatatype of (string * int * (string * int * typ option) list) list
+       | DVal of string * int * typ * exp * string
+       | DValRec of (string * int * typ * exp * string) list
+       | DExport of export_kind * string * int * typ list * typ * bool
+
+       | DTable of string * (string * typ) list * exp * exp
+       | DSequence of string
+       | DView of string * (string * typ) list * exp
+       | DDatabase of {name : string, expunge : int, initialize : int}
+
+       | DJavaScript of string
+
+       | DCookie of string
+       | DStyle of string
+
+       | DTask of exp * exp
+
+       | DPolicy of policy
+       | DOnError of int
+
+withtype decl = decl' located
+
+datatype sidedness =
+         ServerOnly
+       | ServerAndPull
+       | ServerAndPullAndPush
+
+datatype dbmode =
+         NoDb
+       | OneQuery
+       | AnyDb
+
+type file = decl list * (int * sidedness * dbmode) list
+
+end
diff --git a/src/mono_env.sig b/src/mono_env.sig
new file mode 100644
index 0000000..db6fdc9
--- /dev/null
+++ b/src/mono_env.sig
@@ -0,0 +1,55 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MONO_ENV = sig
+
+    type env
+
+    val empty : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+
+    val pushDatatype : env -> string -> int -> (string * int * Mono.typ option) list -> env
+    val lookupDatatype : env -> int -> string * (string * int * Mono.typ option) list
+
+    val lookupConstructor : env -> int -> string * Mono.typ option * int
+
+    val pushERel : env -> string -> Mono.typ -> Mono.exp option -> env
+    val lookupERel : env -> int -> string * Mono.typ * Mono.exp option
+
+    val pushENamed : env -> string -> int -> Mono.typ -> Mono.exp option -> string -> env
+    val lookupENamed : env -> int -> string * Mono.typ * Mono.exp option * string
+
+    val declBinds : env -> Mono.decl -> env
+    val patBinds : env -> Mono.pat -> env
+    val patBindsN : Mono.pat -> int
+
+    val liftExpInExp : int -> Mono.exp -> Mono.exp
+    val subExpInExp : (int * Mono.exp) -> Mono.exp -> Mono.exp
+
+end
diff --git a/src/mono_env.sml b/src/mono_env.sml
new file mode 100644
index 0000000..0dd668e
--- /dev/null
+++ b/src/mono_env.sml
@@ -0,0 +1,169 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MonoEnv :> MONO_ENV = struct
+
+open Mono
+
+structure IM = IntBinaryMap
+
+
+exception UnboundRel of int
+exception UnboundNamed of int
+
+type env = {
+     datatypes : (string * (string * int * typ option) list) IM.map,
+     constructors : (string * typ option * int) IM.map,
+
+     relE : (string * typ * exp option) list,
+     namedE : (string * typ * exp option * string) IM.map
+}
+
+val empty = {
+    datatypes = IM.empty,
+    constructors = IM.empty,
+
+    relE = [],
+    namedE = IM.empty
+}
+
+fun pushDatatype (env : env) x n xncs =
+    {datatypes = IM.insert (#datatypes env, n, (x, xncs)),
+     constructors = foldl (fn ((x, n', to), constructors) =>
+                              IM.insert (constructors, n', (x, to, n)))
+                          (#constructors env) xncs,
+
+     relE = #relE env,
+     namedE = #namedE env}
+
+fun lookupDatatype (env : env) n =
+    case IM.find (#datatypes env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun lookupConstructor (env : env) n =
+    case IM.find (#constructors env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+structure U = MonoUtil
+
+val liftExpInExp =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+val subExpInExp =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | (ctx, _) => ctx}
+
+fun pushERel (env : env) x t eo =
+    {datatypes = #datatypes env,
+     constructors = #constructors env,
+     relE = (x, t, eo) :: map (fn (x, t, eo) => (x, t, Option.map (liftExpInExp 0) eo)) (#relE env),
+     namedE = #namedE env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushENamed (env : env) x n t eo s =
+    {datatypes = #datatypes env,
+     constructors = #constructors env,
+
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t, eo, s))}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun declBinds env (d, loc) =
+    case d of
+        DDatatype dts =>
+        foldl (fn ((x, n, xncs), env) =>
+                  let
+                      val env = pushDatatype env x n xncs
+                      val dt = (TDatatype (n, ref (ElabUtil.classifyDatatype xncs, xncs)), loc)
+                  in
+                      foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt NONE ""
+                              | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc) NONE "")
+                            env xncs
+                  end) env dts
+      | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s
+      | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis
+      | DExport _ => env
+      | DTable _ => env
+      | DSequence _ => env
+      | DView _ => env
+      | DDatabase _ => env
+      | DJavaScript _ => env
+      | DCookie _ => env
+      | DStyle _ => env
+      | DTask _ => env
+      | DPolicy _ => env
+      | DOnError _ => env
+
+fun patBinds env (p, loc) =
+    case p of
+        PVar (x, t) => pushERel env x t NONE
+      | PPrim _ => env
+      | PCon (_, _, NONE) => env
+      | PCon (_, _, SOME p) => patBinds env p
+      | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+      | PNone _ => env
+      | PSome (_, p) => patBinds env p
+
+fun patBindsN (p, loc) =
+    case p of
+        PVar _ => 1
+      | PPrim _ => 0
+      | PCon (_, _, NONE) => 0
+      | PCon (_, _, SOME p) => patBindsN p
+      | PRecord xps => foldl (fn ((_, p, _), count) => count + patBindsN p) 0 xps
+      | PNone _ => 0
+      | PSome (_, p) => patBindsN p
+
+end
diff --git a/src/mono_fooify.sig b/src/mono_fooify.sig
new file mode 100644
index 0000000..0cc7234
--- /dev/null
+++ b/src/mono_fooify.sig
@@ -0,0 +1,39 @@
+signature MONO_FOOIFY = sig
+
+(* TODO: don't expose raw references if possible. *)
+val nextPvar : int ref
+val pvarDefs : ((string * int * (string * int * Mono.typ option) list) list) ref
+
+datatype foo_kind = Attr | Url
+
+structure Fm : sig
+    type t
+
+    type vr = string * int * Mono.typ * Mono.exp * string
+
+    val empty : int -> t
+
+    val lookup : t -> foo_kind -> int -> (int -> t -> vr * t) -> t * int
+    val lookupList : t -> foo_kind -> Mono.typ -> (int -> t -> vr * t) -> t * int
+    val enter : t -> t
+    (* This list should be reversed before adding to list of file declarations. *)
+    val decls : t -> Mono.decl list
+
+    val freshName : t -> int * t
+end
+
+(* General form used in [Monoize]. *)
+val fooifyExp : foo_kind
+                -> (int -> Mono.typ * string)
+                -> (int -> string * (string * int * Mono.typ option) list)
+                -> Fm.t
+                -> Mono.exp * Mono.typ
+                -> Mono.exp * Fm.t
+
+(* Easy-to-use interface in [Sqlcache]. Uses [Fm.canonical]. *)
+val canonicalFm : Fm.t ref (* Set at the end of [Monoize]. *)
+val urlify : MonoEnv.env -> Mono.exp * Mono.typ -> Mono.exp option
+(* This list should be reversed before adding to list of file declarations. *)
+val getNewFmDecls : unit -> Mono.decl list
+
+end
diff --git a/src/mono_fooify.sml b/src/mono_fooify.sml
new file mode 100644
index 0000000..e64207c
--- /dev/null
+++ b/src/mono_fooify.sml
@@ -0,0 +1,346 @@
+structure MonoFooify :> MONO_FOOIFY = struct
+
+open Mono
+
+datatype foo_kind =
+         Attr
+       | Url
+
+val nextPvar = ref 0
+val pvarDefs = ref ([] : (string * int * (string * int * typ option) list) list)
+
+structure Fm = struct
+
+type vr = string * int * typ * exp * string
+
+structure IM = IntBinaryMap
+
+structure M = BinaryMapFn(struct
+                          type ord_key = foo_kind
+                          fun compare x =
+                              case x of
+                                  (Attr, Attr) => EQUAL
+                                | (Attr, _) => LESS
+                                | (_, Attr) => GREATER
+
+                                | (Url, Url) => EQUAL
+                          end)
+
+structure TM = BinaryMapFn(struct
+                           type ord_key = typ
+                           val compare = MonoUtil.Typ.compare
+                           end)
+
+type t = {
+     count : int,
+     map : int IM.map M.map,
+     listMap : int TM.map M.map,
+     decls : vr list
+}
+
+fun empty count = {
+    count = count,
+    map = M.empty,
+    listMap = M.empty,
+    decls = []
+}
+
+fun chooseNext count =
+    let
+        val n = !nextPvar
+    in
+        if count < n then
+            (count, count+1)
+        else
+            (nextPvar := n + 1;
+             (n, n+1))
+    end
+
+fun enter ({count, map, listMap, ...} : t) = {count = count, map = map, listMap = listMap, decls = []}
+fun freshName {count, map, listMap, decls} =
+    let
+        val (next, count) = chooseNext count
+    in
+        (next, {count = count , map = map, listMap = listMap, decls = decls})
+    end
+fun decls ({decls, ...} : t) =
+    case decls of
+        [] => []
+      | _ => [(DValRec decls, ErrorMsg.dummySpan)]
+
+fun lookup (t as {count, map, listMap, decls}) k n thunk =
+    let
+        val im = Option.getOpt (M.find (map, k), IM.empty)
+    in
+        case IM.find (im, n) of
+            NONE =>
+            let
+                val n' = count
+                val (d, {count, map, listMap, decls}) =
+                    thunk count {count = count + 1,
+                                 map = M.insert (map, k, IM.insert (im, n, n')),
+                                 listMap = listMap,
+                                 decls = decls}
+            in
+                ({count = count,
+                  map = map,
+                  listMap = listMap,
+                  decls = d :: decls}, n')
+            end
+          | SOME n' => (t, n')
+    end
+
+fun lookupList (t as {count, map, listMap, decls}) k tp thunk =
+    let
+        val tm = Option.getOpt (M.find (listMap, k), TM.empty)
+    in
+        case TM.find (tm, tp) of
+            NONE =>
+            let
+                val n' = count
+                val (d, {count, map, listMap, decls}) =
+                    thunk count {count = count + 1,
+                                 map = map,
+                                 listMap = M.insert (listMap, k, TM.insert (tm, tp, n')),
+                                 decls = decls}
+            in
+                ({count = count,
+                  map = map,
+                  listMap = listMap,
+                  decls = d :: decls}, n')
+            end
+          | SOME n' => (t, n')
+    end
+
+end
+
+fun fk2s fk =
+    case fk of
+        Attr => "attr"
+      | Url => "url"
+
+fun capitalize s =
+    if s = "" then
+        s
+    else
+        str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+structure E = ErrorMsg
+
+exception TypeMismatch of Fm.t * E.span
+exception CantPass of Fm.t * typ
+exception DontKnow of Fm.t * typ
+
+val dummyExp = (EPrim (Prim.Int 0), E.dummySpan)
+
+fun fooifyExpWithExceptions fk lookupENamed lookupDatatype =
+    let
+        fun fooify fm (e, tAll as (t, loc)) =
+            case #1 e of
+                EClosure (fnam, [(ERecord [], _)]) =>
+                let
+                    val (_, s) = lookupENamed fnam
+                in
+                    ((EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm)
+                end
+              | EClosure (fnam, args) =>
+                let
+                    val (ft, s) = lookupENamed fnam
+                    fun attrify (args, ft, e, fm) =
+                        case (args, ft) of
+                            ([], _) => (e, fm)
+                          | (arg :: args, (TFun (t, ft), _)) =>
+                            let
+                                val (arg', fm) = fooify fm (arg, t)
+                            in
+                                attrify (args, ft,
+                                         (EStrcat (e,
+                                                      (EStrcat ((EPrim (Prim.String (Prim.Normal, "/")), loc),
+                                                                   arg'), loc)), loc),
+                                         fm)
+                            end
+                          | _ => raise TypeMismatch (fm, loc)
+                in
+                    attrify (args, ft, (EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm)
+                end
+              | _ =>
+                case t of
+                    TFfi ("Basis", "unit") => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm)
+                  | TFfi (m, x) => (if Settings.mayClientToServer (m, x)
+                                    then ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm)
+                                    else raise CantPass (fm, tAll))
+
+                  | TRecord [] => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm)
+                  | TRecord ((x, t) :: xts) =>
+                    let
+                        val (se, fm) = fooify fm ((EField (e, x), loc), t)
+                    in
+                        foldl (fn ((x, t), (se, fm)) =>
+                                  let
+                                      val (se', fm) = fooify fm ((EField (e, x), loc), t)
+                                  in
+                                      ((EStrcat (se,
+                                                    (EStrcat ((EPrim (Prim.String (Prim.Normal, "/")), loc),
+                                                                 se'), loc)), loc),
+                                       fm)
+                                  end) (se, fm) xts
+                    end
+
+                  | TDatatype (i, ref (dk, _)) =>
+                    let
+                        fun makeDecl n fm =
+                            let
+                                val (x, xncs) =
+                                    case ListUtil.search (fn (x, i', xncs) =>
+                                                             if i' = i then
+                                                                 SOME (x, xncs)
+                                                             else
+                                                                 NONE) (!pvarDefs) of
+                                        NONE => lookupDatatype i
+                                      | SOME v => v
+
+                                val (branches, fm) =
+                                    ListUtil.foldlMap
+                                        (fn ((x, n, to), fm) =>
+                                            case to of
+                                                NONE =>
+                                                (((PCon (dk, PConVar n, NONE), loc),
+                                                  (EPrim (Prim.String (Prim.Normal, x)), loc)),
+                                                 fm)
+                                              | SOME t =>
+                                                let
+                                                    val (arg, fm) = fooify fm ((ERel 0, loc), t)
+                                                in
+                                                    (((PCon (dk, PConVar n, SOME (PVar ("a", t), loc)), loc),
+                                                      (EStrcat ((EPrim (Prim.String (Prim.Normal, x ^ "/")), loc),
+                                                                   arg), loc)),
+                                                     fm)
+                                                end)
+                                        fm xncs
+
+                                val dom = tAll
+                                val ran = (TFfi ("Basis", "string"), loc)
+                            in
+                                ((fk2s fk ^ "ify_" ^ x,
+                                  n,
+                                  (TFun (dom, ran), loc),
+                                  (EAbs ("x",
+                                            dom,
+                                            ran,
+                                            (ECase ((ERel 0, loc),
+                                                       branches,
+                                                       {disc = dom,
+                                                        result = ran}), loc)), loc),
+                                  ""),
+                                 fm)
+                            end
+
+                        val (fm, n) = Fm.lookup fm fk i makeDecl
+                    in
+                        ((EApp ((ENamed n, loc), e), loc), fm)
+                    end
+
+                  | TOption t =>
+                    let
+                        val (body, fm) = fooify fm ((ERel 0, loc), t)
+                    in
+                        ((ECase (e,
+                                    [((PNone t, loc),
+                                      (EPrim (Prim.String (Prim.Normal, "None")), loc)),
+
+                                     ((PSome (t, (PVar ("x", t), loc)), loc),
+                                      (EStrcat ((EPrim (Prim.String (Prim.Normal, "Some/")), loc),
+                                                   body), loc))],
+                                    {disc = tAll,
+                                     result = (TFfi ("Basis", "string"), loc)}), loc),
+                         fm)
+                    end
+
+                  | TList t =>
+                    let
+                        fun makeDecl n fm =
+                            let
+                                val rt = (TRecord [("1", t), ("2", (TList t, loc))], loc)
+                                val (arg, fm) = fooify fm ((ERel 0, loc), rt)
+
+                                val branches = [((PNone rt, loc),
+                                                 (EPrim (Prim.String (Prim.Normal, "Nil")), loc)),
+                                                ((PSome (rt, (PVar ("a", rt), loc)), loc),
+                                                 (EStrcat ((EPrim (Prim.String (Prim.Normal, "Cons/")), loc),
+                                                              arg), loc))]
+
+                                val dom = tAll
+                                val ran = (TFfi ("Basis", "string"), loc)
+                            in
+                                ((fk2s fk ^ "ify_list",
+                                  n,
+                                  (TFun (dom, ran), loc),
+                                  (EAbs ("x",
+                                            dom,
+                                            ran,
+                                            (ECase ((ERel 0, loc),
+                                                       branches,
+                                                       {disc = dom,
+                                                        result = ran}), loc)), loc),
+                                  ""),
+                                 fm)
+                            end
+
+                        val (fm, n) = Fm.lookupList fm fk t makeDecl
+                    in
+                        ((EApp ((ENamed n, loc), e), loc), fm)
+                    end
+
+                  | _ => raise DontKnow (fm, tAll)
+    in
+        fooify
+    end
+
+fun fooifyExp fk lookupENamed lookupDatatype fm exp =
+    fooifyExpWithExceptions fk lookupENamed lookupDatatype fm exp
+    handle TypeMismatch (fm, loc) =>
+           (E.errorAt loc "Type mismatch encoding attribute";
+            (dummyExp, fm))
+         | CantPass (fm, typ as (_, loc)) =>
+           (E.errorAt loc "MonoFooify: can't pass type from client to server";
+            Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty typ)];
+            (dummyExp, fm))
+         | DontKnow (fm, typ as (_, loc)) =>
+           (E.errorAt loc "Don't know how to encode attribute/URL type";
+            Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty typ)];
+            (dummyExp, fm))
+
+(* Has to be set at the end of [Monoize]. *)
+val canonicalFm = ref (Fm.empty 0 : Fm.t)
+
+fun urlify env expTyp =
+    let
+        val (exp, fm) =
+            fooifyExpWithExceptions
+                Url
+                (fn n =>
+                    let
+                        val (_, t, _, s) = MonoEnv.lookupENamed env n
+                    in
+                        (t, s)
+                    end)
+                (fn n => MonoEnv.lookupDatatype env n)
+                (!canonicalFm)
+                expTyp
+    in
+        canonicalFm := fm;
+        SOME exp
+    end
+    handle TypeMismatch _ => NONE
+         | CantPass _ => NONE
+         | DontKnow _ => NONE
+
+fun getNewFmDecls () =
+    let
+        val fm = !canonicalFm
+    in
+        canonicalFm := Fm.enter fm;
+        Fm.decls fm
+    end
+
+end
diff --git a/src/mono_inline.sml b/src/mono_inline.sml
new file mode 100644
index 0000000..d23419f
--- /dev/null
+++ b/src/mono_inline.sml
@@ -0,0 +1,28 @@
+structure MonoInline = struct
+
+fun inlineFull file =
+    let
+        val oldInline = Settings.getMonoInline ()
+        val oldFull = !MonoReduce.fullMode
+    in
+        (Settings.setMonoInline (case Int.maxInt of
+                                     NONE => 1000000
+                                   | SOME n => n);
+         MonoReduce.fullMode := true;
+         let
+             val file = MonoReduce.reduce file
+             val file = MonoOpt.optimize file
+             val file = Fuse.fuse file
+             val file = MonoOpt.optimize file
+             val file = MonoShake.shake file
+         in
+             file
+         end before
+         (MonoReduce.fullMode := oldFull;
+          Settings.setMonoInline oldInline))
+        handle ex => (Settings.setMonoInline oldInline;
+                      MonoReduce.fullMode := oldFull;
+                      raise ex)
+    end
+
+end
diff --git a/src/mono_opt.sig b/src/mono_opt.sig
new file mode 100644
index 0000000..1d0fec5
--- /dev/null
+++ b/src/mono_opt.sig
@@ -0,0 +1,33 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MONO_OPT = sig
+
+    val optimize : Mono.file -> Mono.file
+    val optExp : Mono.exp -> Mono.exp
+    
+end
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
new file mode 100644
index 0000000..40b865b
--- /dev/null
+++ b/src/mono_opt.sml
@@ -0,0 +1,655 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MonoOpt :> MONO_OPT = struct
+
+open Mono
+structure U = MonoUtil
+
+fun typ t = t
+fun decl d = d
+
+fun attrifyInt n =
+    if n < 0 then
+        "-" ^ Int64.toString (Int64.~ n)
+    else
+        Int64.toString n
+
+fun attrifyFloat n =
+    if n < 0.0 then
+        "-" ^ Real.toString (Real.~ n)
+    else
+        Real.toString n
+
+fun attrifyChar ch =
+    case ch of
+        #"\"" => "&quot;"
+      | #"&" => "&amp;"
+      | ch => str ch
+
+val attrifyString = String.translate attrifyChar
+
+
+val urlifyInt = attrifyInt
+val urlifyFloat = attrifyFloat
+
+val htmlifyInt = attrifyInt
+val htmlifyFloat = attrifyFloat
+
+val htmlifyString = String.translate (fn #"<" => "&lt;"
+                                       | #"&" => "&amp;"
+                                       | ch => str ch)
+
+fun htmlifySpecialChar ch = "&#" ^ Int.toString (ord ch) ^ ";"
+
+fun hexIt ch =
+    let
+        val s = Int.fmt StringCvt.HEX (ord ch)
+    in
+        case size s of
+            0 => "00"
+          | 1 => "0" ^ s
+          | _ => s
+    end
+
+fun urlifyString s =
+    case s of
+        "" => "_"
+      | _ =>
+        (if String.sub (s, 0) = #"_" then
+             "_"
+         else
+             "")
+        ^ String.translate (fn #" " => "+"
+                             | ch => if Char.isAlphaNum ch then
+                                         str ch
+                                     else
+                                         "." ^ hexIt ch) s
+
+
+fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int)
+fun sqlifyFloat n = #p_cast (Settings.currentDbms ()) (attrifyFloat n, Settings.Float)
+
+fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s
+fun sqlifyChar ch = #sqlifyString (Settings.currentDbms ()) (str ch)
+
+fun unAs s =
+    let
+        fun doChars (cs, acc) =
+            case cs of
+                #"T" :: #"_" :: #"T" :: #"." :: cs => doChars (cs, acc)
+              | #"'" :: cs => doString (cs, #"'" :: acc)
+              | ch :: cs => doChars (cs, ch :: acc)
+              | [] => String.implode (rev acc)
+
+        and doString (cs, acc) =
+            case cs of
+                #"\\" :: #"\\" :: cs => doString (cs, #"\\" :: #"\\" :: acc)
+              | #"\\" :: #"'" :: cs => doString (cs, #"'" :: #"\\" :: acc)
+              | #"'" :: cs => doChars (cs, #"'" :: acc)
+              | ch :: cs => doString (cs, ch :: acc)
+              | [] => String.implode (rev acc)
+    in
+        doChars (String.explode s, [])
+    end
+
+fun checkUrl s = CharVector.all Char.isGraph s andalso Settings.checkUrl s
+val checkData = CharVector.all (fn ch => Char.isAlphaNum ch
+                                         orelse ch = #"_"
+                                         orelse ch = #"-")
+val checkAtom = CharVector.all (fn ch => Char.isAlphaNum ch
+                                         orelse ch = #"+"
+                                         orelse ch = #"-"
+                                         orelse ch = #"."
+                                         orelse ch = #"%"
+                                         orelse ch = #"#")
+val checkCssUrl = CharVector.all (fn ch => Char.isAlphaNum ch
+                                           orelse ch = #":"
+                                           orelse ch = #"/"
+                                           orelse ch = #"."
+                                           orelse ch = #"_"
+                                           orelse ch = #"+"
+                                           orelse ch = #"-"
+                                           orelse ch = #"%"
+                                           orelse ch = #"?"
+                                           orelse ch = #"&"
+                                           orelse ch = #"="
+                                           orelse ch = #"#")
+fun checkProperty s = size s > 0
+                      andalso (Char.isLower (String.sub (s, 0)) orelse String.sub (s, 0) = #"_")
+                      andalso CharVector.all (fn ch => Char.isLower ch orelse Char.isDigit ch orelse ch = #"_" orelse ch = #"-") s
+
+fun exp e =
+    case e of
+        EPrim (Prim.String (Prim.Html, s)) =>
+        if CharVector.exists Char.isSpace s then
+            let
+                val (_, chs) =
+                    CharVector.foldl (fn (ch, (lastSpace, chs)) =>
+                                         let
+                                             val isSpace = Char.isSpace ch
+                                         in
+                                             if isSpace andalso lastSpace then
+                                                 (true, chs)
+                                             else
+                                                 (isSpace, ch :: chs)
+                                         end)
+                                     (false, []) s
+            in
+                EPrim (Prim.String (Prim.Html, String.implode (rev chs)))
+            end
+        else
+            e
+
+      | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2))
+
+      | EStrcat (e1, (EPrim (Prim.String (_, "")), _)) => #1 e1
+      | EStrcat ((EPrim (Prim.String (_, "")), _), e2) => #1 e2
+
+      | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) =>
+        let
+            val s =
+                if size s1 > 0 andalso size s2 > 0
+                   andalso Char.isSpace (String.sub (s1, size s1 - 1))
+                   andalso Char.isSpace (String.sub (s2, 0)) then
+                    s1 ^ String.extract (s2, 1, NONE)
+                else
+                    s1 ^ s2
+        in
+            EPrim (Prim.String (Prim.Html, s))
+        end
+
+      | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) =>
+        EPrim (Prim.String (Prim.Normal, s1 ^ s2))
+
+      | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) =>
+        let
+            val s =
+                if size s1 > 0 andalso size s2 > 0
+                   andalso Char.isSpace (String.sub (s1, size s1 - 1))
+                   andalso Char.isSpace (String.sub (s2, 0)) then
+                    s1 ^ String.extract (s2, 1, NONE)
+                else
+                    s1 ^ s2
+        in
+            EStrcat ((EPrim (Prim.String (Prim.Html, s)), loc), rest)
+        end
+
+      | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EStrcat ((EPrim (Prim.String (_, s2)), _), rest), _)) =>
+        EStrcat ((EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), rest)
+
+      | EStrcat ((EStrcat (e1, e2), loc), e3) =>
+        optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
+
+      | EWrite (EStrcat (e1, e2), loc) =>
+        ESeq ((optExp (EWrite e1, loc), loc),
+              (optExp (EWrite e2, loc), loc))
+
+      | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc),
+              (EWrite (EPrim (Prim.String (_, s2)), _), _)) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc)
+      | ESeq ((EWrite (EPrim (Prim.String (_, s1)), _), loc),
+              (ESeq ((EWrite (EPrim (Prim.String (_, s2)), _), _),
+                     e), _)) =>
+        ESeq ((EWrite (EPrim (Prim.String (Prim.Normal, s1 ^ s2)), loc), loc),
+              e)
+
+      | EFfiApp ("Basis", "htmlifySpecialChar", [((EPrim (Prim.Char ch), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifySpecialChar ch))
+      | EWrite (EFfiApp ("Basis", "htmlifySpecialChar", [e]), _) =>
+        EFfiApp ("Basis", "htmlifySpecialChar_w", [e])
+
+      | EWrite (EFfiApp ("Basis", "intToString", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyInt_w", [e])
+      | EApp ((EFfi ("Basis", "intToString"), loc), e) =>
+        EFfiApp ("Basis", "intToString", [(e, (TFfi ("Basis", "int"), loc))])
+
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", [((EPrim (Prim.Int n), _), _)]), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyInt n))
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", es), _), _)]) =>
+        EFfiApp ("Basis", "htmlifyInt", es)
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _),
+                                                    (EPrim (Prim.Int n), _)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyInt n))
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _),
+                                                    e), loc), _)]) =>
+        EFfiApp ("Basis", "htmlifyInt", [(e, (TFfi ("Basis", "int"), loc))])
+      | EWrite (EFfiApp ("Basis", "htmlifyInt", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyInt_w", [e])
+
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", [((EPrim (Prim.Float n), _), _)]), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyFloat n))
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", es), _), _)]) =>
+        EFfiApp ("Basis", "htmlifyFloat", es)
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _),
+                                                    (EPrim (Prim.Float n), _)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyFloat n))
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _),
+                                                    e), loc), _)]) =>
+        EFfiApp ("Basis", "htmlifyFloat", [(e, (TFfi ("Basis", "float"), loc))])
+      | EWrite (EFfiApp ("Basis", "htmlifyFloat", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyFloat_w", [e])
+
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString",
+                                                       [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, "True"))
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString",
+                                                       [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, "False"))
+      | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", es), _), _)]) =>
+        EFfiApp ("Basis", "htmlifyBool", es)
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
+                                                    (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, "True"))
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
+                                                    (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, "False"))
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _),
+                                                    e), loc), _)]) =>
+        EFfiApp ("Basis", "htmlifyBool", [(e, (TFfi ("Basis", "bool"), loc))])
+      | EWrite (EFfiApp ("Basis", "htmlifyBool", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyBool_w", [e])
+
+      | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "timeToString"), _), e), loc), _)]) =>
+        EFfiApp ("Basis", "htmlifyTime", [(e, (TFfi ("Basis", "time"), loc))])
+      | EFfiApp ("Basis", "htmlifyString_w", [((EApp ((EFfi ("Basis", "timeToString"), loc), e), _), _)]) =>
+        EFfiApp ("Basis", "htmlifyTime_w", [(e, (TFfi ("Basis", "time"), loc))])
+      | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyTime_w", [e])
+
+      | EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, htmlifyString s))
+      | EWrite (EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc)
+      | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyString_w", [e])
+      | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String (_, s)), loc), _)]) =>
+        EWrite (EPrim (Prim.String (Prim.Html, htmlifyString s)), loc)
+
+      | EWrite (EFfiApp ("Basis", "htmlifySource", [e]), _) =>
+        EFfiApp ("Basis", "htmlifySource_w", [e])
+
+      | EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, attrifyInt n))
+      | EWrite (EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyInt n)), loc)
+      | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) =>
+        EFfiApp ("Basis", "attrifyInt_w", [e])
+
+      | EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, attrifyFloat n))
+      | EWrite (EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyFloat n)), loc)
+      | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) =>
+        EFfiApp ("Basis", "attrifyFloat_w", [e])
+
+      | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, attrifyString s))
+      | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyString s)), loc)
+      | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
+        EFfiApp ("Basis", "attrifyString_w", [e])
+
+      | EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, attrifyChar s))
+      | EWrite (EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, attrifyChar s)), loc)
+      | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) =>
+        EFfiApp ("Basis", "attrifyChar_w", [e])
+
+      | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Html, s))
+      | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String (_, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Html, s)), loc)
+      | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) =>
+        EFfiApp ("Basis", "attrifyString_w", [e])
+
+      | EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, urlifyInt n))
+      | EWrite (EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyInt n)), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyInt", [e]), _) =>
+        EFfiApp ("Basis", "urlifyInt_w", [e])
+
+      | EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, urlifyFloat n))
+      | EWrite (EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyFloat n)), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyFloat", [e]), _) =>
+        EFfiApp ("Basis", "urlifyFloat_w", [e])
+
+      | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, urlifyString s))
+      | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String (Prim.Normal, s)), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, urlifyString s)), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) =>
+        EFfiApp ("Basis", "urlifyString_w", [e])
+
+      | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, "1"))
+      | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, "0"))
+      | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, "1")), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), loc) =>
+        EWrite (EPrim (Prim.String (Prim.Normal, "0")), loc)
+      | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) =>
+        EFfiApp ("Basis", "urlifyBool_w", [e])
+
+      | EFfiApp ("Basis", "sqlifyInt", [((EPrim (Prim.Int n), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyInt n))
+      | EFfiApp ("Basis", "sqlifyIntN", [((ENone _, _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, "NULL"))
+      | EFfiApp ("Basis", "sqlifyIntN", [((ESome (_, (EPrim (Prim.Int n), _)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyInt n))
+
+      | EFfiApp ("Basis", "sqlifyFloat", [((EPrim (Prim.Float n), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyFloat n))
+      | EFfiApp ("Basis", "sqlifyBool", [(b as (_, loc), _)]) =>
+        optExp (ECase (b,
+                       [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc),
+                         (EPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))), loc)),
+                        ((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc),
+                         (EPrim (Prim.String (Prim.Normal, #falseString (Settings.currentDbms ()))), loc))],
+                       {disc = (TFfi ("Basis", "bool"), loc),
+                        result = (TFfi ("Basis", "string"), loc)}), loc)
+      | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String (_, n)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyString n))
+      | EFfiApp ("Basis", "sqlifyChar", [((EPrim (Prim.Char n), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, sqlifyChar n))
+
+      | EWrite (ECase (discE, pes, {disc, ...}), loc) =>
+        optExp (ECase (discE,
+                       map (fn (p, e) => (p, (EWrite e, loc))) pes,
+                       {disc = disc,
+                        result = (TRecord [], loc)}), loc)
+
+      | EApp ((ECase (discE, pes, {disc, result = (TFun (_, ran), _)}), loc), arg as (ERecord [], _)) =>
+        let
+            fun doBody e =
+                case #1 e of
+                    EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body
+                  | _ => (EApp (e, arg), loc)
+        in
+            optExp (ECase (discE,
+                           map (fn (p, e) => (p, doBody e)) pes,
+                           {disc = disc,
+                            result = ran}), loc)
+        end
+
+      | EWrite (EQuery {exps, tables, state, query,
+                        initial = (EPrim (Prim.String (k, "")), _),
+                        body = (EStrcat ((EPrim (Prim.String (_, s)), _),
+                                         (EStrcat ((ERel 0, _),
+                                                   e'), _)), _)}, loc) =>
+        if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then
+            EQuery {exps = exps, tables = tables, query = query,
+                    state = (TRecord [], loc),
+                    initial = (ERecord [], loc),
+                    body = (optExp (EWrite e', loc), loc)}
+        else
+            e
+
+      | EWrite (EQuery {exps, tables, state, query,
+                        initial = (EPrim (Prim.String (_, "")), _),
+                        body}, loc) =>
+        let
+            fun passLets (depth, (e', _), lets) =
+                case e' of
+                    EStrcat ((ERel x, _), e'') =>
+                    if x = depth then
+                        let
+                            val body = (optExp (EWrite e'', loc), loc)
+                            val body = foldl (fn ((x, t, e'), e) =>
+                                                 (ELet (x, t, e', e), loc))
+                                             body lets
+                        in
+                            EQuery {exps = exps, tables = tables, query = query,
+                                    state = (TRecord [], loc),
+                                    initial = (ERecord [], loc),
+                                    body = body}
+                        end
+                    else
+                        e
+                  | ELet (x, t, e', e'') =>
+                    passLets (depth + 1, e'', (x, t, e') :: lets)
+                  | _ => e
+        in
+            passLets (0, body, [])
+        end
+
+      (*| EWrite (EQuery {exps, tables, state, query,
+                        initial = (EPrim (Prim.String ""), _),
+                        body = (EStrcat ((ERel 0, _), e'), _)}, loc) =>
+        EQuery {exps = exps, tables = tables, query = query,
+                state = (TRecord [], loc),
+                initial = (ERecord [], loc),
+                body = (optExp (EWrite e', loc), loc)}*)
+
+      | EWrite (ELet (x, t, e1, e2), loc) =>
+        optExp (ELet (x, t, e1, (EWrite e2, loc)), loc)
+
+      | EWrite (EPrim (Prim.String (_, "")), loc) =>
+        ERecord []
+
+      | ESignalBind ((ESignalReturn e1, loc), e2) =>
+        optExp (EApp (e2, e1), loc)
+
+      | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkData s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid HTML5 data-* attribute " ^ s);
+         se)
+
+      | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkUrl s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'bless'");
+         se)
+      | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkUrl s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMime s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMime'");
+         se)
+      | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMime s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "atom", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkAtom s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'atom'");
+         se)
+      | EFfiApp ("Basis", "css_url", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkCssUrl s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'css_url'");
+         se)
+      | EFfiApp ("Basis", "property", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if checkProperty s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'property'");
+         se)
+      | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkRequestHeader s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessRequestHeader'");
+         se)
+      | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkRequestHeader s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkResponseHeader s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessResponseHeader'");
+         se)
+      | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkResponseHeader s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkEnvVar s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessEnvVar'");
+         se)
+      | EFfiApp ("Basis", "checkEnvVar", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkEnvVar s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+      | EFfiApp ("Basis", "blessMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ()
+         else
+             ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMeta'");
+         se)
+      | EFfiApp ("Basis", "checkMeta", [((se as EPrim (Prim.String (_, s)), loc), _)]) =>
+        (if Settings.checkMeta s then
+             ESome ((TFfi ("Basis", "string"), loc), (se, loc))
+         else
+             ENone (TFfi ("Basis", "string"), loc))
+
+      | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) =>
+        let
+            fun uwify (cs, acc) =
+                case cs of
+                    [] => String.concat (rev acc)
+                  | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc)
+                  | #" " :: #"_" :: cs => uwify (cs, " uw_" :: acc)
+                  | #"'" :: cs =>
+                    let
+                        fun waitItOut (cs, acc) =
+                            case cs of
+                                [] => raise Fail "MonoOpt: Unterminated SQL string literal"
+                              | #"'" :: cs => uwify (cs, "'" :: acc)
+                              | #"\\" :: #"'" :: cs => waitItOut (cs, "\\'" :: acc)
+                              | #"\\" :: #"\\" :: cs => waitItOut (cs, "\\\\" :: acc)
+                              | c :: cs => waitItOut (cs, str c :: acc)
+                    in
+                        waitItOut (cs, "'" :: acc)
+                    end
+                  | c :: cs => uwify (cs, str c :: acc)
+
+            val s = case String.explode s of
+                        #"_" :: cs => uwify (cs, ["uw_"])
+                      | cs => uwify (cs, [])
+        in
+            EPrim (Prim.String (Prim.Normal, s))
+        end
+
+      | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) =>
+        let
+            fun uwify (cs, acc) =
+                case cs of
+                    [] => String.concat (rev acc)
+                  | #"A" :: #"S" :: #" " :: #"_" :: cs => uwify (cs, "AS uw_" :: acc)
+                  | #"'" :: cs =>
+                    let
+                        fun waitItOut (cs, acc) =
+                            case cs of
+                                [] => raise Fail "MonoOpt: Unterminated SQL string literal"
+                              | #"'" :: cs => uwify (cs, "'" :: acc)
+                              | #"\\" :: #"'" :: cs => waitItOut (cs, "\\'" :: acc)
+                              | #"\\" :: #"\\" :: cs => waitItOut (cs, "\\\\" :: acc)
+                              | c :: cs => waitItOut (cs, str c :: acc)
+                    in
+                        waitItOut (cs, "'" :: acc)
+                    end
+                  | c :: cs => uwify (cs, str c :: acc)
+
+            val s = uwify (String.explode s, [])
+        in
+            EPrim (Prim.String (Prim.Normal, s))
+        end
+
+      | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, unAs s))
+      | EFfiApp ("Basis", "unAs", [(e', _)]) =>
+        let
+            fun parts (e as (_, loc)) =
+                case #1 e of
+                    EStrcat (s1, s2) =>
+                    (case (parts s1, parts s2) of
+                         (SOME p1, SOME p2) => SOME (p1 @ p2)
+                       | _ => NONE)
+                  | EPrim (Prim.String (_, s)) => SOME [(EPrim (Prim.String (Prim.Normal, unAs s)), loc)]
+                  | EFfiApp ("Basis", f, [_]) =>
+                    if String.isPrefix "sqlify" f then
+                        SOME [e]
+                    else
+                        NONE
+                  | _ => NONE
+        in
+            case parts e' of
+                SOME [e] => #1 e
+              | SOME es =>
+                (case rev es of
+                     (e as (_, loc)) :: es => #1 (foldl (fn (e, es) => (EStrcat (e, es), loc)) e es)
+                   | [] => raise Fail "MonoOpt impossible nil")
+              | NONE => e
+        end
+
+      | EFfiApp ("Basis", "str1", [((EPrim (Prim.Char ch), _), _)]) =>
+        EPrim (Prim.String (Prim.Normal, str ch))
+      | EFfiApp ("Basis", "attrifyString", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
+        EFfiApp ("Basis", "attrifyChar", [e])
+      | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
+        EFfiApp ("Basis", "attrifyChar_w", [e])
+      | EWrite (EFfiApp ("Basis", "str1", [e]), _) =>
+        EFfiApp ("Basis", "writec", [e])
+
+      | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
+      | EBinop (_, "-", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.- (n1, n2)))
+      | EBinop (_, "*", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.* (n1, n2)))
+
+      | _ => e
+
+and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
+
+val optimize = U.File.map {typ = typ, exp = exp, decl = decl}
+
+val optExp = U.Exp.map {typ = typ, exp = exp}
+
+end
diff --git a/src/mono_print.sig b/src/mono_print.sig
new file mode 100644
index 0000000..405ff41
--- /dev/null
+++ b/src/mono_print.sig
@@ -0,0 +1,38 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web monomorphic language *)
+
+signature MONO_PRINT = sig
+    val p_typ : MonoEnv.env -> Mono.typ Print.printer
+    val p_exp : MonoEnv.env -> Mono.exp Print.printer
+    val p_decl : MonoEnv.env -> Mono.decl Print.printer
+    val p_file : MonoEnv.env -> Mono.file Print.printer
+
+    val debug : bool ref
+end
+
diff --git a/src/mono_print.sml b/src/mono_print.sml
new file mode 100644
index 0000000..a3b55ec
--- /dev/null
+++ b/src/mono_print.sml
@@ -0,0 +1,554 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing monomorphic Ur/Web *)
+
+structure MonoPrint :> MONO_PRINT = struct
+
+open Print.PD
+open Print
+
+open Mono
+
+structure E = MonoEnv
+
+val debug = ref false
+
+val dummyt = (TRecord [], ErrorMsg.dummySpan)
+
+fun p_typ' par env (t, _) =
+    case t of
+        TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_typ env t2])
+      | TRecord xcs => box [string "{",
+                            p_list (fn (x, t) =>
+                                       box [string x,
+                                            space,
+                                            string ":",
+                                            space,
+                                            p_typ env t]) xcs,
+                            string "}"]
+      | TDatatype (n, ref (dk, _)) =>
+        ((if !debug then
+              string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n  ^ "["
+                      ^ (case dk of
+                             Option => "Option"
+                           | Enum => "Enum"
+                           | Default => "Default")
+                      ^ "]")
+          else
+              string (#1 (E.lookupDatatype env n)))
+         handle E.UnboundNamed _ => string ("UNBOUND_DATATYPE_" ^ Int.toString n))
+      | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+      | TOption t => box [string "option(",
+                          p_typ env t,
+                          string ")"]
+      | TList t => box [string "list(",
+                        p_typ env t,
+                        string ")"]
+      | TSource => string "source"
+      | TSignal t => box [string "signal(",
+                          p_typ env t,
+                          string ")"]
+
+and p_typ env = p_typ' false env
+
+fun p_enamed env n =
+    (if !debug then
+         string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+     else
+         string (#1 (E.lookupENamed env n)))
+    handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n)
+
+fun p_con_named env n =
+    (if !debug then
+        string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n)
+     else
+         string (#1 (E.lookupConstructor env n)))
+    handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n)
+
+fun p_patCon env pc =
+    case pc of
+        PConVar n => p_con_named env n
+      | PConFfi {mod = m, con, ...} => box [string "FFIC(",
+                                            string m,
+                                            string ".",
+                                            string con,
+                                            string ")"]
+
+fun p_pat' par env (p, _) =
+    case p of
+        PVar (s, _) => string s
+      | PPrim p => Prim.p_t p
+      | PCon (_, n, NONE) => p_patCon env n
+      | PCon (_, n, SOME p) => parenIf par (box [p_patCon env n,
+                                                 space,
+                                                 p_pat' true env p])
+      | PRecord xps =>
+        box [string "{",
+             p_list_sep (box [string ",", space]) (fn (x, p, _) =>
+                                                      box [string x,
+                                                           space,
+                                                           string "=",
+                                                           space,
+                                                           p_pat env p]) xps,
+             string "}"]
+      | PNone _ => string "None"
+      | PSome (t, p) =>
+        if !debug then
+            box [string "Some[",
+                 p_typ env t,
+                 string "]",
+                 space,
+                 p_pat' true env p]
+        else
+            box [string "Some",
+                 space,
+                 p_pat' true env p]
+
+and p_pat x = p_pat' false x
+
+fun p_mode env m =
+    case m of
+        Attribute => string "Attribute"
+      | Script => string "Script"
+      | Source t => box [string "Source", space, p_typ env t]
+
+fun p_exp' par env (e, _) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n =>
+        ((if !debug then
+              string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
+          else
+              string (#1 (E.lookupERel env n)))
+         handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
+      | ENamed n => p_enamed env n
+      | ECon (_, pc, NONE) => p_patCon env pc
+      | ECon (_, pc, SOME e) => parenIf par (box [p_patCon env pc,
+                                                  space,
+                                                  p_exp' true env e])
+      | ENone _ => string "None"
+      | ESome (_, e) => parenIf par (box [string "Some",
+                                          space,
+                                          p_exp' true env e])
+
+      | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+      | EFfiApp (m, x, es) => box [string "FFI(",
+                                   string m,
+                                   string ".",
+                                   string x,
+                                   string "(",
+                                   p_list (p_exp env o #1) es,
+                                   string "))"]
+      | EApp (e1, e2) => parenIf par (box [p_exp env e1,
+                                           space,
+                                           p_exp' true env e2])
+      | EAbs (x, t, _, e) => parenIf true (box [string "fn",
+                                                space,
+                                                string x,
+                                                space,
+                                                string ":",
+                                                space,
+                                                p_typ env t,
+                                                space,
+                                                string "=>",
+                                                space,
+                                                p_exp (E.pushERel env x t NONE) e])
+
+      | EUnop (s, e) => parenIf true (box [string s,
+                                           space,
+                                           p_exp' true env e])
+      | EBinop (_, s, e1, e2) => parenIf true (box [p_exp' true env e1,
+                                                    space,
+                                                    string s,
+                                                    space,
+                                                    p_exp' true env e2])
+
+      | ERecord xes => box [string "{",
+                            p_list (fn (x, e, _) =>
+                                       box [string x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_exp env e]) xes,
+                            string "}"]
+      | EField (e, x) =>
+        box [p_exp' true env e,
+             string ".",
+             string x]
+
+      | ECase (e, pes, {result, ...}) => parenIf true (box [string "case",
+                                                            space,
+                                                            p_exp env e,
+                                                            space,
+                                                            if !debug then
+                                                                box [string "return",
+                                                                     space,
+                                                                     p_typ env result,
+                                                                     space]
+                                                            else
+                                                                box [],
+                                                            string "of",
+                                                            space,
+                                                            p_list_sep (box [space, string "|", space])
+                                                                       (fn (p, e) => box [p_pat env p,
+                                                                                          space,
+                                                                                          string "=>",
+                                                                                          space,
+                                                                                          p_exp (E.patBinds env p) e])
+                                                                       pes])
+
+      | EError (e, t) => box [string "(error",
+                              space,
+                              p_exp env e,
+                              space,
+                              string ":",
+                              space,
+                              p_typ env t,
+                              string ")"]
+      | EReturnBlob {blob = SOME blob, mimeType, t} => box [string "(blob",
+                                                            space,
+                                                            p_exp env blob,
+                                                            space,
+                                                            string "in",
+                                                            space,
+                                                            p_exp env mimeType,
+                                                            space,
+                                                            string ":",
+                                                            space,
+                                                            p_typ env t,
+                                                            string ")"]
+      | EReturnBlob {blob = NONE, mimeType, t} => box [string "(blob",
+                                                       space,
+                                                       string "<page>",
+                                                       space,
+                                                       string "in",
+                                                       space,
+                                                       p_exp env mimeType,
+                                                       space,
+                                                       string ":",
+                                                       space,
+                                                       p_typ env t,
+                                                       string ")"]
+      | ERedirect (e, t) => box [string "(redirect",
+                                 space,
+                                 p_exp env e,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_typ env t,
+                                 string ")"]
+
+      | EStrcat (e1, e2) => parenIf par (box [p_exp' true env e1,
+                                              space,
+                                              string "^",
+                                              space,
+                                              p_exp env e2])
+
+      | EWrite e => box [string "write(",
+                         p_exp env e,
+                         string ")"]
+
+      | ESeq (e1, e2) => box [string "(",
+                              p_exp env e1,
+                              string ";",
+                              space,
+                              p_exp env e2,
+                              string ")"]
+      | ELet (x, t, e1, e2) => box [string "(let",
+                                    space,
+                                    string x,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_typ env t,
+                                    space,
+                                    string "=",
+                                    space,
+                                    string "(",
+                                    p_exp env e1,
+                                    string ")",
+                                    space,
+                                    string "in",
+                                    space,
+                                    string "(",
+                                    p_exp (E.pushERel env x t NONE) e2,
+                                    string "))"]
+
+      | EClosure (n, es) => box [string "CLOSURE(",
+                                 p_enamed env n,
+                                 p_list_sep (string "") (fn e => box [string ", ",
+                                                                      p_exp env e]) es,
+                                 string ")"]
+
+      | EQuery {exps, tables, state, query, body, initial} =>
+        box [string "query[",
+             p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
+             string "] [",
+             p_list (fn (x, xts) => box [string x,
+                                         space,
+                                         string ":",
+                                         space,
+                                         string "{",
+                                         p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
+                                         string "}"]) tables,
+             string "] [",
+             p_typ env state,
+             string "]",
+             space,
+             p_exp env query,
+             space,
+             string "initial",
+             space,
+             p_exp env initial,
+             space,
+             string "in",
+             space,
+             p_exp (E.pushERel (E.pushERel env "r" dummyt NONE) "acc" dummyt NONE) body]
+      | EDml (e, _) => box [string "dml(",
+                            p_exp env e,
+                            string ")"]
+      | 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 ")"]
+      | EJavaScript (m, e) => box [string "JavaScript(",
+                                   p_mode env m,
+                                   string ",",
+                                   space,
+                                   p_exp env e,
+                                   string ")"]
+
+      | ESignalReturn e => box [string "Return(",
+                                p_exp env e,
+                                string ")"]
+      | ESignalBind (e1, e2) => box [string "Bind(",
+                                     p_exp env e1,
+                                     string ",",
+                                     space,
+                                     p_exp env e2,
+                                     string ")"]
+      | ESignalSource e => box [string "Source(",
+                                p_exp env e,
+                                string ")"]
+
+      | EServerCall (n, _, _, _) => box [string "Server(",
+                                      p_exp env n,
+                                      string ")"]
+      | ERecv (n, _) => box [string "Recv(",
+                             p_exp env n,
+                             string ")"]
+      | ESleep n => box [string "Sleep(",
+                         p_exp env n,
+                         string ")"]
+      | ESpawn n => box [string "Spawn(",
+                         p_exp env n,
+                         string ")"]
+
+and p_exp env = p_exp' false env
+
+fun p_vali env (x, n, t, e, s) =
+    let
+        val xp = if !debug then
+                     box [string x,
+                          string "__",
+                          string (Int.toString n)]
+                 else
+                     string x
+    in
+        box [xp,
+             space,
+             string "as",
+             space,
+             string s,
+             space,
+             string ":",
+             space,
+             p_typ env t,
+             space,
+             string "=",
+             space,
+             p_exp env e]
+    end
+
+fun p_datatype env (x, n, cons) =
+    let
+        val env = E.pushDatatype env x n cons
+    in
+        box [if !debug then (string (x ^ "__" ^ Int.toString n))
+             else string x,
+             space,
+             string "=",
+             space,
+             p_list_sep (box [space, string "|", space])
+                        (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n))
+                                            else string x
+                          | (x, _, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n))
+                                                   else string x, space, string "of", space, p_typ env t])
+                        cons]
+    end
+
+fun p_policy env pol =
+    case pol of
+        PolClient e => box [string "sendClient",
+                            space,
+                            p_exp env e]
+      | PolInsert e => box [string "mayInsert",
+                            space,
+                            p_exp env e]
+      | PolDelete e => box [string "mayDelete",
+                            space,
+                            p_exp env e]
+      | PolUpdate e => box [string "mayUpdate",
+                            space,
+                            p_exp env e]
+      | PolSequence e => box [string "sendOwnIds",
+                              space,
+                              p_exp env e]
+
+fun p_decl env (dAll as (d, _) : decl) =
+    case d of
+        DDatatype x => box [string "datatype",
+                            space,
+                            p_list_sep (box [space, string "and", space]) (p_datatype (E.declBinds env dAll)) x]
+      | DVal vi => box [string "val",
+                        space,
+                        p_vali env vi]
+      | DValRec vis =>
+        let
+            val env = E.declBinds env dAll
+        in
+            box [string "val",
+                 space,
+                 string "rec",
+                 space,
+                 p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
+        end
+
+      | DExport (ek, s, n, ts, t, _) => box [string "export",
+                                             space,
+                                             Export.p_export_kind ek,
+                                             space,
+                                             p_enamed env n,
+                                             space,
+                                             string "as",
+                                             space,
+                                             string s,
+                                             p_list_sep (string "") (fn t => box [space,
+                                                                                  string "(",
+                                                                                  p_typ env t,
+                                                                                  string ")"]) ts,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_typ env t]
+
+      | DTable (s, xts, pe, ce) => box [string "(* SQL table ",
+                                        string s,
+                                        space,
+                                        string ":",
+                                        space,
+                                        p_list (fn (x, t) => box [string x,
+                                                                  space,
+                                                                  string ":",
+                                                                  space,
+                                                                  p_typ env t]) xts,
+                                        space,
+                                        string "keys",
+                                        space,
+                                        p_exp env pe,
+                                        space,
+                                        string "constraints",
+                                        space,
+                                        p_exp env ce,
+                                        space,
+                                        string "*)"]
+      | DSequence s => box [string "(* SQL sequence ",
+                            string s,
+                            string "*)"]
+      | DView (s, _, e) => box [string "(* SQL view ",
+                                string s,
+                                space,
+                                string "as",
+                                space,
+                                p_exp env e,
+                                string "*)"]
+      | DDatabase {name, expunge, initialize} => box [string "database",
+                                                      space,
+                                                      string name,
+                                                      space,
+                                                      string "(",
+                                                      p_enamed env expunge,
+                                                      string ",",
+                                                      space,
+                                                      p_enamed env initialize,
+                                                      string ")"]
+      | DJavaScript s => box [string "JavaScript(",
+                              string s,
+                              string ")"]
+
+      | DCookie s => box [string "cookie",
+                          space,
+                          string s]
+      | DStyle s => box [string "style",
+                         space,
+                         string s]
+      | DTask (e1, e2) => box [string "task",
+                               space,
+                               p_exp env e1,
+                               space,
+                               string "=",
+                               space,
+                               p_exp env e2]
+      | DPolicy p => box [string "policy",
+                          space,
+                          p_policy env p]
+      | DOnError _ => string "ONERROR"
+
+fun p_file env (file, _) =
+    let
+        val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
+                                             (p_decl env d,
+                                              E.declBinds env d))
+                             env file
+    in
+        p_list_sep newline (fn x => x) pds
+    end
+
+end
diff --git a/src/mono_reduce.sig b/src/mono_reduce.sig
new file mode 100644
index 0000000..8990b21
--- /dev/null
+++ b/src/mono_reduce.sig
@@ -0,0 +1,40 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Mono program algebraically *)
+
+signature MONO_REDUCE = sig
+
+    val reduce : Mono.file -> Mono.file
+
+    val subExpInExp : int * Mono.exp -> Mono.exp -> Mono.exp
+
+    val impure : Mono.exp -> bool
+
+    val fullMode : bool ref
+
+end
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
new file mode 100644
index 0000000..5bcb6f5
--- /dev/null
+++ b/src/mono_reduce.sml
@@ -0,0 +1,924 @@
+(* Copyright (c) 2008, 2013-2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Mono program algebraically *)
+
+structure MonoReduce :> MONO_REDUCE = struct
+
+open Mono
+
+val fullMode = ref false
+
+structure E = MonoEnv
+structure U = MonoUtil
+
+structure IM = IntBinaryMap
+structure IS = IntBinarySet
+
+structure SS = BinarySetFn(struct
+                            type ord_key = string
+                            val compare = String.compare
+                            end)
+
+structure SLS = BinarySetFn(struct
+                             type ord_key = string list
+                             val compare = Order.joinL String.compare
+                             end)
+
+
+
+fun simpleTypeImpure tsyms =
+    U.Typ.exists (fn TFun _ => true
+                   | TDatatype (n, _) => IS.member (tsyms, n)
+                   | _ => false)
+
+fun simpleImpure isGlobal (tsyms, syms) =
+    U.Exp.existsB {typ = fn _ => false,
+                   exp = fn (env, e) =>
+                            case e of
+                                EWrite _ => true
+                              | EQuery _ => true
+                              | EDml _ => true
+                              | ENextval _ => true
+                              | ESetval _ => true
+                              | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x)
+                              | EServerCall _ => true
+                              | ERecv _ => true
+                              | ESleep _ => true
+                              | ENamed n => IS.member (syms, n)
+                              | ERel n =>
+                                let
+                                    val (_, t, _) = E.lookupERel env n
+                                in
+                                    simpleTypeImpure tsyms t
+                                end
+                              | EApp _ => not isGlobal
+                              | _ => false,
+                   bind = fn (env, b) =>
+                             case b of
+                                 U.Exp.RelE (x, t) => E.pushERel env x t NONE
+                               | _ => env}
+
+fun impure (e, _) =
+    case e of
+        EWrite _ => true
+      | EQuery _ => true
+      | EDml _ => true
+      | ENextval _ => true
+      | ESetval _ => true
+      | EUnurlify (e, _, _) => impure e
+      | EAbs _ => false
+
+      | EPrim _ => false
+      | ERel _ => false
+      | ENamed _ => false
+      | ECon (_, _, eo) => (case eo of NONE => false | SOME e => impure e)
+      | ENone _ => false
+      | ESome (_, e) => impure e
+      | EFfi _ => false
+      | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x)
+      | EApp ((EFfi _, _), _) => false
+      | EApp _ => true
+
+      | EUnop (_, e) => impure e
+      | EBinop (_, _, e1, e2) => impure e1 orelse impure e2
+
+      | ERecord xes => List.exists (fn (_, e, _) => impure e) xes
+      | EField (e, _) => impure e
+
+      | ECase (e, pes, _) => impure e orelse List.exists (fn (_, e) => impure e) pes
+
+      | EError _ => true
+      | EReturnBlob {blob = NONE, mimeType = e2, ...} => impure e2
+      | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => impure e1 orelse impure e2
+      | ERedirect (e, _) => impure e
+
+      | EStrcat (e1, e2) => impure e1 orelse impure e2
+
+      | ESeq (e1, e2) => impure e1 orelse impure e2
+      | ELet (_, _, e1, e2) => impure e1 orelse impure e2
+
+      | EClosure (_, es) => List.exists impure es
+      | EJavaScript (_, e) => impure e
+      | ESignalReturn e => impure e
+      | ESignalBind (e1, e2) => impure e1 orelse impure e2
+      | ESignalSource e => impure e
+      | EServerCall _ => true
+      | ERecv _ => true
+      | ESleep _ => true
+      | ESpawn _ => true
+
+val liftExpInExp = Monoize.liftExpInExp
+
+fun multiLift n e =
+    case n of
+        0 => e
+      | _ => multiLift (n - 1) (liftExpInExp 0 e)
+
+val subExpInExp' =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | (ctx, _) => ctx}
+
+fun subExpInExp (n, e1) e2 =
+    let
+        val r = subExpInExp' (n, e1) e2
+    in
+        (*Print.prefaces "subExpInExp" [("e1", MonoPrint.p_exp MonoEnv.empty e1),
+                                      ("e2", MonoPrint.p_exp MonoEnv.empty e2),
+                                      ("r", MonoPrint.p_exp MonoEnv.empty r)];*)
+        r
+    end
+
+fun typ c = c
+
+val swapExpVars =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn lower => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn = lower then
+                                             ERel (lower + 1)
+                                         else if xn = lower + 1 then
+                                             ERel lower
+                                         else
+                                             e
+                                       | _ => e,
+                bind = fn (lower, U.Exp.RelE _) => lower+1
+                        | (lower, _) => lower}
+
+val swapExpVarsPat =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn (lower, len) => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn = lower then
+                                             ERel (lower + len)
+                                         else if xn >= lower + 1 andalso xn < lower + 1 + len then
+                                             ERel (xn - 1)
+                                         else
+                                             e
+                                       | _ => e,
+                bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len)
+                        | (st, _) => st}
+
+datatype result = Yes of (string * typ * exp) list | No | Maybe
+
+fun match (env, p : pat, e : exp) =
+    case (#1 p, #1 e) of
+        (PVar (x, t), _) => Yes ((x, t, e) :: env)
+
+      | (PPrim (Prim.String (_, s)), EStrcat ((EPrim (Prim.String (_, s')), _), _)) =>
+        if String.isPrefix s' s then
+            Maybe
+        else
+            No
+
+      | (PPrim (Prim.String (_, s)), EStrcat (_, (EPrim (Prim.String (_, s')), _))) =>
+        if String.isSuffix s' s then
+            Maybe
+        else
+            No
+
+      | (PPrim p, EPrim p') =>
+        if Prim.equal (p, p') then
+            Yes env
+        else
+            No
+
+      | (PPrim (Prim.String (_, s)), _) =>
+        let
+            fun lengthLb (e : exp) =
+                case #1 e of
+                    EStrcat (e1, e2) => lengthLb e1 + lengthLb e2
+                  | EPrim (Prim.String (_, s)) => size s
+                  | _ => 0
+        in
+            if lengthLb e > size s then
+                No
+            else
+                Maybe
+        end
+
+      | (PCon (_, PConVar n1, po), ECon (_, PConVar n2, eo)) =>
+        if n1 = n2 then
+            case (po, eo) of
+                (NONE, NONE) => Yes env
+              | (SOME p, SOME e) => match (env, p, e)
+              | _ => Maybe
+        else
+            No
+
+      | (PCon (_, PConFfi {mod = m1, con = con1, ...}, NONE), ECon (_, PConFfi {mod = m2, con = con2, ...}, NONE)) =>
+        if m1 = m2 andalso con1 = con2 then
+            Yes env
+        else
+            No
+
+      | (PCon (_, PConFfi {mod = m1, con = con1, ...}, SOME ep), ECon (_, PConFfi {mod = m2, con = con2, ...}, SOME e)) =>
+        if m1 = m2 andalso con1 = con2 then
+            match (env, p, e)
+        else
+            No
+
+      | (PRecord xps, ERecord xes) =>
+        let
+            fun consider (xps, env) =
+                case xps of
+                    [] => Yes env
+                  | (x, p, _) :: rest =>
+                    case List.find (fn (x', _, _) => x' = x) xes of
+                        NONE => No
+                      | SOME (_, e, _) =>
+                        case match (env, p, e) of
+                            No => No
+                          | Maybe => Maybe
+                          | Yes env => consider (rest, env)
+        in
+            consider (xps, env)
+        end
+
+      | (PNone _, ENone _) => Yes env
+      | (PNone _, ESome _) => No
+      | (PSome (_, p), ESome (_, e)) => match (env, p, e)
+      | (PSome _, ENone _) => No
+
+      | _ => Maybe
+
+datatype event =
+         WritePage
+       | ReadDb
+       | WriteDb
+       | ReadCookie
+       | WriteCookie
+       | UseRel
+       | Unsure
+       | Abort
+
+fun p_event e =
+    let
+        open Print.PD
+    in
+        case e of
+            WritePage => string "WritePage"
+          | ReadDb => string "ReadDb"
+          | WriteDb => string "WriteDb"
+          | ReadCookie => string "ReadCookie"
+          | WriteCookie => string "WriteCookie"
+          | UseRel => string "UseRel"
+          | Unsure => string "Unsure"
+          | Abort => string "Abort"
+    end
+
+val p_events = Print.p_list p_event
+
+fun patBinds (p, _) =
+    case p of
+        PVar _ => 1
+      | PPrim _ => 0
+      | PCon (_, _, NONE) => 0
+      | PCon (_, _, SOME p) => patBinds p
+      | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
+      | PNone _ => 0
+      | PSome (_, p) => patBinds p
+
+val countFree = U.Exp.foldB {typ = fn (_, n) => n,
+                             exp = fn (x, e, n) =>
+                                      case e of
+                                          ERel x' => if x = x' then n + 1 else n
+                                        | _ => n,
+                             bind = fn (n, b) =>
+                                       case b of
+                                           U.Exp.RelE _ => n + 1
+                                     | _ => n}
+
+val freeInAbs = U.Exp.existsB {typ = fn _ => false,
+                               exp = fn (n, e) =>
+                                        case e of
+                                            EAbs (_, _, _, b) => countFree n 0 b > 0
+                                          | EJavaScript (_, b) => countFree n 0 b > 0
+                                          | _ => false,
+                               bind = fn (n, b) =>
+                                         case b of
+                                             U.Exp.RelE _ => n + 1
+                                           | _ => n} 0
+
+val yankedCase = ref false
+
+fun reduce' (file : file) =
+    let
+        val (timpures, impures, absCounts) =
+            foldl (fn ((d, _), (timpures, impures, absCounts)) =>
+                      let
+                          fun countAbs env e =
+                              case #1 e of
+                                  EAbs (x, t, _, e) => 1 + countAbs (E.pushERel env x t NONE) e
+                                | _ =>
+                                  let
+                                      fun remaining e =
+                                          case #1 e of
+                                              ENamed n => IM.find (absCounts, n)
+                                            | EApp (e, arg) =>
+                                              if simpleImpure true (timpures, impures) env arg then
+                                                  NONE
+                                              else
+                                                  (case remaining e of
+                                                       NONE => NONE
+                                                     | SOME n => if n > 0 then
+                                                                     SOME (n - 1)
+                                                                 else
+                                                                     NONE)
+                                            | _ => NONE
+                                  in
+                                      getOpt (remaining e, 0)
+                                  end
+                      in
+                          case d of
+                              DDatatype dts =>
+                              (if List.exists (fn (_, _, cs) =>
+                                                  List.exists (fn (_, _, NONE) => false
+                                                                | (_, _, SOME t) => simpleTypeImpure timpures t) cs)
+                                              dts then
+                                   IS.addList (timpures, map #2 dts)
+                               else
+                                   timpures,
+                               impures,
+                               absCounts)
+                            | DVal (_, n, _, e, _) =>
+                              (timpures,
+                               if simpleImpure true (timpures, impures) E.empty e then
+                                   IS.add (impures, n)
+                               else
+                                   impures,
+                               IM.insert (absCounts, n, countAbs E.empty e))
+                            | DValRec vis =>
+                              (timpures,
+                               if List.exists (fn (_, _, _, e, _) => simpleImpure true (timpures, impures) E.empty e) vis then
+                                   foldl (fn ((_, n, _, _, _), impures) =>
+                                             IS.add (impures, n)) impures vis
+                               else
+                                   impures,
+                               foldl (fn ((x, n, _, e, _), absCounts) =>
+                                         IM.insert (absCounts, n, countAbs E.empty e))
+                                     absCounts vis)
+                            | _ => (timpures, impures, absCounts)
+                      end)
+                  (IS.empty, IS.empty, IM.empty) (#1 file)
+
+        val uses = U.File.fold {typ = fn (_, m) => m,
+                                exp = fn (e, m) =>
+                                         case e of
+                                             ENamed n => IM.insert (m, n, 1 + Option.getOpt (IM.find (m, n), 0))
+                                           | _ => m,
+                                decl = fn (_, m) => m}
+                               IM.empty file
+
+        val size = U.Exp.fold {typ = fn (_, n) => n,
+                               exp = fn (_, n) => n + 1} 0
+
+        val functionInside' = U.Typ.exists (fn c => case c of
+                                                        TFun _ => true
+                                                      | _ => false)
+                              
+        fun functionInside t =
+            case #1 t of
+                TFun (t1, t2) => functionInside' t1 orelse functionInside t2
+              | _ => functionInside' t
+
+        fun mayInline (n, e, t, s) =
+            case IM.find (uses, n) of
+                NONE => false
+              | SOME count => not (Settings.checkNeverInline s)
+                              andalso (count <= 1
+                                       orelse size e <= Settings.getMonoInline ()
+                                       orelse functionInside t
+                                       orelse Settings.checkAlwaysInline s)
+
+        fun summarize d (e, _) =
+            let
+                val s =
+                    case e of
+                        EPrim _ => []
+                      | ERel n => if n = d then [UseRel] else []
+                      | ENamed _ => []
+                      | ECon (_, _, NONE) => []
+                      | ECon (_, _, SOME e) => summarize d e
+                      | ENone _ => []
+                      | ESome (_, e) => summarize d e
+                      | EFfi _ => []
+                      | EFfiApp ("Basis", "get_cookie", [(e, _)]) =>
+                        summarize d e @ [ReadCookie]
+                      | EFfiApp ("Basis", "set_cookie", es) =>
+                        List.concat (map (summarize d o #1) es) @ [WriteCookie]
+                      | EFfiApp ("Basis", "clear_cookie", es) =>
+                        List.concat (map (summarize d o #1) es) @ [WriteCookie]
+                      | EFfiApp (m, x, es) =>
+                        if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then
+                            List.concat (map (summarize d o #1) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then
+                                                                           WritePage
+                                                                       else
+                                                                           Unsure]
+                        else
+                            List.concat (map (summarize d o #1) es)
+                      | EApp ((EFfi _, _), e) => summarize d e
+                      | EApp _ =>
+                        let
+                            fun unravel (e, passed, ls) =
+                                case e of
+                                    ENamed n =>
+                                    let
+                                        val ls = rev ls
+                                    in
+                                        if IS.member (impures, n) then
+                                            case IM.find (absCounts, n) of
+                                                NONE => [Unsure]
+                                              | SOME len =>
+                                                if passed < len then
+                                                    ls
+                                                else
+                                                    ls @ [Unsure]
+                                        else
+                                            ls
+                                    end
+                                  | ERel n => List.revAppend (ls,
+                                                              if n = d then
+                                                                  [UseRel, Unsure]
+                                                              else
+                                                                  [Unsure])
+                                  | EApp (f, x) =>
+                                    unravel (#1 f, passed + 1, List.revAppend (summarize d x,
+                                                                               ls))
+                                  | EError _ => [Abort]
+                                  | _ => [Unsure]
+                        in
+                            unravel (e, 0, [])
+                        end
+
+                      | EAbs _ => []
+
+                      | EUnop (_, e) => summarize d e
+                      | EBinop (_, _, e1, e2) => summarize d e1 @ summarize d e2
+
+                      | ERecord xets => List.concat (map (summarize d o #2) xets)
+                      | EField (e, _) => summarize d e
+
+                      | ECase (e, pes, _) =>
+                        let
+                            val lss = map (fn (p, e) => summarize (if d = ~1 then ~1 else d + patBinds p) e) pes
+
+                            fun splitRel ls acc =
+                                case ls of
+                                    [] => (acc, false, ls)
+                                  | UseRel :: ls  => (acc, true, ls)
+                                  | v :: ls => splitRel ls (v :: acc)
+
+                            val (pre, used, post) = foldl (fn (ls, (pre, used, post)) =>
+                                                              let
+                                                                  val (pre', used', post') = splitRel ls []
+                                                              in
+                                                                  (pre' @ pre, used' orelse used, post' @ post)
+                                                              end)
+                                                    ([], false, []) lss
+                        in
+                            summarize d e
+                            @ pre
+                            @ (if used then [UseRel] else [])
+                            @ post
+                        end
+                      | EStrcat (e1, e2) => summarize d e1 @ summarize d e2
+
+                      | EError (e, _) => summarize d e @ [Abort]
+                      | EReturnBlob {blob = NONE, mimeType = e2, ...} => summarize d e2 @ [Abort]
+                      | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort]
+                      | ERedirect (e, _) => summarize d e @ [Abort]
+
+                      | EWrite e => summarize d e @ [WritePage]
+                                    
+                      | ESeq (e1, e2) => summarize d e1 @ summarize d e2
+                      | ELet (_, _, e1, e2) => summarize d e1 @ summarize (if d = ~1 then ~1 else d + 1) e2
+
+                      | EClosure (_, es) => List.concat (map (summarize d) es)
+
+                      | EQuery {query, body, initial, ...} =>
+                        List.concat [summarize d query,
+                                     summarize d initial,
+                                     [ReadDb],
+                                     summarize (if d = ~1 then ~1 else d + 2) body]
+
+                      | 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
+                      | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
+                      | ESignalSource e => summarize d e
+
+                      | EServerCall (e, _, _, _) => summarize d e @ [Unsure]
+                      | ERecv (e, _) => summarize d e @ [Unsure]
+                      | ESleep e => summarize d e @ [Unsure]
+                      | ESpawn e => summarize d e @ [Unsure]
+            in
+                (*Print.prefaces "Summarize"
+                               [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
+                                ("d", Print.PD.string (Int.toString d)),
+                                ("s", p_events s)];*)
+                s
+            end
+
+        val impure = fn env => fn e =>
+                        simpleImpure false (timpures, impures) env e andalso impure e
+                        andalso not (List.null (summarize ~1 e))
+
+        fun passive (e : exp) =
+            case #1 e of
+                EPrim _ => true
+              | ERel _ => true
+              | ENamed _ => true
+              | ECon (_, _, NONE) => true
+              | ECon (_, _, SOME e) => passive e
+              | ENone _ => true
+              | ESome (_, e) => passive e
+              | EFfi _ => true
+              | EAbs _ => true
+              | ERecord xets => List.all (passive o #2) xets
+              | EField (e, _) => passive e
+              | _ => false
+
+        fun exp env e =
+            let
+                (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*)
+
+                fun doLet (x, t, e', b) =
+                    let
+                        fun doSub () =
+                            let
+                                val r = subExpInExp (0, e') b
+                            in
+                                (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
+                                                        ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                                        ("r", MonoPrint.p_exp env r)];*)
+                                #1 (reduceExp env r)
+                            end
+
+                        fun trySub () =
+                            ((*Print.prefaces "trySub"
+                                            [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*)
+                             case t of
+                                 (TFfi ("Basis", "string"), _) => doSub ()
+                               | (TSignal _, _) => e
+                               | _ =>
+                                 case e' of
+                                     (ECase _, _) => e
+                                   | _ => doSub ())
+
+                        fun isRecord () =
+                            case #1 e' of
+                                ERecord _ => true
+                              | _ => false
+
+                        fun prefixFrom i (e : exp) =
+                            case #1 e of
+                                ERel i' => if i' = i then SOME [] else NONE
+                              | EField (e', s) =>
+                                (case prefixFrom i e' of
+                                     NONE => NONE
+                                   | SOME ss => SOME (ss @ [s]))
+                              | _ => NONE
+
+                        fun whichProj i (e : exp) =
+                            case #1 e of
+                                EPrim _ => SOME SLS.empty
+                              | ERel i' => if i' = i then NONE else SOME SLS.empty
+                              | ENamed _ => SOME SLS.empty
+                              | ECon (_, _, NONE) => SOME SLS.empty
+                              | ECon (_, _, SOME e') => whichProj i e'
+                              | ENone _ => SOME SLS.empty
+                              | ESome (_, e') => whichProj i e'
+                              | EFfi _ => SOME SLS.empty
+                              | EFfiApp (_, _, es) => whichProjs i (map #1 es)
+                              | EApp (e1, e2) => whichProjs i [e1, e2]
+                              | EAbs (_, _, _, e) => whichProj (i + 1) e
+                              | EUnop (_, e1) => whichProj i e1
+                              | EBinop (_, _, e1, e2) => whichProjs i [e1, e2]
+                              | ERecord xets => whichProjs i (map #2 xets)
+                              | EField (e1, s) =>
+                                (case prefixFrom i e1 of
+                                     NONE => SOME SLS.empty
+                                   | SOME ss => SOME (SLS.singleton (ss @ [s])))
+                              | ECase (e1, pes, _) =>
+                                whichProjs' i ((0, e1)
+                                               :: map (fn (p, e) => (patBinds p, e)) pes)
+                              | EStrcat (e1, e2) => whichProjs i [e1, e2]
+                              | EError (e1, _) => whichProj i e1
+                              | EReturnBlob {blob = NONE, mimeType = e2, ...} => whichProj i e2
+                              | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => whichProjs i [e1, e2]
+                              | ERedirect (e1, _) => whichProj i e1
+                              | EWrite e1 => whichProj i e1
+                              | ESeq (e1, e2) => whichProjs i [e1, e2]
+                              | ELet (_, _, e1, e2) => whichProjs' i [(0, e1), (1, e2)]
+                              | EClosure (_, es) => whichProjs i es
+                              | EQuery {query = e1, body = e2, initial = e3, ...} =>
+                                whichProjs' i [(0, e1), (2, e2), (0, e3)]
+                              | EDml (e1, _) => whichProj i e1
+                              | ENextval e1 => whichProj i e1
+                              | ESetval (e1, e2) => whichProjs i [e1, e2]
+                              | EUnurlify (e1, _, _) => whichProj i e1
+                              | EJavaScript (_, e1) => whichProj i e1
+                              | ESignalReturn e1 => whichProj i e1
+                              | ESignalBind (e1, e2) => whichProjs i [e1, e2]
+                              | ESignalSource e1 => whichProj i e1
+                              | EServerCall (e1, _, _, _) => whichProj i e1
+                              | ERecv (e1, _) => whichProj i e1
+                              | ESleep e1 => whichProj i e1
+                              | ESpawn e1 => whichProj i e1
+
+                        and whichProjs i es =
+                            whichProjs' i (map (fn e => (0, e)) es)
+
+                        and whichProjs' i es =
+                            case es of
+                                [] => SOME SLS.empty
+                              | (n, e) :: es' =>
+                                case (whichProj (i + n) e, whichProjs' i es') of
+                                    (SOME m1, SOME m2) =>
+                                    if SLS.isEmpty (SLS.intersection (m1, m2)) then
+                                        SOME (SLS.union (m1, m2))
+                                    else
+                                        NONE
+                                  | _ => NONE
+                    in
+                        if impure env e' then
+                            let
+                                val effs_e' = summarize 0 e'
+                                val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
+                                val effs_b = summarize 0 b
+
+                                (*val () = Print.prefaces "Try"
+                                                        [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
+                                                         ("e'", MonoPrint.p_exp env e'),
+                                                         ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                                         ("e'_eff", p_events effs_e'),
+                                                         ("b_eff", p_events effs_b)]*)
+
+                                fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
+                                val writesPage = does WritePage
+                                val readsDb = does ReadDb
+                                val writesDb = does WriteDb
+                                val readsCookie = does ReadCookie
+                                val writesCookie = does ReadCookie
+
+                                fun verifyUnused eff =
+                                    case eff of
+                                        UseRel => false
+                                      | _ => true
+
+                                fun verifyCompatible effs =
+                                    case effs of
+                                        [] => false
+                                      | eff :: effs =>
+                                        case eff of
+                                            Unsure => false
+                                          | UseRel => List.all verifyUnused effs
+                                          | WritePage => not writesPage andalso verifyCompatible effs
+                                          | ReadDb => not writesDb andalso verifyCompatible effs
+                                          | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
+                                          | ReadCookie => not writesCookie andalso verifyCompatible effs
+                                          | WriteCookie => not writesCookie andalso not readsCookie
+                                                           andalso verifyCompatible effs
+                                          | Abort => true
+                            in
+                                (*Print.prefaces "verifyCompatible"
+                                                 [("e'", MonoPrint.p_exp env e'),
+                                                  ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                                  ("effs_e'", Print.p_list p_event effs_e'),
+                                                  ("effs_b", Print.p_list p_event effs_b)];*)
+                                if (List.null effs_e'
+                                    orelse (List.all (fn eff => eff <> Unsure) effs_e'
+                                            andalso verifyCompatible effs_b)
+                                    orelse (case effs_b of
+                                                UseRel :: effs => List.all verifyUnused effs
+                                              | _ => false))
+                                   andalso countFree 0 0 b = 1
+                                   andalso not (freeInAbs b) then
+                                    trySub ()
+                                else
+                                    e
+                            end
+                        else if countFree 0 0 b > 1
+                                andalso not (!fullMode)
+                                andalso not (passive e')
+                                andalso not (isRecord () andalso Option.isSome (whichProj 0 b)) then
+                            e
+                        else
+                            trySub ()
+                    end
+
+                val r =
+                    case e of
+                        ERel n =>
+                        (case E.lookupERel env n of
+                             (_, _, SOME e') => #1 e'
+                           | _ => e)
+                      | ENamed n =>
+                        (case E.lookupENamed env n of
+                             (_, _, SOME e', _) => ((*Print.prefaces "Switch" [("n", Print.PD.string (Int.toString n)),
+                                                                               ("e'", MonoPrint.p_exp env e')];*)
+                                                    #1 e')
+                           | _ => e)
+
+                      | EApp ((EAbs (x, t, _, e1), loc), e2) =>
+                        ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1),
+                                                       ("e2", MonoPrint.p_exp env e2),
+                                                       ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*)
+                         if impure env e2 orelse (not (!fullMode) andalso countFree 0 0 e1 > 1) then
+                             #1 (reduceExp env (ELet (x, t, e2, e1), loc))
+                         else
+                             #1 (reduceExp env (subExpInExp (0, e2) e1)))
+
+                      | ECase (e', pes, {disc, result}) =>
+                        let
+                            fun push () =
+                                case result of
+                                    (TFun (dom, result), loc) =>
+                                    let
+                                        fun safe e =
+                                            List.all (fn UseRel => true
+                                                       | Abort => true
+                                                       | _ => false) (summarize 0 e)
+
+                                        fun p_events' es = Print.box [Print.PD.string "{",
+                                                                      p_events es,
+                                                                      Print.PD.string "}"]
+                                    in
+                                        if List.all (safe o #2) pes then
+                                            (yankedCase := true;
+                                             EAbs ("y", dom, result,
+                                                   (ECase (liftExpInExp 0 e',
+                                                           map (fn (p, (EAbs (_, _, _, e), _)) =>
+                                                                   (p, swapExpVarsPat (0, patBinds p) e)
+                                                               | (p, (EError (e, (TFun (_, t), _)), loc)) =>
+                                                                 (p, (EError (liftExpInExp (patBinds p) e, t), loc))
+                                                               | (p, e) =>
+                                                                 (p, (EApp (liftExpInExp (patBinds p) e,
+                                                                            (ERel (patBinds p), loc)), loc)))
+                                                               pes,
+                                                           {disc = disc, result = result}), loc)))
+                                        else
+                                            e
+                                    end
+                                  | _ => e
+
+                            fun search pes =
+                                case pes of
+                                    [] => push ()
+                                  | (p, body) :: pes =>
+                                    case match ([], p, e') of
+                                        No => search pes
+                                      | Maybe => push ()
+                                      | Yes subs =>
+                                        let
+                                            val (body, remaining) =
+                                                foldl (fn ((x, t, e), (body, remaining)) =>
+                                                          (if countFree 0 0 body > 1 then
+                                                               (ELet (x, t, multiLift remaining e, body), #2 e')
+                                                           else
+                                                               subExpInExp (0, multiLift remaining e) body, remaining - 1))
+                                                      (body, length subs - 1) subs
+                                            val r = reduceExp (E.patBinds env p) body
+                                        in
+                                            (*Print.preface ("subs", Print.p_list (MonoPrint.p_exp env) subs);*)
+                                            (*Print.prefaces "ECase"
+                                                           [("old", MonoPrint.p_exp env body),
+                                                            ("body", MonoPrint.p_exp env body),
+                                                            ("r", MonoPrint.p_exp env r)];*)
+                                            #1 r
+                                        end
+                        in
+                            if impure env e' then
+                                e
+                            else
+                                search pes
+                        end
+
+                      | EField (e1, x) =>
+                        let
+                            fun yankLets (e : exp) =
+                                case #1 e of
+                                    ELet (x, t, e1, e2) => (ELet (x, t, e1, yankLets e2), #2 e)
+                                  | ERecord xes =>
+                                    (case List.find (fn (x', _, _) => x' = x) xes of
+                                         SOME (_, e, _) => e
+                                       | NONE => (EField (e, x), #2 e))
+                                  | _ => (EField (e, x), #2 e)
+                        in
+                            #1 (yankLets e1)
+                        end
+
+                      | ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) =>
+                        let
+                            val e' = (ELet (x2, t2, e1,
+                                            (ELet (x1, t1, b1,
+                                                   liftExpInExp 1 b2), loc)), loc)
+                        in
+                            (*Print.prefaces "ELet commute" [("e", MonoPrint.p_exp env (e, loc)),
+                                                             ("e'", MonoPrint.p_exp env e')];*)
+                            #1 (reduceExp env e')
+                        end
+                      | EApp ((ELet (x, t, e, b), loc), e') =>
+                        #1 (reduceExp env (ELet (x, t, e,
+                                                 (EApp (b, liftExpInExp 0 e'), loc)), loc))
+
+                      | ELet (x, t, e', b as (EAbs (x', t' as (TRecord [], _), ran, e''), loc)) =>
+                        if impure env e' then
+                            doLet (x, t, e', b)
+                        else
+                            EAbs (x', t', ran, reduceExp (E.pushERel env x' t' NONE)
+                                                         (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc))
+
+                      | ELet (x, t, e', b) => doLet (x, t, e', b)
+
+                      | EStrcat ((EPrim (Prim.String (k1, s1)), _), (EPrim (Prim.String (k2, s2)), _)) =>
+                        EPrim (Prim.String ((case (k1, k2) of
+                                                 (Prim.Html, Prim.Html) => Prim.Html
+                                               | _ => Prim.Normal), s1 ^ s2))
+
+                      | ESignalBind ((ESignalReturn e1, loc), e2) =>
+                        #1 (reduceExp env (EApp (e2, e1), loc))
+
+                      | _ => e
+            in
+                (*Print.prefaces "exp'" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),
+                                       ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*)
+                r
+            end
+
+        and bind (env, b) =
+            case b of
+                U.Decl.Datatype (x, n, xncs) => E.pushDatatype env x n xncs
+              | U.Decl.RelE (x, t) => E.pushERel env x t NONE
+              | U.Decl.NamedE (x, n, t, eo, s) =>
+                let
+                    val eo = case eo of
+                                 NONE => NONE
+                               | SOME e => if mayInline (n, e, t, s) then
+                                               SOME e
+                                           else
+                                               NONE
+                in
+                    E.pushENamed env x n t (Option.map (reduceExp env) eo) s
+                end
+
+        and reduceExp env = U.Exp.mapB {typ = typ, exp = exp, bind = bind} env
+
+        fun decl env d = ((*Print.preface ("d", MonoPrint.p_decl env (d, ErrorMsg.dummySpan));*)
+                          d)
+    in
+        U.File.mapB {typ = typ, exp = exp, decl = decl, bind = bind} E.empty file
+    end
+
+fun reduce file =
+    let
+        val () = yankedCase := false
+        val file' = reduce' file
+    in
+        if !yankedCase then
+            reduce file'
+        else
+            file'
+    end
+
+
+end
diff --git a/src/mono_shake.sig b/src/mono_shake.sig
new file mode 100644
index 0000000..813bc52
--- /dev/null
+++ b/src/mono_shake.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove unused definitions from a file *)
+
+signature MONO_SHAKE = sig
+
+    val shake : Mono.file -> Mono.file
+
+end
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
new file mode 100644
index 0000000..5818fea
--- /dev/null
+++ b/src/mono_shake.sml
@@ -0,0 +1,164 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove unused definitions from a file *)
+
+structure MonoShake :> MONO_SHAKE = struct
+
+open Mono
+
+structure U = MonoUtil
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+type free = {
+     con : IS.set,
+     exp : IS.set
+}
+
+fun shake (file : file) =
+    let
+        val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) =>
+                                     (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef)
+                                   | ((DVal (_, n, t, e, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, (t, e)))
+                                   | ((DValRec vis, _), (cdef, edef)) =>
+                                     (cdef, foldl (fn ((_, n, t, e, _), edef) => IM.insert (edef, n, (t, e))) edef vis)
+                                   | ((DExport _, _), acc) => acc
+                                   | ((DTable _, _), acc) => acc
+                                   | ((DSequence _, _), acc) => acc
+                                   | ((DView _, _), acc) => acc
+                                   | ((DDatabase _, _), acc) => acc
+                                   | ((DJavaScript _, _), acc) => acc
+                                   | ((DCookie _, _), acc) => acc
+                                   | ((DStyle _, _), acc) => acc
+                                   | ((DTask _, _), acc) => acc
+                                   | ((DPolicy _, _), acc) => acc
+                                   | ((DOnError _, _), acc) => acc)
+                                 (IM.empty, IM.empty) (#1 file)
+
+        fun typ (c, s) =
+            case c of
+                TDatatype (n, _) =>
+                if IS.member (#con s, n) then
+                    s
+                else
+                    let
+                        val s' = {exp = #exp s,
+                                  con = IS.add (#con s, n)}
+                    in
+                        case IM.find (cdef, n) of
+                            NONE => s'
+                          | SOME xncs => foldl (fn ((_, _, to), s) =>
+                                                   case to of
+                                                       NONE => s
+                                                     | SOME t => shakeTyp s t)
+                                         s' xncs
+                    end
+              | _ => s
+
+        and shakeTyp s = U.Typ.fold typ s
+
+        fun exp (e, s) =
+            case e of
+                ENamed n =>
+                if IS.member (#exp s, n) then
+                    s
+                else
+                    let
+                        val s' = {exp = IS.add (#exp s, n),
+                                  con = #con s}
+                    in
+                        case IM.find (edef, n) of
+                            NONE => s'
+                          | SOME (t, e) => shakeExp s' e
+                    end
+              | _ => s
+
+        and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s
+
+        fun usedVars (cs, es) e =
+            let
+                val {con = cs', exp = es'} = shakeExp {con = cs, exp = es} e
+            in
+                (cs', es')
+            end
+
+        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]))
+                  | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1
+                  | ((DTable (_, xts, e1, e2), _), st) => usedVars (usedVars (usedVars st e1) e2)
+                                                                   (ERecord (map (fn (x, t) => (x, (ERecord [], #2 e1), t)) xts), #2 e1)
+                  | ((DView (_, _, e), _), st) => usedVars st e
+                  | ((DPolicy pol, _), st) =>
+                    let
+                        val e1 = case pol of
+                                     PolClient e1 => e1
+                                   | PolInsert e1 => e1
+                                   | PolDelete e1 => e1
+                                   | PolUpdate e1 => e1
+                                   | PolSequence e1 => e1
+                    in
+                        usedVars st e1
+                    end
+                  | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
+                  | (_, st) => st) (IS.empty, IS.empty) (#1 file)
+
+        val s = {con = page_cs, exp = 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)
+                       | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
+                       | (DExport _, _) => true
+                       | (DTable _, _) => true
+                       | (DSequence _, _) => true
+                       | (DView _, _) => true
+                       | (DDatabase _, _) => true
+                       | (DJavaScript _, _) => true
+                       | (DCookie _, _) => true
+                       | (DStyle _, _) => true
+                       | (DTask _, _) => true
+                       | (DPolicy _, _) => true
+                       | (DOnError _, _) => true) (#1 file), #2 file)
+    end
+
+end
diff --git a/src/mono_util.sig b/src/mono_util.sig
new file mode 100644
index 0000000..5c078a7
--- /dev/null
+++ b/src/mono_util.sig
@@ -0,0 +1,161 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MONO_UTIL = sig
+
+structure Typ : sig
+    val compare : Mono.typ * Mono.typ -> order
+    val sortFields : (string * Mono.typ) list -> (string * Mono.typ) list
+
+    val mapfold : (Mono.typ', 'state, 'abort) Search.mapfolder
+                  -> (Mono.typ, 'state, 'abort) Search.mapfolder
+
+    val map : (Mono.typ' -> Mono.typ')
+              -> Mono.typ -> Mono.typ
+
+    val fold : (Mono.typ' * 'state -> 'state)
+              -> 'state -> Mono.typ -> 'state
+
+    val exists : (Mono.typ' -> bool) -> Mono.typ -> bool
+end
+
+structure Exp : sig
+    datatype binder =
+             Datatype of string * int * (string * int * Mono.typ option) list
+           | RelE of string * Mono.typ
+           | NamedE of string * int * Mono.typ * Mono.exp option * string
+
+    val mapfoldB : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                    exp : ('typtext, Mono.exp', 'state, 'abort) Search.mapfolderB,
+                    bind : 'typtext * binder -> 'typtext}
+                   -> ('typtext, Mono.exp, 'state, 'abort) Search.mapfolderB
+    val mapfold : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                   exp : (Mono.exp', 'state, 'abort) Search.mapfolder}
+                  -> (Mono.exp, 'state, 'abort) Search.mapfolder
+
+    val map : {typ : Mono.typ' -> Mono.typ',
+               exp : Mono.exp' -> Mono.exp'}
+              -> Mono.exp -> Mono.exp
+    val mapB : {typ : Mono.typ' -> Mono.typ',
+                exp : 'typtext -> Mono.exp' -> Mono.exp',
+                bind : 'typtext * binder -> 'typtext}
+               -> 'typtext -> (Mono.exp -> Mono.exp)
+
+    val fold : {typ : Mono.typ' * 'state -> 'state,
+                exp : Mono.exp' * 'state -> 'state}
+               -> 'state -> Mono.exp -> 'state
+
+    val exists : {typ : Mono.typ' -> bool,
+                  exp : Mono.exp' -> bool} -> Mono.exp -> bool
+
+    val existsB : {typ : Mono.typ' -> bool,
+                   exp : 'context * Mono.exp' -> bool,
+                   bind : 'context * binder -> 'context} -> 'context -> Mono.exp -> bool
+
+    val foldB : {typ : Mono.typ' * 'state -> 'state,
+                 exp : 'context * Mono.exp' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Mono.exp -> 'state
+
+    val appLoc : (Mono.exp -> unit) -> Mono.exp -> unit
+end
+
+structure Decl : sig
+    datatype binder = datatype Exp.binder
+
+    val mapfoldB : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                    exp : ('typtext, Mono.exp', 'state, 'abort) Search.mapfolderB,
+                    decl : ('typtext, Mono.decl', 'state, 'abort) Search.mapfolderB,
+                    bind : 'typtext * binder -> 'typtext}
+                   -> ('typtext, Mono.decl, 'state, 'abort) Search.mapfolderB
+    val mapfold : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                   exp : (Mono.exp', 'state, 'abort) Search.mapfolder,
+                   decl : (Mono.decl', 'state, 'abort) Search.mapfolder}
+                  -> (Mono.decl, 'state, 'abort) Search.mapfolder
+
+    val fold : {typ : Mono.typ' * 'state -> 'state,
+                exp : Mono.exp' * 'state -> 'state,
+                decl : Mono.decl' * 'state -> 'state}
+               -> 'state -> Mono.decl -> 'state
+
+    val map : {typ : Mono.typ' -> Mono.typ',
+               exp : Mono.exp' -> Mono.exp',
+               decl : Mono.decl' -> Mono.decl'}
+              -> Mono.decl -> Mono.decl
+
+    val foldMap : {typ : Mono.typ' * 'state -> Mono.typ' * 'state,
+                   exp : Mono.exp' * 'state -> Mono.exp' * 'state,
+                   decl : Mono.decl' * 'state -> Mono.decl' * 'state}
+                  -> 'state -> Mono.decl -> Mono.decl * 'state
+
+    val foldMapB : {typ : Mono.typ' * 'state -> Mono.typ' * 'state,
+                    exp : 'context * Mono.exp' * 'state -> Mono.exp' * 'state,
+                    decl : 'context * Mono.decl' * 'state -> Mono.decl' * 'state,
+                    bind : 'context * binder -> 'context}
+                   -> 'context -> 'state -> Mono.decl -> Mono.decl * 'state
+
+    val exists : {typ : Mono.typ' -> bool,
+                  exp : Mono.exp' -> bool,
+                  decl : Mono.decl' -> bool} -> Mono.decl -> bool
+end
+
+structure File : sig
+    datatype binder = datatype Exp.binder
+
+    val mapfoldB : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                    exp : ('typtext, Mono.exp', 'state, 'abort) Search.mapfolderB,
+                    decl : ('typtext, Mono.decl', 'state, 'abort) Search.mapfolderB,
+                    bind : 'typtext * binder -> 'typtext}
+                   -> ('typtext, Mono.file, 'state, 'abort) Search.mapfolderB
+
+    val mapfold : {typ : (Mono.typ', 'state, 'abort) Search.mapfolder,
+                   exp : (Mono.exp', 'state, 'abort) Search.mapfolder,
+                   decl : (Mono.decl', 'state, 'abort) Search.mapfolder}
+                  -> (Mono.file, 'state, 'abort) Search.mapfolder
+
+    val mapB : {typ : Mono.typ' -> Mono.typ',
+                exp : 'typtext -> Mono.exp' -> Mono.exp',
+                decl : 'typtext -> Mono.decl' -> Mono.decl',
+                bind : 'typtext * binder -> 'typtext}
+               -> 'typtext -> Mono.file -> Mono.file
+
+    val map : {typ : Mono.typ' -> Mono.typ',
+                exp : Mono.exp' -> Mono.exp',
+                decl : Mono.decl' -> Mono.decl'}
+              -> Mono.file -> Mono.file
+
+    val fold : {typ : Mono.typ' * 'state -> 'state,
+                exp : Mono.exp' * 'state -> 'state,
+                decl : Mono.decl' * 'state -> 'state}
+               -> 'state -> Mono.file -> 'state
+
+    val maxName : Mono.file -> int
+
+    val appLoc : (Mono.exp -> unit) -> Mono.file -> unit
+end
+
+end
diff --git a/src/mono_util.sml b/src/mono_util.sml
new file mode 100644
index 0000000..fc1a2bc
--- /dev/null
+++ b/src/mono_util.sml
@@ -0,0 +1,825 @@
+(* Copyright (c) 2008, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MonoUtil :> MONO_UTIL = struct
+
+open Mono
+
+structure S = Search
+
+val dummyt = (TRecord [], ErrorMsg.dummySpan)
+
+structure Typ = struct
+
+open Order
+
+fun compare ((t1, _), (t2, _)) =
+    case (t1, t2) of
+        (TFun (d1, r1), TFun (d2, r2)) =>
+        join (compare (d1, d2), fn () => compare (r1, r2))
+      | (TRecord xts1, TRecord xts2) =>
+        let
+            val xts1 = sortFields xts1
+            val xts2 = sortFields xts2
+        in
+            joinL compareFields (xts1, xts2)
+        end
+      | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2)
+      | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
+      | (TOption t1, TOption t2) => compare (t1, t2)
+      | (TList t1, TList t2) => compare (t1, t2)
+      | (TSource, TSource) => EQUAL
+      | (TSignal t1, TSignal t2) => compare (t1, t2)
+
+      | (TFun _, _) => LESS
+      | (_, TFun _) => GREATER
+
+      | (TRecord _, _) => LESS
+      | (_, TRecord _) => GREATER
+
+      | (TDatatype _, _) => LESS
+      | (_, TDatatype _) => GREATER
+
+      | (TFfi _, _) => LESS
+      | (_, TFfi _) => GREATER
+
+      | (TOption _, _) => LESS
+      | (_, TOption _) => GREATER
+
+      | (TList _, _) => LESS
+      | (_, TList _) => GREATER
+
+      | (TSource, _) => LESS
+      | (_, TSource) => GREATER
+
+and compareFields ((x1, t1), (x2, t2)) =
+    join (String.compare (x1, x2),
+          fn () => compare (t1, t2))
+
+and sortFields xts = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xts
+
+fun mapfold fc =
+    let
+        fun mft c acc =
+            S.bindP (mft' c acc, fc)
+
+        and mft' (cAll as (c, loc)) =
+            case c of
+                TFun (t1, t2) =>
+                S.bind2 (mft t1,
+                      fn t1' =>
+                         S.map2 (mft t2,
+                              fn t2' =>
+                                 (TFun (t1', t2'), loc)))
+              | TRecord xts =>
+                S.map2 (ListUtil.mapfold (fn (x, t) =>
+                                             S.map2 (mft t,
+                                                  fn t' =>
+                                                     (x, t')))
+                                         xts,
+                     fn xts' => (TRecord xts', loc))
+              | TDatatype _ => S.return2 cAll
+              | TFfi _ => S.return2 cAll
+              | TOption t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (TOption t, loc))
+              | TList t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (TList t, loc))
+              | TSource => S.return2 cAll
+              | TSignal t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (TSignal t, loc))
+    in
+        mft
+    end
+
+fun map typ c =
+    case mapfold (fn c => fn () => S.Continue (typ c, ())) c () of
+        S.Return () => raise Fail "Mono_util.Typ.map"
+      | S.Continue (c, ()) => c
+
+fun fold typ s c =
+    case mapfold (fn c => fn s => S.Continue (c, typ (c, s))) c s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "MonoUtil.Typ.fold: Impossible"
+
+fun exists typ k =
+    case mapfold (fn c => fn () =>
+                             if typ c then
+                                 S.Return ()
+                             else
+                                 S.Continue (c, ())) k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure Exp = struct
+
+datatype binder =
+         Datatype of string * int * (string * int * typ option) list
+       | RelE of string * typ
+       | NamedE of string * int * typ * exp option * string
+
+fun mapfoldB {typ = fc, exp = fe, bind} =
+    let
+        val mft = Typ.mapfold fc
+
+        fun mfe ctx e acc =
+            S.bindP (mfe' ctx e acc, fe ctx)
+
+        and mfet ctx (e, t) =
+            S.bind2 (mfe ctx e,
+                  fn e' =>
+                     S.map2 (mft t,
+                          fn t' => (e', t')))
+
+        and mfe' ctx (eAll as (e, loc)) =
+            case e of
+                EPrim _ => S.return2 eAll
+              | ERel _ => S.return2 eAll
+              | ENamed _ => S.return2 eAll
+              | ECon (_, _, NONE) => S.return2 eAll
+              | ECon (dk, n, SOME e) =>
+                S.map2 (mfe ctx e,
+                        fn e' =>
+                           (ECon (dk, n, SOME e'), loc))
+              | ENone t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (ENone t', loc))
+              | ESome (t, e) =>
+                S.bind2 (mft t,
+                         fn t' =>
+                            S.map2 (mfe ctx e,
+                                 fn e' =>
+                                    (ESome (t', e'), loc)))
+              | EFfi _ => S.return2 eAll
+              | EFfiApp (m, x, es) =>
+                S.map2 (ListUtil.mapfold (fn e => mfet ctx e) es,
+                     fn es' =>
+                        (EFfiApp (m, x, es'), loc))
+              | EApp (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EApp (e1', e2'), loc)))
+              | EAbs (x, dom, ran, e) =>
+                S.bind2 (mft dom,
+                      fn dom' =>
+                         S.bind2 (mft ran,
+                               fn ran' =>
+                                  S.map2 (mfe (bind (ctx, RelE (x, dom'))) e,
+                                       fn e' =>
+                                          (EAbs (x, dom', ran', e'), loc))))
+
+              | EUnop (s, e) =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (EUnop (s, e'), loc))
+              | EBinop (bi, s, e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EBinop (bi, s, e1', e2'), loc)))
+
+              | ERecord xes =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfe ctx e,
+                                                  fn e' =>
+                                                     S.map2 (mft t,
+                                                             fn t' =>
+                                                                (x, e', t'))))
+                                         xes,
+                     fn xes' =>
+                        (ERecord xes', loc))
+              | EField (e, x) =>
+                S.map2 (mfe ctx e,
+                      fn e' =>
+                         (EField (e', x), loc))
+
+              | ECase (e, pes, {disc, result}) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.bind2 (ListUtil.mapfold (fn (p, e) =>
+                                                          let
+                                                              fun pb ((p, _), ctx) =
+                                                                  case p of
+                                                                      PVar (x, t) => bind (ctx, RelE (x, t))
+                                                                    | PPrim _ => ctx
+                                                                    | PCon (_, _, NONE) => ctx
+                                                                    | PCon (_, _, SOME p) => pb (p, ctx)
+                                                                    | PRecord xps => foldl (fn ((_, p, _), ctx) =>
+                                                                                               pb (p, ctx)) ctx xps
+                                                                    | PNone _ => ctx
+                                                                    | PSome (_, p) => pb (p, ctx)
+                                                          in
+                                                              S.map2 (mfe (pb (p, ctx)) e,
+                                                                   fn e' => (p, e'))
+                                                          end) pes,
+                                    fn pes' =>
+                                       S.bind2 (mft disc,
+                                                fn disc' =>
+                                                   S.map2 (mft result,
+                                                        fn result' =>
+                                                           (ECase (e', pes', {disc = disc', result = result'}), loc)))))
+
+              | EError (e, t) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.map2 (mft t,
+                                    fn t' =>
+                                       (EError (e', t'), loc)))
+              | EReturnBlob {blob = NONE, mimeType, t} =>
+                S.bind2 (mfe ctx mimeType,
+                      fn mimeType' =>
+                         S.map2 (mft t,
+                              fn t' =>
+                                 (EReturnBlob {blob = NONE, mimeType = mimeType', t = t'}, loc)))
+              | EReturnBlob {blob = SOME blob, mimeType, t} =>
+                S.bind2 (mfe ctx blob,
+                         fn blob' =>
+                            S.bind2 (mfe ctx mimeType,
+                                  fn mimeType' =>
+                                     S.map2 (mft t,
+                                          fn t' =>
+                                             (EReturnBlob {blob = SOME blob', mimeType = mimeType', t = t'}, loc))))
+              | ERedirect (e, t) =>
+                S.bind2 (mfe ctx e,
+                         fn e' =>
+                            S.map2 (mft t,
+                                    fn t' =>
+                                       (ERedirect (e', t'), loc)))
+
+              | EStrcat (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (EStrcat (e1', e2'), loc)))
+
+              | EWrite e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (EWrite e', loc))
+
+              | ESeq (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (ESeq (e1', e2'), loc)))
+              | ELet (x, t, e1, e2) =>
+                S.bind2 (mft t,
+                         fn t' =>
+                            S.bind2 (mfe ctx e1,
+                                  fn e1' =>
+                                     S.map2 (mfe (bind (ctx, RelE (x, t'))) e2,
+                                          fn e2' =>
+                                             (ELet (x, t', e1', e2'), loc))))
+
+              | EClosure (n, es) =>
+                S.map2 (ListUtil.mapfold (mfe ctx) es,
+                     fn es' =>
+                        (EClosure (n, es'), loc))
+
+              | EQuery {exps, tables, state, query, body, initial} =>
+                S.bind2 (ListUtil.mapfold (fn (x, t) =>
+                                              S.map2 (mft t,
+                                                      fn t' => (x, t'))) exps,
+                         fn exps' =>
+                            S.bind2 (ListUtil.mapfold (fn (x, xts) =>
+                                                          S.map2 (ListUtil.mapfold
+                                                                       (fn (x, t) =>
+                                                                           S.map2 (mft t,
+                                                                                fn t' => (x, t'))) xts,
+                                                                   fn xts' => (x, xts'))) tables,
+                                  fn tables' =>
+                                     S.bind2 (mft state,
+                                              fn state' =>
+                                                 S.bind2 (mfe ctx query,
+                                                          fn query' =>
+                                                             S.bind2 (mfe (bind (bind (ctx, RelE ("r", dummyt)),
+                                                                                 RelE ("acc", dummyt)))
+                                                                          body,
+                                                                   fn body' =>
+                                                                      (* ASK: is this the right thing to do? *)
+                                                                      S.map2 (mfe ctx initial,
+                                                                           fn initial' =>
+                                                                              (EQuery {exps = exps',
+                                                                                       tables = tables',
+                                                                                       state = state',
+                                                                                       query = query',
+                                                                                       body = body',
+                                                                                       initial = initial'},
+                                                                               loc)))))))
+
+              | EDml (e, fm) =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (EDml (e', fm), loc))
+              | ENextval e =>
+                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, b) =>
+                S.bind2 (mfe ctx e,
+                     fn e' =>
+                        S.map2 (mft t,
+                                fn t' =>
+                                   (EUnurlify (e', t', b), loc)))
+              | EJavaScript (m, e) =>
+                S.bind2 (mfmode ctx m,
+                         fn m' =>
+                            S.map2 (mfe ctx e,
+                                 fn e' =>
+                                    (EJavaScript (m', e'), loc)))
+
+              | ESignalReturn e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (ESignalReturn e', loc))
+              | ESignalBind (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (ESignalBind (e1', e2'), loc)))
+              | ESignalSource e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (ESignalSource e', loc))
+
+              | EServerCall (s, t, eff, fm) =>
+                S.bind2 (mfe ctx s,
+                         fn s' =>
+                            S.map2 (mft t,
+                                  fn t' =>
+                                     (EServerCall (s', t', eff, fm), loc)))
+              | ERecv (s, t) =>
+                S.bind2 (mfe ctx s,
+                      fn s' =>
+                         S.map2 (mft t,
+                              fn t' =>
+                                 (ERecv (s', t'), loc)))
+              | ESleep s =>
+                S.map2 (mfe ctx s,
+                      fn s' =>
+                         (ESleep s', loc))
+
+              | ESpawn s =>
+                S.map2 (mfe ctx s,
+                      fn s' =>
+                         (ESpawn s', loc))
+
+        and mfmode ctx mode =
+            case mode of
+                Attribute => S.return2 mode
+              | Script => S.return2 mode
+              | Source t =>
+                S.map2 (mft t,
+                     fn t' => Source t')
+    in
+        mfe
+    end
+
+fun mapfold {typ = fc, exp = fe} =
+    mapfoldB {typ = fc,
+              exp = fn () => fe,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {typ, exp, bind} ctx e =
+    case mapfoldB {typ = fn c => fn () => S.Continue (typ c, ()),
+                   exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
+                   bind = bind} ctx e () of
+        S.Continue (e, ()) => e
+      | S.Return _ => raise Fail "MonoUtil.Exp.mapB: Impossible"
+
+fun map {typ, exp} e =
+    case mapfold {typ = fn c => fn () => S.Continue (typ c, ()),
+                  exp = fn e => fn () => S.Continue (exp e, ())} e () of
+        S.Return () => raise Fail "Mono_util.Exp.map"
+      | S.Continue (e, ()) => e
+
+fun fold {typ, exp} s e =
+    case mapfold {typ = fn c => fn s => S.Continue (c, typ (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s))} e s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "MonoUtil.Exp.fold: Impossible"
+
+fun exists {typ, exp} k =
+    case mapfold {typ = fn c => fn () =>
+                                    if typ c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun existsB {typ, exp, bind} ctx e =
+    case mapfoldB {typ = fn t => fn () =>
+                                    if typ t then
+                                        S.Return ()
+                                    else
+                                        S.Continue (t, ()),
+                   exp = fn ctx => fn e => fn () =>
+                                              if exp (ctx, e) then
+                                                  S.Return ()
+                                              else
+                                                  S.Continue (e, ()),
+                   bind = bind} ctx e () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+fun foldB {typ, exp, bind} ctx s e =
+    case mapfoldB {typ = fn t => fn s => S.Continue (t, typ (t, s)),
+                   exp = fn ctx => fn e => fn s => S.Continue (e, exp (ctx, e, s)),
+                   bind = bind} ctx e s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "MonoUtil.Exp.foldB: Impossible"
+
+fun appLoc f =
+    let
+        fun appl e =
+            (f e;
+             case #1 e of
+                 EPrim _ => ()
+               | ERel _ => ()
+               | ENamed _ => ()
+               | ECon (_, _, eo) => Option.app appl eo
+               | ENone _ => ()
+               | ESome (_, e) => appl e
+               | EFfi _ => ()
+               | EFfiApp (_, _, es) => app (appl o #1) es
+               | EApp (e1, e2) => (appl e1; appl e2)
+               | EAbs (_, _, _, e1) => appl e1
+               | EUnop (_, e1) => appl e1
+               | EBinop (_, _, e1, e2) => (appl e1; appl e2)
+               | ERecord xets => app (appl o #2) xets
+               | EField (e1, _) => appl e1
+               | ECase (e1, pes, _) => (appl e1; app (appl o #2) pes)
+               | EStrcat (e1, e2) => (appl e1; appl e2)
+               | EError (e1, _) => appl e1
+               | EReturnBlob {blob = NONE, mimeType = e2, ...} => appl e2
+               | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => (appl e1; appl e2)
+               | ERedirect (e1, _) => appl e1
+               | EWrite e1 => appl e1
+               | ESeq (e1, e2) => (appl e1; appl e2)
+               | ELet (_, _, e1, e2) => (appl e1; appl e2)
+               | EClosure (_, es) => app appl es
+               | EQuery {query = e1, body = e2, initial = e3, ...} => (appl e1; appl e2; appl e3)
+               | EDml (e1, _) => appl e1
+               | ENextval e1 => appl e1
+               | ESetval (e1, e2) => (appl e1; appl e2)
+               | EUnurlify (e1, _, _) => appl e1
+               | EJavaScript (_, e1) => appl e1
+               | ESignalReturn e1 => appl e1
+               | ESignalBind (e1, e2) => (appl e1; appl e2)
+               | ESignalSource e1 => appl e1
+               | EServerCall (e1, _, _, _) => appl e1
+               | ERecv (e1, _) => appl e1
+               | ESleep e1 => appl e1
+               | ESpawn e1 => appl e1)
+    in
+        appl
+    end
+
+end
+
+structure Decl = struct
+
+datatype binder = datatype Exp.binder
+
+fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
+    let
+        val mft = Typ.mapfold fc
+
+        val mfe = Exp.mapfoldB {typ = fc, exp = fe, bind = bind}
+
+        fun mfd ctx d acc =
+            S.bindP (mfd' ctx d acc, fd ctx)
+
+        and mfd' ctx (dAll as (d, loc)) =
+            case d of
+                DDatatype dts =>
+                S.map2 (ListUtil.mapfold (fn (x, n, xncs) =>
+                                             S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+                                                                          case c of
+                                                                              NONE => S.return2 (x, n, c)
+                                                                            | SOME c =>
+                                                                              S.map2 (mft c,
+                                                                                   fn c' => (x, n, SOME c'))) xncs,
+                                                  fn xncs' => (x, n, xncs'))) dts,
+                        fn dts' =>
+                           (DDatatype dts', loc))
+              | DVal vi =>
+                S.map2 (mfvi ctx vi,
+                     fn vi' =>
+                        (DVal vi', loc))
+              | DValRec vis =>
+                let
+                    val ctx' = foldl (fn ((x, n, t, _, s), ctx') => bind (ctx', NamedE (x, n, t, NONE, s))) ctx vis
+                in
+                    S.map2 (ListUtil.mapfold (mfvi ctx') vis,
+                         fn vis' =>
+                            (DValRec vis', loc))
+                end
+              | DExport (ek, s, n, ts, t, b) =>
+                S.bind2 (ListUtil.mapfold mft ts,
+                        fn ts' =>
+                           S.map2 (mft t,
+                                   fn t' =>
+                                      (DExport (ek, s, n, ts', t', b), loc)))
+              | DTable (s, xts, pe, ce) =>
+                S.bind2 (mfe ctx pe,
+                      fn pe' =>
+                         S.map2 (mfe ctx ce,
+                              fn ce' =>
+                                 (DTable (s, xts, pe', ce'), loc)))
+              | DSequence _ => S.return2 dAll
+              | DView (s, xts, e) =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (DView (s, xts, e'), loc))
+              | DDatabase _ => S.return2 dAll
+              | DJavaScript _ => S.return2 dAll
+              | DCookie _ => S.return2 dAll
+              | DStyle _ => S.return2 dAll
+              | DTask (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                     fn e1' =>
+                        S.map2 (mfe ctx e2,
+                             fn e2' =>
+                                (DTask (e1', e2'), loc)))
+              | DPolicy pol =>
+                S.map2 (mfpol ctx pol,
+                     fn p' =>
+                        (DPolicy p', loc))
+              | DOnError _ => S.return2 dAll
+
+        and mfpol ctx pol =
+            case pol of
+                PolClient e =>
+                S.map2 (mfe ctx e,
+                        PolClient)
+              | PolInsert e =>
+                S.map2 (mfe ctx e,
+                        PolInsert)
+              | PolDelete e =>
+                S.map2 (mfe ctx e,
+                        PolDelete)
+              | PolUpdate e =>
+                S.map2 (mfe ctx e,
+                        PolUpdate)
+              | PolSequence e =>
+                S.map2 (mfe ctx e,
+                        PolSequence)
+
+        and mfvi ctx (x, n, t, e, s) =
+            S.bind2 (mft t,
+                  fn t' =>
+                     S.map2 (mfe ctx e,
+                          fn e' =>
+                             (x, n, t', e', s)))
+    in
+        mfd
+    end
+
+fun mapfold {typ = fc, exp = fe, decl = fd} =
+    mapfoldB {typ = fc,
+              exp = fn () => fe,
+              decl = fn () => fd,
+              bind = fn ((), _) => ()} ()
+
+fun fold {typ, exp, decl} s d =
+    case mapfold {typ = fn c => fn s => S.Continue (c, typ (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s)),
+                  decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "MonoUtil.Decl.fold: Impossible"
+
+fun map {typ, exp, decl} e =
+    case mapfold {typ = fn c => fn () => S.Continue (typ c, ()),
+                  exp = fn e => fn () => S.Continue (exp e, ()),
+                  decl = fn d => fn () => S.Continue (decl d, ())} e () of
+        S.Return () => raise Fail "MonoUtil.Decl.map: Impossible"
+      | S.Continue (e, ()) => e
+
+fun foldMap {typ, exp, decl} s d =
+    case mapfold {typ = fn c => fn s => S.Continue (typ (c, s)),
+                  exp = fn e => fn s => S.Continue (exp (e, s)),
+                  decl = fn d => fn s => S.Continue (decl (d, s))} d s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "MonoUtil.Decl.foldMap: Impossible"
+
+fun foldMapB {typ, exp, decl, bind} ctx s d =
+    case mapfoldB {typ = fn c => fn s => S.Continue (typ (c, s)),
+                   exp = fn ctx => fn e => fn s => S.Continue (exp (ctx, e, s)),
+                   decl = fn ctx => fn d => fn s => S.Continue (decl (ctx, d, s)),
+                   bind = bind} ctx d s of
+        S.Continue v => v
+      | S.Return _ => raise Fail "MonoUtil.Decl.foldMapB: Impossible"
+
+fun exists {typ, exp, decl} k =
+    case mapfold {typ = fn c => fn () =>
+                                    if typ c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ()),
+                  decl = fn d => fn () =>
+                                    if decl d then
+                                        S.Return ()
+                                    else
+                                        S.Continue (d, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
+end
+
+structure File = struct
+
+datatype binder = datatype Exp.binder
+
+fun mapfoldB (all as {bind, ...}) =
+    let
+        val mfd = Decl.mapfoldB all
+
+        fun mff ctx (ds, ps) =
+            case ds of
+                nil => S.return2 (nil, ps)
+              | d :: ds' =>
+                S.bind2 (mfd ctx d,
+                         fn d' =>
+                            let
+                                val ctx' =
+                                    case #1 d' of
+                                        DDatatype dts =>
+                                        foldl (fn ((x, n, xncs), ctx) =>
+                                                  let
+                                                      val ctx = bind (ctx, Datatype (x, n, xncs))
+                                                      val t = (TDatatype (n, ref (ElabUtil.classifyDatatype xncs, xncs)),
+                                                               #2 d')
+                                                  in
+                                                      foldl (fn ((x, n, to), ctx) =>
+                                                                let
+                                                                    val t = case to of
+                                                                                NONE => t
+                                                                              | SOME t' => (TFun (t', t), #2 d')
+                                                                in
+                                                                    bind (ctx, NamedE (x, n, t, NONE, ""))
+                                                                end)
+                                                            ctx xncs
+                                                  end) ctx dts
+                                      | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
+                                      | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) =>
+                                                                 bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis
+                                      | DExport _ => ctx
+                                      | DTable _ => ctx
+                                      | DSequence _ => ctx
+                                      | DView _ => ctx
+                                      | DDatabase _ => ctx
+                                      | DJavaScript _ => ctx
+                                      | DCookie _ => ctx
+                                      | DStyle _ => ctx
+                                      | DTask _ => ctx
+                                      | DPolicy _ => ctx
+                                      | DOnError _ => ctx
+                            in
+                                S.map2 (mff ctx' (ds', ps),
+                                     fn (ds', _) =>
+                                        (d' :: ds', ps))
+                            end)
+    in
+        mff
+    end
+
+fun mapfold {typ = fc, exp = fe, decl = fd} =
+    mapfoldB {typ = fc,
+              exp = fn () => fe,
+              decl = fn () => fd,
+              bind = fn ((), _) => ()} ()
+
+fun mapB {typ, exp, decl, bind} ctx ds =
+    case mapfoldB {typ = fn c => fn () => S.Continue (typ c, ()),
+                   exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()),
+                   decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()),
+                   bind = bind} ctx ds () of
+        S.Continue (ds, ()) => ds
+      | S.Return _ => raise Fail "MonoUtil.File.mapB: Impossible"
+
+fun map {typ, exp, decl} e =
+    case mapfold {typ = fn c => fn () => S.Continue (typ c, ()),
+                  exp = fn e => fn () => S.Continue (exp e, ()),
+                  decl = fn d => fn () => S.Continue (decl d, ())} e () of
+        S.Return () => raise Fail "MonoUtil.File.map: Impossible"
+      | S.Continue (e, ()) => e
+
+fun fold {typ, exp, decl} s d =
+    case mapfold {typ = fn c => fn s => S.Continue (c, typ (c, s)),
+                  exp = fn e => fn s => S.Continue (e, exp (e, s)),
+                  decl = fn d => fn s => S.Continue (d, decl (d, s))} d s of
+        S.Continue (_, s) => s
+      | S.Return _ => raise Fail "MonoUtil.File.fold: Impossible"
+
+fun maxName (f : file) =
+    foldl (fn ((d, _) : decl, count) =>
+              case d of
+                  DDatatype dts =>
+                  foldl (fn ((_, n, ns), count) =>
+                            foldl (fn ((_, n', _), m) => Int.max (n', m))
+                                  (Int.max (n, count)) ns) count dts
+                | DVal (_, n, _, _, _) => Int.max (n, count)
+                | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
+                | DExport _ => count
+                | DTable _ => count
+                | DSequence _ => count
+                | DView _ => count
+                | DDatabase _ => count
+                | DJavaScript _ => count
+                | DCookie _ => count
+                | DStyle _ => count
+                | DTask _ => count
+                | DPolicy _ => count
+                | DOnError _ => count) 0 (#1 f)
+
+fun appLoc f (fl : file) =
+    let
+        val eal = Exp.appLoc f
+
+        fun appl (d : decl) =
+            case #1 d of
+                DDatatype _ => ()
+              | DVal (_, _, _, e1, _) => eal e1
+              | DValRec vis => app (eal o #4) vis
+              | DExport _ => ()
+              | DTable (_, _, e1, e2) => (eal e1; eal e2)
+              | DSequence _ => ()
+              | DView (_, _, e1) => eal e1
+              | DDatabase _ => ()
+              | DJavaScript _ => ()
+              | DCookie _ => ()
+              | DStyle _ => ()
+              | DTask (e1, e2) => (eal e1; eal e2)
+              | DPolicy pol => applPolicy pol
+              | DOnError _ => ()
+
+        and applPolicy p =
+            case p of
+                PolClient e1 => eal e1
+              | PolInsert e1 => eal e1
+              | PolDelete e1 => eal e1
+              | PolUpdate e1 => eal e1
+              | PolSequence e1 => eal e1
+    in
+        app appl (#1 fl)
+    end
+
+end
+
+end
diff --git a/src/monoize.sig b/src/monoize.sig
new file mode 100644
index 0000000..951db01
--- /dev/null
+++ b/src/monoize.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MONOIZE = sig
+
+    val monoize : CoreEnv.env -> Core.file -> Mono.file
+
+    val liftExpInExp : int -> Mono.exp -> Mono.exp
+
+end
diff --git a/src/monoize.sml b/src/monoize.sml
new file mode 100644
index 0000000..ddf6cd4
--- /dev/null
+++ b/src/monoize.sml
@@ -0,0 +1,4549 @@
+(* Copyright (c) 2008-2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Monoize :> MONOIZE = struct
+
+structure E = ErrorMsg
+structure Env = CoreEnv
+
+structure L = Core
+structure L' = Mono
+
+structure IM = IntBinaryMap
+structure IS = IntBinarySet
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+
+structure RM = BinaryMapFn(struct
+                           type ord_key = (string * L'.typ) list
+                           fun compare (r1, r2) = MonoUtil.Typ.compare ((L'.TRecord r1, E.dummySpan),
+                                                                        (L'.TRecord r2, E.dummySpan))
+                           end)
+
+val nextPvar = MonoFooify.nextPvar
+val pvars = ref (RM.empty : (int * (string * int * L'.typ) list) RM.map)
+val pvarDefs = MonoFooify.pvarDefs
+val pvarOldDefs = ref ([] : (int * (string * int * L.con option) list) list)
+
+fun choosePvar () =
+    let
+        val n = !nextPvar
+    in
+        nextPvar := n + 1;
+        n
+    end
+
+fun pvar (r, r', loc) =
+    case RM.find (!pvars, r') of
+        NONE =>
+        let
+            val n = choosePvar ()
+            val fs = map (fn (x, t) => (x, choosePvar (), t)) r'
+            val r = ListMergeSort.sort (fn (((L.CName x, _), _), ((L.CName y, _), _)) => String.compare (x, y) = GREATER
+                                         | _ => raise Fail "Monoize: pvar, not CName") r
+            val (r, fs') = ListPair.foldr (fn ((_, t), (x, n, _), (r, fs')) =>
+                                              ((x, n, SOME t) :: r,
+                                               SM.insert (fs', x, n))) ([], SM.empty) (r, fs)
+        in
+            pvars := RM.insert (!pvars, r', (n, fs));
+            pvarDefs := ("$poly" ^ Int.toString n, n, map (fn (x, n, t) => (x, n, SOME t)) fs)
+                        :: !pvarDefs;
+            pvarOldDefs := (n, r) :: !pvarOldDefs;
+            (n, fs)
+        end
+      | SOME v => v
+
+val singletons = SS.addList (SS.empty,
+                             ["link",
+                              "br",
+                              "p",
+                              "hr",
+                              "input",
+                              "img",
+                              "base",
+                              "meta",
+                              "param",
+                              "area",
+                              "col"])
+
+val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
+
+structure U = MonoUtil
+
+val liftExpInExp =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         L'.ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             L'.ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+fun monoName env (all as (c, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported name constructor";
+             Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
+             "")
+    in
+        case c of
+            L.CName s => s
+          | _ => poly ()
+    end
+
+fun lowercaseFirst "" = ""
+  | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0)))
+                       ^ String.extract (s, 1, NONE)
+
+fun monoNameLc env c = lowercaseFirst (monoName env c)
+
+fun readType' (t, loc) = (L'.TFun ((L'.TFfi ("Basis", "string"), loc),
+                                   (L'.TOption t, loc)), loc)
+fun readErrType (t, loc) = (L'.TFun ((L'.TFfi ("Basis", "string"), loc),
+                                     t), loc)
+fun readType (t, loc) =
+    (L'.TRecord [("Read", readType' (t, loc)),
+                 ("ReadError", readErrType (t, loc))],
+     loc)
+
+fun monoType env =
+    let
+        fun mt env dtmap (all as (c, loc)) =
+            let
+                fun poly () =
+                    (E.errorAt loc "Unsupported type constructor";
+                     Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
+                     dummyTyp)
+            in
+                case c of
+                    L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc)
+                  | L.TCFun _ => poly ()
+                  | L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
+                    let
+                        val xcs = map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs
+                        val xcs = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xcs
+                    in
+                        (L'.TRecord xcs, loc)
+                    end
+                  | L.TRecord _ => poly ()
+
+                  | L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
+                    (L'.TOption (mt env dtmap t), loc)
+                  | L.CApp ((L.CFfi ("Basis", "list"), _), t) =>
+                    (L'.TList (mt env dtmap t), loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "variant"), _), (L.CRecord ((L.KType, _), xts), _)) =>
+                    let
+                        val xts' = map (fn (x, t) => (monoName env x, mt env dtmap t)) xts
+                        val xts' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xts'
+                        val (n, cs) = pvar (xts, xts', loc)
+                        val cs = map (fn (x, n, t) => (x, n, SOME t)) cs
+                    in
+                        (L'.TDatatype (n, ref (ElabUtil.classifyDatatype cs, cs)), loc)
+                    end
+
+                  | L.CApp ((L.CFfi ("Basis", "monad"), _), _) =>
+                    (L'.TRecord [], loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "eq"), _), t) =>
+                    let
+                        val t = mt env dtmap t
+                    in
+                        (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)
+                    end
+                  | L.CApp ((L.CFfi ("Basis", "num"), _), t) =>
+                    let
+                        val t = mt env dtmap t
+                    in
+                        (L'.TRecord [("Zero", t),
+                                     ("Neg", (L'.TFun (t, t), loc)),
+                                     ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+				     ("Pow", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
+                         loc)
+                    end
+                  | L.CApp ((L.CFfi ("Basis", "ord"), _), t) =>
+                    let
+                        val t = mt env dtmap t
+                    in
+                        (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
+                                     ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))],
+                         loc)
+                    end
+                  | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
+                    (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
+                  | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
+                    readType (mt env dtmap t, loc)
+
+                  | L.CFfi ("Basis", "unit") => (L'.TRecord [], loc)
+                  | L.CFfi ("Basis", "page") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "xhead") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "xbody") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "xtable") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "xtr") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "xform") => (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "mimeType") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "css_value") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "css_property") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "css_style") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "id") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "meta") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
+                    (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
+                  | L.CApp ((L.CFfi ("Basis", "source"), _), t) =>
+                    (L'.TSource, loc)
+                  | L.CApp ((L.CFfi ("Basis", "signal"), _), t) =>
+                    (L'.TSignal (mt env dtmap t), loc)
+                  | L.CApp ((L.CFfi ("Basis", "http_cookie"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_table"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_view"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_sequence") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_expw"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_window"), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window_function"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "sql_constraints"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "linkable"), _), _), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "matching"), _), _), _), _) =>
+                    let
+                        val string = (L'.TFfi ("Basis", "string"), loc)
+                    in
+                        (L'.TRecord [("1", string), ("2", string)], loc)
+                    end
+                  | L.CApp ((L.CFfi ("Basis", "propagation_mode"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "dml") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_subset"), _), _), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CFfi ("Basis", "sql_relop") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_direction") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_order_by"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_limit") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_offset") =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "fieldsOf"), _), _), _), _) =>
+                    (L'.TRecord [], loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "sql_injectable_prim"), _), t) =>
+                    (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) =>
+                    (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "nullify"), _), _), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_summable"), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_arith"), _), _) =>
+                    (L'.TRecord [], loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_ufunc"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_partition"), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window"), _), _), _), _), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
+
+                  | L.CApp ((L.CFfi ("Basis", "channel"), _), _) =>
+                    (L'.TFfi ("Basis", "channel"), loc)
+
+                  | L.CRel _ => poly ()
+                  | L.CNamed n =>
+                    (case IM.find (dtmap, n) of
+                         SOME r => (L'.TDatatype (n, r), loc)
+                       | NONE =>
+                         let
+                             val r = ref (L'.Default, [])
+                             val (_, xs, xncs) = Env.lookupDatatype env n
+
+                             val dtmap' = IM.insert (dtmap, n, r)
+
+                             val xncs = map (fn (x, n, to) => (x, n, Option.map (mt env dtmap') to)) xncs
+                         in
+                             case xs of
+                                 [] =>(r := (ElabUtil.classifyDatatype xncs, xncs);
+                                       (L'.TDatatype (n, r), loc))
+                               | _ => poly ()
+                         end)
+                  | L.CFfi mx => (L'.TFfi mx, loc)
+                  | L.CApp _ => poly ()
+                  | L.CAbs _ => poly ()
+
+                  | L.CName _ => poly ()
+
+                  | L.CRecord _ => poly ()
+                  | L.CConcat _ => poly ()
+                  | L.CMap _ => poly ()
+                  | L.CUnit => poly ()
+
+                  | L.CTuple _ => poly ()
+                  | L.CProj _ => poly ()
+
+                  | L.CKAbs _ => poly ()
+                  | L.CKApp _ => poly ()
+                  | L.TKFun _ => poly ()
+            end
+    in
+        mt env IM.empty
+    end
+
+val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
+
+structure Fm = MonoFooify.Fm
+
+fun fooifyExp fk env =
+    MonoFooify.fooifyExp
+        fk
+        (fn n =>
+            let
+                val (_, t, _, s) = Env.lookupENamed env n
+            in
+                (monoType env t, s)
+            end)
+        (fn n =>
+            let
+                val (x, _, xncs) = Env.lookupDatatype env n
+            in
+                (x, map (fn (x, n, c) => (x, n, Option.map (monoType env) c)) xncs)
+            end)
+
+val attrifyExp = fooifyExp MonoFooify.Attr
+val urlifyExp = fooifyExp MonoFooify.Url
+
+datatype 'a failable_search =
+         Found of 'a
+       | NotFound
+       | Error
+
+structure St :> sig
+    type t
+
+    val empty : t
+
+    val radioGroup : t -> string option
+    val setRadioGroup : t * string -> t
+end = struct
+
+type t = {
+     radioGroup : string option
+}
+
+val empty = {radioGroup = NONE}
+
+fun radioGroup (t : t) = #radioGroup t
+
+fun setRadioGroup (t : t, x) = {radioGroup = SOME x}
+
+end
+
+fun monoPatCon env pc =
+    case pc of
+        L.PConVar n => L'.PConVar n
+      | L.PConFfi {mod = m, datatyp, con, arg, ...} => L'.PConFfi {mod = m, datatyp = datatyp, con = con,
+                                                                   arg = Option.map (monoType env) arg}
+
+val dummyPat = (L'.PPrim (Prim.Int 0), ErrorMsg.dummySpan)
+
+
+fun listify t = (L'.TRecord [("1", t), ("2", (L'.TList t, #2 t))], #2 t)
+
+fun monoPat env (all as (p, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported pattern";
+             Print.eprefaces' [("Pattern", CorePrint.p_pat env all)];
+             dummyPat)
+    in
+        case p of
+            L.PVar (x, t) => (L'.PVar (x, monoType env t), loc)
+          | L.PPrim p => (L'.PPrim p, loc)
+          | L.PCon (dk, pc, [], po) => (L'.PCon (dk, monoPatCon env pc, Option.map (monoPat env) po), loc)
+          | L.PCon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], NONE) =>
+            (L'.PNone (listify (monoType env t)), loc)
+          | L.PCon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], SOME p) =>
+            (L'.PSome (listify (monoType env t), monoPat env p), loc)
+          | L.PCon (L.Option, _, [t], NONE) => (L'.PNone (monoType env t), loc)
+          | L.PCon (L.Option, pc, [t], SOME p) => (L'.PSome (monoType env t, monoPat env p), loc)
+          | L.PCon _ => poly ()
+          | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
+    end
+
+fun strcat loc es =
+    case es of
+        [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc)
+      | [e] => e
+      | _ =>
+        let
+            val e2 = List.last es
+            val es = List.take (es, length es - 1)
+            val e1 = List.last es
+            val es = List.take (es, length es - 1)
+        in
+            foldr (fn (e, e') => (L'.EStrcat (e, e'), loc))
+            (L'.EStrcat (e1, e2), loc) es
+        end
+
+fun strcatComma loc es =
+    case es of
+        [] => (L'.EPrim (Prim.String (Prim.Normal, "")), loc)
+      | [e] => e
+      | _ =>
+        let
+            val e1 = List.last es
+            val es = List.take (es, length es - 1)
+        in
+            foldr (fn (e, e') =>
+                      case (e, e') of
+                          ((L'.EPrim (Prim.String (_, "")), _), _) => e'
+                        | (_, (L'.EPrim (Prim.String (_, "")), _)) => e
+                        | _ =>
+                          (L'.EStrcat (e,
+                                       (L'.EStrcat ((L'.EPrim (Prim.String (Prim.Normal, ", ")), loc), e'), loc)), loc))
+            e1 es
+        end
+
+fun strcatR loc e xs = strcatComma loc (map (fn (x, _) => (L'.EField (e, x), loc)) xs)
+
+val readCookie = ref IS.empty
+
+fun isBlobby (t : L.con) =
+    case #1 t of
+        L.CFfi ("Basis", "string") => true
+      | L.CFfi ("Basis", "blob") => true
+      | _ => false
+
+fun monoExp (env, st, fm) (all as (e, loc)) =
+    let
+        val strcat = strcat loc
+        val strcatComma = strcatComma loc
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
+
+        fun poly () =
+            (E.errorAt loc "Unsupported expression";
+             Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
+             (dummyExp, fm))
+
+        fun numTy t =
+            (L'.TRecord [("Zero", t),
+                         ("Neg", (L'.TFun (t, t), loc)),
+                         ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+			 ("Pow", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
+        fun numEx (t, zero, neg, plus, minus, times, dv, md, ex) =
+            ((L'.ERecord [("Zero", (L'.EPrim zero, loc), t),
+                          ("Neg", neg, (L'.TFun (t, t), loc)),
+                          ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Pow", ex, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
+
+        fun ordTy t =
+            (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
+                         ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc)
+        fun ordEx (t, lt, le) =
+            ((L'.ERecord [("Lt", lt, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
+                          ("Le", le, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))],
+              loc), fm)
+
+        fun outerRec xts =
+            (L'.TRecord (map (fn ((L.CName x, _), (L.CRecord (_, xts), _)) =>
+                                 (x, (L'.TRecord (map (fn (x', _) => (x, (L'.TRecord [], loc))) xts), loc))
+                               | (x, all as (_, loc)) =>
+                                 (E.errorAt loc "Unsupported record field constructor";
+                                  Print.eprefaces' [("Name", CorePrint.p_con env x),
+                                                    ("Constructor", CorePrint.p_con env all)];
+                                  ("", dummyTyp))) xts), loc)
+    in
+        case e of
+            L.EPrim p => ((L'.EPrim p, loc), fm)
+          | L.ERel n => ((L'.ERel n, loc), fm)
+          | L.ENamed n => ((L'.ENamed n, loc), fm)
+          | L.ECon (dk, pc, [], eo) =>
+            let
+                val (eo, fm) =
+                    case eo of
+                        NONE => (NONE, fm)
+                      | SOME e =>
+                        let
+                            val (e, fm) = monoExp (env, st, fm) e
+                        in
+                            (SOME e, fm)
+                        end
+            in
+                ((L'.ECon (dk, monoPatCon env pc, eo), loc), fm)
+            end
+          | L.ECon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], NONE) =>
+            ((L'.ENone (listify (monoType env t)), loc), fm)
+          | L.ECon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], SOME e) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.ESome (listify (monoType env t), e), loc), fm)
+            end
+          | L.ECon (L.Option, _, [t], NONE) =>
+            ((L'.ENone (monoType env t), loc), fm)
+          | L.ECon (L.Option, _, [t], SOME e) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.ESome (monoType env t, e), loc), fm)
+            end
+          | L.ECon _ => poly ()
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp ((L.EFfi ("Basis", "make"), _), nmC as (L.CName nm, _)), _),
+             t), _),
+            (L.CRecord (_, xts), _)) =>
+            let
+                val t' = monoType env t
+                val xts' = map (fn (x, t) => (monoName env x, monoType env t)) xts
+                val xts' = (nm, t') :: xts'
+                val xts' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xts'
+                val (n, cs) = pvar ((nmC, t) :: xts, xts', loc)
+                val cs' = map (fn (x, n, t) => (x, n, SOME t)) cs
+                val cl = ElabUtil.classifyDatatype cs'
+            in
+                case List.find (fn (nm', _, _) => nm' = nm) cs of
+                    NONE => raise Fail "Monoize: Polymorphic variant tag mismatch for 'make'"
+                  | SOME (_, n', _) => ((L'.EAbs ("x", t', (L'.TDatatype (n, ref (cl, cs')), loc),
+                                                  (L'.ECon (cl, L'.PConVar n', SOME (L'.ERel 0, loc)), loc)), loc),
+                                        fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp ((L.EFfi ("Basis", "match"), _), (L.CRecord (_, xts), _)), _),
+            t) =>
+            let
+                val t = monoType env t
+                val xts' = map (fn (x, t) => (monoName env x, monoType env t)) xts
+                val xts' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xts'
+                val (n, cs) = pvar (xts, xts', loc)
+                val cs' = map (fn (x, n, t) => (x, n, SOME t)) cs
+                val cl = ElabUtil.classifyDatatype cs'
+                val fs = (L'.TRecord (map (fn (x, t') => (x, (L'.TFun (t', t), loc))) xts'), loc)
+                val dt = (L'.TDatatype (n, ref (cl, cs')), loc)
+            in
+                ((L'.EAbs ("v",
+                           dt,
+                           (L'.TFun (fs, t), loc),
+                           (L'.EAbs ("fs", fs, t,
+                                     (L'.ECase ((L'.ERel 1, loc),
+                                                map (fn (x, n', t') =>
+                                                        ((L'.PCon (cl, L'.PConVar n', SOME (L'.PVar ("x", t'), loc)), loc),
+                                                         (L'.EApp ((L'.EField ((L'.ERel 1, loc), x), loc),
+                                                                   (L'.ERel 0, loc)), loc))) cs,
+                                                {disc = dt, result = t}), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "eq"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+                val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc)
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "ne"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+                val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc)
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.EAbs ("x", t, (L'.TFun (t, b), loc),
+                                     (L'.EAbs ("y", t, b,
+                                               (L'.EUnop ("!", (L'.EApp ((L'.EApp ((L'.ERel 2, loc),
+                                                                                   (L'.ERel 1, loc)), loc),
+                                                                         (L'.ERel 0, loc)), loc)), loc)),
+                                      loc)),
+                            loc)),
+                  loc), fm)
+            end
+          | L.EFfi ("Basis", "eq_int") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop (L'.Int, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "eq_float") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "eq_bool") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "bool"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "eq_string") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop (L'.NotInt, "!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "eq_char") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "char"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "eq_time") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EFfiApp ("Basis", "eq_time", [((L'.ERel 1, loc), (L'.TFfi ("Basis", "time"), loc)),
+                                                                   ((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc)), loc),
+             fm)
+
+          | L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+                val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc)
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "zero"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, t,
+                           (L'.EField ((L'.ERel 0, loc), "Zero"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "neg"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, t), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Neg"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "plus"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Plus"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "minus"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Minus"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "times"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Times"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "divide"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Div"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "mod"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm)
+            end
+	  | L.ECApp ((L.EFfi ("Basis", "pow"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Pow"), loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "num_int") =>
+            let
+                fun intBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
+                                        (L'.TFfi ("Basis", "int"), loc),
+                                        (L'.EBinop (L'.Int, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                numEx ((L'.TFfi ("Basis", "int"), loc),
+                       Prim.Int (Int64.fromInt 0),
+                       (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                                 (L'.TFfi ("Basis", "int"), loc),
+                                 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
+                       intBin "+",
+                       intBin "-",
+                       intBin "*",
+                       intBin "/",
+                       intBin "%",
+                       intBin "powl"
+                       )
+            end
+          | L.EFfi ("Basis", "num_float") =>
+            let
+                fun floatBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "float"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
+                                        (L'.TFfi ("Basis", "float"), loc),
+                                        (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                numEx ((L'.TFfi ("Basis", "float"), loc),
+                       Prim.Float 0.0,
+                       (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                                 (L'.TFfi ("Basis", "float"), loc),
+                                 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
+                       floatBin "+",
+                       floatBin "-",
+                       floatBin "*",
+                       floatBin "fdiv",
+                       floatBin "fmod",
+                       floatBin "powf"
+		       )
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "lt"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", ordTy t, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Lt"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "le"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", ordTy t, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Le"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "gt"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+            in
+                ((L'.EAbs ("f", ordTy t, (L'.TFun (t, (L'.TFun (t, b), loc)), loc),
+                           (L'.EAbs ("x", t, (L'.TFun (t, b), loc),
+                                     (L'.EAbs ("y", t, b,
+                                               (L'.EUnop ("!",
+                                                          (L'.EApp ((L'.EApp ((L'.EField ((L'.ERel 2, loc),
+                                                                                          "Le"), loc),
+                                                                              (L'.ERel 1, loc)), loc),
+                                                                    (L'.ERel 0, loc)), loc)), loc)), loc)),
+                            loc)),
+                  loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "ge"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+            in
+                ((L'.EAbs ("f", ordTy t, (L'.TFun (t, (L'.TFun (t, b), loc)), loc),
+                           (L'.EAbs ("x", t, (L'.TFun (t, b), loc),
+                                     (L'.EAbs ("y", t, b,
+                                               (L'.EUnop ("!",
+                                                          (L'.EApp ((L'.EApp ((L'.EField ((L'.ERel 2, loc),
+                                                                                          "Lt"), loc),
+                                                                              (L'.ERel 1, loc)), loc),
+                                                                    (L'.ERel 0, loc)), loc)), loc)), loc)),
+                            loc)),
+                  loc), fm)
+            end
+          | L.EFfi ("Basis", "ord_int") =>
+            let
+                fun intBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (L'.Int, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "int"), loc),
+                       intBin "<",
+                       intBin "<=")
+            end
+          | L.EFfi ("Basis", "ord_float") =>
+            let
+                fun floatBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "float"), loc),
+                       floatBin "<",
+                       floatBin "<=")
+            end
+          | L.EFfi ("Basis", "ord_bool") =>
+            let
+                fun boolBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "bool"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "bool"), loc),
+                       boolBin "<",
+                       boolBin "<=")
+            end
+          | L.EFfi ("Basis", "ord_string") =>
+            let
+                fun boolBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (L'.NotInt, s,
+                                                    (L'.EBinop (L'.NotInt, "strcmp",
+                                                                (L'.ERel 1, loc),
+                                                                (L'.ERel 0, loc)), loc),
+                                                    (L'.EPrim (Prim.Int (Int64.fromInt 0)), loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "string"), loc),
+                       boolBin "<",
+                       boolBin "<=")
+            end
+          | L.EFfi ("Basis", "ord_char") =>
+            let
+                fun charBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "char"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "char"), loc),
+                       charBin "<",
+                       charBin "<=")
+            end
+          | L.EFfi ("Basis", "ord_time") =>
+            let
+                fun boolBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EFfiApp ("Basis", s, [((L'.ERel 1, loc), (L'.TFfi ("Basis", "time"), loc)),
+                                                                  ((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "time"), loc),
+                       boolBin "lt_time",
+                       boolBin "le_time")
+            end
+          | L.ECApp ((L.EFfi ("Basis", "mkOrd"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+                val dom = ordTy t
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", (L'.TFun (t, s), loc), (L'.TFun (t, s), loc),
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_int") =>
+            ((L'.EFfi ("Basis", "intToString"), loc), fm)
+          | L.EFfi ("Basis", "show_float") =>
+            ((L'.EFfi ("Basis", "floatToString"), loc), fm)
+          | L.EFfi ("Basis", "show_string") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_queryString") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_url") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_css_class") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_id") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "show_char") =>
+            ((L'.EFfi ("Basis", "charToString"), loc), fm)
+          | L.EFfi ("Basis", "show_bool") =>
+            ((L'.EFfi ("Basis", "boolToString"), loc), fm)
+          | L.EFfi ("Basis", "show_time") =>
+            ((L'.EFfi ("Basis", "timeToString"), loc), fm)
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "show_xml"), _), _),_), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "show_sql_query"), _), _), _), _), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "mkShow"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "string"), loc)
+                val dom = (L'.TFun (t, b), loc)
+            in
+                ((L'.EAbs ("f", dom, dom,
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "read"), _), t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", readType (t, loc), readType' (t, loc),
+                           (L'.EField ((L'.ERel 0, loc), "Read"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "readError"), _), t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", readType (t, loc), readErrType (t, loc),
+                           (L'.EField ((L'.ERel 0, loc), "ReadError"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "mkRead"), _), t) =>
+            let
+                val t = monoType env t
+                val b = (L'.TFfi ("Basis", "string"), loc)
+                val b' = (L'.TOption b, loc)
+                val dom = (L'.TFun (t, b), loc)
+                val dom' = (L'.TFun (t, b'), loc)
+            in
+                ((L'.EAbs ("f", dom, (L'.TFun (dom', readType (t, loc)), loc),
+                           (L'.EAbs ("f'", dom', readType (t, loc),
+                                     (L'.ERecord [("Read", (L'.ERel 0, loc), dom),
+                                                  ("ReadError", (L'.ERel 1, loc), dom')], loc)), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_int") =>
+            let
+                val t = (L'.TFfi ("Basis", "int"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToInt"), loc), readType' (t, loc)),
+                               ("ReadError", (L'.EFfi ("Basis", "stringToInt_error"), loc), readErrType (t, loc))],
+                  loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_float") =>
+            let
+                val t = (L'.TFfi ("Basis", "float"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToFloat"), loc), readType' (t, loc)),
+                              ("ReadError", (L'.EFfi ("Basis", "stringToFloat_error"), loc), readErrType (t, loc))],
+                  loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_string") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EAbs ("s", s, (L'.TOption s, loc),
+                                                 (L'.ESome (s, (L'.ERel 0, loc)), loc)), loc), readType' (s, loc)),
+                              ("ReadError", (L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), readErrType (s, loc))], loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_char") =>
+            let
+                val t = (L'.TFfi ("Basis", "char"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToChar"), loc), readType' (t, loc)),
+                               ("ReadError", (L'.EFfi ("Basis", "stringToChar_error"), loc), readErrType (t, loc))],
+                  loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_bool") =>
+            let
+                val t = (L'.TFfi ("Basis", "bool"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToBool"), loc), readType' (t, loc)),
+                              ("ReadError", (L'.EFfi ("Basis", "stringToBool_error"), loc), readErrType (t, loc))],
+                  loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "read_time") =>
+            let
+                val t = (L'.TFfi ("Basis", "time"), loc)
+            in
+                ((L'.ERecord [("Read", (L'.EFfi ("Basis", "stringToTime"), loc), readType' (t, loc)),
+                              ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))],
+                  loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "transaction_return"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("x", t,
+                                     (L'.TFun ((L'.TRecord [], loc), t), loc),
+                                     (L'.EAbs ("_", (L'.TRecord [], loc), t,
+                                               (L'.ERel 1, loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "transaction_bind"), _), t1), _), t2) =>
+            let
+                val t1 = monoType env t1
+                val t2 = monoType env t2
+                val un = (L'.TRecord [], loc)
+                val mt1 = (L'.TFun (un, t1), loc)
+                val mt2 = (L'.TFun (un, t2), loc)
+            in
+                ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc),
+                           (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc),
+                                     (L'.EAbs ("_", un, un,
+                                               (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc),
+                                                                            (L'.ERecord [], loc)), loc),
+                                                         (L'.EApp (
+                                                          (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc),
+                                                          (L'.ERecord [], loc)),
+                                                          loc)), loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), ch) =>
+            let
+                val un = (L'.TRecord [], loc)
+                val t1 = monoType env t1
+                val (ch, fm) = monoExp (env, st, fm) ch
+            in
+                ((L'.EAbs ("_", un, un, (L'.ERecv (liftExpInExp 0 ch, t1), loc)), loc), fm)
+            end
+          | L.EFfiApp ("Basis", "recv", _) => poly ()
+
+          | L.EFfiApp ("Basis", "float", [(e, t)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EFfiApp ("Basis", "floatFromInt", [(e, monoType env t)]), loc), fm)
+            end
+
+          | L.EFfiApp ("Basis", "sleep", [(n, _)]) =>
+            let
+                val (n, fm) = monoExp (env, st, fm) n
+            in
+                ((L'.ESleep n, loc), fm)
+            end
+          | L.EFfiApp ("Basis", "sleep", _) => poly ()
+
+          | L.ECApp ((L.EFfi ("Basis", "source"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc),
+                           (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc),
+                                     (L'.EFfiApp ("Basis", "new_client_source",
+                                                  [((L'.EJavaScript (L'.Source t, (L'.ERel 1, loc)), loc),
+                                                    (L'.TSource, loc))]),
+                                      loc)), loc)),
+                  loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "set"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("src", (L'.TSource, loc),
+                           (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc)), loc),
+                           (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc),
+                                     (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                                               (L'.EFfiApp ("Basis", "set_client_source",
+                                                            [((L'.ERel 2, loc), (L'.TSource, loc)),
+                                                             ((L'.EJavaScript (L'.Source t,
+                                                                               (L'.ERel 1, loc)), loc),
+                                                              (L'.TFfi ("Basis", "string"), loc))]),
+                                                loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "get"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("src", (L'.TSource, loc),
+                           (L'.TFun ((L'.TRecord [], loc), t), loc),
+                           (L'.EAbs ("_", (L'.TRecord [], loc), t,
+                                     (L'.EFfiApp ("Basis", "get_client_source",
+                                                  [((L'.ERel 1, loc), (L'.TSource, loc))]),
+                                      loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "current"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("src", (L'.TSource, loc),
+                           (L'.TFun ((L'.TRecord [], loc), t), loc),
+                           (L'.EAbs ("_", (L'.TRecord [], loc), t,
+                                     (L'.EFfiApp ("Basis", "current",
+                                                  [((L'.ERel 1, loc), (L'.TSource, loc))]),
+                                      loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "spawn", [(e, _)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.ESpawn e, loc), fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "signal_return"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("x", t, (L'.TSignal t, loc),
+                           (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "signal_bind"), _), t1), _), t2) =>
+            let
+                val t1 = monoType env t1
+                val t2 = monoType env t2
+                val un = (L'.TRecord [], loc)
+                val mt1 = (L'.TSignal t1, loc)
+                val mt2 = (L'.TSignal t2, loc)
+            in
+                ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc),
+                           (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2,
+                                     (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), (L'.TSignal t, loc),
+                           (L'.ESignalSource (L'.ERel 0, loc), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val un = (L'.TRecord [], loc)
+                val t = monoType env t
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (un, s), loc),
+                           (L'.EAbs ("_", un, s,
+                                     (L'.EUnurlify ((L'.EFfiApp ("Basis", "get_cookie", [((L'.ERel 1, loc), s)]), loc),
+                                                    t, true),
+                                      loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "setCookie"), _), t) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val un = (L'.TRecord [], loc)
+                val t = monoType env t
+                val rt = (L'.TRecord [("Value", t),
+                                      ("Expires", (L'.TOption (L'.TFfi ("Basis", "time"),
+                                                               loc), loc)),
+                                      ("Secure", (L'.TFfi ("Basis", "bool"), loc))], loc)
+
+                fun fd x = (L'.EField ((L'.ERel 1, loc), x), loc)
+                val (e, fm) = urlifyExp env fm (fd "Value", t)
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (rt, (L'.TFun (un, un), loc)), loc),
+                           (L'.EAbs ("r", rt, (L'.TFun (un, un), loc),
+                                     (L'.EAbs ("_", un, un,
+                                               (L'.EFfiApp ("Basis", "set_cookie", [(str (Settings.getUrlPrefix ()), s),
+                                                                                    ((L'.ERel 2, loc), s),
+                                                                                    (e, s),
+                                                                                    (fd "Expires", (L'.TOption (L'.TFfi ("Basis", "time"), loc), loc)),
+                                                                                    (fd "Secure", (L'.TFfi ("Basis", "bool"), loc))])
+                                              , loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "clearCookie"), _), t) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val un = (L'.TRecord [], loc)
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (un, un), loc),
+                           (L'.EAbs ("_", un, un,
+                                     (L'.EFfiApp ("Basis", "clear_cookie",
+                                                  [(str (Settings.getUrlPrefix ()), s),
+                                                   ((L'.ERel 1, loc), s)]),
+                                      loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "channel"), _), t) =>
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "channel"), loc),
+                           (L'.EFfiApp ("Basis", "new_channel", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc)), loc),
+                 fm)
+          | L.ECApp ((L.EFfi ("Basis", "send"), _), t) =>
+            let
+                val t = monoType env t
+                val (e, fm) = urlifyExp env fm ((L'.ERel 1, loc), t)
+            in
+                ((L'.EAbs ("ch", (L'.TFfi ("Basis", "channel"), loc),
+                           (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc)), loc),
+                           (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc),
+                                     (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                                               (L'.EFfiApp ("Basis", "send",
+                                                            [((L'.ERel 2, loc), (L'.TFfi ("Basis", "channel"), loc)),
+                                                             (e, (L'.TFfi ("Basis", "string"), loc))]),
+                                                loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "no_primary_key"), _), _) =>
+            (str "", fm)
+          | L.ECApp (
+            (L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "primary_key"), _), _), _), t), _),
+                      nm), _),
+            (L.CRecord (_, unique), _)) =>
+            let
+                val unique = (nm, t) :: unique
+                val witnesses = (L'.TRecord (map (fn (nm, _) => (monoName env nm, (L'.TRecord [], loc))) unique), loc)
+            in
+                ((L'.EAbs ("_", witnesses, (L'.TFfi ("Basis", "string"), loc),
+                           (str
+                                (String.concatWith ", "
+                                                   (map (fn (x, _) =>
+                                                            Settings.mangleSql (monoNameLc env x)
+                                                            ^ (if #textKeysNeedLengths (Settings.currentDbms ())
+                                                                  andalso isBlobby t then
+                                                                   "(767)"
+                                                               else
+                                                                   "")) unique)))),
+                  loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "no_constraint"), _), _) =>
+            ((L'.ERecord [], loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "one_constraint"), _), _), _), _), _), (L.CName name, _)) =>
+            ((L'.EAbs ("c",
+                       (L'.TFfi ("Basis", "string"), loc),
+                       (L'.TFfi ("Basis", "sql_constraints"), loc),
+                       (L'.ERecord [(name, (L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))], loc)), loc),
+             fm)
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.EFfi ("Basis", "join_constraints"), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val constraints = (L'.TFfi ("Basis", "sql_constraints"), loc)
+            in
+                ((L'.EAbs ("cs1", constraints, (L'.TFun (constraints, constraints), loc),
+                           (L'.EAbs ("cs2", constraints, constraints,
+                                     (L'.EStrcat ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "unique"), _), _), _), t), _),
+                      nm), _),
+            (L.CRecord (_, unique), _)) =>
+            let
+                val unique = (nm, t) :: unique
+            in
+                (str ("UNIQUE ("
+                      ^ String.concatWith ", "
+                                          (map (fn (x, t) => Settings.mangleSql (monoNameLc env x)
+                                                             ^ (if #textKeysNeedLengths (Settings.currentDbms ())
+                                                                   andalso isBlobby t then
+                                                                    "(767)"
+                                                                else
+                                                                    "")) unique)
+                      ^ ")"),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "linkable_same"), loc), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "linkable_from_nullable"), loc), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "linkable_to_nullable"), loc), _) =>
+            ((L'.ERecord [], loc), fm)
+
+          | L.EFfi ("Basis", "mat_nil") =>
+            let
+                val string = (L'.TFfi ("Basis", "string"), loc)
+                val stringE = str ""
+            in
+                ((L'.ERecord [("1", stringE, string),
+                              ("2", stringE, string)], loc), fm)
+            end
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "mat_cons"), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             (L.CName nm1, _)), _),
+            (L.CName nm2, _)) =>
+            let
+                val string = (L'.TFfi ("Basis", "string"), loc)
+                val mat = (L'.TRecord [("1", string), ("2", string)], loc)
+            in
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (mat, mat), loc),
+                           (L'.EAbs ("m", mat, mat,
+                                     (L'.ECase ((L'.EField ((L'.ERel 0, loc), "1"), loc),
+                                                [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                  (L'.ERecord [("1", str (Settings.mangleSql (lowercaseFirst nm1)),
+                                                                string),
+                                                               ("2", str (Settings.mangleSql (lowercaseFirst nm2)),
+                                                                string)], loc)),
+                                                 ((L'.PVar ("_", string), loc),
+                                                  (L'.ERecord [("1", (L'.EStrcat (
+                                                                      str (Settings.mangleSql (lowercaseFirst nm1)
+                                                                            ^ ", "),
+                                                                      (L'.EField ((L'.ERel 1, loc), "1"), loc)),
+                                                                      loc), string),
+                                                               ("2", (L'.EStrcat (
+                                                                      str (Settings.mangleSql (lowercaseFirst nm2)
+                                                                           ^ ", "),
+                                                                      (L'.EField ((L'.ERel 1, loc), "2"), loc)),
+                                                                      loc), string)],
+                                                   loc))],
+                                                {disc = string,
+                                                 result = mat}), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "restrict"), _), _) => (str "RESTRICT", fm)
+          | L.ECApp ((L.EFfi ("Basis", "cascade"), _), _) => (str "CASCADE", fm)
+          | L.ECApp ((L.EFfi ("Basis", "no_action"), _), _) => (str "NO ACTION", fm)
+          | L.ECApp ((L.EFfi ("Basis", "set_null"), _), _) => (str "SET NULL", fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.ECApp (
+                  (L.ECApp (
+                   (L.EFfi ("Basis", "foreign_key"), _),
+                   _), _),
+                  _), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val unit = (L'.TRecord [], loc)
+                val string = (L'.TFfi ("Basis", "string"), loc)
+                val mat = (L'.TRecord [("1", string), ("2", string)], loc)
+                val recd = (L'.TRecord [("OnDelete", string),
+                                        ("OnUpdate", string)], loc)
+
+                fun strcat [] = raise Fail "Monoize.strcat"
+                  | strcat [e] = e
+                  | strcat (e1 :: es) = (L'.EStrcat (e1, strcat es), loc)
+
+                fun prop (fd, kw) =
+                    (L'.ECase ((L'.EField ((L'.ERel 0, loc), fd), loc),
+                               [((L'.PPrim (Prim.String (Prim.Normal, "NO ACTION")), loc),
+                                 str ""),
+                                ((L'.PVar ("_", string), loc),
+                                 strcat [str (" ON " ^ kw ^ " "),
+                                         (L'.EField ((L'.ERel 1, loc), fd), loc)])],
+                               {disc = string,
+                                result = string}), loc)
+            in
+                ((L'.EAbs ("m", mat, (L'.TFun (string, (L'.TFun (recd, string), loc)), loc),
+                           (L'.EAbs ("tab", string, (L'.TFun (recd, string), loc),
+                                     (L'.EAbs ("pr", recd, string,
+                                               strcat [str "FOREIGN KEY (",
+                                                       (L'.EField ((L'.ERel 2, loc), "1"), loc),
+                                                       str ") REFERENCES ",
+                                                       (L'.ERel 1, loc),
+                                                       str " (",
+                                                       (L'.EField ((L'.ERel 2, loc), "2"), loc),
+                                                       str ")",
+                                                       prop ("OnDelete", "DELETE"),
+                                                       prop ("OnUpdate", "UPDATE")]), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.ECApp (
+                  (L.EFfi ("Basis", "sql_exp_weaken"), _),
+                  _), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val string = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("e", string, string, (L'.ERel 0, loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "check"), _), _) =>
+            let
+                val string = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("e", string, string,
+                           (L'.EStrcat (str "CHECK ",
+                                        (L'.EFfiApp ("Basis", "checkString",
+                                                     [((L'.ERel 0, loc), string)]), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "dml", [(e, _)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EDml (e, L'.Error), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "tryDml", [(e, _)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EDml (e, L'.None), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "insert"), _), fields), _), _) =>
+            (case monoType env (L.TRecord fields, loc) of
+                 (L'.TRecord fields, _) =>
+                 let
+                     val s = (L'.TFfi ("Basis", "string"), loc)
+                     val fields = map (fn (x, _) => (x, s)) fields
+                     val rt = (L'.TRecord fields, loc)
+                 in
+                     ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc),
+                                (L'.EAbs ("fs", rt, s,
+                                          strcat [str "INSERT INTO ",
+                                                  (L'.ERel 1, loc),
+                                                  str " (",
+                                                  strcatComma (map (fn (x, _) => str (Settings.mangleSql x)) fields),
+                                                  str ") VALUES (",
+                                                  strcatComma (map (fn (x, _) =>
+                                                                       (L'.EField ((L'.ERel 0, loc),
+                                                                                   x), loc)) fields),
+                                                  str ")"]), loc)), loc),
+                      fm)
+                 end
+               | _ => poly ())
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "update"), _), _), _), _), _), changed) =>
+            (case monoType env (L.TRecord changed, loc) of
+                 (L'.TRecord changed, _) =>
+                 let
+                     val s = (L'.TFfi ("Basis", "string"), loc)
+                     val changed = map (fn (x, _) => (x, s)) changed
+                     val rt = (L'.TRecord changed, loc)
+                 in
+                     ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                (L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
+                                          (L'.EAbs ("e", s, s,
+                                                    if #supportsUpdateAs (Settings.currentDbms ()) then
+                                                        strcat [str "UPDATE ",
+                                                                (L'.ERel 1, loc),
+                                                                str " AS T_T SET ",
+                                                                strcatComma (map (fn (x, _) =>
+                                                                                     strcat [str (Settings.mangleSql x
+                                                                                                 ^ " = "),
+                                                                                             (L'.EField
+                                                                                                  ((L'.ERel 2,
+                                                                                                    loc),
+                                                                                                   x), loc)])
+                                                                                 changed),
+                                                                str " WHERE ",
+                                                                (L'.ERel 0, loc)]
+                                                    else
+                                                        strcat [str "UPDATE ",
+                                                                (L'.ERel 1, loc),
+                                                                str " SET ",
+                                                                strcatComma (map (fn (x, _) =>
+                                                                                     strcat [str (Settings.mangleSql x
+                                                                                                 ^ " = "),
+                                                                                             (L'.EFfiApp ("Basis", "unAs",
+                                                                                                          [((L'.EField
+                                                                                                                 ((L'.ERel 2,
+                                                                                                                   loc),
+                                                                                                                  x), loc),
+                                                                                                            s)]), loc)])
+                                                                                 changed),
+                                                                str " WHERE ",
+                                                                (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]),
+                                           loc)), loc)), loc),
+                      fm)
+                 end
+               | _ => poly ())
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "delete"), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("e", s, s,
+                                     if #supportsDeleteAs (Settings.currentDbms ()) then
+                                         strcat [str "DELETE FROM ",
+                                                 (L'.ERel 1, loc),
+                                                 str " AS T_T WHERE ",
+                                                 (L'.ERel 0, loc)]
+                                     else
+                                         strcat [str "DELETE FROM ",
+                                                 (L'.ERel 1, loc),
+                                                 str " WHERE ",
+                                                 (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _),
+             exps), _),
+            state) =>
+            (case monoType env (L.TRecord exps, loc) of
+                 (L'.TRecord exps, _) =>
+                 let
+                     val tables = map (fn ((L.CName x, _), xts) =>
+                                        (case monoType env (L.TRecord xts, loc) of
+                                             (L'.TRecord xts, _) => SOME (x, xts)
+                                           | _ => NONE)
+                                      | _ => NONE) tables
+                 in
+                     if List.exists (fn x => x = NONE) tables then
+                         poly ()
+                     else
+                         let
+                             val tables = List.mapPartial (fn x => x) tables
+                             val state = monoType env state
+                             val s = (L'.TFfi ("Basis", "string"), loc)
+                             val un = (L'.TRecord [], loc)
+
+                             val rt = exps @ map (fn (x, xts) => (x, (L'.TRecord xts, loc))) tables
+                             val ft = (L'.TFun ((L'.TRecord rt, loc),
+                                                (L'.TFun (state,
+                                                          (L'.TFun (un, state), loc)),
+                                                 loc)), loc)
+
+                             val body' = (L'.EApp (
+                                          (L'.EApp (
+                                           (L'.EApp ((L'.ERel 4, loc),
+                                                     (L'.ERel 1, loc)), loc),
+                                           (L'.ERel 0, loc)), loc),
+                                          (L'.ERecord [], loc)), loc)
+                             val body = (L'.EQuery {exps = exps,
+                                                    tables = tables,
+                                                    state = state,
+                                                    query = (L'.ERel 3, loc),
+                                                    body = body',
+                                                    initial = (L'.ERel 1, loc)},
+                                         loc)
+                         in
+                             ((L'.EAbs ("q", s, (L'.TFun (ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc)), loc),
+                                        (L'.EAbs ("f", ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc),
+                                                  (L'.EAbs ("i", state, (L'.TFun (un, state), loc),
+                                                            (L'.EAbs ("_", un, state,
+                                                                      body), loc)), loc)), loc)), loc), fm)
+                         end
+                 end
+               | _ => poly ())
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_query"), _), _), _), _), _), _), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
+            in
+                ((L'.EAbs ("r",
+                           (L'.TRecord [("Rows", s), ("OrderBy", s), ("Limit", s), ("Offset", s)], loc),
+                           s,
+                           strcat [gf "Rows",
+                                   (L'.ECase (gf "OrderBy",
+                                              [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), str ""),
+                                               ((L'.PVar ("orderby", s), loc),
+                                                strcat [str " ORDER BY ",
+                                                        (L'.ERel 0, loc)])],
+                                              {disc = s, result = s}), loc),
+                                   gf "Limit",
+                                   gf "Offset"]), loc), fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.ECApp (
+                  (L.EFfi ("Basis", "sql_query1"), _),
+                  _), _),
+                 _), _),
+                (L.CRecord (_, tables), _)), _),
+               (L.CRecord (_, grouped), _)), _),
+              (L.CRecord (_, stables), _)), _),
+             sexps), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val b = (L'.TFfi ("Basis", "bool"), loc)
+                val un = (L'.TRecord [], loc)
+                fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc)
+
+                fun doTables tables =
+                    let
+                        val tables = map (fn ((L.CName x, _), xts) =>
+                                             (case monoType env (L.TRecord xts, loc) of
+                                                  (L'.TRecord xts, _) => SOME (x, xts)
+                                                | _ => NONE)
+                                           | _ => NONE) tables
+                    in
+                        if List.exists (fn x => x = NONE) tables then
+                            NONE
+                        else
+                            let
+                                val tables = List.mapPartial (fn x => x) tables
+                                val tables = ListMergeSort.sort
+                                                 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER)
+                                                 tables
+                                val tables = map (fn (x, xts) =>
+                                                     (x, ListMergeSort.sort
+                                                             (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER)
+                                                             xts)) tables
+                            in
+                                SOME tables
+                            end
+                    end
+            in
+                case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of
+                    (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) =>
+                    let
+                        val sexps = ListMergeSort.sort
+                                        (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps
+                    in
+                        ((L'.EAbs ("r",
+                                   (L'.TRecord [("Distinct", b),
+                                                ("From", s),
+                                                ("Where", s),
+                                                ("GroupBy", un),
+                                                ("Having", s),
+                                                ("SelectFields", un),
+                                                ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
+                                    loc),
+                                   s,
+                                   strcat [str "SELECT ",
+                                           (L'.ECase (gf "Distinct",
+                                                      [((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "True",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        str "DISTINCT "),
+                                                       ((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "False",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        str "")],
+                                                      {disc = b, result = s}), loc),
+                                           strcatComma (map (fn (x, t) =>
+                                                                strcat [
+                                                                (L'.EField (gf "SelectExps", x), loc),
+                                                                str (" AS " ^ Settings.mangleSql x)
+                                                            ]) sexps
+                                                        @ map (fn (x, xts) =>
+                                                                  strcatComma
+                                                                      (map (fn (x', _) =>
+                                                                               str ("T_" ^ x
+										   ^ "."
+										   ^ Settings.mangleSql x'))
+                                                                           xts)) stables),
+                                           (L'.ECase (gf "From",
+                                                      [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                        str ""),
+                                                       ((L'.PVar ("x", s), loc),
+                                                        strcat [str " FROM ",
+                                                                (L'.ERel 0, loc)])],
+                                                      {disc = s,
+                                                       result = s}), loc),
+                                           (L'.ECase (gf "Where",
+                                                      [((L'.PPrim (Prim.String (Prim.Normal, #trueString (Settings.currentDbms ()))),
+                                                         loc),
+                                                        str ""),
+                                                       ((L'.PVar ("where", s), loc),
+                                                        strcat [str " WHERE ", (L'.ERel 0, loc)])],
+                                                      {disc = s,
+                                                       result = s}), loc),
+
+                                           if List.all (fn (x, xts) =>
+                                                           case List.find (fn (x', _) => x' = x) grouped of
+                                                               NONE => List.null xts
+                                                             | SOME (_, xts') =>
+                                                               List.all (fn (x, _) =>
+                                                                            List.exists (fn (x', _) => x' = x)
+                                                                                        xts') xts) tables then
+                                               str ""
+                                           else
+                                               strcat [
+                                               str " GROUP BY ",
+                                               strcatComma (map (fn (x, xts) =>
+                                                                    strcatComma
+                                                                        (map (fn (x', _) =>
+                                                                                 str ("T_" ^ x
+										     ^ "."
+										     ^ Settings.mangleSql x'))
+                                                                             xts)) grouped)
+                                               ],
+
+                                           (L'.ECase (gf "Having",
+                                                      [((L'.PPrim (Prim.String
+                                                                       (Prim.Normal, #trueString (Settings.currentDbms ()))), loc),
+                                                        str ""),
+                                                       ((L'.PVar ("having", s), loc),
+                                                        strcat [str " HAVING ", (L'.ERel 0, loc)])],
+                                                      {disc = s,
+                                                       result = s}), loc)
+                                  ]), loc),
+                         fm)
+                    end
+                  | _ => poly ()
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_inject"), _),
+               _), _),
+              _), _),
+             _), _),
+            t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", (L'.TFun (t, s), loc), (L'.TFun (t, s), loc),
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+
+          | L.EFfi ("Basis", "sql_int") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyInt", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "int"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_float") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyFloat", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "float"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_bool") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyBool", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "bool"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_string") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_char") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyChar", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "char"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_time") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyTime", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_blob") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "blob"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyBlob", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "blob"), loc))]), loc)), loc),
+             fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyChannel", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "channel"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_client") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "client"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyClient", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "client"), loc))]), loc)), loc),
+             fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_serialized"), _), _) =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc),
+             fm)
+          | L.EFfi ("Basis", "sql_url") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc),
+             fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) =>
+            let
+                val t = monoType env t
+                val tf = (L'.TFun (t, (L'.TFfi ("Basis", "string"), loc)), loc)
+            in
+                ((L'.EAbs ("f", tf, tf, (L'.ERel 0, loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "sql_option_prim"), _), t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+
+                fun toSqlType (t : L'.typ) =
+                    case #1 t of
+                        L'.TFfi ("Basis", "int") => Settings.Int
+                      | L'.TFfi ("Basis", "float") => Settings.Float
+                      | L'.TFfi ("Basis", "string") => Settings.String
+                      | L'.TFfi ("Basis", "char") => Settings.Char
+                      | L'.TFfi ("Basis", "bool") => Settings.Bool
+                      | L'.TFfi ("Basis", "time") => Settings.Time
+                      | L'.TFfi ("Basis", "blob") => Settings.Blob
+                      | L'.TFfi ("Basis", "channel") => Settings.Channel
+                      | L'.TFfi ("Basis", "client") => Settings.Client
+                      | _ => raise Fail "Monoize/sql_option_prim: invalid SQL type"
+            in
+                ((L'.EAbs ("f",
+                           (L'.TFun (t, s), loc),
+                           (L'.TFun ((L'.TOption t, loc), s), loc),
+                           (L'.EAbs ("x",
+                                     (L'.TOption t, loc),
+                                     s,
+                                     (L'.ECase ((L'.ERel 0, loc),
+                                                [((L'.PNone t, loc),
+                                                  str (#p_cast (Settings.currentDbms ()) ("NULL", toSqlType t))),
+                                                 ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc),
+                                                  (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))],
+                                                {disc = (L'.TOption t, loc),
+                                                 result = s}), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "nullify_option"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "nullify_prim"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                       (L'.ERecord [], loc)), loc),
+             fm)
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_subset_concat"),
+                                                    _), _), _), _), _), _), _), _) =>
+            let
+                val un = (L'.TRecord [], loc)
+            in
+                ((L'.EAbs ("_", un, (L'.TFun (un, un), loc),
+                           (L'.EAbs ("_", un, un,
+                                     (L'.ERecord [], loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "fieldsOf_table"), _), _), _), _) =>
+            ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "fieldsOf_view"), _), _) =>
+            ((L'.ERecord [], loc), fm)
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_from_nil"), _), _) =>
+            (str "", fm)
+          | L.ECApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _),
+                                                   _), _), _), _), _), _), _),
+                     (L.CName name, _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("tab", s, s,
+                           strcat [(L'.ERel 0, loc),
+                                   str (" AS T_" ^ name)]), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_query"), _), _),
+                                          _), _), _),
+                     (L.CName name, _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("q", s, s,
+                           strcat [str "(",
+                                   (L'.ERel 0, loc),
+                                   str (") AS T_" ^ name)]), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TRecord [("1", s), ("2", s)], loc)
+            in
+                ((L'.EAbs ("tab1", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("tab2", s, s,
+                                     (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), s),
+                                                             ("2", (L'.ERel 0, loc), s)], loc),
+                                                [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
+                                                  (L'.ERel 0, loc)),
+                                                 ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
+                                                  (L'.ERel 1, loc)),
+                                                 ((L'.PVar ("_", disc), loc),
+                                                  strcat [(L'.ERel 2, loc),
+                                                          str ", ",
+                                                          (L'.ERel 1, loc)])],
+                                                {disc = disc,
+                                                 result = s}), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_inner_join"), _), _), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TRecord [("1", s), ("2", s)], loc)
+            in
+                ((L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("on", s, s,
+                                               (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
+                                                                       ("2", (L'.ERel 1, loc), s)], loc),
+                                                          [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
+                                                            (L'.ERel 1, loc)),
+                                                           ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")), loc), s)], loc),
+                                                            (L'.ERel 2, loc)),
+                                                           ((L'.PVar ("_", disc), loc),
+                                                            strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [str "("]
+                                                                               else
+                                                                                   [])
+                                                                    @ [(L'.ERel 3, loc),
+                                                                       str " JOIN ",
+                                                                       (L'.ERel 2, loc),
+                                                                       str " ON ",
+                                                                       (L'.ERel 1, loc)]
+                                                                    @ (if #nestedRelops
+                                                                              (Settings.currentDbms ()) then
+                                                                           [str ")"]
+                                                                       else
+                                                                           [])))],
+                                                          {disc = disc,
+                                                           result = s}), loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_left_join"), _), _), _), _), _),
+                     (L.CRecord (_, right), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TRecord [("1", s), ("2", s)], loc)
+            in
+                ((L'.EAbs ("_", outerRec right,
+                           (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("on", s, s,
+                                                         (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
+                                                                                 ("2", (L'.ERel 1, loc), s)], loc),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 1, loc)),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 2, loc)),
+                                                                     ((L'.PVar ("_", disc), loc),
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [str "("]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 3, loc),
+                                                                                 str " LEFT JOIN ",
+                                                                                 (L'.ERel 2, loc),
+                                                                                 str " ON ",
+                                                                                 (L'.ERel 1, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [str ")"]
+                                                                                 else
+                                                                                     [])))],
+                                                                    {disc = disc,
+                                                                     result = s}), loc)), loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_right_join"), _), (L.CRecord (_, left), _)),
+                                _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TRecord [("1", s), ("2", s)], loc)
+            in
+                ((L'.EAbs ("_", outerRec left,
+                           (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("on", s, s,
+                                                         (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
+                                                                                 ("2", (L'.ERel 1, loc), s)], loc),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 1, loc)),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 2, loc)),
+                                                                     ((L'.PVar ("_", disc), loc),
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [str "("]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 3, loc),
+                                                                                 str " RIGHT JOIN ",
+                                                                                 (L'.ERel 2, loc),
+                                                                                 str " ON ",
+                                                                                 (L'.ERel 1, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [str ")"]
+                                                                                 else
+                                                                                     [])))],
+                                                                    {disc = disc,
+                                                                     result = s}), loc)), loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_full_join"), _), (L.CRecord (_, left), _)), _),
+                     (L.CRecord (_, right), _)), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TRecord [("1", s), ("2", s)], loc)
+            in
+                ((L'.EAbs ("_", outerRec (left @ right),
+                           (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("on", s, s,
+                                                         (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s),
+                                                                                 ("2", (L'.ERel 1, loc), s)], loc),
+                                                                    [((L'.PRecord [("1", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 1, loc)),
+                                                                     ((L'.PRecord [("2", (L'.PPrim (Prim.String (Prim.Normal, "")),
+                                                                                          loc), s)], loc),
+                                                                      (L'.ERel 2, loc)),
+                                                                     ((L'.PVar ("_", disc), loc),
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [str "("]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 3, loc),
+                                                                                 str " FULL JOIN ",
+                                                                                 (L'.ERel 2, loc),
+                                                                                 str " ON ",
+                                                                                 (L'.ERel 1, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [str ")"]
+                                                                                 else
+                                                                                     [])))],
+                                                                    {disc = disc,
+                                                                     result = s}), loc)), loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
+            (str "", fm)
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_random"), _), _), _), _) =>
+            (str (#randomFunction (Settings.currentDbms ()) ^ "()"), fm)
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_order_by_Cons"), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                           (L'.EAbs ("e1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                     (L'.EAbs ("d", s, (L'.TFun (s, s), loc),
+                                               (L'.EAbs ("e2", s, s,
+                                                         (L'.ECase ((L'.ERel 0, loc),
+                                                                    [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                                      strcat [(L'.ERel 2, loc),
+                                                                              (L'.ERel 1, loc)]),
+                                                                     ((L'.PVar ("_", s), loc),
+                                                                      strcat [(L'.ERel 3, loc),
+                                                                              (L'.ERel 2, loc),
+                                                                              str ", ",
+                                                                              (L'.ERel 1, loc)])],
+                                                                    {disc = s, result = s}), loc)), loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "sql_no_limit") =>
+            (str "", fm)
+          | L.EFfiApp ("Basis", "sql_limit", [(e, t)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                (strcat [
+                 str " LIMIT ",
+                 (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc)
+                 ],
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "sql_no_offset") =>
+            (str "", fm)
+          | L.EFfiApp ("Basis", "sql_offset", [(e, t)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                (strcat [
+                 str " OFFSET ",
+                 (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc)
+                 ],
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_eq"), _), _) =>
+            (str "=", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_ne"), _), _) =>
+            (str "<>", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_lt"), _), _) =>
+            (str "<", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_le"), _), _) =>
+            (str "<=", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_gt"), _), _) =>
+            (str ">", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_ge"), _), _) =>
+            (str ">=", fm)
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_plus"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "+"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_minus"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "-"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_times"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "*"), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_div"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "/"), loc), fm)
+          | L.EFfi ("Basis", "sql_mod") =>
+            (str "%", fm)
+
+          | L.EFfi ("Basis", "sql_like") =>
+            (str "LIKE", fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                 (L.EFfi ("Basis", "sql_unary"), _),
+                 _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                     strcat [str "(",
+                                             (L'.ERel 1, loc),
+                                             str " ",
+                                             (L'.ERel 0, loc),
+                                             str ")"]), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_not") => (str "NOT", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_neg"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "-"), loc), fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "sql_binary"), _),
+                 _), _),
+                _), _),
+               _), _),
+              arg1), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+
+                fun default n = strcat [str "(",
+                                        (L'.ERel (n + 1), loc),
+                                        str " ",
+                                        (L'.ERel (n + 2), loc),
+                                        str " ",
+                                        (L'.ERel n, loc),
+                                        str ")"]
+
+                val body = case #1 arg1 of
+                               L.CApp ((L.CFfi ("Basis", "option"), _), _) =>
+                               (L'.ECase ((L'.ERel 2, loc),
+                                          [((L'.PPrim (Prim.String (Prim.Normal, "=")), loc),
+                                            if #supportsIsDistinctFrom (Settings.currentDbms ()) then
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " IS NOT DISTINCT FROM ",
+                                                        (L'.ERel 0, loc),
+                                                        str "))"]
+                                            else
+                                                strcat [str "((",
+                                                        (L'.ERel 1, loc),
+                                                        str " ",
+                                                        (L'.ERel 2, loc),
+                                                        str " ",
+                                                        (L'.ERel 0, loc),
+                                                        str ") OR ((",
+                                                        (L'.ERel 1, loc),
+                                                        str ") IS NULL AND (",
+                                                        (L'.ERel 0, loc),
+                                                        str ") IS NULL))"]),
+                                           ((L'.PVar ("_", s), loc),
+                                            default 1)],
+                                          {disc = s,
+                                           result = s}), loc)
+                               | _ => default 0
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("e2", s, s,
+                                               body), loc)), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_and") => (str "AND", fm)
+          | L.EFfi ("Basis", "sql_or") => (str "OR", fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.ECApp (
+                  (L.EFfi ("Basis", "sql_field"), _),
+                  _), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             (L.CName tab, _)), _),
+            (L.CName field, _)) => (str ("T_" ^ tab ^ "." ^ Settings.mangleSql (lowercaseFirst field)), fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_exp"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            (L.CName nm, _)) => (str (Settings.mangleSql (lowercaseFirst nm)), fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "sql_relop"), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+                val disc = (L'.TFfi ("Basis", "bool"), loc)
+            in
+                (if #nestedRelops (Settings.currentDbms ()) then
+                     (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                               (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                         (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                                   (L'.EAbs ("e2", s, s,
+                                                             strcat [str "((",
+                                                                     (L'.ERel 1, loc),
+                                                                     str ") ",
+                                                                     (L'.ERel 3, loc),
+                                                                     (L'.ECase ((L'.ERel 2, loc),
+                                                                                [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
+                                                                                                                 datatyp = "bool",
+                                                                                                                 con = "True",
+                                                                                                                 arg = NONE}, NONE), loc),
+                                                                                  str " ALL"),
+                                                                                 ((L'.PVar ("_", disc), loc),
+                                                                                  str "")],
+                                                                                {disc = disc,
+                                                                                 result = s}), loc),
+                                                                     str " (",
+                                                                     (L'.ERel 0, loc),
+                                                                     str "))"]), loc)), loc)), loc)), loc)
+                 else
+                     (L'.EAbs ("c", s, (L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
+                               (L'.EAbs ("all", (L'.TFfi ("Basis", "bool"), loc), (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                                         (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
+                                                   (L'.EAbs ("e2", s, s,
+                                                             strcat [(L'.ERel 1, loc),
+                                                                     str " ",
+                                                                     (L'.ERel 3, loc),
+                                                                     (L'.ECase ((L'.ERel 2, loc),
+                                                                                [((L'.PCon (L'.Enum, L'.PConFfi {mod = "Basis",
+                                                                                                                 datatyp = "bool",
+                                                                                                                 con = "True",
+                                                                                                                 arg = NONE}, NONE), loc),
+                                                                                  str " ALL"),
+                                                                                 ((L'.PVar ("_", disc), loc),
+                                                                                  str "")],
+                                                                                {disc = disc,
+                                                                                 result = s}), loc),
+                                                                     str " ",
+                                                                     (L'.ERel 0, loc)]), loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_forget_tables"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("x", s, s, (L'.ERel 0, loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "sql_union") => (str "UNION", fm)
+          | L.EFfi ("Basis", "sql_intersect") =>
+            (if #onlyUnion (Settings.currentDbms ()) then
+                 ErrorMsg.errorAt loc "The DBMS you've selected doesn't support INTERSECT."
+             else
+                 ();
+             (str "INTERSECT", fm))
+          | L.EFfi ("Basis", "sql_except") =>
+            (if #onlyUnion (Settings.currentDbms ()) then
+                 ErrorMsg.errorAt loc "The DBMS you've selected doesn't support EXCEPT."
+             else
+                 ();
+             (str "EXCEPT", fm))
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.EFfi ("Basis", "sql_count"), _),
+              _), _),
+             _), _),
+            _) => (str "COUNT(*)", fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_aggregate"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            t) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+
+                val main = strcat [(L'.ERel 1, loc),
+                                   str "(",
+                                   (L'.ERel 0, loc),
+                                   str ")"]
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "sql_count_col"), _), _) =>
+            (str "COUNT", fm)
+
+          | L.EFfi ("Basis", "sql_summable_int") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_summable_float") => ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_summable_option"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                       (L'.ERecord [], loc)), loc),
+             fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_avg"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                       str "AVG"), loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_sum"), _), _), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
+                       (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                                 str "SUM"), loc)), loc),
+             fm)
+
+          | L.EFfi ("Basis", "sql_arith_int") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_arith_float") => ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_arith_option"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                       (L'.ERecord [], loc)), loc),
+             fm)
+
+          | L.EFfi ("Basis", "sql_maxable_int") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_maxable_float") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_maxable_string") => ((L'.ERecord [], loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_maxable_option"), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                       (L'.ERecord [], loc)), loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_max"), _), _), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
+                       (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                                 str "MAX"), loc)), loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_min"), _), _), _), _) =>
+            ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc)), loc),
+                       (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "string"), loc),
+                                 str "MIN"), loc)), loc),
+             fm)
+
+          | L.EFfi ("Basis", "sql_asc") => (str "", fm)
+          | L.EFfi ("Basis", "sql_desc") => (str " DESC", fm)
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_nfunc"), _),
+               _), _),
+              _), _),
+             _), _),
+           _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "sql_window_normal") => ((L'.ERecord [], loc), fm)
+          | L.EFfi ("Basis", "sql_window_fancy") => ((L'.ERecord [], loc), fm)
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_window"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
+                           (L'.EAbs ("e", s, s,
+                                     (L'.ERel 0, loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "sql_current_timestamp") => (str "CURRENT_TIMESTAMP", fm)
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_ufunc"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("x", s, s,
+                                     strcat [(L'.ERel 1, loc),
+                                             str "(",
+                                             (L'.ERel 0, loc),
+                                             str ")"]), loc)), loc),
+                 fm)
+            end
+          | L.EFfi ("Basis", "sql_octet_length") =>
+            (str (if #supportsOctetLength (Settings.currentDbms ()) then
+                      "octet_length"
+                  else
+                      "length"), fm)
+          | L.EFfi ("Basis", "sql_lower") =>
+            (str "lower", fm)
+          | L.EFfi ("Basis", "sql_upper") =>
+            (str "upper", fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) =>
+            ((L'.EFfi ("Basis", "sql_known"), loc), fm)
+
+          | (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_is_null"), _), _),
+                _), _),
+               _), _),
+              _), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, s,
+                           strcat [str "(",
+                                   (L'.ERel 0, loc),
+                                   str " IS NULL)"]), loc),
+                 fm)
+            end
+
+          | (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_coalesce"), _), _),
+                _), _),
+               _), _),
+              _), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("x1", s, (L'.TFun (s, s), loc),
+                           (L'.EAbs ("x1", s, s,
+                                     strcat [str "COALESCE(",
+                                             (L'.ERel 1, loc),
+                                             str ",",
+                                             (L'.ERel 0, loc),
+                                             str ")"]), loc)), loc),
+                 fm)
+            end
+
+          | (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_if_then_else"), _), _),
+                _), _),
+               _), _),
+              _), _)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("if", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("then", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("else", s, s,
+                                               strcat [str "(CASE WHEN (",
+                                                       (L'.ERel 2, loc),
+                                                       str ") THEN (",
+                                                       (L'.ERel 1, loc),
+                                                       str ") ELSE (",
+                                                       (L'.ERel 0, loc),
+                                                       str ") END)"]), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_nullable"), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("u", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
+                           (L'.EAbs ("x", s, s,
+                                     (L'.ERel 0, loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "sql_subquery"), _),
+                 _), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (s, s), loc),
+                           (L'.EAbs ("x", s, s,
+                                     strcat [str "(",
+                                             (L'.ERel 0, loc),
+                                             str ")"]), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+               (L.EFfi ("Basis", "sql_no_partition"), _),
+               _), _),
+             _), _),
+            _) => (str "", fm)
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_partition"), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("e", s, s, strcat [str "PARTITION BY ", (L'.ERel 0, loc)]), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.EFfi ("Basis", "sql_window_function"), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val () = if #windowFunctions (Settings.currentDbms ()) then
+                             ()
+                         else
+                             ErrorMsg.errorAt loc "The DBMS you've selected doesn't support window functions."
+
+                val s = (L'.TFfi ("Basis", "string"), loc)
+
+                val main = strcat [(L'.ERel 2, loc),
+                                   str " OVER (",
+                                   (L'.ERel 1, loc),
+                                   (L'.ECase ((L'.ERel 0, loc),
+                                              [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                str ""),
+                                               ((L'.PVar ("_", s), loc),
+                                                strcat [str " ORDER BY ",
+                                                        (L'.ERel 1, loc)])],
+                                              {disc = s,
+                                               result = s}), loc),
+                                   str ")"]
+            in
+                ((L'.EAbs ("w", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("p", s, (L'.TFun (s, s), loc),
+                                     (L'.EAbs ("o", s, s,
+                                               main), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp (
+            (L.ECApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.EFfi ("Basis", "sql_window_aggregate"), _),
+                _), _),
+               _), _),
+              _), _),
+             _), _),
+            _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+
+                val main = strcat [(L'.ERel 1, loc),
+                                   str "(",
+                                   (L'.ERel 0, loc),
+                                   str ")"]
+            in
+                ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+                           (L'.EAbs ("e1", s, s, main), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) =>
+            (str "COUNT(*)", fm)
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_rank"), _), _), _), _), _), _) =>
+            (str "RANK()", fm)
+
+          | L.EFfiApp ("Basis", "nextval", [(e, _)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            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.EFfi ("Basis", "null") => (str "", fm)
+
+          | L.EFfiApp ("Basis", "classes", [(s1, _), (s2, _)]) =>
+            let
+                val (s1, fm) = monoExp (env, st, fm) s1
+                val (s2, fm) = monoExp (env, st, fm) s2
+            in
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "data_kind") => (str "data-", fm)
+          | L.EFfi ("Basis", "aria_kind") => (str "aria-", fm)
+
+          | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) =>
+            let
+                val (sk, fm) = monoExp (env, st, fm) sk
+                val (s1, fm) = monoExp (env, st, fm) s1
+                val (s2, fm) = monoExp (env, st, fm) s2
+            in
+                ((L'.EStrcat (sk,
+                              (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc),
+                                           (L'.EStrcat (str "=\"",
+                                                        (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc),
+                                                                     str "\""), loc)),
+                                            loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "data_attrs", [(s1, _), (s2, _)]) =>
+            let
+                val (s1, fm) = monoExp (env, st, fm) s1
+                val (s2, fm) = monoExp (env, st, fm) s2
+            in
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "css_url", [(s, _)]) =>
+            let
+                val (s, fm) = monoExp (env, st, fm) s
+            in
+                ((L'.EStrcat (str "url(",
+                              (L'.EStrcat ((L'.EFfiApp ("Basis", "css_url", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
+                                           str ")"), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "property", [(s, _)]) =>
+            let
+                val (s, fm) = monoExp (env, st, fm) s
+            in
+                ((L'.EStrcat ((L'.EFfiApp ("Basis", "property", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
+                              str ":"), loc),
+                 fm)
+            end
+          | L.EFfiApp ("Basis", "value", [(s1, _), (s2, _)]) =>
+            let
+                val (s1, fm) = monoExp (env, st, fm) s1
+                val (s2, fm) = monoExp (env, st, fm) s2
+            in
+                ((L'.EStrcat (s1, (L'.EStrcat (str " ", s2), loc)), loc),
+                 fm)
+            end
+
+          | L.EFfi ("Basis", "noStyle") => (str "", fm)
+          | L.EFfiApp ("Basis", "oneProperty", [(s1, _), (s2, _)]) =>
+            let
+                val (s1, fm) = monoExp (env, st, fm) s1
+                val (s2, fm) = monoExp (env, st, fm) s2
+            in
+                ((L'.EStrcat (s1, (L'.EStrcat (s2, str ";"), loc)), loc),
+                 fm)
+            end
+
+          | L.EApp (
+            (L.ECApp (
+             (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
+             _), _),
+            se) =>
+            let
+                val (se, fm) = monoExp (env, st, fm) se
+            in
+                ((L'.EFfiApp ("Basis", "htmlifyString", [(se, (L'.TFfi ("Basis", "string"), loc))]), loc), fm)
+            end
+          | L.ECApp (
+             (L.ECApp ((L.EFfi ("Basis", "cdataChar"), _), _), _),
+             _) =>
+            ((L'.EAbs ("ch", (L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "htmlifySpecialChar", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "char"), loc))]), loc)), loc), fm)
+
+          | L.EApp (
+            (L.EApp (
+             (L.ECApp (
+              (L.ECApp (
+               (L.ECApp (
+                (L.ECApp (
+                 (L.EFfi ("Basis", "join"),
+                     _), _), _),
+                _), _),
+               _), _),
+              _), _),
+             xml1), _),
+            xml2) =>
+            let
+                val (xml1, fm) = monoExp (env, st, fm) xml1
+                val (xml2, fm) = monoExp (env, st, fm) xml2
+            in
+                ((L'.EStrcat (xml1, xml2), loc), fm)
+            end
+
+          | L.EApp (
+            (L.EApp (
+             (L.EApp (
+              (L.EApp (
+               (L.EApp (
+                (L.EApp (
+                 (L.EApp (
+		  (L.ECApp (
+                   (L.ECApp (
+                    (L.ECApp (
+                     (L.ECApp (
+                      (L.ECApp (
+                       (L.ECApp (
+                        (L.ECApp (
+                         (L.ECApp (
+			  (L.EFfi ("Basis", "tag"),
+                           _), (L.CRecord (_, attrsGiven), _)), _), _), _), ctxOuter), _), _), _), _), _), _), _), _), _), _), _),
+		  class), _),
+	         dynClass), _),
+                style), _),
+               dynStyle), _),
+              attrs), _),
+             tag), _),
+            xml) =>
+            let
+                fun getTag' (e, _) =
+                    case e of
+                        L.EFfi (_, tag) => (tag, [])
+                      | L.ECApp (e, t) => let
+                            val (tag, ts) = getTag' e
+                        in
+                            (tag, ts @ [t])
+                        end
+                      | _ => (E.errorAt loc "Non-constant XML tag";
+                              Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
+                              ("", []))
+
+                fun getTag (e, _) =
+                    case e of
+                        L.EFfiApp (_, tag, [((L.ERecord [], _), _)]) => (tag, [])
+                      | L.EApp (e, (L.ERecord [], _)) => getTag' e
+                      | _ => (E.errorAt loc "Non-constant XML tag";
+                              Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
+                              ("", []))
+
+                val (tag, targs) = getTag tag
+
+                val (attrs, fm) = monoExp (env, st, fm) attrs
+                val attrs = case #1 attrs of
+                                L'.ERecord xes => xes
+                              | _ => map (fn ((L.CName x, _), t) => (x, (L'.EField (attrs, x), loc), monoType env t)
+                                           | (c, t) => (E.errorAt loc "Non-constant field name for HTML tag attribute";
+                                                        Print.eprefaces' [("Name", CorePrint.p_con env c)];
+                                                        ("", (L'.EField (attrs, ""), loc), monoType env t))) attrsGiven
+
+                val attrs =
+                    if List.exists (fn ("Link", _, _) => true
+                                     | _ => false) attrs then
+                        List.filter (fn ("Href", _, _) => false
+                                      | _ => true) attrs
+                    else
+                        attrs
+
+                fun findOnload (attrs, onload, onunload, acc) =
+                    case attrs of
+                        [] => (onload, onunload, acc)
+                      | ("Onload", e, _) :: rest => findOnload (rest, SOME e, onunload, acc)
+                      | ("Onunload", e, _) :: rest => findOnload (rest, onload, SOME e, acc)
+                      | x :: rest => findOnload (rest, onload, onunload, x :: acc)
+
+                val (onload, onunload, attrs) =
+                    if tag = "body" then
+                        findOnload (attrs, NONE, NONE, [])
+                    else
+                        (NONE, NONE, attrs)
+
+                val (class, fm) = monoExp (env, st, fm) class
+                val (dynClass, fm) = monoExp (env, st, fm) dynClass
+                val (style, fm) = monoExp (env, st, fm) style
+                val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
+
+                (* Special case for <button value=""> *)
+                val (attrs, extraString) = case tag of
+                                               "button" =>
+                                               (case List.partition (fn (x, _, _) => x = "Value") attrs of
+                                                    ([(_, value, _)], rest) =>
+                                                    (rest, SOME value)
+                                                  | _ => (attrs, NONE))
+                                             | "body" =>
+                                               (attrs,
+                                                if (case (#1 dynClass, #1 dynStyle) of
+                                                        (L'.ESome _, _) => true
+                                                      | (_, L'.ESome _) => true
+                                                      | _ => false) then
+                                                    let
+                                                        fun jsify (e : L'.exp) =
+                                                            case #1 e of
+                                                                L'.ESome (_, ds) => strcat [str "execD(",
+                                                                                            (L'.EJavaScript (L'.Script, ds), loc),
+                                                                                            str ")"]
+                                                              | _ => str "null"
+                                                    in
+                                                        SOME (strcat [str "<script type=\"text/javascript\">bodyDynClass(",
+                                                                      jsify dynClass,
+                                                                      str ",",
+                                                                      jsify dynStyle,
+				                                      str ")</script>"])
+                                                    end
+                                                else
+                                                    NONE)
+                                             | _ => (attrs, NONE)
+
+
+                val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
+
+                fun isSome (e, _) =
+                    case e of
+                        L'.ESome _ => true
+                      | _ => false
+
+                val () = if isSome dynClass orelse isSome dynStyle then
+                             if List.exists (fn x => x = tag) dynamics then
+                                 E.errorAt loc ("Dynamic tag <" ^ tag ^ "> cannot be combined with 'dynClass' or 'dynStyle' attribute; an additional <span> may be useful")
+                             else
+                                 ()
+                         else
+                             ()
+
+                fun tagStart tag' =
+                    let
+                        val t = (L'.TFfi ("Basis", "string"), loc)
+                        val s = strH (String.concat ["<", tag'])
+
+                        val s = (L'.EStrcat (s,
+                                             (L'.ECase (class,
+                                                        [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                          strH ""),
+                                                         ((L'.PVar ("x", t), loc),
+                                                          (L'.EStrcat (strH " class=\"",
+                                                                       (L'.EStrcat ((L'.ERel 0, loc),
+                                                                                    strH "\""),
+                                                                        loc)), loc))],
+                                                        {disc = t,
+                                                         result = t}), loc)), loc)
+
+                        val s = (L'.EStrcat (s,
+                                             (L'.ECase (style,
+                                                        [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                          strH ""),
+                                                         ((L'.PVar ("x", t), loc),
+                                                          (L'.EStrcat (strH " style=\"",
+                                                                       (L'.EStrcat ((L'.ERel 0, loc),
+                                                                                    strH "\""),
+                                                                        loc)), loc))],
+                                                        {disc = t,
+                                                         result = t}), loc)), loc)
+
+                        val (s, fm) = foldl (fn (("Action", _, _), acc) => acc
+                                              | (("Source", _, _), acc) => acc
+                                              | (("Data", e, _), (s, fm)) =>
+                                                ((L'.EStrcat (s,
+                                                              (L'.EStrcat (
+                                                               strH " ",
+                                                               e), loc)), loc),
+                                                 fm)
+                                              | ((x, e, t), (s, fm)) =>
+                                                case t of
+                                                    (L'.TFfi ("Basis", "bool"), _) =>
+                                                    let
+                                                        val s' = " " ^ lowercaseFirst x
+                                                    in
+                                                        ((L'.ECase (e,
+                                                                    [((L'.PCon (L'.Enum,
+                                                                                L'.PConFfi {mod = "Basis",
+                                                                                            datatyp = "bool",
+                                                                                            con = "True",
+                                                                                            arg = NONE},
+                                                                                NONE), loc),
+                                                                      (L'.EStrcat (s,
+                                                                                   strH s'), loc)),
+                                                                     ((L'.PCon (L'.Enum,
+                                                                                L'.PConFfi {mod = "Basis",
+                                                                                            datatyp = "bool",
+                                                                                            con = "False",
+                                                                                            arg = NONE},
+                                                                                NONE), loc),
+                                                                      s)],
+                                                                    {disc = (L'.TFfi ("Basis", "bool"), loc),
+                                                                     result = (L'.TFfi ("Basis", "string"), loc)}), loc),
+                                                         fm)
+                                                    end
+                                                  | (L'.TFun (dom, _), _) =>
+                                                    let
+                                                        val e =
+                                                            case #1 dom of
+                                                                L'.TRecord [] => (L'.EApp (e, (L'.ERecord [], loc)), loc)
+                                                              | _ =>
+                                                                if String.isPrefix "Onkey" x then
+                                                                    (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "keyEvent", []), loc)),
+                                                                               loc), (L'.ERecord [], loc)), loc)
+                                                                else
+                                                                    (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "mouseEvent", []), loc)),
+                                                                               loc), (L'.ERecord [], loc)), loc)
+
+                                                        val s' = " " ^ lowercaseFirst x ^ "='uw_event=event;exec("
+                                                    in
+                                                        ((L'.EStrcat (s,
+                                                                      (L'.EStrcat (
+                                                                       strH s',
+                                                                       (L'.EStrcat (
+                                                                        (L'.EJavaScript (L'.Attribute, e), loc),
+                                                                        strH ")'"), loc)),
+                                                                       loc)), loc),
+                                                         fm)
+                                                    end
+                                                  | _ =>
+                                                    let
+                                                        val fooify =
+                                                            case x of
+                                                                "Link" => urlifyExp
+                                                              | "Action" => urlifyExp
+                                                              | _ => attrifyExp
+
+                                                        val x =
+                                                            case x of
+                                                                "Typ" => "Type"
+                                                              | "Nam" => "Name"
+                                                              | "Link" => "Href"
+                                                              | _ => x
+
+                                                        val x = String.translate (fn #"_" => "-"
+                                                                                   | ch => String.str ch) x
+
+                                                        val xp = " " ^ lowercaseFirst x ^ "=\""
+
+                                                        val (e, fm) = fooify env fm (e, t)
+                                                        val e = case (tag, x) of
+                                                                    ("coption", "Value") => (L'.EStrcat (strH "x", e), loc)
+                                                                  | _ => e
+                                                    in
+                                                        ((L'.EStrcat (s,
+                                                                      (L'.EStrcat (strH xp,
+                                                                                   (L'.EStrcat (e,
+                                                                                                strH "\""),
+                                                                                    loc)),
+                                                                       loc)), loc),
+                                                         fm)
+                                                    end)
+                                            (s, fm) attrs
+                    in
+                        (if tag = "coption" andalso List.all (fn ("Value", _, _) => false | _ => true) attrs then
+                            (L'.EStrcat (s,
+                                         strH " value=\"\""), loc)
+                         else
+                             s,
+                         fm)
+                    end
+
+                fun input typ =
+                    case targs of
+                        [_, (L.CName name, _)] =>
+                        let
+                            val (ts, fm) = tagStart "input"
+                        in
+                            ((L'.EStrcat (ts,
+                                          strH (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")), loc), fm)
+                        end
+                      | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                              raise Fail "No name passed to input tag")
+
+                fun normal (tag, extra) =
+                    let
+                        val (tagStart, fm) = tagStart tag
+                        val tagStart = case extra of
+                                           NONE => tagStart
+                                         | SOME extra => (L'.EStrcat (tagStart, extra), loc)
+
+                        val firstWord = Substring.string o #1 o Substring.splitl (fn ch => not (Char.isSpace ch)) o Substring.full
+
+                        fun normal () =
+                            let
+                                val (xml, fm) = monoExp (env, st, fm) xml
+
+                                val xml = case extraString of
+                                              NONE => xml
+                                            | SOME extra => (L'.EStrcat (extra, xml), loc)
+                            in
+                                ((L'.EStrcat ((L'.EStrcat (tagStart, strH ">"), loc),
+                                              (L'.EStrcat (xml,
+                                                           strH (String.concat ["</", firstWord tag, ">"])), loc)),
+                                  loc),
+                                 fm)
+                            end
+
+                        fun isSingleton () =
+                            let
+                                val (bef, aft) = Substring.splitl (not o Char.isSpace) (Substring.full tag)
+                            in
+                                SS.member (singletons, if Substring.isEmpty aft then
+                                                           tag
+                                                       else
+                                                           Substring.string bef)
+                            end
+                    in
+                        case (xml, extraString) of
+                            ((L.EApp ((L.ECApp (
+                                       (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
+                                                 _), _),
+                                       _), _),
+                                      (L.EPrim (Prim.String (_, s)), _)), _), NONE) =>
+                            if CharVector.all Char.isSpace s andalso isSingleton () then
+                                ((L'.EStrcat (tagStart, strH " />"), loc), fm)
+                            else
+                                normal ()
+                          | _ => normal ()
+                    end
+
+                fun setAttrs jexp =
+                    let
+                        val s = strH (String.concat ["<", tag])
+
+                        val assgns = List.mapPartial
+                                     (fn ("Source", _, _) => NONE
+                                       | ("Onchange", e, _) =>
+                                         SOME (strcat [str "addOnChange(d,exec(",
+                                                       (L'.EJavaScript (L'.Script, e), loc),
+                                                       str "));"])
+                                       | (x, e, (L'.TFun ((L'.TRecord [], _), _), _)) =>
+                                         SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
+                                                       (L'.EJavaScript (L'.Script, e), loc),
+                                                       str ");"])
+                                       | (x, e, _) =>
+                                         if String.isPrefix "On" x then
+                                             let
+                                                 val arg = if String.isPrefix "Onkey" x then
+                                                               SOME (L'.EFfiApp ("Basis", "keyEvent", []), loc)
+                                                           else if String.isSuffix "click" x orelse String.isPrefix "Onmouse" x then
+                                                               SOME (L'.EFfiApp ("Basis", "mouseEvent", []), loc)
+                                                           else
+                                                               NONE
+
+                                                 val e = liftExpInExp 0 e
+
+                                                 val e = case arg of
+                                                             NONE => e
+                                                           | SOME arg => (L'.EApp (e, arg), loc)
+
+                                                 val e = (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                                                                   (L'.EApp (e, (L'.ERecord [], loc)), loc)), loc)
+                                             in
+                                                 case x of
+                                                     "Onkeyup" =>
+                                                     SOME (strcat [str ("((function(c){addOnKeyUp(d,function(ev){window.uw_event=ev?ev:window.event;return c();});})(exec("),
+                                                                   (L'.EJavaScript (L'.Script, e), loc),
+                                                                   str ")));"])
+                                                   | _ =>
+                                                     SOME (strcat [str ("((function(c){d." ^ lowercaseFirst x ^ "=function(ev){window.uw_event=ev?ev:window.event;return c();};})(exec("),
+                                                                   (L'.EJavaScript (L'.Script, e), loc),
+                                                                   str ")));"])
+                                             end
+                                         else
+                                             SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
+                                                           (L'.EJavaScript (L'.Script, e), loc),
+                                                           str ");"]))
+                                     attrs
+
+                        val t = (L'.TFfi ("Basis", "string"), loc)
+                        val setClass = (L'.ECase (class,
+                                                  [((L'.PPrim (Prim.String (Prim.Normal, "")), loc),
+                                                    str ""),
+                                                   ((L'.PVar ("x", t), loc),
+                                                    (L'.EStrcat (strH "d.className=\"",
+                                                                 (L'.EStrcat ((L'.ERel 0, loc),
+                                                                              strH "\";"), loc)),
+                                                     loc))],
+                                                  {disc = (L'.TOption t, loc),
+                                                   result = t}), loc)
+                    in
+                        case assgns of
+                            [] => strcat [str "var d=",
+                                          jexp,
+                                          str ";",
+                                          setClass]
+                          | _ => strcat (str "var d="
+                                         :: jexp
+                                         :: str ";"
+                                         :: setClass
+                                         :: assgns)
+                    end
+
+                fun execify e =
+                    case e of
+                        NONE => strH ""
+                      | SOME e =>
+                        let
+                            val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
+                        in
+                            (L'.EStrcat (strH "exec(",
+                                         (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
+                                                      strH ")"), loc)), loc)
+                        end
+
+                fun inTag tag' = case ctxOuter of
+				     (L.CRecord (_, ctx), _) =>
+				     List.exists (fn ((L.CName tag'', _), _) => tag'' = tag'
+                                                   | _ => false) ctx
+                                  | _ => false
+
+                fun pnode () = if inTag "Tr" then
+			           "tr"
+                               else if inTag "Table" then
+			           "table"
+                               else
+			           "span"
+
+                fun cinput (fallback, dynamic) =
+		    case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                        NONE =>
+                        let
+			    val (ts, fm) = tagStart "input"
+                        in
+			    ((L'.EStrcat (ts,
+                                          strH (" type=\"" ^ fallback ^ "\" />")),
+                              loc), fm)
+                        end
+                      | SOME (_, src, _) =>
+                        let
+			    val sc = strcat [str (dynamic ^ "(exec("),
+					     (L'.EJavaScript (L'.Script, src), loc),
+					     str "))"]
+			    val sc = setAttrs sc
+                        in
+			    (strcat [str "<script type=\"text/javascript\">",
+				     sc,
+				     str "</script>"],
+			     fm)
+                        end
+
+		val baseAll as (base, fm) =
+                    case tag of
+			"body" => let
+                            val onload = execify onload
+                            val onunload = execify onunload
+                            val s = (L'.TFfi ("Basis", "string"), loc)
+			in
+                            normal ("body",
+                                    SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload",
+                                                                   [((L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings",
+                                                                                               [((L'.ERecord [], loc),
+                                                                                                 (L'.TRecord [], loc))]), loc),
+										  onload), loc),
+                                                                     s)]),
+                                                       loc),
+                                                      (L'.EFfiApp ("Basis", "maybe_onunload",
+                                                                   [(onunload, s)]),
+                                                       loc)), loc))
+			end
+
+                      | "dyn" =>
+			let
+			in
+                            case attrs of
+				[("Signal", e, _)] =>
+				((L'.EStrcat
+                                      (strH ("<script type=\"text/javascript\">dyn(\""
+                                             ^ pnode () ^ "\", execD("),
+                                       (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
+                                                    strH ("))</script>")), loc)), loc),
+				 fm)
+                              | _ => raise Fail "Monoize: Bad <dyn> attributes"
+			end
+
+                      | "active" =>
+                        (case attrs of
+			     [("Code", e, _)] =>
+			     ((L'.EStrcat
+                                   (strH "<script type=\"text/javascript\">active(execD(",
+                                    (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
+                                                 strH "))</script>"), loc)), loc),
+			      fm)
+                           | _ => raise Fail "Monoize: Bad <active> attributes")
+
+                      | "script" =>
+                        (case attrs of
+			     [("Code", e, _)] =>
+			     ((L'.EStrcat
+                                   (strH "<script type=\"text/javascript\">execF(execD(",
+                                    (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
+                                                 strH "))</script>"), loc)), loc),
+			      fm)
+                           | _ => raise Fail "Monoize: Bad <script> attributes")
+
+                      | "submit" => normal ("input type=\"submit\"", NONE)
+                      | "image" => normal ("input type=\"image\"", NONE)
+                      | "hidden" => input "hidden"
+
+                      | "textbox" =>
+			(case targs of
+                             [_, (L.CName name, _)] =>
+                             (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+				  NONE =>
+				  let
+                                      val (ts, fm) = tagStart "input"
+				  in
+                                      ((L'.EStrcat (ts,
+                                                    strH (" type=\"text\" name=\"" ^ name ^ "\" />")),
+                                        loc), fm)
+				  end
+				| SOME (_, src, _) =>
+				  (strcat [str "<script type=\"text/javascript\">inp(exec(",
+                                           (L'.EJavaScript (L'.Script, src), loc),
+                                           str "), \"",
+                                           str name,
+                                           str "\")</script>"],
+                                   fm))
+                           | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                                   raise Fail "No name passed to textbox tag"))
+                      | "password" => input "password"
+                      | "email" => input "email"
+                      | "search" => input "search"
+                      | "url_" => input "url"
+                      | "tel" => input "tel"
+                      | "color" => input "color"
+                      | "number" => input "number"
+                      | "range" => input "range"
+                      | "date" => input "date"
+                      | "datetime" => input "datetime"
+                      | "datetime_local" => input "datetime-local"
+                      | "month" => input "month"
+                      | "week" => input "week"
+                      | "timeInput" => input "time"
+                      | "textarea" =>
+			(case targs of
+                             [_, (L.CName name, _)] =>
+                             let
+				 val (ts, fm) = tagStart "textarea"
+				 val (xml, fm) = monoExp (env, st, fm) xml
+                             in
+				 ((L'.EStrcat ((L'.EStrcat (ts,
+                                                            strH (" name=\"" ^ name ^ "\">")), loc),
+                                               (L'.EStrcat (xml,
+                                                            strH "</textarea>"), loc)),
+                                   loc), fm)
+                             end
+                           | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                                   raise Fail "No name passed to ltextarea tag"))
+
+                      | "checkbox" => input "checkbox"
+                      | "upload" => input "file"
+
+                      | "radio" =>
+			(case targs of
+                             [_, (L.CName name, _)] =>
+                             monoExp (env, St.setRadioGroup (st, name), fm) xml
+                           | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                                   raise Fail "No name passed to radio tag"))
+                      | "radioOption" =>
+			(case St.radioGroup st of
+                             NONE => raise Fail "No name for radioGroup"
+                           | SOME name =>
+                             normal ("input",
+                                     SOME (strH (" type=\"radio\" name=\"" ^ name ^ "\""))))
+
+                      | "select" =>
+			(case targs of
+                             [_, (L.CName name, _)] =>
+                             let
+				 val (ts, fm) = tagStart "select"
+				 val (xml, fm) = monoExp (env, st, fm) xml
+                             in
+				 ((L'.EStrcat ((L'.EStrcat (ts,
+                                                            strH (" name=\"" ^ name ^ "\">")), loc),
+                                               (L'.EStrcat (xml,
+                                                            strH "</select>"),
+                                                loc)),
+                                   loc),
+				  fm)
+                             end
+                           | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                                   raise Fail "No name passed to lselect tag"))
+
+                      | "ctextbox" => cinput ("text", "inp")
+                      | "cpassword" => cinput ("password", "password")
+                      | "cemail" => cinput ("email", "email")
+                      | "csearch" => cinput ("search", "search")
+                      | "curl" => cinput ("url", "url")
+                      | "ctel" => cinput ("tel", "tel")
+                      | "ccolor" => cinput ("color", "color")
+
+                      | "cnumber" => cinput ("number", "number")
+                      | "crange" => cinput ("range", "range")
+                      | "cdate" => cinput ("date", "date")
+                      | "cdatetime" => cinput ("datetime", "datetime")
+                      | "cdatetime_local" => cinput ("datetime-local", "datetime_local")
+                      | "cmonth" => cinput ("month", "month")
+                      | "cweek" => cinput ("week", "week")
+                      | "ctime" => cinput ("time", "time")
+
+                      | "ccheckbox" => cinput ("checkbox", "chk")
+                      | "cselect" =>
+			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                             NONE =>
+                             let
+				 val (xml, fm) = monoExp (env, st, fm) xml
+				 val (ts, fm) = tagStart "select"
+                             in
+				 (strcat [ts,
+					  str ">",
+					  xml,
+					  str "</select>"],
+				  fm)
+                             end
+                           | SOME (_, src, _) =>
+                             let
+				 val (xml, fm) = monoExp (env, st, fm) xml
+
+				 val sc = strcat [str "sel(exec(",
+						  (L'.EJavaScript (L'.Script, src), loc),
+						  str "),exec(",
+						  (L'.EJavaScript (L'.Script, xml), loc),
+						  str "))"]
+				 val sc = setAttrs sc
+                             in
+				 (strcat [str "<script type=\"text/javascript\">",
+					  sc,
+					  str "</script>"],
+				  fm)
+                             end)
+
+                      | "coption" => normal ("option", NONE)
+
+                      | "ctextarea" =>
+			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                             NONE =>
+                             let
+				 val (ts, fm) = tagStart "textarea"
+                             in
+				 ((L'.EStrcat (ts,
+                                               strH " />"),
+                                   loc), fm)
+                             end
+                           | SOME (_, src, _) =>
+                             let
+				 val sc = strcat [str "tbx(exec(",
+						  (L'.EJavaScript (L'.Script, src), loc),
+						  str "))"]
+				 val sc = setAttrs sc
+                             in
+				 (strcat [str "<script type=\"text/javascript\">",
+					  sc,
+					  str "</script>"],
+				  fm)
+                             end)
+
+                      | "tabl" => normal ("table", NONE)
+                      | _ => normal (tag, NONE)
+
+                val (dynClass', dynStyle') =
+                    case tag of
+                        "body" => ((L'.ENone dummyTyp, ErrorMsg.dummySpan),
+                                   (L'.ENone dummyTyp, ErrorMsg.dummySpan))
+                      | _ => (dynClass, dynStyle)
+	    in
+		case #1 dynClass' of
+		    L'.ENone _ =>
+		    (case #1 dynStyle' of
+		         L'.ENone _ => baseAll
+		       | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"",
+                                                      str (pnode ()),
+                                                      str "\",execD(",
+				                      (L'.EJavaScript (L'.Script, base), loc),
+				                      str "),null,execD(",
+				                      (L'.EJavaScript (L'.Script, ds), loc),
+				                      str "))</script>"],
+			                      fm)
+                       | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
+                               baseAll))
+		  | L'.ESome (_, dc) =>
+                    let
+                        val e = case #1 dynStyle' of
+                                    L'.ENone _ => str "null"
+                                  | L'.ESome (_, ds) => strcat [str "execD(",
+                                                                (L'.EJavaScript (L'.Script, ds), loc),
+                                                                str ")"]
+                                  | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
+                                          str "null")
+                    in
+                        (strcat [str "<script type=\"text/javascript\">dynClass(\"",
+                                 str (pnode ()),
+                                 str "\",execD(",
+				 (L'.EJavaScript (L'.Script, base), loc),
+				 str "),execD(",
+				 (L'.EJavaScript (L'.Script, dc), loc),
+				 str "),",
+                                 e,
+                                 str ")</script>"],
+			 fm)
+                    end
+                  | _ => (E.errorAt loc "Absence/presence of 'dynClass' unknown";
+                          baseAll)
+            end
+
+          | L.EApp (
+            (L.EApp ((L.EApp ((L.ECApp (
+                                    (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
+                                    (L.CRecord (_, fields), _)), _),
+                              id), _),
+                     class), _),
+            xml) =>
+            let
+                fun findSubmit (e, _) =
+                    case e of
+                        L.EApp (
+                        (L.EApp (
+                         (L.ECApp (
+                          (L.ECApp (
+                           (L.ECApp (
+                            (L.ECApp (
+                             (L.EFfi ("Basis", "join"),
+                              _), _), _),
+                            _), _),
+                           _), _),
+                          _), _),
+                         xml1), _),
+                        xml2) => (case findSubmit xml1 of
+                                      Error => Error
+                                    | NotFound => findSubmit xml2
+                                    | Found e =>
+                                      case findSubmit xml2 of
+                                          NotFound => Found e
+                                        | _ => Error)
+                      | L.EApp (
+                        (L.EApp (
+                         (L.EApp (
+                          (L.EApp (
+                           (L.EApp (
+                            (L.EApp (
+                             (L.EApp (
+                              (L.ECApp (
+                               (L.ECApp (
+                                (L.ECApp (
+                                 (L.ECApp (
+                                  (L.ECApp (
+                                   (L.ECApp (
+                                    (L.ECApp (
+                                     (L.ECApp (
+                                      (L.EFfi ("Basis", "tag"),
+                                       _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+                              _), _),
+                             _), _),
+                            _), _),
+                           _), _),
+                          attrs), _),
+                         _), _),
+                        xml) =>
+                        (case #1 attrs of
+                             L.ERecord xes =>
+                             (case ListUtil.search (fn ((L.CName "Action", _), e, t) => SOME (e, t)
+                                                     | _ => NONE) xes of
+                                  NONE => findSubmit xml
+                                | SOME et =>
+                                  case findSubmit xml of
+                                      NotFound => Found et
+                                    | _ => Error)
+                           | _ => findSubmit xml)
+                      | _ => NotFound
+
+                val (func, action, fm) = case findSubmit xml of
+                    NotFound => (0, strH "", fm)
+                  | Error => raise Fail "Not ready for multi-submit lforms yet"
+                  | Found (action, actionT) =>
+                    let
+                        val func = case #1 action of
+                                       L.EClosure (n, _) => n
+                                     | _ => raise Fail "Monoize: Action is not a closure"
+                        val actionT = monoType env actionT
+                        val (action, fm) = monoExp (env, st, fm) action
+                        val (action, fm) = urlifyExp env fm (action, actionT)
+                    in
+                        (func,
+                         (L'.EStrcat (strH " action=\"",
+                                      (L'.EStrcat (action,
+                                                   strH "\""), loc)), loc),
+                         fm)
+                    end
+
+                val hasUpload = CoreUtil.Exp.exists {kind = fn _ => false,
+                                                     con = fn _ => false,
+                                                     exp = fn e =>
+                                                              case e of
+                                                                  L.EFfi ("Basis", "upload") => true
+                                                                | _ => false} xml
+
+                val (xml, fm) = monoExp (env, st, fm) xml
+
+                val xml =
+                    if IS.member (!readCookie, func) then
+                        let
+                            fun inFields s = List.exists (fn ((L.CName s', _), _) => s' = s
+                                                           | _ => true) fields
+
+                            fun getSigName () =
+                                let
+                                    fun getSigName' n =
+                                        let
+                                            val s = "Sig" ^ Int.toString n
+                                        in
+                                            if inFields s then
+                                                getSigName' (n + 1)
+                                            else
+                                                s
+                                        end
+                                in
+                                    if inFields "Sig" then
+                                        getSigName' 0
+                                    else
+                                        "Sig"
+                                end
+
+                            val sigName = getSigName ()
+                            val sigSet = (L'.EFfiApp ("Basis", "sigString", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc)
+                            val sigSet = (L'.EStrcat (strH ("<input type=\"hidden\" name=\""
+                                                            ^ sigName
+                                                            ^ "\" value=\""),
+                                                      sigSet), loc)
+                            val sigSet = (L'.EStrcat (sigSet,
+                                                      strH "\" />"), loc)
+                        in
+                            (L'.EStrcat (sigSet, xml), loc)
+                        end
+                    else
+                        xml
+
+                val action = if hasUpload then
+                                 (L'.EStrcat (action,
+                                              strH " enctype=\"multipart/form-data\""), loc)
+                             else
+                                 action
+
+                val stt = (L'.TFfi ("Basis", "string"), loc)
+                val (id, fm) = monoExp (env, st, fm) id
+                val (class, fm) = monoExp (env, st, fm) class
+                val action = (L'.EStrcat (action,
+                                          (L'.ECase (class,
+                                                     [((L'.PNone stt, loc),
+                                                       strH ""),
+                                                      ((L'.PSome (stt, (L'.PVar ("x", stt), loc)), loc),
+                                                       (L'.EStrcat (strH " class=\"",
+                                                                    (L'.EStrcat ((L'.ERel 0, loc),
+                                                                                 strH "\""), loc)), loc))],
+                                                     {disc = (L'.TOption stt, loc),
+                                                      result = stt}), loc)), loc)
+            in
+                ((L'.EStrcat ((L'.EStrcat (strH "<form method=\"post\"",
+                                           (L'.EStrcat ((L'.ECase (id,
+                                                                   [((L'.PNone stt, loc),
+                                                                     strH ""),
+                                                                    ((L'.PSome (stt, (L'.PVar ("id", stt), loc)), loc),
+                                                                     (L'.EStrcat (strH " id=\"",
+                                                                                  (L'.EStrcat ((L'.ERel 0, loc),
+                                                                                               strH "\""), loc)), loc))],
+                                                                   {disc = (L'.TOption stt, loc),
+                                                                    result = stt}), loc),
+                                                        (L'.EStrcat (action,
+                                                                     strH ">"), loc)), loc)), loc),
+                              (L'.EStrcat (xml,
+                                           strH "</form>"), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp (
+                                          (L.EFfi ("Basis", "subform"), _), _), _), _),
+                                _), _), _), (L.CName nm, loc)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("xml", s, s,
+                           strcat [strH ("<input type=\"hidden\" name=\".b\" value=\""
+                                         ^ nm ^ "\" />"),
+                                   (L'.ERel 0, loc),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
+                  loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.ECApp (
+                                          (L.EFfi ("Basis", "subforms"), _), _), _), _),
+                                _), _), _), (L.CName nm, loc)) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("xml", s, s,
+                           strcat [strH ("<input type=\"hidden\" name=\".s\" value=\""
+                                         ^ nm ^ "\" />"),
+                                   (L'.ERel 0, loc),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
+                  loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp (
+                      (L.EFfi ("Basis", "entry"), _), _), _), _) =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("xml", s, s,
+                           strcat [strH ("<input type=\"hidden\" name=\".i\" value=\"1\" />"),
+                                   (L'.ERel 0, loc),
+                                   strH ("<input type=\"hidden\" name=\".e\" value=\"1\" />")]),
+                  loc),
+                 fm)
+            end
+
+          | L.EApp ((L.ECApp (
+                     (L.ECApp (
+                      (L.ECApp (
+                       (L.ECApp (
+                        (L.EFfi ("Basis", "useMore"), _), _), _),
+                       _), _),
+                      _), _),
+                     _), _),
+                    xml) => monoExp (env, st, fm) xml
+
+          | L.ECApp ((L.EFfi ("Basis", "error"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("s", (L'.TFfi ("Basis", "string"), loc), t,
+                           (L'.EError ((L'.ERel 0, loc), t), loc)), loc),
+                 fm)
+            end
+          | L.EApp (
+            (L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t), _),
+            (L.EFfiApp ("Basis", "textBlob", [(e, _)]), _)) =>
+            let
+                val t = monoType env t
+                val un = (L'.TRecord [], loc)
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc),
+                           (L'.EAbs ("_", un, t,
+                                     (L'.ESeq ((L'.EFfiApp ("Basis", "clear_page", []), loc),
+                                               (L'.ESeq ((L'.EWrite (liftExpInExp 0 (liftExpInExp 0 e)), loc),
+                                                         (L'.EReturnBlob {blob = NONE,
+                                                                          mimeType = (L'.ERel 1, loc),
+                                                                          t = t}, loc)), loc)), loc)), loc)),
+                  loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t) =>
+            let
+                val t = monoType env t
+                val un = (L'.TRecord [], loc)
+            in
+                ((L'.EAbs ("b", (L'.TFfi ("Basis", "blob"), loc),
+                           (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc)), loc),
+                           (L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc),
+                                     (L'.EAbs ("_", un, t,
+                                               (L'.EReturnBlob {blob = SOME (L'.ERel 2, loc),
+                                                                mimeType = (L'.ERel 1, loc),
+                                                                t = t}, loc)), loc)), loc)), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "redirect"), _), t) =>
+            let
+                val t = monoType env t
+                val un = (L'.TRecord [], loc)
+            in
+                ((L'.EAbs ("url", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc),
+                           (L'.EAbs ("_", un, t,
+                                     (L'.ERedirect ((L'.ERel 1, loc), t), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.EFfi ("Basis", "serialize"), _), t) =>
+            let
+                val t = monoType env t
+                val (e, fm) = urlifyExp env fm ((L'.ERel 0, loc), t)
+            in
+                ((L'.EAbs ("v", t, (L'.TFfi ("Basis", "string"), loc), e), loc),
+                 fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "deserialize"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("v", (L'.TFfi ("Basis", "string"), loc), t, (L'.EUnurlify ((L'.ERel 0, loc), t, false),
+                                                                        loc)), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "url", [(e, _)]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+                val (e, fm) = urlifyExp env fm (e, dummyTyp)
+            in
+                ((L'.EStrcat (str (Settings.getUrlPrePrefix ()), e), loc), fm)
+            end
+
+          | L.EApp (e1, e2) =>
+            let
+                val (e1, fm) = monoExp (env, st, fm) e1
+                val (e2, fm) = monoExp (env, st, fm) e2
+            in
+                ((L'.EApp (e1, e2), loc), fm)
+            end
+          | L.EAbs (x, dom, ran, e) =>
+            let
+                val (e, fm) = monoExp (Env.pushERel env x dom, st, fm) e
+            in
+                ((L'.EAbs (x, monoType env dom, monoType env ran, e), loc), fm)
+            end
+
+          | L.ECApp (e, _) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                case #1 e of
+                    L'.EFfi _ => (e, fm)
+                  | _ => poly ()
+            end
+          | L.ECAbs _ => poly ()
+
+          | L.EFfi mx => ((L'.EFfi mx, loc), fm)
+          | L.EFfiApp (m, x, es) =>
+            let
+                val (es, fm) = ListUtil.foldlMap (fn ((e, t), fm) =>
+                                                     let
+                                                         val (e, fm) = monoExp (env, st, fm) e
+                                                     in
+                                                         ((e, monoType env t), fm)
+                                                     end) fm es
+            in
+                ((L'.EFfiApp (m, x, es), loc), fm)
+            end
+
+          | L.ERecord xes =>
+            let
+                val (xes, fm) = ListUtil.foldlMap
+                                    (fn ((x, e, t), fm) =>
+                                        let
+                                            val (e, fm) = monoExp (env, st, fm) e
+                                        in
+                                            ((monoName env x,
+                                              e,
+                                              monoType env t), fm)
+                                        end) fm xes
+
+                val xes = ListMergeSort.sort (fn ((x, _, _), (y, _, _)) => String.compare (x, y) = GREATER) xes
+            in
+                ((L'.ERecord xes, loc), fm)
+            end
+          | L.EField (e, x, _) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EField (e, monoName env x), loc), fm)
+            end
+          | L.EConcat _ => poly ()
+          | L.ECut _ => poly ()
+          | L.ECutMulti _ => poly ()
+
+          | L.ECase (e, pes, {disc, result}) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+                val (pes, fm) = ListUtil.foldlMap
+                                    (fn ((p, e), fm) =>
+                                        let
+                                            val (e, fm) = monoExp (env, st, fm) e
+                                        in
+                                            ((monoPat env p, e), fm)
+                                        end) fm pes
+            in
+                ((L'.ECase (e, pes, {disc = monoType env disc, result = monoType env result}), loc), fm)
+            end
+
+          | L.EWrite e =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
+                           (L'.EWrite (liftExpInExp 0 e), loc)), loc), fm)
+            end
+
+          | L.EClosure (n, es) =>
+            let
+                val (es, fm) = ListUtil.foldlMap (fn (e, fm) =>
+                                                     monoExp (env, st, fm) e)
+                                                 fm es
+                val e = (L'.EClosure (n, es), loc)
+            in
+                (e, fm)
+            end
+
+          | L.ELet (x, t, e1, e2) =>
+            let
+                val t' = monoType env t
+                val (e1, fm) = monoExp (env, st, fm) e1
+                val (e2, fm) = monoExp (Env.pushERel env x t, st, fm) e2
+            in
+                ((L'.ELet (x, t', e1, e2), loc), fm)
+            end
+
+          | L.EServerCall (n, es, t, fmode) =>
+            let
+                val t = monoType env t
+                val (_, ft, _, name) = Env.lookupENamed env n
+                val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+
+                fun encodeArgs (es, ft, acc, fm) =
+                    case (es, ft) of
+                        ([], _) => (rev acc, fm)
+                      | (e :: es, (L.TFun (dom, ran), _)) =>
+                        let
+                            val (e, fm) = urlifyExp env fm (e, monoType env dom)
+                        in
+                            encodeArgs (es, ran, e
+                                                 :: str "/"
+                                                 :: acc, fm)
+                        end
+                      | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type"
+
+                val (call, fm) = encodeArgs (es, ft, [], fm)
+                val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
+                                 (str name) call
+
+                val unit = (L'.TRecord [], loc)
+
+                val eff = if IS.member (!readCookie, n) then
+                              L'.ReadCookieWrite
+                          else
+                              L'.ReadOnly
+
+                val e = (L'.EServerCall (call, t, eff, fmode), loc)
+                val e = liftExpInExp 0 e
+                val e = (L'.EAbs ("_", unit, unit, e), loc)
+            in
+                (e, fm)
+            end
+
+          | L.EKAbs _ => poly ()
+          | L.EKApp _ => poly ()
+    end
+
+fun monoDecl (env, fm) (all as (d, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported declaration";
+             Print.eprefaces' [("Declaration", CorePrint.p_decl env all)];
+             NONE)
+
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
+    in
+        case d of
+            L.DCon _ => NONE
+          | L.DDatatype [("list", n, [_], [("Nil", _, NONE),
+                                           ("Cons", _, SOME (L.TRecord (L.CRecord (_,
+                                                                                   [((L.CName "1", _),
+                                                                                     (L.CRel 0, _)),
+                                                                                    ((L.CName "2", _),
+                                                                                     (L.CApp ((L.CNamed n', _),
+                                                                                              (L.CRel 0, _)),
+                                                                                      _))]), _), _))])] =>
+            if n = n' then
+                NONE
+            else
+                poly ()
+          | L.DDatatype dts =>
+            let
+                val env' = Env.declBinds env all
+                val dts = map (fn (x, n, [], xncs) =>
+                                  (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env') to)) xncs)
+                                | _ => (E.errorAt loc "Polymorphic datatype needed too late";
+                                        Print.eprefaces' [("Declaration", CorePrint.p_decl env all)];
+                                        ("", 0, []))) dts
+                val d = (L'.DDatatype dts, loc)
+            in
+                SOME (env', fm, [d])
+            end
+          | L.DVal (x, n, t, e, s) =>
+            let
+                val (e, fm) = monoExp (env, St.empty, fm) e
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DVal (x, n, monoType env t, e, s), loc)])
+            end
+          | L.DValRec vis =>
+            let
+                val vis = map (fn (x, n, t, e, s) =>
+                                  let
+                                      fun maybeTransaction (t, e) =
+                                          case (#1 t, #1 e) of
+                                              (L.CApp ((L.CFfi ("Basis", "transaction"), _), _), _) =>
+                                              SOME (L.EAbs ("_",
+                                                            (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc),
+                                                            t,
+                                                            (L.EApp (CoreEnv.liftExpInExp 0 e,
+                                                                     (L.ERecord [], loc)), loc)), loc)
+                                            | (L.TFun (dom, ran), L.EAbs (x, _, _, e)) =>
+                                              (case maybeTransaction (ran, e) of
+                                                   NONE => NONE
+                                                 | SOME e => SOME (L.EAbs (x, dom, ran, e), loc))
+                                            | _ => NONE
+                                  in
+                                      (x, n, t,
+                                       case maybeTransaction (t, e) of
+                                           NONE => e
+                                         | SOME e => e,
+                                       s)
+                                  end) vis
+
+                val env = foldl (fn ((x, n, t, e, s), env) => Env.pushENamed env x n t NONE s) env vis
+
+                val (vis, fm) = ListUtil.foldlMap
+                                    (fn ((x, n, t, e, s), fm) =>
+                                        let
+                                            val (e, fm) = monoExp (env, St.empty, fm) e
+                                        in
+                                            ((x, n, monoType env t, e, s), fm)
+                                        end)
+                                    fm vis
+            in
+                SOME (env,
+                      fm,
+                      [(L'.DValRec vis, loc)])
+            end
+          | L.DExport (ek, n, b) =>
+            let
+                val (_, t, _, s) = Env.lookupENamed env n
+
+                fun unwind (t, args) =
+                    case #1 t of
+                        L.TFun (dom, ran) => unwind (ran, dom :: args)
+                      | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
+                        unwind (t, (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc) :: args)
+                      | _ => (rev args, t)
+
+                val (ts, ran) = unwind (t, [])
+                val ts = map (monoType env) ts
+                val ran = monoType env ran
+            in
+                SOME (env, fm, [(L'.DExport (ek, s, n, ts, ran, b), loc)])
+            end
+          | L.DTable (x, n, (L.CRecord (_, xts), _), s, pe, _, ce, _) =>
+            let
+                val t = (L.CFfi ("Basis", "string"), loc)
+                val t' = (L'.TFfi ("Basis", "string"), loc)
+                val s = Settings.mangleSqlTable s
+                val e_name = str s
+
+                val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
+
+                val (pe, fm) = monoExp (env, St.empty, fm) pe
+                val (ce, fm) = monoExp (env, St.empty, fm) ce
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DTable (s, xts, pe, ce), loc),
+                       (L'.DVal (x, n, t', e_name, s), loc)])
+            end
+          | L.DTable _ => poly ()
+          | L.DView (x, n, s, e, (L.CRecord (_, xts), _)) =>
+            let
+                val t = (L.CFfi ("Basis", "string"), loc)
+                val t' = (L'.TFfi ("Basis", "string"), loc)
+                val s = Settings.mangleSqlTable s
+                val e_name = str s
+
+                val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
+
+                val (e, fm) = monoExp (env, St.empty, fm) e
+                val e = (L'.EFfiApp ("Basis", "viewify", [(e, t')]), loc)
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DView (s, xts, e), loc),
+                       (L'.DVal (x, n, t', e_name, s), loc)])
+            end
+          | L.DView _ => poly ()
+          | L.DSequence (x, n, s) =>
+            let
+                val t = (L.CFfi ("Basis", "string"), loc)
+                val t' = (L'.TFfi ("Basis", "string"), loc)
+                val s = Settings.mangleSql s
+                val e = str s
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DSequence s, loc),
+                       (L'.DVal (x, n, t', e, s), loc)])
+            end
+          | L.DDatabase _ => NONE
+          | L.DCookie (x, n, t, s) =>
+            let
+                val t = (L.CFfi ("Basis", "string"), loc)
+                val t' = (L'.TFfi ("Basis", "string"), loc)
+                val e = str s
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DCookie s, loc),
+                       (L'.DVal (x, n, t', e, s), loc)])
+            end
+          | L.DStyle (x, n, s) =>
+            let
+                val t = (L.CFfi ("Basis", "string"), loc)
+                val t' = (L'.TFfi ("Basis", "string"), loc)
+                val e = strH s
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DStyle s, loc),
+                       (L'.DVal (x, n, t', e, s), loc)])
+            end
+          | L.DTask (e1, e2) =>
+            let
+                val (e1, fm) = monoExp (env, St.empty, fm) e1
+                val (e2, fm) = monoExp (env, St.empty, fm) e2
+
+                val un = (L'.TRecord [], loc)
+                val t = if MonoUtil.Exp.exists {typ = fn _ => false,
+                                                exp = fn L'.EFfiApp ("Basis", "periodic", _) =>
+                                                         (if #persistent (Settings.currentProtocol ()) then
+                                                              ()
+                                                          else
+                                                              E.errorAt (#2 e1)
+                                                                        ("Periodic tasks aren't allowed in the selected protocol (" ^ #name (Settings.currentProtocol ()) ^ ").");
+                                                          true)
+                                                       | _ => false} e1 then
+                            (L'.TFfi ("Basis", "int"), loc)
+                        else
+                            un
+
+                val e2 = (L'.EAbs ("$x", t, (L'.TFun (un, un), loc),
+                                   (L'.EAbs ("$y", un, un,
+                                             (L'.EApp (
+                                              (L'.EApp (e2, (L'.ERel 1, loc)), loc),
+                                              (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                SOME (env,
+                      fm,
+                      [(L'.DTask (e1, e2), loc)])
+            end
+          | L.DPolicy e =>
+            let
+                fun policies (e, fm) =
+                    case #1 e of
+                        L.EFfiApp ("Basis", "also", [(e1, _), (e2, _)]) =>
+                        let
+                            val (ps1, fm) = policies (e1, fm)
+                            val (ps2, fm) = policies (e2, fm)
+                        in
+                            (ps1 @ ps2, fm)
+                        end
+                      | _ =>
+                        let
+                            val (e, make) =
+                                case #1 e of
+                                    L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
+                                    (e, L'.PolClient)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
+                                    (e, L'.PolInsert)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
+                                    (e, L'.PolDelete)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) =>
+                                    (e, L'.PolUpdate)
+                                  | L.EFfiApp ("Basis", "sendOwnIds", [(e, _)]) =>
+                                    (e, L'.PolSequence)
+                                  | _ => (poly (); (e, L'.PolClient))
+
+                            val (e, fm) = monoExp (env, St.empty, fm) e
+                        in
+                            ([(L'.DPolicy (make e), loc)], fm)
+                        end
+
+                val (ps, fm) = policies (e, fm)
+            in
+                SOME (env, fm, ps)
+            end
+          | L.DOnError n => SOME (env,
+                                  fm,
+                                  [(L'.DOnError n, loc)])
+    end
+
+datatype expungable = Client | Channel
+
+fun monoize env file =
+    let
+        val () = pvars := RM.empty
+
+        (* Calculate which exported functions need cookie signature protection *)
+        val rcook = foldl (fn ((d, _), rcook) =>
+                              case d of
+                                  L.DExport (L.Action L.ReadCookieWrite, n, _) => IS.add (rcook, n)
+                                | L.DExport (L.Rpc L.ReadCookieWrite, n, _) => IS.add (rcook, n)
+                                | _ => rcook)
+                          IS.empty file
+        val () = readCookie := rcook
+
+        val loc = E.dummySpan
+        val client = (L'.TFfi ("Basis", "client"), loc)
+        val unit = (L'.TRecord [], loc)
+
+        fun str s = (L'.EPrim (Prim.String (Prim.Normal, s)), loc)
+        fun strH s = (L'.EPrim (Prim.String (Prim.Html, s)), loc)
+
+        fun calcClientish xts =
+            foldl (fn ((x : L.con, t : L.con), st as (nullable, notNullable)) =>
+                      case #1 x of
+                          L.CName x =>
+                          (case #1 t of
+                               L.CFfi ("Basis", "client") =>
+                               (nullable, (x, Client) :: notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "option"), _),
+                                       (L.CFfi ("Basis", "client"), _)) =>
+                               ((x, Client) :: nullable, notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "channel"), _), _) =>
+                               (nullable, (x, Channel) :: notNullable)
+                             | L.CApp ((L.CFfi ("Basis", "option"), _),
+                                       (L.CApp ((L.CFfi ("Basis", "channel"), _), _), _)) =>
+                               ((x, Channel) :: nullable, notNullable)
+                             | _ => st)
+                        | _ => st) ([], []) xts
+
+        fun expunger () =
+            let
+                val target = (L'.EFfiApp ("Basis", "sqlifyClient", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "client"), loc))]), loc)
+
+                fun doTable (tab, xts, e) =
+                    case xts of
+                        L.CRecord (_, xts) =>
+                        let
+                            val (nullable, notNullable) = calcClientish xts
+
+                            fun cond (x, v) =
+                                (L'.EStrcat ((L'.EStrcat (str ("(("
+                                                               ^ Settings.mangleSql x
+                                                               ^ (case v of
+                                                                      Client => ""
+                                                                    | Channel => " >> 32")
+                                                               ^ ") = "),
+                                                          target), loc),
+                                             str ")"), loc)
+
+                            val e =
+                                foldl (fn ((x, v), e) =>
+                                          (L'.ESeq (
+                                           (L'.EDml ((L'.EStrcat (
+                                                      str ("UPDATE "
+                                                           ^ Settings.mangleSql tab
+                                                           ^ " SET "
+                                                           ^ Settings.mangleSql x
+                                                           ^ " = NULL WHERE "),
+                                                      cond (x, v)), loc), L'.Error), loc),
+                                           e), loc))
+                                      e nullable
+
+                            val e =
+                                case notNullable of
+                                    [] => e
+                                  | eb :: ebs =>
+                                    (L'.ESeq (
+                                     (L'.EDml ((L'.EStrcat (str ("DELETE FROM "
+                                                                 ^ Settings.mangleSql tab
+                                                                 ^ " WHERE "),
+                                                            foldl (fn (eb, s) =>
+                                                                      (L'.EStrcat (str "(",
+                                                                       (L'.EStrcat (s,
+                                                                        (L'.EStrcat (str " OR ",
+                                                                         (L'.EStrcat (cond eb,
+                                                                                      str ")"),
+                                                                          loc)), loc)), loc)), loc))
+                                                                  (cond eb)
+                                                                  ebs), loc),
+                                      L'.Error), loc),
+                                     e), loc)
+                        in
+                            e
+                        end
+                      | _ => e
+
+                val e = (L'.ERecord [], loc)
+            in
+                foldl (fn ((d, _), e) =>
+                          case d of
+                              L.DTable (_, _, xts, tab, _, _, _, _) => doTable (tab, #1 xts, e)
+                            | _ => e) e file
+            end
+
+        fun initializer () =
+            let
+                fun doTable (tab, xts, e) =
+                    case xts of
+                        L.CRecord (_, xts) =>
+                        let
+                            val (nullable, notNullable) = calcClientish xts
+
+                            val e =
+                                case nullable of
+                                    [] => e
+                                  | (x, _) :: ebs =>
+                                    (L'.ESeq (
+                                     (L'.EDml (str
+                                                   (foldl (fn ((x, _), s) =>
+                                                              s ^ ", " ^ Settings.mangleSql x ^ " = NULL")
+                                                          ("UPDATE "
+                                                           ^ Settings.mangleSql tab
+                                                           ^ " SET "
+                                                           ^ Settings.mangleSql x
+                                                                      ^ " = NULL")
+                                                          ebs), L'.Error), loc),
+                                     e), loc)
+
+                            val e =
+                                case notNullable of
+                                    [] => e
+                                  | eb :: ebs =>
+                                    (L'.ESeq (
+                                     (L'.EDml (str ("DELETE FROM "
+                                                    ^ Settings.mangleSql tab), L'.Error), loc),
+                                     e), loc)
+                        in
+                            e
+                        end
+                      | _ => e
+
+                val e = (L'.ERecord [], loc)
+            in
+                foldl (fn ((d, _), e) =>
+                          case d of
+                              L.DTable (_, _, xts, tab, _, _, _, _) => doTable (tab, #1 xts, e)
+                            | _ => e) e file
+            end
+
+        val mname = CoreUtil.File.maxName file + 1
+        val () = nextPvar := mname
+
+        val (_, fm, ds) = List.foldl (fn (d, (env, fm, ds)) =>
+                                        case #1 d of
+                                            L.DDatabase s =>
+                                            let
+                                                val (nExp, fm) = Fm.freshName fm
+                                                val (nIni, fm) = Fm.freshName fm
+
+                                                val dExp = L'.DVal ("expunger",
+                                                                    nExp,
+                                                                    (L'.TFun (client, unit), loc),
+                                                                    (L'.EAbs ("cli", client, unit, expunger ()), loc),
+                                                                    "expunger")
+                                                val dIni = L'.DVal ("initializer",
+                                                                    nIni,
+                                                                    (L'.TFun (unit, unit), loc),
+                                                                    (L'.EAbs ("_", unit, unit, initializer ()), loc),
+                                                                    "initializer")
+                                            in
+                                                (env, Fm.enter fm, (L'.DDatabase {name = s,
+                                                                                  expunge = nExp,
+                                                                                  initialize = nIni}, loc)
+                                                                   :: (dExp, loc)
+                                                                   :: (dIni, loc)
+                                                                   :: ds)
+                                            end
+                                          | _ =>
+                                            (pvarDefs := [];
+                                             pvarOldDefs := [];
+                                             case monoDecl (env, fm) d of
+                                                 NONE => (env, fm, ds)
+                                               | SOME (env, fm, ds') =>
+                                                 (foldr (fn ((n, cs), env) =>
+                                                            Env.declBinds env (L.DDatatype [("$poly" ^ Int.toString n,
+                                                                                             n,
+                                                                                             [],
+                                                                                             cs)], loc))
+                                                        env (!pvarOldDefs),
+                                                  Fm.enter fm,
+                                                  case ds' of
+                                                      [(L'.DDatatype dts, loc)] =>
+                                                      (L'.DDatatype (dts @ !pvarDefs), loc) :: Fm.decls fm @ ds
+                                                    | _ =>
+                                                      ds' @ Fm.decls fm @ (L'.DDatatype (!pvarDefs), loc) :: ds)))
+                                     (env, Fm.empty mname, []) file
+        val monoFile = (rev ds, [])
+    in
+        pvars := RM.empty;
+        pvarDefs := [];
+        pvarOldDefs := [];
+        MonoFooify.canonicalFm := Fm.empty (MonoUtil.File.maxName monoFile + 1);
+        monoFile
+    end
+
+end
diff --git a/src/multimap_fn.sml b/src/multimap_fn.sml
new file mode 100644
index 0000000..3dab68a
--- /dev/null
+++ b/src/multimap_fn.sml
@@ -0,0 +1,16 @@
+functor MultimapFn (structure KeyMap : ORD_MAP structure ValSet : ORD_SET) = struct
+    type key = KeyMap.Key.ord_key
+    type item = ValSet.item
+    type itemSet = ValSet.set
+    type multimap = ValSet.set KeyMap.map
+    val empty : multimap = KeyMap.empty
+    fun insertSet (kToVs : multimap, k : key, vs : itemSet) : multimap =
+        KeyMap.unionWith ValSet.union (kToVs, KeyMap.singleton (k, vs))
+    fun insert (kToVs : multimap, k : key, v : item) : multimap =
+        insertSet (kToVs, k, ValSet.singleton v)
+    fun findSet (kToVs : multimap, k : key) =
+        case KeyMap.find (kToVs, k) of
+            SOME vs => vs
+          | NONE => ValSet.empty
+    val findList : multimap * key -> item list = ValSet.listItems o findSet
+end
diff --git a/src/mysql.sig b/src/mysql.sig
new file mode 100644
index 0000000..fa254ae
--- /dev/null
+++ b/src/mysql.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature MYSQL = sig
+
+end
diff --git a/src/mysql.sml b/src/mysql.sml
new file mode 100644
index 0000000..52e4921
--- /dev/null
+++ b/src/mysql.sml
@@ -0,0 +1,1614 @@
+(* Copyright (c) 2009-2010, 2015, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure MySQL :> MYSQL = struct
+
+open Settings
+open Print.PD
+open Print
+
+fun p_sql_type t =
+    case t of
+        Int => "bigint"
+      | Float => "double"
+      | String => "longtext"
+      | Char => "char"
+      | Bool => "bool"
+      | Time => "timestamp"
+      | Blob => "longblob"
+      | Channel => "bigint"
+      | Client => "int"
+      | Nullable t => p_sql_type t
+
+fun p_buffer_type t =
+    case t of
+        Int => "MYSQL_TYPE_LONGLONG"
+      | Float => "MYSQL_TYPE_DOUBLE"
+      | String => "MYSQL_TYPE_STRING"
+      | Char => "MYSQL_TYPE_STRING"
+      | Bool => "MYSQL_TYPE_LONG"
+      | Time => "MYSQL_TYPE_TIMESTAMP"
+      | Blob => "MYSQL_TYPE_BLOB"
+      | Channel => "MYSQL_TYPE_LONGLONG"
+      | Client => "MYSQL_TYPE_LONG"
+      | Nullable t => p_buffer_type t
+
+fun p_sql_type_base t =
+    case t of
+        Int => "bigint"
+      | Float => "double"
+      | String => "longtext"
+      | Char => "char"
+      | Bool => "tinyint"
+      | Time => "timestamp"
+      | Blob => "longblob"
+      | Channel => "bigint"
+      | Client => "int"
+      | Nullable t => p_sql_type_base t
+
+val ident = String.translate (fn #"'" => "PRIME"
+                               | ch => str ch)
+
+fun checkRel (table, checkNullable) (s, xts) =
+    let
+        val sl = CharVector.map Char.toLower s
+        val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then
+                     String.substring (sl, 1, size sl - 2)
+                 else
+                     sl
+        val both = "table_name = '" ^ sl ^ "'"
+
+        val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both
+
+        val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
+                                both,
+                                " AND (",
+                                case String.concatWith " OR "
+                                                       (map (fn (x, t) =>
+                                                                String.concat ["(LOWER(column_name) = '",
+                                                                               Settings.mangleSqlCatalog
+                                                                                   (CharVector.map
+                                                                                        Char.toLower (ident x)),
+                                                                               "' AND data_type ",
+                                                                               case p_sql_type_base t of
+                                                                                   "bigint" =>
+                                                                                   "IN ('bigint', 'int')"
+                                                                                 | "longtext" =>
+                                                                                   "IN ('longtext', 'varchar')"
+                                                                                 | s => "= '" ^ s ^ "'",
+                                                                               if checkNullable then
+                                                                                   (" AND is_nullable = '"
+                                                                                    ^ (if isNotNull t then
+                                                                                           "NO"
+                                                                                       else
+                                                                                           "YES")
+                                                                                    ^ "'")
+                                                                               else
+                                                                                   "",
+                                                                               ")"]) xts) of
+                                    "" => "FALSE"
+                                  | s => s,
+                                ")"]
+
+        val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
+                                 both,
+                                 " AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
+    in
+        box [string "if (mysql_query(conn->conn, \"",
+             string q,
+             string "\")) {",
+             newline,
+             box [string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Result store failed:\\n",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (mysql_num_fields(res) != 1) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Bad column count:\\n",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((row = mysql_fetch_row(res)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (strcmp(row[0], \"1\")) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' does not exist.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "mysql_free_result(res);",
+             newline,
+             newline,
+
+             string "if (mysql_query(conn->conn, \"",
+             string q',
+             string "\")) {",
+             newline,
+             box [string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Result store failed:\\n",
+                  string q',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (mysql_num_fields(res) != 1) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Bad column count:\\n",
+                  string q',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((row = mysql_fetch_row(res)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
+                  string q',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (strcmp(row[0], \"",
+             string (Int.toString (length xts)),
+             string "\")) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' has the wrong column types.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "mysql_free_result(res);",
+             newline,
+             newline,
+
+             string "if (mysql_query(conn->conn, \"",
+             string q'',
+             string "\")) {",
+             newline,
+             box [string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q'',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Result store failed:\\n",
+                  string q'',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (mysql_num_fields(res) != 1) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Bad column count:\\n",
+                  string q'',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if ((row = mysql_fetch_row(res)) == NULL) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
+                  string q'',
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (strcmp(row[0], \"",
+             string (Int.toString (length xts)),
+             string "\")) {",
+             newline,
+             box [string "mysql_free_result(res);",
+                  newline,
+                  string "mysql_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' has extra columns.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "mysql_free_result(res);",
+             newline]
+    end
+
+fun init {dbstring, prepared = ss, tables, views, sequences} =
+    let
+        val host = ref NONE
+        val user = ref NONE
+        val passwd = ref NONE
+        val db = ref NONE
+        val port = ref NONE
+        val unix_socket = ref NONE
+
+        fun stringOf r = case !r of
+                             NONE => string "NULL"
+                           | SOME s => box [string "\"",
+                                            string (Prim.toCString s),
+                                            string "\""]
+    in
+        app (fn s =>
+                case String.fields (fn ch => ch = #"=") s of
+                    [name, value] =>
+                    (case name of
+                         "host" =>
+                         if size value > 0 andalso String.sub (value, 0) = #"/" then
+                             unix_socket := SOME value
+                         else
+                             host := SOME value
+                       | "hostaddr" => host := SOME value
+                       | "port" => port := Int.fromString value
+                       | "dbname" => db := SOME value
+                       | "user" => user := SOME value
+                       | "password" => passwd := SOME value
+                       | _ => ())
+                  | _ => ()) (String.tokens Char.isSpace dbstring);
+
+        box [string "typedef struct {",
+             newline,
+             box [string "MYSQL *conn;",
+                  newline,
+                  p_list_sepi (box [])
+                              (fn i => fn _ =>
+                                          box [string "MYSQL_STMT *p",
+                                               string (Int.toString i),
+                                               string ";",
+                                               newline])
+                              ss],
+             string "} uw_conn;",
+             newline,
+             newline,
+
+             string "static void uw_client_init(void) {",
+             newline,
+             box [string "uw_sqlfmtInt = \"%lld%n\";",
+                  newline,
+                  string "uw_sqlfmtFloat = \"%.16g%n\";",
+                  newline,
+                  string "uw_Estrings = 0;",
+                  newline,
+                  string "uw_sql_type_annotations = 0;",
+                  newline,
+                  string "uw_sqlsuffixString = \"\";",
+                  newline,
+                  string "uw_sqlsuffixChar = \"\";",
+                  newline,
+                  string "uw_sqlsuffixBlob = \"\";",
+                  newline,
+                  string "uw_sqlfmtUint4 = \"%u%n\";",
+                  newline,
+                  newline,
+
+                  string "if (mysql_library_init(0, NULL, NULL)) {",
+                  newline,
+                  box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
+                       newline,
+                       string "exit(1);",
+                       newline],
+                  string "}",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             if #persistent (currentProtocol ()) then
+                 box [string "static void uw_db_validate(uw_context ctx) {",
+                      newline,
+                      string "uw_conn *conn = uw_get_db(ctx);",
+                      newline,
+                      string "MYSQL_RES *res;",
+                      newline,
+                      string "MYSQL_ROW row;",
+                      newline,
+                      newline,
+                      p_list_sep newline (checkRel ("tables", true)) tables,
+                      p_list_sep newline (fn name => checkRel ("tables", true)
+                                                              (name, [("id", Settings.Client)])) sequences,
+                      p_list_sep newline (checkRel ("views", false)) views,
+                      string "}",
+                      newline,
+                      newline,
+
+                      string "static void uw_db_prepare(uw_context ctx) {",
+                      newline,
+                      string "uw_conn *conn = uw_get_db(ctx);",
+                      newline,
+                      string "MYSQL_STMT *stmt;",
+                      newline,
+                      newline,
+
+                      p_list_sepi newline (fn i => fn (s, _) =>
+                                                      let
+                                                          fun uhoh this s args =
+                                                              box [p_list_sepi (box [])
+                                                                               (fn j => fn () =>
+                                                                                           box [string
+                                                                                                    "mysql_stmt_close(conn->p",
+                                                                                                string (Int.toString j),
+                                                                                                string ");",
+                                                                                                newline])
+                                                                               (List.tabulate (i, fn _ => ())),
+                                                                   box (if this then
+                                                                            [string
+                                                                                 "mysql_stmt_close(conn->p",
+                                                                             string (Int.toString i),
+                                                                             string ");",
+                                                                             newline]
+                                                                        else
+                                                                            []),
+                                                                   string "mysql_close(conn->conn);",
+                                                                   newline,
+                                                                   string "uw_error(ctx, FATAL, \"",
+                                                                   string s,
+                                                                   string "\"",
+                                                                   p_list_sep (box []) (fn s => box [string ", ",
+                                                                                                     string s]) args,
+                                                                   string ");",
+                                                                   newline]
+                                                      in
+                                                          box [string "stmt = mysql_stmt_init(conn->conn);",
+                                                               newline,
+                                                               string "if (stmt == NULL) {",
+                                                               newline,
+                                                               uhoh false "Out of memory allocating prepared statement" [],
+                                                               string "}",
+                                                               newline,
+                                                               string "conn->p",
+                                                               string (Int.toString i),
+                                                               string " = stmt;",
+                                                               newline,
+
+                                                               string "if (mysql_stmt_prepare(stmt, \"",
+                                                               string (Prim.toCString s),
+                                                               string "\", ",
+                                                               string (Int.toString (size s)),
+                                                               string ")) {",
+                                                               newline,
+                                                               box [string "char msg[1024];",
+                                                                    newline,
+                                                                    string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
+                                                                    newline,
+                                                                    string "msg[1023] = 0;",
+                                                                    newline,
+                                                                    uhoh true "Error preparing statement: %s" ["msg"]],
+                                                               string "}",
+                                                               newline]
+                                                      end)
+                                  ss,
+
+                      string "}"]
+             else
+                 box [string "static void uw_db_prepare(uw_context ctx) { }",
+                      newline,
+                      string "static void uw_db_validate(uw_context ctx) { }"],
+             newline,
+             newline,
+
+             string "static void uw_db_init(uw_context ctx) {",
+             newline,
+             string "MYSQL *mysql = mysql_init(NULL);",
+             newline,
+             string "uw_conn *conn;",
+             newline,
+             string "if (mysql == NULL) uw_error(ctx, FATAL, ",
+             string "\"libmysqlclient can't allocate a connection.\");",
+             newline,
+             string "if (mysql_real_connect(mysql, ",
+             stringOf host,
+             string ", ",
+             stringOf user,
+             string ", ",
+             stringOf passwd,
+             string ", ",
+             stringOf db,
+             string ", ",
+             case !port of
+                 NONE => string "0"
+               | SOME n => string (Int.toString n),
+             string ", ",
+             stringOf unix_socket,
+             string ", CLIENT_MULTI_STATEMENTS) == NULL) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, mysql_error(mysql), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "mysql_close(mysql);",
+                  newline,
+                  string "uw_error(ctx, FATAL, ",
+                  string "\"Connection to MySQL server failed: %s\", msg);"],
+             newline,
+             string "}",
+             newline,
+             newline,
+             string "if (mysql_set_character_set(mysql, \"utf8\")) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, mysql_error(mysql), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "mysql_close(mysql);",
+                  newline,
+                  string "uw_error(ctx, FATAL, ",
+                  string "\"Error setting UTF-8 character set for MySQL connection: %s\", msg);"],
+             newline,
+             string "}",
+             newline,
+             newline,
+             string "conn = calloc(1, sizeof(uw_conn));",
+             newline,
+             string "conn->conn = mysql;",
+             newline,
+             string "uw_set_db(ctx, conn);",
+             newline,
+             string "uw_db_validate(ctx);",
+             newline,
+             string "uw_db_prepare(ctx);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static void uw_db_close(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             p_list_sepi (box [])
+                         (fn i => fn _ =>
+                                     box [string "if (conn->p",
+                                          string (Int.toString i),
+                                          string ") mysql_stmt_close(conn->p",
+                                          string (Int.toString i),
+                                          string ");",
+                                          newline])
+                         ss,
+             string "mysql_close(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static int uw_db_begin(uw_context ctx, int could_write) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             newline,
+             string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE; BEGIN\") ? 1 : (mysql_next_result(conn->conn), 0);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static int uw_db_commit(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "return mysql_commit(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static int uw_db_rollback(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "return mysql_rollback(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline]
+    end
+
+fun p_getcol {loc, wontLeakStrings = _, col = i, typ = t} =
+    let
+        fun getter t =
+            case t of
+                String => box [string "({",
+                               newline,
+                               string "uw_Basis_string s = uw_malloc(ctx, length",
+                               string (Int.toString i),
+                               string " + 1);",
+                               newline,
+                               string "out[",
+                               string (Int.toString i),
+                               string "].buffer = s;",
+                               newline,
+                               string "out[",
+                               string (Int.toString i),
+                               string "].buffer_length = length",
+                               string (Int.toString i),
+                               string " + 1;",
+                               newline,
+                               string "mysql_stmt_fetch_column(stmt, &out[",
+                               string (Int.toString i),
+                               string "], ",
+                               string (Int.toString i),
+                               string ", 0);",
+                               newline,
+                               string "s[length",
+                               string (Int.toString i),
+                               string "] = 0;",
+                               newline,
+                               string "s;",
+                               newline,
+                               string "})"]
+              | Blob => box [string "({",
+                             newline,
+                             string "uw_Basis_blob b = {length",
+                             string (Int.toString i),
+                             string ", uw_malloc(ctx, length",
+                             string (Int.toString i),
+                             string ")};",
+                             newline,
+                             string "out[",
+                             string (Int.toString i),
+                             string "].buffer = b.data;",
+                             newline,
+                             string "out[",
+                             string (Int.toString i),
+                             string "].buffer_length = length",
+                             string (Int.toString i),
+                             string ";",
+                             newline,
+                             string "mysql_stmt_fetch_column(stmt, &out[",
+                             string (Int.toString i),
+                             string "], ",
+                             string (Int.toString i),
+                             string ", 0);",
+                             newline,
+                             string "b;",
+                             newline,
+                             string "})"]
+              | Time => box [string "({",
+                             string "MYSQL_TIME *mt = &buffer",
+                             string (Int.toString i),
+                             string ";",
+                             newline,
+                             newline,
+                             string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month-1, mt->year - 1900, 0, 0, -1};",
+                             newline,
+                             string "uw_Basis_time res = {mktime(&t), 0};",
+                             newline,
+                             string "res;",
+                             newline,
+                             string "})"]
+              | Channel => box [string "({",
+                                string "uw_Basis_channel ch = {buffer",
+                                string (Int.toString i),
+                                string " >> 32, buffer",
+                                string (Int.toString i),
+                                string " & 0xFFFFFFFF};",
+                                newline,
+                                string "ch;",
+                                newline,
+                                string "})"]
+              | _ => box [string "buffer",
+                          string (Int.toString i)]
+    in
+        case t of
+            Nullable t => box [string "(is_null",
+                               string (Int.toString i),
+                               string " ? NULL : ",
+                               case t of
+                                   String => getter t
+                                 | _ => box [string "({",
+                                             newline,
+                                             string (p_sql_ctype t),
+                                             space,
+                                             string "*tmp = uw_malloc(ctx, sizeof(",
+                                             string (p_sql_ctype t),
+                                             string "));",
+                                             newline,
+                                             string "*tmp = ",
+                                             getter t,
+                                             string ";",
+                                             newline,
+                                             string "tmp;",
+                                             newline,
+                                             string "})"],
+                               string ")"]
+          | _ => box [string "(is_null",
+                      string (Int.toString i),
+                      string " ? ",
+                      box [string "({",
+                           string (p_sql_ctype t),
+                           space,
+                           string "tmp;",
+                           newline,
+                           string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
+                           string (Int.toString i),
+                           string "\");",
+                           newline,
+                           string "tmp;",
+                           newline,
+                           string "})"],
+                      string " : ",
+                      getter t,
+                      string ")"]
+    end
+
+fun queryCommon {loc, query, cols, doCols} =
+    box [string "int n, r;",
+         newline,
+         string "MYSQL_BIND out[",
+         string (Int.toString (length cols)),
+         string "];",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "unsigned long length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Blob => box [string "unsigned long length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Time => box [string "MYSQL_TIME buffer",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Channel => box [string "unsigned long long buffer",
+                                                                      string (Int.toString i),
+                                                                      string ";",
+                                                                      newline]
+                                                    | _ => box [string (p_sql_ctype t),
+                                                                space,
+                                                                string "buffer",
+                                                                string (Int.toString i),
+                                                                string ";",
+                                                                newline]
+                                          in
+                                              box [string "my_bool is_null",
+                                                   string (Int.toString i),
+                                                   string ";",
+                                                   newline,
+                                                   case t of
+                                                       Nullable t => buffers t
+                                                     | _ => buffers t,
+                                                   newline]
+                                          end) cols,
+         newline,
+
+         string "memset(out, 0, sizeof out);",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "out[",
+                                                                     string (Int.toString i),
+                                                                     string "].length = &length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Char => box [string "out[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer_length = 1;",
+                                                                   newline,
+                                                                   string "out[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer = &buffer",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Blob => box [string "out[",
+                                                                   string (Int.toString i),
+                                                                   string "].length = &length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | _ => box [string "out[",
+                                                                string (Int.toString i),
+                                                                string "].buffer = &buffer",
+                                                                string (Int.toString i),
+                                                                string ";",
+                                                                newline]
+                                          in
+                                              box [string "out[",
+                                                   string (Int.toString i),
+                                                   string "].buffer_type = ",
+                                                   string (p_buffer_type t),
+                                                   string ";",
+                                                   newline,
+                                                   string "out[",
+                                                   string (Int.toString i),
+                                                   string "].is_null = &is_null",
+                                                   string (Int.toString i),
+                                                   string ";",
+                                                   newline,
+
+                                                   case t of
+                                                       Nullable t => buffers t
+                                                     | _ => buffers t,
+                                                  newline]
+                                          end) cols,
+         newline,
+
+         string "if (mysql_stmt_reset(stmt)) {",
+         box [newline,
+              string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"",
+              string (ErrorMsg.spanToString loc),
+              string ": Error resetting statement: %s\\n%s\", ",
+              query,
+              string ", mysql_error(conn->conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (mysql_stmt_execute(stmt)) {",
+         newline,
+         box [string "if (mysql_errno(conn->conn) == 1213)",
+              newline,
+              box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
+                   newline],
+              newline,
+              string "uw_error(ctx, FATAL, \"",
+              string (ErrorMsg.spanToString loc),
+              string ": Error executing query: %s\\n%s\", ",
+              query,
+              string ", mysql_error(conn->conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": Error binding query result: %s\\n%s\", ",
+         query,
+         string ", mysql_error(conn->conn));",
+         newline,
+         newline,
+
+         string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": Error storing query result: %s\\n%s\", ",
+         query,
+         string ", mysql_error(conn->conn));",
+         newline,
+         newline,
+
+         string "uw_end_region(ctx);",
+         newline,
+         string "while (1) {",
+         newline,
+         string "r = mysql_stmt_fetch(stmt);",
+         newline,
+         string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;",
+         newline,
+         doCols p_getcol,
+         string "}",
+         newline,
+         newline,
+
+         string "if (r == 1) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": query result fetching failed: %s\\n%s\", ",
+         query,
+         string ", mysql_error(conn->conn));",
+         newline,
+         newline,
+
+         string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": Error resetting statement: %s\\n%s\", ",
+         query,
+         string ", mysql_error(conn->conn));",
+         newline,
+         newline]
+
+fun query {loc, cols, doCols} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
+         newline,
+         string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": can't allocate temporary prepared statement\");",
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
+         newline,
+         string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));",
+         newline,
+         newline,
+
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
+
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "MYSQL_BIND in[",
+         string (Int.toString (length inputs)),
+         string "];",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "unsigned long in_length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Blob => box [string "unsigned long in_length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Time => box [string "MYSQL_TIME in_buffer",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | _ => box []
+                                          in
+                                              box [case t of
+                                                       Nullable t => box [string "my_bool in_is_null",
+                                                                          string (Int.toString i),
+                                                                          string ";",
+                                                                          newline,
+                                                                          buffers t]
+                                                     | _ => buffers t,
+                                                   newline]
+                                          end) inputs,
+
+         if nested then
+             box [string "MYSQL_STMT *stmt;",
+                  newline]
+         else
+             box [string "MYSQL_STMT *stmt = conn->p",
+                  string (Int.toString id),
+                  string ";",
+                  newline,
+                  newline,
+
+                  string "if (stmt == NULL) {",
+                  newline],
+
+         box [string "stmt = mysql_stmt_init(conn->conn);",
+              newline,
+              string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
+              newline,
+              if nested then
+                  box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
+                       newline]
+              else
+                  box [],
+              string "if (mysql_stmt_prepare(stmt, \"",
+              string (Prim.toCString query),
+              string "\", ",
+              string (Int.toString (size query)),
+              string ")) {",
+              newline,
+              box [string "char msg[1024];",
+                   newline,
+                   string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
+                   newline,
+                   string "msg[1023] = 0;",
+                   newline,
+                   if nested then
+                       box []
+                   else
+                       box [string "mysql_stmt_close(stmt);",
+                            newline],
+                   string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
+                   newline],
+              string "}",
+              newline,
+              if nested then
+                  box []
+              else
+                  box [string "conn->p",
+                       string (Int.toString id),
+                       string " = stmt;",
+                       newline]],
+         if nested then
+             box []
+         else
+             box [string "}",
+                  newline],
+         newline,
+
+         string "memset(in, 0, sizeof in);",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "in[",
+                                                                     string (Int.toString i),
+                                                                     string "].buffer = arg",
+                                                                     string (Int.toString (i + 1)),
+                                                                     string ";",
+                                                                     newline,
+                                                                     string "in_length",
+                                                                     string (Int.toString i),
+                                                                     string "= in[",
+                                                                     string (Int.toString i),
+                                                                     string "].buffer_length = strlen(arg",
+                                                                     string (Int.toString (i + 1)),
+                                                                     string ");",
+                                                                     newline,
+                                                                     string "in[",
+                                                                     string (Int.toString i),
+                                                                     string "].length = &in_length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Char => box [string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer = &arg",
+                                                                   string (Int.toString (i + 1)),
+                                                                   string ";",
+                                                                   newline,
+                                                                   string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer_length = 1;",
+                                                                   newline]
+                                                    | Blob => box [string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer = arg",
+                                                                   string (Int.toString (i + 1)),
+                                                                   string ".data;",
+                                                                   newline,
+                                                                   string "in_length",
+                                                                   string (Int.toString i),
+                                                                   string "= in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer_length = arg",
+                                                                   string (Int.toString (i + 1)),
+                                                                   string ".size;",
+                                                                   newline,
+                                                                   string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].length = &in_length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Time =>
+                                                      let
+                                                          fun oneField dst src =
+                                                              box [string "in_buffer",
+                                                                   string (Int.toString i),
+                                                                   string ".",
+                                                                   string dst,
+                                                                   string " = tms.tm_",
+                                                                   string src,
+                                                                   string ";",
+                                                                   newline]
+                                                      in
+                                                          box [string "({",
+                                                               newline,
+                                                               string "struct tm tms;",
+                                                               newline,
+                                                               string "if (localtime_r(&arg",
+                                                               string (Int.toString (i + 1)),
+                                                               string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
+                                                               string (ErrorMsg.spanToString loc),
+                                                               string ": error converting to MySQL time\");",
+                                                               newline,
+                                                               oneField "year" "year + 1900",
+                                                               box [string "in_buffer",
+                                                                    string (Int.toString i),
+                                                                    string ".month = tms.tm_mon + 1;",
+                                                                    newline],
+                                                               oneField "day" "mday",
+                                                               oneField "hour" "hour",
+                                                               oneField "minute" "min",
+                                                               oneField "second" "sec",
+                                                               newline,
+                                                               string "in[",
+                                                               string (Int.toString i),
+                                                               string "].buffer = &in_buffer",
+                                                               string (Int.toString i),
+                                                               string ";",
+                                                               newline,
+                                                               string "});",
+                                                               newline]
+                                                      end
+                                                    | Channel => box [string "in_buffer",
+                                                                      string (Int.toString i),
+                                                                      string " = ((unsigned long long)arg",
+                                                                      string (Int.toString (i + 1)),
+                                                                      string ".cli << 32) | arg",
+                                                                      string (Int.toString (i + 1)),
+                                                                      string ".chn;",
+                                                                      newline,
+                                                                      string "in[",
+                                                                      string (Int.toString i),
+                                                                      string "].buffer = &in_buffer",
+                                                                      string (Int.toString i),
+                                                                      string ";",
+                                                                      newline]
+
+                                                    | _ => box [string "in[",
+                                                                string (Int.toString i),
+                                                                string "].buffer = &arg",
+                                                                string (Int.toString (i + 1)),
+                                                                string ";",
+                                                                newline]
+                                          in
+                                              box [string "in[",
+                                                   string (Int.toString i),
+                                                   string "].buffer_type = ",
+                                                   string (p_buffer_type t),
+                                                   string ";",
+                                                   newline,
+
+                                                   case t of
+                                                       Nullable t => box [string "in[",
+                                                                          string (Int.toString i),
+                                                                          string "].is_null = &in_is_null",
+                                                                          string (Int.toString i),
+                                                                          string ";",
+                                                                          newline,
+                                                                          string "if (arg",
+                                                                          string (Int.toString (i + 1)),
+                                                                          string " == NULL) {",
+                                                                          newline,
+                                                                          box [string "in_is_null",
+                                                                               string (Int.toString i),
+                                                                               string " = 1;",
+                                                                               newline],
+                                                                          string "} else {",
+                                                                          box [case t of
+                                                                                   String => box []
+                                                                                 | _ =>
+                                                                                   box [string (p_sql_ctype t),
+                                                                                        space,
+                                                                                        string "tmp = *arg",
+                                                                                        string (Int.toString (i + 1)),
+                                                                                        string ";",
+                                                                                        newline,
+                                                                                        string (p_sql_ctype t),
+                                                                                        space,
+                                                                                        string "arg",
+                                                                                        string (Int.toString (i + 1)),
+                                                                                        string " = tmp;",
+                                                                                        newline],
+                                                                               string "in_is_null",
+                                                                               string (Int.toString i),
+                                                                               string " = 0;",
+                                                                               newline,
+                                                                               buffers t,
+                                                                               newline],
+                                                                          string "}",
+                                                                          newline]
+
+                                                     | _ => buffers t,
+                                                   newline]
+                                          end) inputs,
+         newline,
+
+         string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": error binding parameters\");",
+         newline,
+
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
+                                                                            string (Prim.toCString query),
+                                                                            string "\""]},
+
+         if nested then
+             box [string "uw_pop_cleanup(ctx);",
+                  newline]
+         else
+             box []]
+
+fun dmlCommon {loc, dml, mode} =
+    box [string "if (mysql_stmt_execute(stmt)) {",
+         box [string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "if (mysql_errno(conn->conn) == 1213)",
+              newline,
+              box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
+                   newline],
+              newline,
+              case mode of
+                  Settings.Error => box [string "uw_error(ctx, FATAL, \"",
+                                         string (ErrorMsg.spanToString loc),
+                                         string ": Error executing DML: %s\\n%s\", ",
+                                         dml,
+                                         string ", mysql_error(conn->conn));"]
+                | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));",
+              newline],
+         string "}",
+         newline]
+
+fun dml (loc, mode) =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
+         newline,
+         string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": can't allocate temporary prepared statement\");",
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
+         newline,
+         string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
+         newline,
+         newline,
+
+         dmlCommon {loc = loc, dml = string "dml", mode = mode},
+
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+fun dmlPrepared {loc, id, dml, inputs, mode} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "MYSQL_BIND in[",
+         string (Int.toString (length inputs)),
+         string "];",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "unsigned long in_length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Blob => box [string "unsigned long in_length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Time => box [string "MYSQL_TIME in_buffer",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Channel => box [string "unsigned long long in_buffer",
+                                                                      string (Int.toString i),
+                                                                      string ";",
+                                                                      newline]
+                                                    | _ => box []
+                                          in
+                                              box [case t of
+                                                       Nullable t => box [string "my_bool in_is_null",
+                                                                          string (Int.toString i),
+                                                                          string ";",
+                                                                          newline,
+                                                                          buffers t]
+                                                     | _ => buffers t,
+                                                   newline]
+                                          end) inputs,
+         string "MYSQL_STMT *stmt = conn->p",
+         string (Int.toString id),
+         string ";",
+         newline,
+         newline,
+
+         string "if (stmt == NULL) {",
+         newline,
+         box [string "stmt = mysql_stmt_init(conn->conn);",
+              newline,
+              string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
+              newline,
+              string "if (mysql_stmt_prepare(stmt, \"",
+              string (Prim.toCString dml),
+              string "\", ",
+              string (Int.toString (size dml)),
+              string ")) {",
+              newline,
+              box [string "char msg[1024];",
+                   newline,
+                   string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
+                   newline,
+                   string "msg[1023] = 0;",
+                   newline,
+                   string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
+                   newline],
+              string "}",
+              newline,
+              string "conn->p",
+              string (Int.toString id),
+              string " = stmt;",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "memset(in, 0, sizeof in);",
+         newline,
+         p_list_sepi (box []) (fn i => fn t =>
+                                          let
+                                              fun buffers t =
+                                                  case t of
+                                                      String => box [string "in[",
+                                                                     string (Int.toString i),
+                                                                     string "].buffer = arg",
+                                                                     string (Int.toString (i + 1)),
+                                                                     string ";",
+                                                                     newline,
+                                                                     string "in_length",
+                                                                     string (Int.toString i),
+                                                                     string "= in[",
+                                                                     string (Int.toString i),
+                                                                     string "].buffer_length = strlen(arg",
+                                                                     string (Int.toString (i + 1)),
+                                                                     string ");",
+                                                                     newline,
+                                                                     string "in[",
+                                                                     string (Int.toString i),
+                                                                     string "].length = &in_length",
+                                                                     string (Int.toString i),
+                                                                     string ";",
+                                                                     newline]
+                                                    | Blob => box [string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer = arg",
+                                                                   string (Int.toString (i + 1)),
+                                                                   string ".data;",
+                                                                   newline,
+                                                                   string "in_length",
+                                                                   string (Int.toString i),
+                                                                   string "= in[",
+                                                                   string (Int.toString i),
+                                                                   string "].buffer_length = arg",
+                                                                   string (Int.toString (i + 1)),
+                                                                   string ".size;",
+                                                                   newline,
+                                                                   string "in[",
+                                                                   string (Int.toString i),
+                                                                   string "].length = &in_length",
+                                                                   string (Int.toString i),
+                                                                   string ";",
+                                                                   newline]
+                                                    | Time =>
+                                                      let
+                                                          fun oneField dst src =
+                                                              box [string "in_buffer",
+                                                                   string (Int.toString i),
+                                                                   string ".",
+                                                                   string dst,
+                                                                   string " = tms.tm_",
+                                                                   string src,
+                                                                   string ";",
+                                                                   newline]
+                                                      in
+                                                          box [string "({",
+                                                               newline,
+                                                               string "struct tm tms;",
+                                                               newline,
+                                                               string "if (localtime_r(&arg",
+                                                               string (Int.toString (i + 1)),
+                                                               string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
+                                                               string (ErrorMsg.spanToString loc),
+                                                               string ": error converting to MySQL time\");",
+                                                               newline,
+                                                               oneField "year" "year + 1900",
+                                                               oneField "month" "mon + 1",
+                                                               oneField "day" "mday",
+                                                               oneField "hour" "hour",
+                                                               oneField "minute" "min",
+                                                               oneField "second" "sec",
+                                                               newline,
+                                                               string "in[",
+                                                               string (Int.toString i),
+                                                               string "].buffer = &in_buffer",
+                                                               string (Int.toString i),
+                                                               string ";",
+                                                               newline,
+                                                               string "});",
+                                                               newline]
+                                                      end
+                                                    | Channel => box [string "in_buffer",
+                                                                      string (Int.toString i),
+                                                                      string " = ((unsigned long long)arg",
+                                                                      string (Int.toString (i + 1)),
+                                                                      string ".cli << 32) | arg",
+                                                                      string (Int.toString (i + 1)),
+                                                                      string ".chn;",
+                                                                      newline,
+                                                                      string "in[",
+                                                                      string (Int.toString i),
+                                                                      string "].buffer = &in_buffer",
+                                                                      string (Int.toString i),
+                                                                      string ";",
+                                                                      newline]
+
+                                                    | _ => box [string "in[",
+                                                                string (Int.toString i),
+                                                                string "].buffer = &arg",
+                                                                string (Int.toString (i + 1)),
+                                                                string ";",
+                                                                newline]
+                                          in
+                                              box [string "in[",
+                                                   string (Int.toString i),
+                                                   string "].buffer_type = ",
+                                                   string (p_buffer_type t),
+                                                   string ";",
+                                                   newline,
+
+                                                   case t of
+                                                       Channel => box [string "in[",
+                                                                       string (Int.toString i),
+                                                                       string "].is_unsigned = 1;",
+                                                                       newline]
+                                                     | _ => box [],
+
+                                                   case t of
+                                                       Nullable t => box [string "in[",
+                                                                          string (Int.toString i),
+                                                                          string "].is_null = &in_is_null",
+                                                                          string (Int.toString i),
+                                                                          string ";",
+                                                                          newline,
+                                                                          string "if (arg",
+                                                                          string (Int.toString (i + 1)),
+                                                                          string " == NULL) {",
+                                                                          newline,
+                                                                          box [string "in_is_null",
+                                                                               string (Int.toString i),
+                                                                               string " = 1;",
+                                                                               newline],
+                                                                          string "} else {",
+                                                                          box [case t of
+                                                                                   String => box []
+                                                                                 | _ =>
+                                                                                   box [string (p_sql_ctype t),
+                                                                                        space,
+                                                                                        string "tmp = *arg",
+                                                                                        string (Int.toString (i + 1)),
+                                                                                        string ";",
+                                                                                        newline,
+                                                                                        string (p_sql_ctype t),
+                                                                                        space,
+                                                                                        string "arg",
+                                                                                        string (Int.toString (i + 1)),
+                                                                                        string " = tmp;",
+                                                                                        newline],
+                                                                               string "in_is_null",
+                                                                               string (Int.toString i),
+                                                                               string " = 0;",
+                                                                               newline,
+                                                                               buffers t,
+                                                                               newline],
+                                                                          string "}",
+                                                                          newline]
+
+                                                     | _ => buffers t,
+                                                   newline]
+                                          end) inputs,
+         newline,
+
+         string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": error binding parameters\");",
+         newline,
+
+         dmlCommon {loc = loc, dml = box [string "\"",
+                                          string (Prim.toCString dml),
+                                          string "\""], mode = mode}]
+
+fun nextval {loc, seqE, seqName} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "char *insert = ",
+         case seqName of
+             SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
+           | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
+                          seqE,
+                          string ", \" VALUES ()\"))"],
+         string ";",
+         newline,
+         string "char *delete = ",
+         case seqName of
+             SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
+           | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
+                          seqE,
+                          string ")"],
+         string ";",
+         newline,
+         newline,
+
+         string "if (mysql_query(conn->conn, insert)) {",
+         box [newline,
+              string "if (mysql_errno(conn->conn) == 2006) uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
+              newline],
+         string "}",
+         newline,
+         string "n = mysql_insert_id(conn->conn);",
+         newline,
+         string "if (mysql_query(conn->conn, delete)) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
+         newline]
+
+fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called"
+
+fun setval _ = raise Fail "MySQL.setval called"
+
+fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
+                                              | #"\\" => "\\\\"
+                                              | ch =>
+                                                if Char.isPrint ch then
+                                                    str ch
+                                                else
+                                                    (ErrorMsg.error
+                                                         "Non-printing character found in SQL string literal";
+                                                     ""))
+                                            (Prim.toCString s) ^ "'"
+
+fun p_cast (s, _) = s
+
+fun p_blank _ = "?"
+
+val () = addDbms {name = "mysql",
+                  header = Config.msheader,
+                  randomFunction = "RAND",
+                  link = "-lmysqlclient",
+                  init = init,
+                  p_sql_type = p_sql_type,
+                  query = query,
+                  queryPrepared = queryPrepared,
+                  dml = dml,
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared,
+                  setval = setval,
+                  sqlifyString = sqlifyString,
+                  p_cast = p_cast,
+                  p_blank = p_blank,
+                  supportsDeleteAs = false,
+                  supportsUpdateAs = false,
+                  createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)",
+                  textKeysNeedLengths = true,
+                  supportsNextval = false,
+                  supportsNestedPrepared = false,
+                  sqlPrefix = "SET storage_engine=InnoDB;\n\n",
+                  supportsOctetLength = true,
+                  trueString = "TRUE",
+                  falseString = "FALSE",
+                  onlyUnion = true,
+                  nestedRelops = false,
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = true}
+
+end
diff --git a/src/name_js.sig b/src/name_js.sig
new file mode 100644
index 0000000..6750b7a
--- /dev/null
+++ b/src/name_js.sig
@@ -0,0 +1,35 @@
+(* Copyright (c) 2012, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Phase that introduces names for fragments of JavaScript code, so that they
+ * may be moved to app.js and not repeated in each generated page *)
+
+signature NAME_JS = sig
+
+    val rewrite : Mono.file -> Mono.file
+
+end
diff --git a/src/name_js.sml b/src/name_js.sml
new file mode 100644
index 0000000..f10e593
--- /dev/null
+++ b/src/name_js.sml
@@ -0,0 +1,173 @@
+(* Copyright (c) 2012-2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Phase that introduces names for fragments of JavaScript code, so that they
+ * may be moved to app.js and not repeated in each generated page *)
+
+structure NameJS :> NAME_JS = struct
+
+open Mono
+
+structure U = MonoUtil
+structure IS = IntBinarySet
+
+val freeVars = U.Exp.foldB {typ = #2,
+                            exp = fn (free, e, vs) =>
+                                     case e of
+                                         ERel n =>
+                                         if n < free then
+                                             vs
+                                         else
+                                             IS.add (vs, n - free)
+                                       | _ => vs,
+                            bind = fn (free, b) =>
+                                      case b of
+                                          U.Exp.RelE _ => free+1
+                                        | _ => free}
+               0 IS.empty
+
+fun index (ls, v) =
+    case ls of
+        [] => raise Fail "NameJs.index"
+      | v' :: ls' => if v = v' then 0 else 1 + index (ls', v)
+
+fun squish vs = U.Exp.mapB {typ = fn x => x,
+                            exp = fn free => fn e =>
+                                                case e of
+                                                    ERel n =>
+                                                    if n < free then
+                                                        e
+                                                    else
+                                                        ERel (free + index (vs, n - free) + 1)
+                                                  | _ => e,
+                            bind = fn (free, b) =>
+                                      case b of
+                                          U.Exp.RelE _ => free+1
+                                        | _ => free}
+                           0
+
+fun rewrite file =
+    let
+        fun isTricky' dontName e =
+            case e of
+                ENamed n => IS.member (dontName, n)
+              | EFfiApp ("Basis", "sigString", _) => true
+              | _ => false
+
+        fun isTricky dontName = U.Decl.exists {typ = fn _ => false,
+                                               exp = isTricky' dontName,
+                                               decl = fn _ => false}
+
+        fun isTrickyE dontName = U.Exp.exists {typ = fn _ => false,
+                                               exp = isTricky' dontName}
+
+        val dontName = foldl (fn (d, dontName) =>
+                                 if isTricky dontName d then
+                                     case #1 d of
+                                         DVal (_, n, _, _, _) => IS.add (dontName, n)
+                                       | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis
+                                       | _ => dontName
+                                 else
+                                     dontName) IS.empty (#1 file)
+
+        val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) =>
+                                                    let
+                                                        val (d, (nextName, newDs)) =
+                                                            U.Decl.foldMapB {typ = fn x => x,
+                                                                             decl = fn (_, e, s) => (e, s),
+                                                                             exp = fn (env, e, st as (nextName, newDs)) =>
+                                                                                      case e of
+                                                                                          EJavaScript (mode, e') =>
+                                                                                          (case mode of
+                                                                                               Source _ => (e, st)
+                                                                                             | _ =>
+                                                                                               let
+                                                                                                   fun isTrulySimple (e, _) =
+                                                                                                       case e of
+                                                                                                           ERel _ => true
+                                                                                                         | ENamed _ => true
+                                                                                                         | ERecord [] => true
+                                                                                                         | _ => false
+
+                                                                                                   fun isAlreadySimple e =
+                                                                                                       case #1 e of
+                                                                                                           EApp (e, arg) => isTrulySimple arg andalso isAlreadySimple e
+                                                                                                         | _ => isTrulySimple e
+                                                                                               in
+                                                                                                   if isAlreadySimple e' orelse isTrickyE dontName e' then
+                                                                                                       (e, st)
+                                                                                                   else
+                                                                                                       let
+                                                                                                           val loc = #2 e'
+
+                                                                                                           val vs = freeVars e'
+                                                                                                           val vs = IS.listItems vs
+                                                                                                                    
+                                                                                                           val x = "script" ^ Int.toString nextName
+                                                                                                                   
+                                                                                                           val un = (TRecord [], loc)
+                                                                                                           val s = (TFfi ("Basis", "string"), loc)
+                                                                                                           val base = (TFun (un, s), loc)
+                                                                                                           val t = foldl (fn (n, t) => (TFun (#2 (List.nth (env, n)), t), loc)) base vs
+                                                                                                           val e' = squish vs e'
+                                                                                                           val e' = (EAbs ("_", un, s, e'), loc)
+                                                                                                           val (e', _) = foldl (fn (n, (e', t)) =>
+                                                                                                                                   let
+                                                                                                                                       val (x, this) = List.nth (env, n)
+                                                                                                                                   in
+                                                                                                                                       ((EAbs (x, this, t, e'), loc),
+                                                                                                                                        (TFun (this, t), loc))
+                                                                                                                                   end) (e', base) vs
+                                                                                                           val d = (x, nextName, t, e', "<script>")
+
+                                                                                                           val e = (ENamed nextName, loc)
+                                                                                                           val e = foldr (fn (n, e) => (EApp (e, (ERel n, loc)), loc)) e vs
+                                                                                                           val e = (EApp (e, (ERecord [], loc)), loc)
+                                                                                                           val e = EJavaScript (Script, e)
+                                                                                                       in
+                                                                                                           (e, (nextName+1, d :: newDs))
+                                                                                                       end
+                                                                                               end)
+                                                                                        | _ => (e, st),
+                                                                             bind = fn (env, b) =>
+                                                                                       case b of
+                                                                                           U.Decl.RelE x => x :: env
+                                                                                         | _ => env}
+                                                            [] (nextName, []) d
+                                                    in
+                                                        (case newDs of
+                                                             [] => [d]
+                                                           | _ => case #1 d of
+                                                                      DValRec vis => [(DValRec (vis @ newDs), #2 d)]
+                                                                    | _ => List.revAppend (map (fn vi => (DVal vi, #2 d)) newDs, [d]),
+                                                         nextName)
+                                                    end) (U.File.maxName file + 1) (#1 file)
+    in
+        (ds, #2 file)
+    end
+
+end
diff --git a/src/option_key_fn.sml b/src/option_key_fn.sml
new file mode 100644
index 0000000..27ba913
--- /dev/null
+++ b/src/option_key_fn.sml
@@ -0,0 +1,12 @@
+functor OptionKeyFn(K : ORD_KEY)
+        : ORD_KEY where type ord_key = K.ord_key option = struct
+
+type ord_key = K.ord_key option
+
+val compare =
+ fn (NONE, NONE) => EQUAL
+  | (NONE, _) => LESS
+  | (_, NONE) => GREATER
+  | (SOME x, SOME y) => K.compare (x, y)
+
+end
diff --git a/src/order.sig b/src/order.sig
new file mode 100644
index 0000000..fcee69e
--- /dev/null
+++ b/src/order.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Utility code for implementing comparisons *)
+
+signature ORDER = sig
+    
+    val join : order * (unit -> order) -> order
+    val joinL : ('a * 'b -> order) -> 'a list * 'b list -> order
+    val joinO : ('a * 'b -> order) -> 'a option * 'b option -> order
+
+end
diff --git a/src/order.sml b/src/order.sml
new file mode 100644
index 0000000..3f5bce6
--- /dev/null
+++ b/src/order.sml
@@ -0,0 +1,53 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Utility code for implementing comparisons *)
+
+structure Order :> ORDER = struct
+
+fun join (o1, o2) =
+    case o1 of
+        EQUAL => o2 ()
+      | v => v
+             
+fun joinL f (os1, os2) =
+    case (os1, os2) of
+        (nil, nil) => EQUAL
+      | (nil, _) => LESS
+      | (h1 :: t1, h2 :: t2) =>
+        join (f (h1, h2), fn () => joinL f (t1, t2))
+      | (_ :: _, nil) => GREATER
+
+fun joinO f (v1, v2) =
+    case (v1, v2) of
+        (NONE, NONE) => EQUAL
+      | (NONE, _) => LESS
+      | (_, NONE) => GREATER
+
+      | (SOME v1, SOME v2) => f (v1, v2)
+
+end
diff --git a/src/pair_key_fn.sml b/src/pair_key_fn.sml
new file mode 100644
index 0000000..cd33950
--- /dev/null
+++ b/src/pair_key_fn.sml
@@ -0,0 +1,12 @@
+functor PairKeyFn (structure I : ORD_KEY
+                     structure J : ORD_KEY)
+        : ORD_KEY where type ord_key = I.ord_key * J.ord_key = struct
+
+type ord_key = I.ord_key * J.ord_key
+
+fun compare ((i1, j1), (i2, j2)) =
+    case I.compare (i1, i2) of
+        EQUAL => J.compare (j1, j2)
+      | ord => ord
+
+end
diff --git a/src/pathcheck.sig b/src/pathcheck.sig
new file mode 100644
index 0000000..e4b9c7a
--- /dev/null
+++ b/src/pathcheck.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature PATH_CHECK = sig
+
+    val check : Mono.file -> unit
+
+end
diff --git a/src/pathcheck.sml b/src/pathcheck.sml
new file mode 100644
index 0000000..3533032
--- /dev/null
+++ b/src/pathcheck.sml
@@ -0,0 +1,115 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure PathCheck :> PATH_CHECK = struct
+
+open Mono
+
+structure E = ErrorMsg
+
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) =
+    let
+        fun doFunc s =
+            (if SS.member (funcs, s) then
+                 E.errorAt loc ("Duplicate function path " ^ s)
+             else
+                 ();
+             (SS.add (funcs, s), rels, cookies, styles))
+
+        fun doRel s =
+            (if SS.member (rels, s) then
+                 E.errorAt loc ("Duplicate table/sequence path " ^ s)
+             else
+                 ();
+             (funcs, SS.add (rels, s), cookies, styles))
+
+        fun doCookie s =
+            (if SS.member (cookies, s) then
+                 E.errorAt loc ("Duplicate cookie path " ^ s)
+             else
+                 ();
+             (funcs, rels, SS.add (cookies, s), styles))
+
+        fun doStyle s =
+            (if SS.member (styles, s) then
+                 E.errorAt loc ("Duplicate style path " ^ s)
+             else
+                 ();
+             (funcs, rels, cookies, SS.add (styles, s)))
+    in
+        case d of
+            DExport (_, s, _, _, _, _) => doFunc s
+            
+          | DTable (s, _, pe, ce) =>
+            let
+                fun constraints (e, rels) =
+                    case #1 e of
+                        ERecord [(s', _, _)] =>
+                        let
+                            val s' = s ^ "_" ^ s'
+                        in
+                            if SS.member (rels, s') then
+                                E.errorAt loc ("Duplicate constraint path " ^ s')
+                            else
+                                ();
+                            SS.add (rels, s')
+                        end
+                      | EStrcat (e1, e2) => constraints (e2, constraints (e1, rels))
+                      | _ => rels
+
+                val rels = #2 (doRel s)
+                val rels = case #1 pe of
+                               EPrim (Prim.String (_, "")) => rels
+                             | _ =>
+                               let
+                                   val s' = s ^ "_Pkey"
+                               in
+                                   if SS.member (rels, s') then
+                                       E.errorAt loc ("Duplicate primary key constraint path " ^ s')
+                                   else
+                                       ();
+                                   SS.add (rels, s')
+                               end
+            in
+                (funcs, constraints (ce, rels), cookies, styles)
+            end
+          | DSequence s => doRel s
+
+          | DCookie s => doCookie s
+          | DStyle s => doStyle s
+
+          | _ => (funcs, rels, cookies, styles)
+    end
+
+fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds)
+
+end
diff --git a/src/postgres.sig b/src/postgres.sig
new file mode 100644
index 0000000..54117f0
--- /dev/null
+++ b/src/postgres.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature POSTGRES = sig
+
+end
diff --git a/src/postgres.sml b/src/postgres.sml
new file mode 100644
index 0000000..404384d
--- /dev/null
+++ b/src/postgres.sml
@@ -0,0 +1,1153 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Postgres :> POSTGRES = struct
+
+open Settings
+open Print.PD
+open Print
+
+val ident = String.translate (fn #"'" => "PRIME"
+                               | ch => str ch)
+
+fun p_sql_type t =
+    case t of
+        Int => "int8"
+      | Float => "float8"
+      | String => "text"
+      | Char => "char"
+      | Bool => "bool"
+      | Time => "timestamp"
+      | Blob => "bytea"
+      | Channel => "int8"
+      | Client => "int4"
+      | Nullable t => p_sql_type t
+
+fun p_sql_type_base t =
+    case t of
+        Int => "bigint"
+      | Float => "double precision"
+      | String => "text"
+      | Char => "character"
+      | Bool => "boolean"
+      | Time => "timestamp without time zone"
+      | Blob => "bytea"
+      | Channel => "bigint"
+      | Client => "integer"
+      | Nullable t => p_sql_type_base t
+
+fun checkRel (table, checkNullable) (s, xts) =
+    let
+        val sl = CharVector.map Char.toLower s
+        val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then
+                     String.substring (sl, 1, size sl - 2)
+                 else
+                     sl
+
+        val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
+                ^ sl ^ "'"
+
+        val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
+                                sl,
+                                "' AND (",
+                                case String.concatWith " OR "
+                                                       (map (fn (x, t) =>
+                                                                String.concat ["(LOWER(column_name) = '",
+                                                                               Settings.mangleSqlCatalog
+                                                                                   (CharVector.map
+                                                                                        Char.toLower (ident x)),
+                                                                               (case p_sql_type_base t of
+                                                                                    "bigint" =>
+                                                                                    "' AND data_type IN ('bigint', 'numeric', 'integer')"
+                                                                                  | "text" =>
+                                                                                    "' AND data_type IN ('text', 'character varying')"                                                                          
+                                                                                  | t =>
+                                                                                    String.concat ["' AND data_type = '",
+                                                                                                   t,
+                                                                                                   "'"]),
+                                                                               if checkNullable then
+                                                                                   (" AND is_nullable = '"
+                                                                                    ^ (if isNotNull t then
+                                                                                           "NO"
+                                                                                       else
+                                                                                           "YES")
+                                                                                    ^ "'")
+                                                                               else
+                                                                                   "",
+                                                                               ")"]) xts) of
+                                    "" => "FALSE"
+                                  | s => s,
+                                ")"]
+
+        val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
+                                 sl,
+                                 "' AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
+    in
+        box [string "res = PQexec(conn, \"",
+             string q,
+             string "\");",
+             newline,
+             newline,
+             string "if (res == NULL) {",
+             newline,
+             box [string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q,
+                  string "\\n%s\", msg);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
+             newline,
+             box [string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' does not exist.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "PQclear(res);",
+             newline,
+
+             string "res = PQexec(conn, \"",
+             string q',
+             string "\");",
+             newline,
+             newline,
+             string "if (res == NULL) {",
+             newline,
+             box [string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q',
+                  string "\\n%s\", msg);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (strcmp(PQgetvalue(res, 0, 0), \"",
+             string (Int.toString (length xts)),
+             string "\")) {",
+             newline,
+             box [string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' has the wrong column types.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "PQclear(res);",
+             newline,
+             newline,
+
+             string "res = PQexec(conn, \"",
+             string q'',
+             string "\");",
+             newline,
+             newline,
+             string "if (res == NULL) {",
+             newline,
+             box [string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+             newline,
+             box [string "char msg[1024];",
+                  newline,
+                  string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                  newline,
+                  string "msg[1023] = 0;",
+                  newline,
+                  string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                  string q'',
+                  string "\\n%s\", msg);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (strcmp(PQgetvalue(res, 0, 0), \"",
+             string (Int.toString (length xts)),
+             string "\")) {",
+             newline,
+             box [string "PQclear(res);",
+                  newline,
+                  string "PQfinish(conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string sl,
+                  string "' has extra columns.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "PQclear(res);",
+             newline]
+    end
+
+fun init {dbstring, prepared = ss, tables, views, sequences} =
+    box [if #persistent (currentProtocol ()) then
+             box [string "static void uw_db_validate(uw_context ctx) {",
+                  newline,
+                  string "PGconn *conn = uw_get_db(ctx);",
+                  newline,
+                  string "PGresult *res;",
+                  newline,
+                  newline,
+                  p_list_sep newline (checkRel ("tables", true)) tables,
+                  p_list_sep newline (checkRel ("views", false)) views,
+
+                  p_list_sep newline
+                             (fn s =>
+                                 let
+                                     val sl = CharVector.map Char.toLower s
+
+                                     val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
+                                             ^ sl ^ "' AND relkind = 'S' AND pg_catalog.pg_table_is_visible(oid)"
+                                 in
+                                     box [string "res = PQexec(conn, \"",
+                                          string q,
+                                          string "\");",
+                                          newline,
+                                          newline,
+                                          string "if (res == NULL) {",
+                                          newline,
+                                          box [string "PQfinish(conn);",
+                                               newline,
+                                               string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+                                               newline],
+                                          string "}",
+                                          newline,
+                                          newline,
+                                          string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+                                          newline,
+                                          box [string "char msg[1024];",
+                                               newline,
+                                               string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                                               newline,
+                                               string "msg[1023] = 0;",
+                                               newline,
+                                               string "PQclear(res);",
+                                               newline,
+                                               string "PQfinish(conn);",
+                                               newline,
+                                               string "uw_error(ctx, FATAL, \"Query failed:\\n",
+                                               string q,
+                                               string "\\n%s\", msg);",
+                                               newline],
+                                          string "}",
+                                          newline,
+                                          newline,
+                                          string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
+                                          newline,
+                                          box [string "PQclear(res);",
+                                               newline,
+                                               string "PQfinish(conn);",
+                                               newline,
+                                               string "uw_error(ctx, FATAL, \"Sequence '",
+                                               string s,
+                                               string "' does not exist.\");",
+                                               newline],
+                                          string "}",
+                                          newline,
+                                          newline,
+                                          string "PQclear(res);",
+                                          newline]
+                                 end) sequences,
+
+                  string "}",
+
+                  string "static void uw_db_prepare(uw_context ctx) {",
+                  newline,
+                  string "PGconn *conn = uw_get_db(ctx);",
+                  newline,
+                  string "PGresult *res;",
+                  newline,
+                  newline,
+
+                  p_list_sepi newline (fn i => fn (s, _) =>
+                                                  box [string "res = PQprepare(conn, \"uw",
+                                                       string (Int.toString i),
+                                                       string "\", \"",
+                                                       string (Prim.toCString s),
+                                                       string "\", 0, NULL);",
+                                                       newline,
+                                                       string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+                                                       newline,
+                                                       box [string "char msg[1024];",
+                                                            newline,
+                                                            string "strncpy(msg, PQerrorMessage(conn), 1024);",
+                                                            newline,
+                                                            string "msg[1023] = 0;",
+                                                            newline,
+                                                            string "PQclear(res);",
+                                                            newline,
+                                                            string "PQfinish(conn);",
+                                                            newline,
+                                                            string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
+                                                            string (Prim.toCString s),
+                                                            string "\\n%s\", msg);",
+                                                            newline],
+                                                       string "}",
+                                                       newline,
+                                                       string "PQclear(res);",
+                                                       newline])
+                              ss,
+
+                  string "}",
+                  newline,
+                  newline]
+         else
+             box [string "static void uw_db_validate(uw_context ctx) { }",
+                  newline,
+                  string "static void uw_db_prepare(uw_context ctx) { }"],
+
+         string "static void uw_client_init(void) {",
+         newline,
+         box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
+              newline,
+              string "uw_sqlfmtFloat = \"%.16g::float8%n\";",
+              newline,
+              string "uw_Estrings = 1;",
+              newline,
+              string "uw_sql_type_annotations = 1;",
+              newline,
+              string "uw_sqlsuffixString = \"::text\";",
+              newline,
+              string "uw_sqlsuffixChar = \"::char\";",
+              newline,
+              string "uw_sqlsuffixBlob = \"::bytea\";",
+              newline,
+              string "uw_sqlfmtUint4 = \"%u::int4%n\";",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "static void uw_db_close(uw_context ctx) {",
+         newline,
+         string "PQfinish(uw_get_db(ctx));",
+         newline,
+         string "}",
+         newline,
+         newline,
+
+         string "static int uw_db_begin(uw_context ctx, int could_write) {",
+         newline,
+         string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");",
+         newline,
+         newline,
+         string "if (res == NULL) return 1;",
+         newline,
+         newline,
+         string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+         box [string "PQclear(res);",
+              newline,
+              string "return 1;",
+              newline],
+         string "}",
+         newline,
+         string "PQclear(res);",
+         newline,
+         string "return 0;",
+         newline,
+         string "}",
+         newline,
+         newline,
+
+         string "static int uw_db_commit(uw_context ctx) {",
+         newline,
+         string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res = PQexec(conn, \"COMMIT\");",
+         newline,
+         newline,
+         string "if (res == NULL) return 1;",
+         newline,
+         newline,
+         string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+         box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "return -1;",
+                   newline],
+              string "}",
+              newline,
+              string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "return -1;",
+                   newline],
+              string "}",
+              newline,
+	      string "PQclear(res);",
+              newline,
+              string "return 1;",
+              newline],
+         string "}",
+         newline,
+         string "PQclear(res);",
+         newline,
+         string "return 0;",
+         newline,
+         string "}",
+         newline,
+         newline,
+
+         string "static int uw_db_rollback(uw_context ctx) {",
+         newline,
+         string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
+         newline,
+         newline,
+         string "if (res == NULL) return 1;",
+         newline,
+         newline,
+         string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+         box [string "PQclear(res);",
+              newline,
+              string "return 1;",
+              newline],
+         string "}",
+         newline,
+         string "PQclear(res);",
+         newline,
+         string "return 0;",
+         newline,
+         string "}",
+
+         newline,
+         newline,
+
+         string "static void uw_db_init(uw_context ctx) {",
+         newline,
+         string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
+	 newline,
+         string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
+         string (Prim.toCString dbstring),
+         string "\" : env_db_str);",
+         newline,
+         string "if (conn == NULL) uw_error(ctx, FATAL, ",
+         string "\"libpq can't allocate a connection.\");",
+         newline,
+         string "if (PQstatus(conn) != CONNECTION_OK) {",
+         newline,
+         box [string "char msg[1024];",
+              newline,
+              string "strncpy(msg, PQerrorMessage(conn), 1024);",
+              newline,
+              string "msg[1023] = 0;",
+              newline,
+              string "PQfinish(conn);",
+              newline,
+              string "uw_error(ctx, BOUNDED_RETRY, ",
+              string "\"Connection to Postgres server failed: %s\", msg);"],
+         newline,
+         string "}",
+         newline,
+         string "uw_set_db(ctx, conn);",
+         newline,
+         string "uw_db_validate(ctx);",
+         newline,
+         string "uw_db_prepare(ctx);",
+         newline,
+         string "}"]
+
+fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
+    let
+        fun p_unsql t e eLen =
+            case t of
+                Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
+              | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
+              | String =>
+                if wontLeakStrings then
+                    e
+                else
+                    box [string "uw_strdup(ctx, ", e, string ")"]
+              | Char => box [e, string "[0]"]
+              | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
+              | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
+              | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
+                             e,
+                             string ", ",
+                             eLen,
+                             string ")"]
+              | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
+              | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
+
+              | Nullable _ => raise Fail "Postgres: Recursive Nullable"
+
+        fun getter t =
+            case t of
+                Nullable t =>
+                box [string "(PQgetisnull(res, i, ",
+                     string (Int.toString i),
+                     string ") ? NULL : ",
+                     case t of
+                         String => getter t
+                       | _ => box [string "({",
+                                   newline,
+                                   string (p_sql_ctype t),
+                                   space,
+                                   string "*tmp = uw_malloc(ctx, sizeof(",
+                                   string (p_sql_ctype t),
+                                   string "));",
+                                   newline,
+                                   string "*tmp = ",
+                                   getter t,
+                                   string ";",
+                                   newline,
+                                   string "tmp;",
+                                   newline,
+                                   string "})"],
+                     string ")"]
+              | _ =>
+                box [string "(PQgetisnull(res, i, ",
+                     string (Int.toString i),
+                     string ") ? ",
+                     box [string "({",
+                          string (p_sql_ctype t),
+                          space,
+                          string "tmp;",
+                          newline,
+                          string "uw_error(ctx, FATAL, \"",
+                          string (ErrorMsg.spanToString loc),
+                          string ": Unexpectedly NULL field #",
+                          string (Int.toString i),
+                          string "\");",
+                          newline,
+                          string "tmp;",
+                          newline,
+                          string "})"],
+                     string " : ",
+                     p_unsql t
+                             (box [string "PQgetvalue(res, i, ",
+                                   string (Int.toString i),
+                                   string ")"])
+                             (box [string "PQgetlength(res, i, ",
+                                   string (Int.toString i),
+                                   string ")"]),
+                     string ")"]
+    in
+        getter t
+    end
+
+fun queryCommon {loc, query, cols, doCols} =
+    box [string "int n, i;",
+         newline,
+         newline,
+
+         string "if (res == NULL) {",
+         box [newline,
+              string "uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"Can't allocate query result; database server may be down.\");",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+         newline,
+         box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
+                   newline],
+              string "}",
+              newline,
+              string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
+                   newline],
+              string "}",
+              newline,
+              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 "if (PQnfields(res) != ",
+         string (Int.toString (length cols)),
+         string ") {",
+         newline,
+         box [string "int nf = PQnfields(res);",
+              newline,
+              string "PQclear(res);",
+              newline,
+              string "uw_error(ctx, FATAL, \"",
+              string (ErrorMsg.spanToString loc),
+              string ": Query returned %d columns instead of ",
+              string (Int.toString (length cols)),
+              string ":\\n%s\\n%s\", nf, ",
+              query,
+              string ", PQerrorMessage(conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "uw_end_region(ctx);",
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
+         newline,
+         string "n = PQntuples(res);",
+         newline,
+         string "for (i = 0; i < n; ++i) {",
+         newline,
+         doCols p_getcol,
+         string "}",
+         newline,
+         newline,
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+fun query {loc, cols, doCols} =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
+         newline,
+         newline,
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
+
+fun p_ensql t e =
+    case t of
+        Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
+      | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
+      | String => e
+      | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
+      | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
+      | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
+      | Blob => box [e, string ".data"]
+      | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
+      | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
+      | Nullable String => e
+      | Nullable t => box [string "(",
+                           e,
+                           string " == NULL ? NULL : ",
+                           p_ensql t (box [string "(*", e, string ")"]),
+                           string ")"]
+
+fun makeParams inputs =
+    box [string "static const int paramFormats[] = { ",
+         p_list_sep (box [string ",", space])
+                    (fn t => if isBlob t then string "1" else string "0") inputs,
+         string " };",
+         newline,
+         if List.exists isBlob inputs then
+             box [string "int *paramLengths = uw_malloc(ctx, ",
+                  string (Int.toString (length inputs)),
+                  string " * sizeof(int));",
+                  newline,
+                  p_list_sepi (box [])
+                              (fn i => fn t =>
+                                          box [string "paramLengths[",
+                                               string (Int.toString i),
+                                               string "] = ",
+                                               case t of
+                                                   Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
+                                                 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
+                                                                            ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
+                                                 | _ => string "0",
+                                               string ";",
+                                               newline]) inputs,
+                  newline]
+         else
+             box [string "const int *paramLengths = paramFormats;",
+                  newline],
+
+         string "const char **paramValues = uw_malloc(ctx, ",
+         string (Int.toString (length inputs)),
+         string " * sizeof(char*));",
+         newline,
+         p_list_sepi (box [])
+                     (fn i => fn t => box [string "paramValues[",
+                                           string (Int.toString i),
+                                           string "] = ",
+                                           p_ensql t (box [string "arg",
+                                                           string (Int.toString (i + 1))]),
+                                           string ";",
+                                           newline])
+                     inputs,
+         newline]
+
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+
+         makeParams inputs,
+
+         newline,
+         string "PGresult *res = ",
+         if #persistent (Settings.currentProtocol ()) then
+             box [string "PQexecPrepared(conn, \"uw",
+                  string (Int.toString id),
+                  string "\", ",
+                  string (Int.toString (length inputs)),
+                  string ", paramValues, paramLengths, paramFormats, 0);"]
+         else
+             box [string "PQexecParams(conn, \"",
+                  string (Prim.toCString query),
+                  string "\", ",
+                  string (Int.toString (length inputs)),
+                  string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
+         newline,
+         newline,
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
+                                                                            string (Prim.toCString query),
+                                                                            string "\""]}]
+
+fun dmlCommon {loc, dml, mode} =
+    box [string "if (res == NULL) {",
+         box [newline,
+              string "uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"Can't allocate DML result; database server may be down.\");",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+         newline,
+         box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
+                   newline],
+              string "}",
+              newline,
+              string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
+                   newline],
+              string "}",
+              newline,
+              case mode of
+                  Settings.Error => box [string "PQclear(res);",
+                                         newline,
+                                         string "uw_error(ctx, FATAL, \"",
+                                         string (ErrorMsg.spanToString loc),
+                                         string ": DML failed:\\n%s\\n%s\", ",
+                                         dml,
+                                         string ", PQerrorMessage(conn));"]
+                | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
+                                        newline,
+                                        newline,
+
+                                        string "res = PQexec(conn, \"ROLLBACK TO s\");",
+                                        newline,
+                                        string "if (res == NULL) {",
+                                        box [newline,
+                                             string "uw_try_reconnecting_and_restarting(ctx);",
+                                             newline,
+                                             string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server may be down.\");",
+                                             newline],
+                                        string "}",
+                                        newline,
+                                        newline,
+
+                                        string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+                                        newline,
+                                        box [string "PQclear(res);",
+                                             newline,
+                                             string "uw_error(ctx, FATAL, \"",
+                                             string (ErrorMsg.spanToString loc),
+                                             string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
+                                             dml,
+                                             string ", PQerrorMessage(conn));",
+                                             newline,
+                                             string "}"],
+                                        newline,
+
+                                        string "PQclear(res);",
+                                        newline],
+              newline],
+         string "}",
+
+         case mode of
+             Error => box [newline,
+                           newline,
+                           string "PQclear(res);",
+                           newline]
+           | None => box[string " else {",
+                         newline,
+                         box [string "PQclear(res);",
+                              newline,
+                              string "res = PQexec(conn, \"RELEASE s\");",
+                              newline,
+                              string "if (res == NULL) {",
+                              box [newline,
+                                   string "uw_try_reconnecting_and_restarting(ctx);",
+                                   newline,
+                                   string "uw_error(ctx, FATAL, \"Can't allocate DML RELEASE result; database server may be down.\");",
+                                   newline],
+                              string "}",
+                              newline,
+                              newline,
+
+                              string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+                              newline,
+                              box [string "PQclear(res);",
+                                   newline,
+                                   string "uw_error(ctx, FATAL, \"",
+                                   string (ErrorMsg.spanToString loc),
+                                   string ": RELEASE failed:\\n%s\\n%s\", ",
+                                   dml,
+                                   string ", PQerrorMessage(conn));",
+                                   newline],
+                              string "}",
+                              newline,
+                              string "PQclear(res);",
+                              newline],
+                         string "}",
+                         newline]]
+
+fun makeSavepoint mode =
+    case mode of
+        Error => box []
+      | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
+                     newline,
+                     string "if (res == NULL) {",
+                     box [newline,
+                          string "uw_try_reconnecting_and_restarting(ctx);",
+                          newline,
+                          string "uw_error(ctx, FATAL, \"Can't allocate DML SAVEPOINT result; database server may be down.\");",
+                          newline],
+                     string "}",
+                     newline,
+                     newline,
+                     string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+                     box [newline,
+                          string "PQclear(res);",
+                          newline,
+                          string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
+                          newline],
+                     string "}",
+                     newline,
+                     string "PQclear(res);",
+                     newline,
+                     newline]
+
+fun dml (loc, mode) =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res;",
+         newline,
+
+         makeSavepoint mode,
+
+         string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
+         newline,
+         newline,
+         dmlCommon {loc = loc, dml = string "dml", mode = mode}]
+
+fun dmlPrepared {loc, id, dml, inputs, mode} =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+
+         makeParams inputs,
+
+         newline,
+         string "PGresult *res;",
+         newline,
+         newline,
+
+         makeSavepoint mode,
+
+         string "res = ",
+         if #persistent (Settings.currentProtocol ()) then
+             box [string "PQexecPrepared(conn, \"uw",
+                  string (Int.toString id),
+                  string "\", ",
+                  string (Int.toString (length inputs)),
+                  string ", paramValues, paramLengths, paramFormats, 0);"]
+         else
+             box [string "PQexecParams(conn, \"",
+                  string (Prim.toCString dml),
+                  string "\", ",
+                  string (Int.toString (length inputs)),
+                  string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
+         newline,
+         newline,
+         dmlCommon {loc = loc, dml = box [string "\"",
+                                          string (Prim.toCString dml),
+                                          string "\""], mode = mode}]
+
+fun nextvalCommon {loc, query} =
+    box [string "if (res == NULL) {",
+         box [newline,
+              string "uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"Can't allocate NEXTVAL result; database server may be down.\");",
+              newline],
+         string "}",
+         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 "n = PQntuples(res);",
+         newline,
+         string "if (n != 1) {",
+         newline,
+         box [string "PQclear(res);",
+              newline,
+              string "uw_error(ctx, FATAL, \"",
+              string (ErrorMsg.spanToString loc),
+              string ": Wrong number of result rows:\\n%s\\n%s\", ",
+              query,
+              string ", PQerrorMessage(conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
+         newline,
+         string "PQclear(res);",
+         newline]
+
+open Cjr
+
+fun nextval {loc, seqE, seqName} =
+    let
+        val query = case seqName of
+                        SOME s =>
+                        string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
+                      | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
+                                  seqE,
+                                  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,
+             nextvalCommon {loc = loc, query = string "query"}]
+    end
+
+fun nextvalPrepared {loc, id, query} =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         newline,
+         string "PGresult *res = ",
+         if #persistent (Settings.currentProtocol ()) then
+             box [string "PQexecPrepared(conn, \"uw",
+                  string (Int.toString id),
+                  string "\", 0, NULL, NULL, NULL, 0);"]
+         else
+             box [string "PQexecParams(conn, \"",
+                  string (Prim.toCString query),
+                  string "\", 0, NULL, NULL, NULL, NULL, 0);"],
+         newline,
+         newline,
+         nextvalCommon {loc = loc, query = box [string "\"",
+                                                string (Prim.toCString query),
+                                                string "\""]}]
+
+fun setvalCommon {loc, query} =
+    box [string "if (res == NULL) {",
+         box [newline,
+              string "uw_try_reconnecting_and_restarting(ctx);",
+              newline,
+              string "uw_error(ctx, FATAL, \"Can't allocate SETVAL result; database server may be down.\");",
+              newline],
+         string "}",
+         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 =>
+                                                 if Char.isPrint ch then
+                                                     str ch
+                                                 else
+                                                     "\\" ^ StringCvt.padLeft #"0" 3
+                                                                              (Int.fmt StringCvt.OCT (ord ch)))
+                                             (Prim.toCString s) ^ "'::text"
+
+fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
+
+fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
+
+val () = addDbms {name = "postgres",
+                  randomFunction = "RANDOM",
+                  header = Config.pgheader,
+                  link = "-lpq",
+                  p_sql_type = p_sql_type,
+                  init = init,
+                  query = query,
+                  queryPrepared = queryPrepared,
+                  dml = dml,
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared,
+                  setval = setval,
+                  sqlifyString = sqlifyString,
+                  p_cast = p_cast,
+                  p_blank = p_blank,
+                  supportsDeleteAs = true,
+                  supportsUpdateAs = true,
+                  createSequence = fn s => "CREATE SEQUENCE " ^ s,
+                  textKeysNeedLengths = false,
+                  supportsNextval = true,
+                  supportsNestedPrepared = true,
+                  sqlPrefix = "",
+                  supportsOctetLength = true,
+                  trueString = "TRUE",
+                  falseString = "FALSE",
+                  onlyUnion = false,
+                  nestedRelops = true,
+                  windowFunctions = true,
+                  supportsIsDistinctFrom = true}
+
+val () = setDbms "postgres"
+
+end
diff --git a/src/prefix.cm b/src/prefix.cm
new file mode 100644
index 0000000..2e71d07
--- /dev/null
+++ b/src/prefix.cm
@@ -0,0 +1,7 @@
+Group is
+
+$/basis.cm
+$/smlnj-lib.cm
+$smlnj/ml-yacc/ml-yacc-lib.cm
+$/pp-lib.cm
+
diff --git a/src/prefix.mlb b/src/prefix.mlb
new file mode 100644
index 0000000..6a51048
--- /dev/null
+++ b/src/prefix.mlb
@@ -0,0 +1,7 @@
+local
+  $(SML_LIB)/basis/basis.mlb
+  $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
+  $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+  $(SML_LIB)/smlnj-lib/PP/pp-lib.mlb
+in
+
diff --git a/src/prepare.sig b/src/prepare.sig
new file mode 100644
index 0000000..0977100
--- /dev/null
+++ b/src/prepare.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature PREPARE = sig
+
+    val prepare : Cjr.file -> Cjr.file
+
+end
diff --git a/src/prepare.sml b/src/prepare.sml
new file mode 100644
index 0000000..660173f
--- /dev/null
+++ b/src/prepare.sml
@@ -0,0 +1,356 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Prepare :> PREPARE = struct
+
+open Cjr
+open Settings
+
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+structure St :> sig
+    type t
+    val empty : t
+    val nameOf : t * string -> t * int
+    val list : t -> (string * int) list
+    val count : t -> int
+end = struct
+
+type t = {map : int SM.map, list : (string * int) list, count : int}
+
+val empty = {map = SM.empty, list = [], count = 0}
+
+fun nameOf (t as {map, list, count}, s) =
+    case SM.find (map, s) of
+        NONE => ({map = SM.insert (map, s, count), list = (s, count) :: list, count = count + 1}, count)
+      | SOME n => (t, n)
+
+fun list (t : t) = rev (#list t)
+fun count (t : t) = #count t
+
+end
+
+fun prepString (e, st) =
+    let
+        fun prepString' (e, ss, n) =
+            let
+                fun doOne t =
+                    SOME (#p_blank (Settings.currentDbms ()) (n + 1, t) :: ss, n + 1)
+            in
+                case #1 e of
+                    EPrim (Prim.String (_, s)) =>
+                    SOME (s :: ss, n)
+                  | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) =>
+                    (case prepString' (e1, ss, n) of
+                         NONE => NONE
+                       | SOME (ss, n) => prepString' (e2, ss, n))
+                  | EFfiApp ("Basis", "sqlifyInt", [_]) => doOne Int
+                  | EFfiApp ("Basis", "sqlifyFloat", [_]) => doOne Float
+                  | EFfiApp ("Basis", "sqlifyString", [_]) => doOne String
+                  | EFfiApp ("Basis", "sqlifyBool", [_]) => doOne Bool
+                  | EFfiApp ("Basis", "sqlifyTime", [_]) => doOne Time
+                  | EFfiApp ("Basis", "sqlifyBlob", [_]) => doOne Blob
+                  | EFfiApp ("Basis", "sqlifyChannel", [_]) => doOne Channel
+                  | EFfiApp ("Basis", "sqlifyClient", [_]) => doOne Client
+
+                  | ECase (e,
+                           [((PNone _, _),
+                             (EPrim (Prim.String (_, "NULL")), _)),
+                            ((PSome (_, (PVar _, _)), _),
+                             (EFfiApp (m, x, [((ERel 0, _), _)]), _))],
+                           {disc = t, ...}) => prepString' ((EFfiApp (m, x, [(e, t)]), #2 e), ss, n)
+
+                  | ECase (e,
+                           [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
+                             (EPrim (Prim.String (_, "TRUE")), _)),
+                            ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
+                             (EPrim (Prim.String (_, "FALSE")), _))],
+                           _) => doOne Bool
+
+                  | _ => NONE
+            end
+    in
+        case prepString' (e, [], 0) of
+            NONE => NONE
+          | SOME (ss, n) =>
+            let
+                val s = String.concat (rev ss)
+                val (st, id) = St.nameOf (st, s)
+            in
+                SOME (id, s, st)
+            end
+    end
+
+fun prepExp (e as (_, loc), st) =
+    case #1 e of
+        EPrim _ => (e, st)
+      | ERel _ => (e, st)
+      | ENamed _ => (e, st)
+      | ECon (_, _, NONE) => (e, st)
+      | ECon (dk, pc, SOME e) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((ECon (dk, pc, SOME e), loc), st)
+        end
+      | ENone t => (e, st)
+      | ESome (t, e) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((ESome (t, e), loc), st)
+        end
+      | EFfi _ => (e, st)
+      | EFfiApp (m, x, es) =>
+        let
+            val (es, st) = ListUtil.foldlMap (fn ((e, t), st) =>
+                                                 let
+                                                     val (e, st) = prepExp (e, st)
+                                                 in
+                                                     ((e, t), st)
+                                                 end) st es
+        in
+            ((EFfiApp (m, x, es), loc), st)
+        end
+      | EApp (e1, es) =>
+        let
+            val (e1, st) = prepExp (e1, st)
+            val (es, st) = ListUtil.foldlMap prepExp st es
+        in
+            ((EApp (e1, es), loc), st)
+        end
+
+      | EUnop (s, e1) =>
+        let
+            val (e1, st) = prepExp (e1, st)
+        in
+            ((EUnop (s, e1), loc), st)
+        end
+      | EBinop (s, e1, e2) =>
+        let
+            val (e1, st) = prepExp (e1, st)
+            val (e2, st) = prepExp (e2, st)
+        in
+            ((EBinop (s, e1, e2), loc), st)
+        end
+
+      | ERecord (rn, xes) =>
+        let
+            val (xes, st) = ListUtil.foldlMap (fn ((x, e), st) =>
+                                                   let
+                                                       val (e, st) = prepExp (e, st)
+                                                   in
+                                                       ((x, e), st)
+                                                   end) st xes
+        in
+            ((ERecord (rn, xes), loc), st)
+        end
+      | EField (e, s) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((EField (e, s), loc), st)
+        end
+
+      | ECase (e, pes, ts) =>
+        let
+            val (e, st) = prepExp (e, st)
+            val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
+                                                   let
+                                                       val (e, st) = prepExp (e, st)
+                                                   in
+                                                       ((p, e), st)
+                                                   end) st pes
+        in
+            ((ECase (e, pes, ts), loc), st)
+        end
+
+      | EError (e, t) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((EError (e, t), loc), st)
+        end
+
+      | EReturnBlob {blob, mimeType, t} =>
+        let
+            val (blob, st) = case blob of
+                                 NONE => (blob, st)
+                               | SOME blob =>
+                                 let
+                                     val (b, st) = prepExp (blob, st)
+                                 in
+                                     (SOME b, st)
+                                 end
+            val (mimeType, st) = prepExp (mimeType, st)
+        in
+            ((EReturnBlob {blob = blob, mimeType = mimeType, t = t}, loc), st)
+        end
+
+      | ERedirect (e, t) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((ERedirect (e, t), loc), st)
+        end
+
+      | EWrite e =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((EWrite e, loc), st)
+        end
+      | ESeq (e1, e2) =>
+        let
+            val (e1, st) = prepExp (e1, st)
+            val (e2, st) = prepExp (e2, st)
+        in
+            ((ESeq (e1, e2), loc), st)
+        end
+      | ELet (x, t, e1, e2) =>
+        let
+            val (e1, st) = prepExp (e1, st)
+            val (e2, st) = prepExp (e2, st)
+        in
+            ((ELet (x, t, e1, e2), loc), st)
+        end
+
+      | EQuery {exps, tables, rnum, state, query, body, initial, ...} =>
+        let
+            val (body, st) = prepExp (body, st)
+        in
+            case prepString (query, st) of
+                NONE =>
+                ((EQuery {exps = exps, tables = tables, rnum = rnum,
+                          state = state, query = query, body = body,
+                          initial = initial, prepared = NONE}, loc),
+                 st)
+              | SOME (id, s, st) =>
+                ((EQuery {exps = exps, tables = tables, rnum = rnum,
+                          state = state, query = query, body = body,
+                          initial = initial, prepared = SOME {id = id, query = s, nested = true}}, loc), st)
+        end
+
+      | EDml {dml, mode, ...} =>
+        (case prepString (dml, st) of
+             NONE => (e, st)
+           | SOME (id, s, st) =>
+             ((EDml {dml = dml, prepared = SOME {id = id, dml = s}, mode = mode}, loc), st))
+
+      | ENextval {seq, ...} =>
+        if #supportsNextval (Settings.currentDbms ()) then
+            let
+                val s = case seq of
+                            (EPrim (Prim.String (_, s)), loc) =>
+                            (EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('" ^ s ^ "')")), loc)
+                          | _ =>
+                            let
+                                val t = (TFfi ("Basis", "string"), loc)
+                                val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String (Prim.Normal, "')")), loc), t)]), loc)
+                            in
+                                (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String (Prim.Normal, "SELECT NEXTVAL('")), loc), t), (s', t)]), loc)
+                            end
+            in
+                case prepString (s, st) of
+                    NONE => (e, st)
+                  | SOME (id, s, st) =>
+                    ((ENextval {seq = seq, prepared = SOME {id = id, query = s}}, loc), st)
+            end
+        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, b) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((EUnurlify (e, t, b), loc), st)
+        end
+
+fun prepDecl (d as (_, loc), st) =
+    case #1 d of
+        DStruct _ => (d, st)
+      | DDatatype _ => (d, st)
+      | DDatatypeForward _ => (d, st)
+      | DVal (x, n, t, e) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((DVal (x, n, t, e), loc), st)
+        end
+      | DFun (x, n, xts, t, e) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((DFun (x, n, xts, t, e), loc), st)
+        end
+      | DFunRec fs =>
+        let
+            val (fs, st) = ListUtil.foldlMap (fn ((x, n, xts, t, e), st) =>
+                                                  let
+                                                      val (e, st) = prepExp (e, st)
+                                                  in
+                                                      ((x, n, xts, t, e), st)
+                                                  end) st fs
+        in
+            ((DFunRec fs, loc), st)
+        end
+
+      | DTable _ => (d, st)
+      | DSequence _ => (d, st)
+      | DView _ => (d, st)
+      | DDatabase _ => (d, st)
+      | DPreparedStatements _ => (d, st)
+      | DJavaScript _ => (d, st)
+      | DCookie _ => (d, st)
+      | DStyle _ => (d, st)
+      | DTask (tk, x1, x2, e) =>
+        let
+            val (e, st) = prepExp (e, st)
+        in
+            ((DTask (tk, x1, x2, e), loc), st)
+        end
+      | DOnError _ => (d, st)
+
+fun prepare (ds, ps) =
+    let
+        val (ds, st) = ListUtil.foldlMap prepDecl St.empty ds
+    in
+        ((DPreparedStatements (St.list st), ErrorMsg.dummySpan) :: ds, ps)
+    end
+
+end
diff --git a/src/prim.sig b/src/prim.sig
new file mode 100644
index 0000000..1da53d3
--- /dev/null
+++ b/src/prim.sig
@@ -0,0 +1,49 @@
+(* Copyright (c) 2008, 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature PRIM = sig
+
+    datatype string_mode = Normal | Html
+
+    datatype t =
+             Int of Int64.int
+           | Float of Real64.real
+           | String of string_mode * string
+           | Char of char
+
+    val p_t : t Print.printer
+    val p_t_GCC : t Print.printer
+
+    val equal : t * t -> bool
+    val compare : t * t -> order
+
+    val toString : t -> string
+
+    val toCString : string -> string
+    (* SML's built-in [String.toCString] gets confused by single quotes! *)
+
+end
diff --git a/src/prim.sml b/src/prim.sml
new file mode 100644
index 0000000..1de4fc7
--- /dev/null
+++ b/src/prim.sml
@@ -0,0 +1,119 @@
+(* Copyright (c) 2008, 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Prim :> PRIM = struct
+
+datatype string_mode = Normal | Html
+
+datatype t =
+         Int of Int64.int
+       | Float of Real64.real
+       | String of string_mode * string
+       | Char of char
+
+open Print.PD
+open Print
+
+fun p_t t =
+    case t of
+        Int n => string (Int64.toString n)
+      | Float n => string (Real64.toString n)
+      | String (_, s) => box [string "\"", string (String.toString s), string "\""]
+      | Char ch => box [string "#\"", string (String.toString (String.str ch)), string "\""]
+
+fun int2s n =
+    if Int64.compare (n, Int64.fromInt 0) = LESS then
+        "-" ^ Int64.toString (Int64.~ n) ^ "LL"
+    else
+        Int64.toString n ^ "LL"
+
+fun int2s' n =
+    if Int64.compare (n, Int64.fromInt 0) = LESS then
+        "-" ^ Int64.toString (Int64.~ n)
+    else
+        Int64.toString n
+
+val float2s = String.translate (fn #"~" => "-" | ch => str ch) o Real64.toString
+
+fun toString t =
+    case t of
+        Int n => int2s' n
+      | Float n => float2s n
+      | String (_, s) => s
+      | Char ch => str ch
+
+fun pad (n, ch, s) =
+    if size s >= n then
+        s
+    else
+        str ch ^ pad (n-1, ch, s)
+
+fun quoteDouble ch =
+    case ch of
+        #"'" => str ch
+      | _ => Char.toCString ch
+
+fun toCChar ch =
+    case ch of
+        #"\"" => str ch
+      | _ => Char.toCString ch
+
+val toCString = String.translate quoteDouble
+
+fun p_t_GCC t =
+    case t of
+        Int n => string (int2s n)
+      | Float n => string (float2s n)
+      | String (_, s) => box [string "\"", string (toCString s), string "\""]
+      | Char ch => box [string "'", string (toCChar ch), string "'"]
+
+fun equal x =
+    case x of
+        (Int n1, Int n2) => n1 = n2
+      | (Float n1, Float n2) => Real64.== (n1, n2)
+      | (String (_, s1), String (_, s2)) => s1 = s2
+      | (Char ch1, Char ch2) => ch1 = ch2
+
+      | _ => false
+
+fun compare (p1, p2) =
+    case (p1, p2) of
+        (Int n1, Int n2) => Int64.compare (n1, n2)
+      | (Int _, _) => LESS
+      | (_, Int _) => GREATER
+
+      | (Float n1, Float n2) => Real64.compare (n1, n2)
+      | (Float _, _) => LESS
+      | (_, Float _) => GREATER 
+
+      | (String (_, n1), String (_, n2)) => String.compare (n1, n2)
+      | (String _, _) => LESS
+      | (_, String _) => GREATER
+
+      | (Char ch1, Char ch2) => Char.compare (ch1, ch2)
+
+end
diff --git a/src/print.sig b/src/print.sig
new file mode 100644
index 0000000..7467e04
--- /dev/null
+++ b/src/print.sig
@@ -0,0 +1,64 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing *)
+
+signature PRINT = sig
+    structure PD : PP_DESC
+                       where type PPS.token = string
+          and type PPS.device = TextIOPP.device
+          and type PPS.stream = TextIOPP.stream
+
+    type 'a printer = 'a -> PD.pp_desc
+
+    val box : PD.pp_desc list -> PD.pp_desc
+    val parenIf : bool -> PD.pp_desc -> PD.pp_desc
+    val space : PD.pp_desc
+
+    val p_list_sep : PD.pp_desc -> 'a printer -> 'a list printer
+    val p_list : 'a printer -> 'a list printer
+
+    val p_list_sepi : PD.pp_desc -> (int -> 'a printer) -> 'a list printer
+
+    val fprint : PD.PPS.stream -> PD.pp_desc -> unit
+    val print : PD.pp_desc -> unit
+    val eprint : PD.pp_desc -> unit
+
+    val fpreface : PD.PPS.stream -> string * PD.pp_desc -> unit
+    val preface : string * PD.pp_desc -> unit
+    val epreface : string * PD.pp_desc -> unit
+
+    val fprefaces : PD.PPS.stream -> string -> (string * PD.pp_desc) list -> unit
+    val prefaces : string -> (string * PD.pp_desc) list -> unit
+    val eprefaces : string -> (string * PD.pp_desc) list -> unit
+
+    val fprefaces' : PD.PPS.stream -> (string * PD.pp_desc) list -> unit
+    val prefaces' : (string * PD.pp_desc) list -> unit
+    val eprefaces' : (string * PD.pp_desc) list -> unit
+
+    val openOut : {dst : TextIO.outstream, wid : int} -> PD.PPS.stream
+end
diff --git a/src/print.sml b/src/print.sml
new file mode 100644
index 0000000..d4059ed
--- /dev/null
+++ b/src/print.sml
@@ -0,0 +1,127 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Generic printing support code *)
+
+structure Print :> PRINT = struct
+
+structure SM = TextIOPP
+structure PD = PPDescFn(SM)
+
+val openOut = SM.openOut
+
+type 'a printer = 'a -> PD.pp_desc
+
+fun box ds = PD.hovBox (PD.PPS.Rel 1, ds)
+fun parenIf b d =
+    if b then
+        box [PD.string "(", d, PD.string ")"]
+    else
+        d
+val space = PD.space 1
+
+val out = SM.openOut {dst = TextIO.stdOut, wid = 70}
+val err = SM.openOut {dst = TextIO.stdErr, wid = 70}
+
+fun p_list_sep sep f ls =
+    case ls of
+        [] => PD.string ""
+      | [x] => f x
+      | x :: rest =>
+        let
+            val tokens = foldr (fn (x, tokens) =>
+                                   sep :: PD.cut :: f x :: tokens)
+                               [] rest
+        in
+            box (f x :: tokens)
+        end
+fun p_list f = p_list_sep (box [PD.string ",", space]) f
+
+fun p_list_sepi sep f ls =
+    case ls of
+        [] => PD.string ""
+      | [x] => f 0 x
+      | x :: rest =>
+        let
+            val tokens = ListUtil.foldri (fn (n, x, tokens) =>
+                                             sep :: PD.cut :: f (n + 1) x :: tokens)
+                                         [] rest
+        in
+            box (f 0 x :: tokens)
+        end
+
+fun fprint f d = (PD.description (f, d);
+                  PD.PPS.flushStream f)
+val print = fprint out
+val eprint = fprint err
+
+fun fpreface f (s, d) =
+    fprint f (PD.hovBox (PD.PPS.Rel 0,
+		         [PD.string s, PD.space 1, d, PD.newline]))
+
+val preface = fpreface out
+val epreface = fpreface err
+
+fun fprefaces f s ls =
+    let
+        val len = foldl (fn ((s, _), best) =>
+                            Int.max (size s, best)) 0 ls
+    in
+        fprint f (PD.string s);
+        fprint f PD.newline;
+        app (fn (s, d) =>
+                let
+                    val s = CharVector.tabulate (len - size s,
+                                                 fn _ => #" ")
+                            ^ s ^ ": "
+                in
+                    fpreface f (s, d)
+                end) ls
+    end
+
+val prefaces = fprefaces out
+val eprefaces = fprefaces err
+
+fun fprefaces' f ls =
+    let
+        val len = foldl (fn ((s, _), best) =>
+                            Int.max (size s, best)) 0 ls
+    in
+        app (fn (s, d) =>
+                let
+                    val s = CharVector.tabulate (len - size s,
+                                                 fn _ => #" ")
+                            ^ s ^ ": "
+                in
+                    fpreface f (s, d)
+                end) ls
+    end
+
+val prefaces' = fprefaces' out
+val eprefaces' = fprefaces' err
+
+end
diff --git a/src/reduce.sig b/src/reduce.sig
new file mode 100644
index 0000000..0a28a59
--- /dev/null
+++ b/src/reduce.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program algebraically *)
+
+signature REDUCE = sig
+
+    val reduce : Core.file -> Core.file
+    
+end
diff --git a/src/reduce.sml b/src/reduce.sml
new file mode 100644
index 0000000..04cec16
--- /dev/null
+++ b/src/reduce.sml
@@ -0,0 +1,953 @@
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program algebraically *)
+
+structure Reduce :> REDUCE = struct
+
+open Core
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+structure E = CoreEnv
+
+fun multiLiftConInCon n c =
+    if n = 0 then
+        c
+    else
+        multiLiftConInCon (n - 1) (E.liftConInCon 0 c)
+
+fun multiLiftExpInExp n e =
+    if n = 0 then
+        e
+    else
+        multiLiftExpInExp (n - 1) (E.liftExpInExp 0 e)
+
+val count = CoreUtil.Exp.foldB {kind = fn (_, _, c) => c,
+                                con = fn (_, _, c) => c,
+                                exp = fn (x, e, c) =>
+                                         case e of
+                                             ERel x' => if x = x' then c + 1 else c
+                                           | _ => c,
+                                bind = fn (x, b) =>
+                                          case b of
+                                              CoreUtil.Exp.RelE _ => x+1
+                                            | _ => x} 0 0
+
+val dangling =
+    CoreUtil.Exp.existsB {kind = fn _ => false,
+                          con = fn _ => false,
+                          exp = fn (n, e) =>
+                                   case e of
+                                       ERel n' => n' >= n
+                                     | _ => false,
+                          bind = fn (n, b) =>
+                                    case b of
+                                        CoreUtil.Exp.RelE _ => n + 1
+                                      | _ => n}
+
+val cdangling =
+    CoreUtil.Exp.existsB {kind = fn _ => false,
+                          con = fn (n, c) =>
+                                   case c of
+                                       CRel n' => n' >= n
+                                     | _ => false,
+                          exp = fn _ => false,
+                          bind = fn (n, b) =>
+                                    case b of
+                                        CoreUtil.Exp.RelC _ => n + 1
+                                      | _ => n}
+
+datatype env_item =
+         UnknownK
+       | KnownK of kind
+
+       | UnknownC
+       | KnownC of con
+
+       | UnknownE
+       | KnownE of exp
+
+       | Lift of int * int * int
+
+val edepth = foldl (fn (UnknownE, n) => n + 1
+                     | (KnownE _, n) => n + 1
+                     | (_, n) => n) 0
+
+val edepth' = foldl (fn (UnknownE, n) => n + 1
+                      | (KnownE _, n) => n + 1
+                      | (Lift (_, _, n'), n) => n + n'
+                      | (_, n) => n) 0
+
+val cdepth = foldl (fn (UnknownC, n) => n + 1
+                     | (KnownC _, n) => n + 1
+                     | (_, n) => n) 0
+
+val cdepth' = foldl (fn (UnknownC, n) => n + 1
+                      | (KnownC _, n) => n + 1
+                      | (Lift (_, n', _), n) => n + n'
+                      | (_, n) => n) 0
+
+type env = env_item list
+
+fun ei2s ei =
+    case ei of
+        UnknownK => "UK"
+      | KnownK _ => "KK"
+      | UnknownC => "UC"
+      | KnownC _ => "KC"
+      | UnknownE => "UE"
+      | KnownE _ => "KE"
+      | Lift (_, n1, n2) => "(" ^ Int.toString n1 ^ ", " ^ Int.toString n2 ^ ")"
+
+fun e2s env = String.concatWith " " (map ei2s env)
+
+(*val deKnown = List.filter (fn KnownC _ => false
+                            | KnownE _ => false
+                            | KnownK _ => false
+                            | _ => true)*)
+
+val deKnown = ListUtil.mapConcat (fn KnownC _ => []
+                                   | KnownE _ => []
+                                   | KnownK _ => []
+                                   | Lift (nk, nc, ne) => List.tabulate (nk, fn _ => UnknownK)
+                                                          @ List.tabulate (nc, fn _ => UnknownC)
+                                                          @ List.tabulate (ne, fn _ => UnknownE)
+                                   | x => [x])
+
+datatype result = Yes of env | No | Maybe
+
+fun match (env, p : pat, e : exp) =
+    let
+        val baseline = length env
+
+        fun match (env, p, e) =
+            case (#1 p, #1 e) of
+                (PVar (x, t), _) => Yes (KnownE (multiLiftExpInExp (length env - baseline) e) :: env)
+
+              | (PPrim p, EPrim p') =>
+                if Prim.equal (p, p') then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConVar n1, _, NONE), ECon (_, PConVar n2, _, NONE)) =>
+                if n1 = n2 then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConVar n1, _, SOME p), ECon (_, PConVar n2, _, SOME e)) =>
+                if n1 = n2 then
+                    match (env, p, e)
+                else
+                    No
+
+              | (PCon (_, PConFfi {mod = m1, con = con1, ...}, _, NONE),
+                 ECon (_, PConFfi {mod = m2, con = con2, ...}, _, NONE)) =>
+                if m1 = m2 andalso con1 = con2 then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConFfi {mod = m1, con = con1, ...}, _, SOME ep),
+                 ECon (_, PConFfi {mod = m2, con = con2, ...}, _, SOME e)) =>
+                if m1 = m2 andalso con1 = con2 then
+                    match (env, p, e)
+                else
+                    No
+
+              | (PRecord xps, ERecord xes) =>
+                if List.exists (fn ((CName _, _), _, _) => false
+                                 | _ => true) xes then
+                    Maybe
+                else
+                    let
+                        fun consider (xps, env) =
+                            case xps of
+                                [] => Yes env
+                              | (x, p, _) :: rest =>
+                                case List.find (fn ((CName x', _), _, _) => x' = x
+                                                 | _ => false) xes of
+                                    NONE => No
+                                  | SOME (_, e, _) =>
+                                    case match (env, p, e) of
+                                        No => No
+                                      | Maybe => Maybe
+                                      | Yes env => consider (rest, env)
+                    in
+                        consider (xps, env)
+                    end
+
+              | _ => Maybe
+    in
+        match (env, p, e)
+    end
+
+fun returnType m loc =
+    (TCFun ("a", (KType, loc),
+            (TFun ((CRel 0, loc),
+                   (CApp (multiLiftConInCon 1 m, (CRel 0, loc)), loc)), loc)), loc)
+
+fun bindType m loc =
+    (TCFun ("a", (KType, loc),
+            (TCFun ("b", (KType, loc),
+                    (TFun ((CApp (multiLiftConInCon 2 m, (CRel 1, loc)), loc),
+                           (TFun ((TFun ((CRel 1, loc),
+                                         (CApp (multiLiftConInCon 2 m, (CRel 0, loc)), loc)),
+                                   loc),
+                                  (CApp (multiLiftConInCon 2 m, (CRel 0, loc)), loc)), loc)),
+                     loc)), loc)), loc)
+
+fun monadRecord m loc =
+    (TRecord (CRecord ((KType, loc),
+                       [((CName "Return", loc),
+                         returnType m loc),
+                        ((CName "Bind", loc),
+                         bindType m loc)]), loc), loc)
+
+fun passive (e : exp) =
+    case #1 e of
+        EPrim _ => true
+      | ERel _ => true
+      | ENamed _ => true
+      | ECon (_, _, _, NONE) => true
+      | ECon (_, _, _, SOME e) => passive e
+      | EFfi _ => true
+      | EAbs _ => true
+      | ECAbs _ => true
+      | EKAbs _ => true
+      | ERecord xes => List.all (passive o #2) xes
+      | EField (e, _, _) => passive e
+      | _ => false
+
+fun notFfi (t : con) =
+    case #1 t of
+        CFfi _ => false
+      | _ => true
+
+fun kindConAndExp (namedC, namedE) =
+    let
+        fun kind env (all as (k, loc)) =
+            case k of
+                KType => all
+              | KArrow (k1, k2) => (KArrow (kind env k1, kind env k2), loc)
+              | KName => all
+              | KRecord k => (KRecord (kind env k), loc)
+              | KUnit => all
+              | KTuple ks => (KTuple (map (kind env) ks), loc)
+
+              | KRel n =>
+                let
+                    fun find (n', env, nudge, lift) =
+                        case env of
+                            [] => raise Fail "Reduce.kind: KRel"
+                          | UnknownC :: rest => find (n', rest, nudge, lift)
+                          | KnownC _ :: rest => find (n', rest, nudge, lift)
+                          | UnknownE :: rest => find (n', rest, nudge, lift)
+                          | KnownE _ :: rest => find (n', rest, nudge, lift)
+                          | Lift (lift', _, _) :: rest => find (n', rest, nudge + lift', lift + lift')
+                          | UnknownK :: rest =>
+                            if n' = 0 then
+                                (KRel (n + nudge), loc)
+                            else
+                                find (n' - 1, rest, nudge, lift + 1)
+                          | KnownK k :: rest =>
+                            if n' = 0 then
+                                kind (Lift (lift, 0, 0) :: rest) k
+                            else
+                                find (n' - 1, rest, nudge - 1, lift)
+                in
+                    find (n, env, 0, 0)
+                end
+              | KFun (x, k) => (KFun (x, kind (UnknownK :: env) k), loc)
+
+        fun con env (all as (c, loc)) =
+            ((*Print.prefaces "con" [("c", CorePrint.p_con CoreEnv.empty all)];*)
+            case c of
+                TFun (c1, c2) => (TFun (con env c1, con env c2), loc)
+              | TCFun (x, k, c2) => (TCFun (x, kind env k, con (UnknownC :: env) c2), loc)
+              | TKFun (x, c2) => (TKFun (x, con (UnknownK :: env) c2), loc)
+              | TRecord c => (TRecord (con env c), loc)
+
+              | CRel n =>
+                let
+                    fun find (n', env, nudge, liftK, liftC) =
+                        case env of
+                            [] => raise Fail "Reduce.con: CRel"
+                          | UnknownK :: rest => find (n', rest, nudge, liftK + 1, liftC)
+                          | KnownK _ :: rest => find (n', rest, nudge, liftK, liftC)
+                          | UnknownE :: rest => find (n', rest, nudge, liftK, liftC)
+                          | KnownE _ :: rest => find (n', rest, nudge, liftK, liftC)
+                          | Lift (liftK', liftC', _) :: rest => find (n', rest, nudge + liftC',
+                                                                      liftK + liftK', liftC + liftC')
+                          | UnknownC :: rest =>
+                            if n' = 0 then
+                                (CRel (n + nudge), loc)
+                            else
+                                find (n' - 1, rest, nudge, liftK, liftC + 1)
+                          | KnownC c :: rest =>
+                            if n' = 0 then
+                                con (Lift (liftK, liftC, 0) :: rest) c
+                            else
+                                find (n' - 1, rest, nudge - 1, liftK, liftC)
+                in
+                    (*print (Int.toString n ^ ": " ^ e2s env ^ "\n");*)
+                    find (n, env, 0, 0, 0)
+                end
+
+              | CNamed n =>
+                (case IM.find (namedC, n) of
+                     NONE => all
+                   | SOME c => c)
+
+              | CFfi ("Basis", "monad") => (CAbs ("m", (KArrow ((KType, loc), (KType, loc)), loc), monadRecord (CRel 0, loc) loc), loc)
+
+              | CFfi _ => all
+              | CApp (c1, c2) =>
+                let
+                    val c1 = con env c1
+                    val c2 = con env c2
+                in
+                    case #1 c1 of
+                        CAbs (_, _, b) =>
+                        con (KnownC c2 :: deKnown env) b
+
+                      | CApp ((CMap (dom, ran), _), f) =>
+                        (case #1 c2 of
+                             CRecord (_, []) => (CRecord (kind env ran, []), loc)
+                           | CRecord (_, (x, c) :: rest) =>
+                             con (deKnown env)
+                                 (CConcat ((CRecord (ran, [(x, (CApp (f, c), loc))]), loc),
+                                           (CApp (c1, (CRecord (kind env dom, rest), loc)), loc)), loc)
+                           | _ => (CApp (c1, c2), loc))                           
+
+                      | _ => (CApp (c1, c2), loc)
+                end
+              | CAbs (x, k, b) => (CAbs (x, kind env k, con (UnknownC :: env) b), loc)
+
+              | CKApp (c1, k) =>
+                let
+                    val c1 = con env c1
+                in
+                    case #1 c1 of
+                        CKAbs (_, b) =>
+                        con (KnownK k :: deKnown env) b
+
+                      | _ => (CKApp (c1, kind env k), loc)
+                end
+              | CKAbs (x, b) => (CKAbs (x, con (UnknownK :: env) b), loc)
+
+              | CName _ => all
+
+              | CRecord (k, xcs) => (CRecord (kind env k, map (fn (x, c) => (con env x, con env c)) xcs), loc)
+              | CConcat (c1, c2) =>
+                let
+                    val c1 = con env c1
+                    val c2 = con env c2
+                in
+                    case (#1 c1, #1 c2) of
+                        (CRecord (k, xcs1), CRecord (_, xcs2)) =>
+                        (CRecord (kind env k, xcs1 @ xcs2), loc)
+                      | (CRecord (_, []), _) => c2
+                      | (_, CRecord (_, [])) => c1
+                      | _ => (CConcat (c1, c2), loc)
+                end
+              | CMap (dom, ran) => (CMap (kind env dom, kind env ran), loc)
+
+              | CUnit => all
+
+              | CTuple cs => (CTuple (map (con env) cs), loc)
+              | CProj (c, n) =>
+                let
+                    val c = con env c
+                in
+                    case #1 c of
+                        CTuple cs => List.nth (cs, n - 1)
+                      | _ => (CProj (c, n), loc)
+                end)
+
+        fun patCon pc =
+            case pc of
+                PConVar _ => pc
+              | PConFfi {mod = m, datatyp, params, con = c, arg, kind} =>
+                PConFfi {mod = m, datatyp = datatyp, params = params, con = c,
+                         arg = Option.map (con (map (fn _ => UnknownC) params)) arg,
+                         kind = kind}
+
+
+        val k = (KType, ErrorMsg.dummySpan)
+        fun doPart e (this as (x, t), rest) =
+            ((x, (EField (e, x, {field = t, rest = (CRecord (k, rest), #2 t)}), #2 t), t),
+             this :: rest)
+
+        fun exp env (all as (e, loc)) =
+            let
+                (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
+                                               ("env", Print.PD.string (e2s env))]*)
+                (*val () = if dangling (edepth env) all then
+                             (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
+                                                    ("env", Print.PD.string (e2s env))];
+                              raise Fail "!")
+                         else
+                             ()*)
+                (*val () = if cdangling (cdepth env) all then
+                             Print.prefaces "Bad exp" [("e", CorePrint.p_exp CoreEnv.empty all),
+                                                       ("env", Print.PD.string (e2s env))]
+                         else
+                             ()*)
+
+                fun patBinds (p, _) =
+                    case p of
+                        PVar _ => 1
+                      | PPrim _ => 0
+                      | PCon (_, _, _, NONE) => 0
+                      | PCon (_, _, _, SOME p) => patBinds p
+                      | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
+
+                val r = case e of
+                            EPrim _ => all
+                          | ERel n =>
+                            let
+                                fun find (n', env, nudge, liftK, liftC, liftE) =
+                                    case env of
+                                        [] => raise Fail ("Reduce.exp: ERel (" ^ ErrorMsg.spanToString loc ^ ")")
+                                      | UnknownK :: rest => find (n', rest, nudge, liftK + 1, liftC, liftE)
+                                      | KnownK _ :: rest => find (n', rest, nudge, liftK, liftC, liftE)
+                                      | UnknownC :: rest => find (n', rest, nudge, liftK, liftC + 1, liftE)
+                                      | KnownC _ :: rest => find (n', rest, nudge, liftK, liftC, liftE)
+                                      | Lift (liftK', liftC', liftE') :: rest =>
+                                        find (n', rest, nudge + liftE',
+                                              liftK + liftK', liftC + liftC', liftE + liftE')
+                                      | UnknownE :: rest =>
+                                        if n' = 0 then
+                                            (ERel (n + nudge), loc)
+                                        else
+                                            find (n' - 1, rest, nudge, liftK, liftC, liftE + 1)
+                                      | KnownE e :: rest =>
+                                        if n' = 0 then
+                                            ((*print "SUBSTITUTING\n";*)
+                                             exp (Lift (liftK, liftC, liftE) :: rest) e)
+                                        else
+                                            find (n' - 1, rest, nudge - 1, liftK, liftC, liftE)
+                            in
+                                (*print (Int.toString n ^ ": " ^ e2s env ^ "\n");*)
+                                find (n, env, 0, 0, 0, 0)
+                            end
+                          | ENamed n =>
+                            (case IM.find (namedE, n) of
+                                 NONE => all
+                               | SOME e => e)
+                          | ECon (dk, pc, cs, eo) => (ECon (dk, patCon pc,
+                                                            map (con env) cs, Option.map (exp env) eo), loc)
+
+                          | EFfi ("Basis", "return") =>
+                            (ECAbs ("m", (KArrow ((KType, loc), (KType, loc)), loc),
+                                    (ECAbs ("a", (KType, loc),
+                                            (EAbs ("m", monadRecord (CRel 1, loc) loc, returnType (CRel 1, loc) loc,
+                                                   (ECApp ((EField ((ERel 0, loc), (CName "Return", loc),
+                                                                    {field = returnType (CRel 1, loc) loc,
+                                                                     rest = (CRecord ((KType, loc),
+                                                                                      [((CName "Bind", loc), bindType (CRel 1, loc) loc)]),
+                                                                             loc)}), loc), (CRel 0, loc)), loc)), loc)), loc)), loc)
+
+                          | EFfi ("Basis", "bind") =>
+                            (ECAbs ("m", (KArrow ((KType, loc), (KType, loc)), loc),
+                                    (ECAbs ("a", (KType, loc),
+                                            (ECAbs ("b", (KType, loc),
+                                                    (EAbs ("m", monadRecord (CRel 2, loc) loc, bindType (CRel 2, loc) loc,
+                                                           (ECApp ((ECApp ((EField ((ERel 0, loc), (CName "Bind", loc),
+                                                                                    {field = bindType (CRel 2, loc) loc,
+                                                                                     rest = (CRecord ((KType, loc),
+                                                                                                      [((CName "Return", loc),
+                                                                                                        returnType (CRel 2, loc) loc)]),
+                                                                                             loc)}), loc), (CRel 1, loc)), loc),
+                                                                  (CRel 0, loc)), loc)), loc)), loc)), loc)), loc)
+
+                          | EFfi ("Basis", "mkMonad") =>
+                            (ECAbs ("m", (KArrow ((KType, loc), (KType, loc)), loc),
+                                    (EAbs ("m", monadRecord (CRel 0, loc) loc, monadRecord (CRel 0, loc) loc,
+                                           (ERel 0, loc)), loc)), loc)
+
+                          | EFfi ("Basis", "transaction_monad") =>
+                            (ERecord [((CName "Return", loc),
+                                       (EFfi ("Basis", "transaction_return"), loc),
+                                       returnType (CFfi ("Basis", "transaction"), loc) loc),
+                                      ((CName "Bind", loc),
+                                       (EFfi ("Basis", "transaction_bind"), loc),
+                                       bindType (CFfi ("Basis", "transaction"), loc) loc)], loc)
+
+                          | EFfi ("Basis", "signal_monad") =>
+                            (ERecord [((CName "Return", loc),
+                                       (EFfi ("Basis", "signal_return"), loc),
+                                       returnType (CFfi ("Basis", "signal"), loc) loc),
+                                      ((CName "Bind", loc),
+                                       (EFfi ("Basis", "signal_bind"), loc),
+                                       bindType (CFfi ("Basis", "signal"), loc) loc)], loc)
+
+                          | EFfi _ => all
+                          | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc)
+
+                          (*| EApp (
+                           (EApp
+                                ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
+                                        (EFfi ("Basis", "transaction_monad"), _)), _),
+                                 (ECase (ed, pes, {disc, ...}), _)), _),
+                           trans2) =>
+                           let
+                               val e' = (EFfi ("Basis", "bind"), loc)
+                               val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                               val e' = (ECApp (e', t1), loc)
+                               val e' = (ECApp (e', t2), loc)
+                               val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+
+                               val pes = map (fn (p, e) =>
+                                                 let
+                                                     val e' = (EApp (e', e), loc)
+                                                     val e' = (EApp (e',
+                                                                     multiLiftExpInExp (E.patBindsN p)
+                                                                                       trans2), loc)
+                                                     val e' = exp env e'
+                                                 in
+                                                     (p, e')
+                                                 end) pes
+                           in
+                               (ECase (exp env ed,
+                                       pes,
+                                       {disc = con env disc,
+                                        result = (CApp ((CFfi ("Basis", "transaction"), loc), con env t2), loc)}),
+                                loc)
+                           end*)
+
+                          | EApp (e1, e2) =>
+                            let
+                                val env' = deKnown env
+
+                                val e1 = exp env e1
+                                val e2 = exp env e2
+                            in
+                                case #1 e1 of
+                                    ELet (x, t, e1', e2') =>
+                                    (ELet (x, t, e1', exp (UnknownE :: env') (EApp (e2', E.liftExpInExp 0 e2), loc)), loc)
+
+                                  | EAbs (x, dom, _, b) =>
+                                    if count b <= 1 orelse passive e2 orelse ESpecialize.functionInside IS.empty dom then
+                                        let
+                                            val r = exp (KnownE e2 :: env') b
+                                        in
+                                            (*Print.prefaces "eapp" [("b", CorePrint.p_exp CoreEnv.empty b),
+                                                                     ("env", Print.PD.string (e2s env')),
+                                                                     ("e2", CorePrint.p_exp CoreEnv.empty e2),
+                                                                     ("r", CorePrint.p_exp CoreEnv.empty r)];*)
+                                            r
+                                        end
+                                    else
+                                        let
+                                            val dom = con env' dom
+                                            val r = exp (UnknownE :: env') b
+                                        in
+                                            (*Print.prefaces "El skippo" [("x", Print.PD.string x),
+                                                                        ("e2", CorePrint.p_exp CoreEnv.empty e2)];*)
+                                            (ELet (x, dom, e2, r), loc)
+                                        end
+
+                                  | ECase (e, pes, cc as {disc, result = res as (TFun (_, c2), _)}) =>
+                                    let
+                                        val pes' = map (fn (p, body) =>
+                                                           let
+                                                               val env' = List.tabulate (patBinds p, fn _ => UnknownE) @ deKnown env
+                                                               val body' = exp env' (EApp (body, multiLiftExpInExp (patBinds p) e2), #2 body)
+                                                           in
+                                                               (p, body')
+                                                           end) pes
+
+                                        val cc' = {disc = con env' disc, result = con env' c2}
+                                    in
+                                        (ECase (e, pes', cc'), loc)
+                                    end
+                                  | _ => (EApp (e1, e2), loc)
+                            end
+
+                          | EAbs (x, dom, ran, e) => (EAbs (x, con env dom, con env ran, exp (UnknownE :: env) e), loc)
+
+                          | ECApp (e, c) =>
+                            let
+                                val e = exp env e
+                                val c = con env c
+                            in
+                                case #1 e of
+                                    ECAbs (_, _, b) =>
+                                    let
+                                        val r = exp (KnownC c :: deKnown env) b
+                                    in
+                                        (*Print.prefaces "csub" [("l", Print.PD.string (ErrorMsg.spanToString loc)),
+                                                               ("env", Print.PD.string (e2s (deKnown env))),
+                                                               ("b", CorePrint.p_exp CoreEnv.empty b),
+                                                               ("c", CorePrint.p_con CoreEnv.empty c),
+                                                               ("r", CorePrint.p_exp CoreEnv.empty r)];*)
+                                        r
+                                    end
+                                  | ECase (e, pes, cc as {disc, result = res as (TCFun (_, _, c'), _)}) =>
+                                    let
+                                        val pes' = map (fn (p, body) =>
+                                                        let
+                                                            val env' = List.tabulate (patBinds p, fn _ => UnknownE) @ deKnown env
+
+                                                            val body' = exp env' (ECApp (body, c), #2 body)
+                                                        in
+                                                            (p, body')
+                                                        end) pes
+
+                                        val c' = E.subConInCon (0, c) c'
+                                        val cc' = {disc = con env disc, result = con env c'}
+                                    in
+                                        (ECase (e, pes', cc'), loc)
+                                    end
+                                  | _ => (ECApp (e, c), loc)
+                            end
+
+                          | ECAbs (x, k, e) => (ECAbs (x, kind env k, exp (UnknownC :: env) e), loc)
+
+                          | EKApp (e, k) =>
+                            let
+                                val e = exp env e
+                            in
+                                case #1 e of
+                                    EKAbs (_, b) =>
+                                    let
+                                        val r = exp (KnownK k :: deKnown env) b
+                                    in
+                                        (*Print.prefaces "ksub" [("l", Print.PD.string (ErrorMsg.spanToString loc)),
+                                                               ("b", CorePrint.p_exp CoreEnv.empty b),
+                                                               ("k", CorePrint.p_kind CoreEnv.empty k),
+                                                               ("r", CorePrint.p_exp CoreEnv.empty r)];*)
+                                        r
+                                    end
+                                  | _ => (EKApp (e, kind env k), loc)
+                            end
+
+                          | EKAbs (x, e) => (EKAbs (x, exp (UnknownK :: env) e), loc)
+
+                          | ERecord xcs => (ERecord (map (fn (x, e, t) => (con env x, exp env e, con env t)) xcs), loc)
+                          | EField (e, c, {field, rest}) =>
+                            let
+                                val e = exp env e
+                                val c = con env c
+
+                                fun default () = (EField (e, c, {field = con env field, rest = con env rest}), loc)
+                            in
+                                case (#1 e, #1 c) of
+                                    (ERecord xcs, CName x) =>
+                                    (case List.find (fn ((CName x', _), _, _) => x' = x | _ => false) xcs of
+                                         NONE => default ()
+                                       | SOME (_, e, _) => e)
+                                  | _ => default ()
+                            end
+
+                          | EConcat (e1, c1, e2, c2) =>
+                            let
+                                val e1 = exp env e1
+                                val e2 = exp env e2
+                            in
+                                case (#1 e1, #1 e2) of
+                                    (ERecord xes1, ERecord xes2) => (ERecord (xes1 @ xes2), loc)
+                                  | _ =>
+                                    let
+                                        val c1 = con env c1
+                                        val c2 = con env c2
+                                    in
+                                        case (#1 c1, #1 c2) of
+                                            (CRecord (k, xcs1), CRecord (_, xcs2)) =>
+                                            let
+                                                val (xes1, rest) = ListUtil.foldlMap (doPart e1) [] xcs1
+                                                val (xes2, _) = ListUtil.foldlMap (doPart e2) rest xcs2
+                                            in
+                                                exp (deKnown env) (ERecord (xes1 @ xes2), loc)
+                                            end
+                                          | _ => (EConcat (e1, c1, e2, c2), loc)
+                                    end
+                            end
+
+                          | ECut (e, c, {field, rest}) =>
+                            let
+                                val e = exp env e
+                                val c = con env c
+
+                                fun default () =
+                                    let
+                                        val rest = con env rest
+                                    in
+                                        case #1 rest of
+                                            CRecord (k, xcs) =>
+                                            let
+                                                val (xes, _) = ListUtil.foldlMap (doPart e) [] xcs
+                                            in
+                                                exp (deKnown env) (ERecord xes, loc)
+                                            end
+                                          | _ => (ECut (e, c, {field = con env field, rest = rest}), loc)
+                                    end
+                            in
+                                case (#1 e, #1 c) of
+                                    (ERecord xes, CName x) =>
+                                    if List.all (fn ((CName _, _), _, _) => true | _ => false) xes then
+                                        (ERecord (List.filter (fn ((CName x', _), _, _) => x' <> x
+                                                                | _ => raise Fail "Reduce: ECut") xes), loc)
+                                    else
+                                        default ()
+                                  | _ => default ()
+                            end
+
+                          | ECutMulti (e, c, {rest}) =>
+                            let
+                                val e = exp env e
+                                val c = con env c
+
+                                fun default () =
+                                    let
+                                        val rest = con env rest
+                                    in
+                                        case #1 rest of
+                                            CRecord (k, xcs) =>
+                                            let
+                                                val (xes, _) = ListUtil.foldlMap (doPart e) [] xcs
+                                            in
+                                                exp (deKnown env) (ERecord xes, loc)
+                                            end
+                                          | _ => (ECutMulti (e, c, {rest = rest}), loc)
+                                    end
+                            in
+                                case (#1 e, #1 c) of
+                                    (ERecord xes, CRecord (_, xcs)) =>
+                                    if List.all (fn ((CName _, _), _, _) => true | _ => false) xes
+                                       andalso List.all (fn ((CName _, _), _) => true | _ => false) xcs then
+                                        (ERecord (List.filter (fn ((CName x', _), _, _) =>
+                                                                  List.all (fn ((CName x, _), _) => x' <> x
+                                                                             | _ => raise Fail "Reduce: ECutMulti [1]") xcs
+                                                                | _ => raise Fail "Reduce: ECutMulti [2]") xes), loc)
+                                    else
+                                        default ()
+                                  | _ => default ()
+                            end
+
+                          | ECase (_, [((PRecord [], _), e)], _) => exp env e
+
+                          | ECase (e, pes, {disc, result}) =>
+                            let
+                                fun pat (all as (p, loc)) =
+                                    case p of
+                                        PVar (x, t) => (PVar (x, con env t), loc)
+                                      | PPrim _ => all
+                                      | PCon (dk, pc, cs, po) =>
+                                        (PCon (dk, patCon pc, map (con env) cs, Option.map pat po), loc)
+                                      | PRecord xpts => (PRecord (map (fn (x, p, t) => (x, pat p, con env t)) xpts), loc)
+
+                                fun push () =
+                                    (ECase (exp env e,
+                                            map (fn (p, e) => (pat p,
+                                                               exp (List.tabulate (patBinds p,
+                                                                                fn _ => UnknownE) @ env) e))
+                                                pes, {disc = con env disc, result = con env result}), loc)
+
+                                fun search pes =
+                                    case pes of
+                                        [] => push ()
+                                      | (p, body) :: pes =>
+                                        case match (env, p, e) of
+                                            No => search pes
+                                          | Maybe => push ()
+                                          | Yes env' => exp env' body
+                            in
+                                search pes
+                            end
+
+                          | EWrite e => (EWrite (exp env e), loc)
+                          | EClosure (n, es) => (EClosure (n, map (exp env) es), loc)
+
+                          | ELet (x, t, e1, e2) =>
+                            let
+                                val e1' = exp env e1
+
+                                val t = con env t
+                            in
+                                if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside IS.empty t) then
+                                    exp (KnownE e1 :: env) e2
+                                else
+                                    (ELet (x, t, e1', exp (UnknownE :: env) e2), loc)
+                            end
+
+                          | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc)
+            in
+                (*if dangling (edepth' (deKnown env)) r then
+                    (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
+                                           ("r", CorePrint.p_exp CoreEnv.empty r)];
+                     raise Fail "!!")
+                else
+                    ();*)
+                (*if cdangling (cdepth' (deKnown env)) r then
+                    (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
+                                           ("r", CorePrint.p_exp CoreEnv.empty r)];
+                     raise Fail "!!")
+                else
+                    ();*)
+                r
+            end
+    in
+        {kind = kind, con = con, exp = exp}
+    end
+
+fun kind namedC env k = #kind (kindConAndExp (namedC, IM.empty)) env k
+fun con namedC env c = #con (kindConAndExp (namedC, IM.empty)) env c
+fun exp (namedC, namedE) env e = #exp (kindConAndExp (namedC, namedE)) env e
+
+fun reduce file =
+    let
+        val uses = CoreUtil.File.fold {kind = fn (_, m) => m,
+                                       con = fn (_, m) => m,
+                                       exp = fn (e, m) =>
+                                                case e of
+                                                    ENamed n => IM.insert (m, n, 1 + Option.getOpt (IM.find (m, n), 0))
+                                                  | _ => m,
+                                       decl = fn (_, m) => m}
+                                      IM.empty file
+
+        fun isPoly names = CoreUtil.Con.exists {kind = fn _ => false,
+                                                con = fn TCFun _ => true
+                                                       | TKFun _ => true
+                                                       | CNamed n => IS.member (names, n)
+                                                       | _ => false}
+
+        val size = CoreUtil.Exp.fold {kind = fn (_, n) => n,
+                                      con = fn (_, n) => n,
+                                      exp = fn (_, n) => n + 1} 0
+
+        fun mayInline (polyC, n, t, e, s) =
+            let
+                fun isPolicy t =
+                    case #1 t of
+                        CFfi ("Basis", "sql_policy") => true
+                      | TFun (_, t) => isPolicy t
+                      | _ => false
+            in
+                not (Settings.checkNeverInline s) andalso
+                case IM.find (uses, n) of
+                    NONE => false
+                  | SOME count => count <= 1
+                                  orelse (case #1 e of
+                                              ERecord _ => true
+                                            | _ => false)
+                                  orelse isPolicy t
+                                  orelse isPoly polyC t
+                                  orelse size e <= Settings.getCoreInline ()
+            end
+
+        fun doDecl (d as (_, loc), st as (polyC, namedC, namedE)) =
+            case #1 d of
+                DCon (x, n, k, c) =>
+                let
+                    val k = kind namedC [] k
+                    val c = con namedC [] c
+                in
+                    ((DCon (x, n, k, c), loc),
+                     (if isPoly polyC c then
+                          IS.add (polyC, n)
+                      else
+                          polyC,
+                      IM.insert (namedC, n, c),
+                      namedE))
+                end
+              | DDatatype dts =>
+                ((DDatatype (map (fn (x, n, ps, cs) =>
+                                     let
+                                         val env = map (fn _ => UnknownC) ps
+                                     in
+                                         (x, n, ps, map (fn (x, n, co) => (x, n, Option.map (con namedC env) co)) cs)
+                                     end) dts), loc),
+                 (if List.exists (fn (_, _, _, cs) => List.exists (fn (_, _, co) => case co of
+                                                                                        NONE => false
+                                                                                      | SOME c => isPoly polyC c) cs)
+                                 dts then
+                      foldl (fn ((_, n, _, _), polyC) => IS.add (polyC, n)) polyC dts
+                  else
+                      polyC,
+                  namedC,
+                  namedE))
+              | DVal (x, n, t, e, s) =>
+                let
+                    val t = con namedC [] t
+                    val e = exp (namedC, namedE) [] e
+                in
+                    ((DVal (x, n, t, e, s), loc),
+                     (polyC,
+                      namedC,
+                      if mayInline (polyC, n, t, e, s) then
+                          IM.insert (namedE, n, e)
+                      else
+                          namedE))
+                end
+              | DValRec vis =>
+                ((DValRec (map (fn (x, n, t, e, s) => (x, n, con namedC [] t,
+                                                       exp (namedC, namedE) [] e, s)) vis), loc),
+                 st)
+              | DExport _ => (d, st)
+              | DTable (s, n, c, s', pe, pc, ce, cc) => ((DTable (s, n, con namedC [] c, s',
+                                                                  exp (namedC, namedE) [] pe,
+                                                                  con namedC [] pc,
+                                                                  exp (namedC, namedE) [] ce,
+                                                                  con namedC [] cc), loc), st)
+              | DSequence _ => (d, st)
+              | DView (s, n, s', e, c) => ((DView (s, n, s', exp (namedC, namedE) [] e, con namedC [] c), loc), st)
+              | 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)
+              | DTask (e1, e2) =>
+                let
+                    val e1 = exp (namedC, namedE) [] e1
+                    val e2 = exp (namedC, namedE) [] e2
+                in
+                    ((DTask (e1, e2), loc),
+                     (polyC,
+                      namedC,
+                      namedE))
+                end
+              | DPolicy e1 =>
+                let
+                    val e1 = exp (namedC, namedE) [] e1
+                in
+                    ((DPolicy e1, loc),
+                     (polyC,
+                      namedC,
+                      namedE))
+                end
+              | DOnError _ => (d, st)
+
+        val (file, _) = ListUtil.foldlMap doDecl (IS.empty, IM.empty, IM.empty) file
+    in
+        file
+    end
+
+end
diff --git a/src/reduce_local.sig b/src/reduce_local.sig
new file mode 100644
index 0000000..ebc22c5
--- /dev/null
+++ b/src/reduce_local.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program algebraically, without unfolding definitions *)
+
+signature REDUCE_LOCAL = sig
+
+    val reduce : Core.file -> Core.file
+    val reduceExp : Core.exp -> Core.exp
+    val reduceCon : Core.con -> Core.con
+    
+end
diff --git a/src/reduce_local.sml b/src/reduce_local.sml
new file mode 100644
index 0000000..06f49fe
--- /dev/null
+++ b/src/reduce_local.sml
@@ -0,0 +1,386 @@
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program algebraically, without unfolding definitions *)
+
+structure ReduceLocal :> REDUCE_LOCAL = struct
+
+open Core
+
+structure IM = IntBinaryMap
+
+fun multiLiftExpInExp n e =
+    if n = 0 then
+        e
+    else
+        multiLiftExpInExp (n - 1) (CoreEnv.liftExpInExp 0 e)
+
+datatype env_item =
+         Unknown
+       | Known of exp
+
+       | UnknownC
+       | KnownC of con
+
+       | Lift of int * int
+
+type env = env_item list
+
+val deKnown = List.filter (fn Known _ => false
+                            | KnownC _ => false
+                            | _ => true)
+
+datatype result = Yes of env | No | Maybe
+
+fun match (env, p : pat, e : exp) =
+    let
+        val baseline = length env
+
+        fun match (env, p, e) =
+            case (#1 p, #1 e) of
+                (PVar (x, t), _) => Yes (Known (multiLiftExpInExp (length env - baseline) e) :: env)
+
+              | (PPrim p, EPrim p') =>
+                if Prim.equal (p, p') then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConVar n1, _, NONE), ECon (_, PConVar n2, _, NONE)) =>
+                if n1 = n2 then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConVar n1, _, SOME p), ECon (_, PConVar n2, _, SOME e)) =>
+                if n1 = n2 then
+                    match (env, p, e)
+                else
+                    No
+
+              | (PCon (_, PConFfi {mod = m1, con = con1, ...}, _, NONE),
+                 ECon (_, PConFfi {mod = m2, con = con2, ...}, _, NONE)) =>
+                if m1 = m2 andalso con1 = con2 then
+                    Yes env
+                else
+                    No
+
+              | (PCon (_, PConFfi {mod = m1, con = con1, ...}, _, SOME ep),
+                 ECon (_, PConFfi {mod = m2, con = con2, ...}, _, SOME e)) =>
+                if m1 = m2 andalso con1 = con2 then
+                    match (env, p, e)
+                else
+                    No
+
+              | (PRecord xps, ERecord xes) =>
+                if List.exists (fn ((CName _, _), _, _) => false
+                                 | _ => true) xes then
+                    Maybe
+                else
+                    let
+                        fun consider (xps, env) =
+                            case xps of
+                                [] => Yes env
+                              | (x, p, _) :: rest =>
+                                case List.find (fn ((CName x', _), _, _) => x' = x
+                                                 | _ => false) xes of
+                                    NONE => No
+                                  | SOME (_, e, _) =>
+                                    case match (env, p, e) of
+                                        No => No
+                                      | Maybe => Maybe
+                                      | Yes env => consider (rest, env)
+                    in
+                        consider (xps, env)
+                    end
+
+              | _ => Maybe
+    in
+        match (env, p, e)
+    end
+
+fun con env (all as (c, loc)) =
+    ((*Print.prefaces "con" [("c", CorePrint.p_con CoreEnv.empty all)];*)
+     case c of
+         TFun (c1, c2) => (TFun (con env c1, con env c2), loc)
+       | TCFun (x, k, c2) => (TCFun (x, k, con (UnknownC :: env) c2), loc)
+       | TKFun (x, c2) => (TKFun (x, con env c2), loc)
+       | TRecord c => (TRecord (con env c), loc)
+
+       | CRel n =>
+         let
+             fun find (n', env, nudge, liftC) =
+                 case env of
+                     [] => raise Fail "ReduceLocal.con: CRel"
+                   | Unknown :: rest => find (n', rest, nudge, liftC)
+                   | Known _ :: rest => find (n', rest, nudge, liftC)
+                   | Lift (liftC', _) :: rest => find (n', rest, nudge + liftC',
+                                                               liftC + liftC')
+                   | UnknownC :: rest =>
+                     if n' = 0 then
+                         (CRel (n + nudge), loc)
+                     else
+                         find (n' - 1, rest, nudge, liftC + 1)
+                   | KnownC c :: rest =>
+                     if n' = 0 then
+                         con (Lift (liftC, 0) :: rest) c
+                     else
+                         find (n' - 1, rest, nudge - 1, liftC)
+         in
+             (*print (Int.toString n ^ ": " ^ e2s env ^ "\n");*)
+             find (n, env, 0, 0)
+         end
+       | CNamed _ => all
+       | CFfi _ => all
+       | CApp (c1, c2) =>
+         let
+             val c1 = con env c1
+             val c2 = con env c2
+         in
+             case #1 c1 of
+                 CAbs (_, _, b) =>
+                 con (KnownC c2 :: deKnown env) b
+
+               | CApp ((CMap (dom, ran), _), f) =>
+                 (case #1 c2 of
+                      CRecord (_, []) => (CRecord (ran, []), loc)
+                    | CRecord (_, (x, c) :: rest) =>
+                      con (deKnown env)
+                          (CConcat ((CRecord (ran, [(x, (CApp (f, c), loc))]), loc),
+                                    (CApp (c1, (CRecord (dom, rest), loc)), loc)), loc)
+                    | _ => (CApp (c1, c2), loc))                           
+
+               | _ => (CApp (c1, c2), loc)
+         end
+       | CAbs (x, k, b) => (CAbs (x, k, con (UnknownC :: env) b), loc)
+
+       | CKApp (c1, k) =>
+         let
+             val c1 = con env c1
+         in
+             case #1 c1 of
+                 CKAbs (_, b) =>
+                 con (deKnown env) b
+
+               | _ => (CKApp (c1, k), loc)
+         end
+       | CKAbs (x, b) => (CKAbs (x, con env b), loc)
+
+       | CName _ => all
+
+       | CRecord (k, xcs) => (CRecord (k, map (fn (x, c) => (con env x, con env c)) xcs), loc)
+       | CConcat (c1, c2) =>
+         let
+             val c1 = con env c1
+             val c2 = con env c2
+         in
+             case (#1 c1, #1 c2) of
+                 (CRecord (k, xcs1), CRecord (_, xcs2)) =>
+                 (CRecord (k, xcs1 @ xcs2), loc)
+               | (CRecord (_, []), _) => c2
+               | (_, CRecord (_, [])) => c1
+               | _ => (CConcat (c1, c2), loc)
+         end
+       | CMap _ => all
+
+       | CUnit => all
+
+       | CTuple cs => (CTuple (map (con env) cs), loc)
+       | CProj (c, n) =>
+         let
+             val c = con env c
+         in
+             case #1 c of
+                 CTuple cs => List.nth (cs, n - 1)
+               | _ => (CProj (c, n), loc)
+         end)
+
+fun patCon pc =
+    case pc of
+        PConVar _ => pc
+      | PConFfi {mod = m, datatyp, params, con = c, arg, kind} =>
+        PConFfi {mod = m, datatyp = datatyp, params = params, con = c,
+                 arg = Option.map (con (map (fn _ => UnknownC) params)) arg,
+                 kind = kind}
+
+fun exp env (all as (e, loc)) =
+    case e of
+        EPrim _ => all
+      | ERel n =>
+        let
+            fun find (n', env, nudge, liftC, liftE) =
+                case env of
+                    [] => (ERel (n + nudge), loc)
+                  | Lift (liftC', liftE') :: rest => find (n', rest, nudge + liftE', liftC + liftC', liftE + liftE')
+                  | UnknownC :: rest => find (n', rest, nudge, liftC + 1, liftE)
+                  | KnownC _ :: rest => find (n', rest, nudge, liftC, liftE)
+                  | Unknown :: rest =>
+                    if n' = 0 then
+                        (ERel (n + nudge), loc)
+                    else
+                        find (n' - 1, rest, nudge, liftC, liftE + 1)
+                  | Known e :: rest =>
+                    if n' = 0 then
+                        ((*print "SUBSTITUTING\n";*)
+                         exp (Lift (liftC, liftE) :: rest) e)
+                    else
+                        find (n' - 1, rest, nudge - 1, liftC, liftE)
+        in
+            find (n, env, 0, 0, 0)
+        end
+      | ENamed _ => all
+      | ECon (dk, pc, cs, eo) => (ECon (dk, patCon pc, map (con env) cs, Option.map (exp env) eo), loc)
+      | EFfi _ => all
+      | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc)
+
+      | EApp (e1, e2) =>
+        let
+            val e1 = exp env e1
+            val e2 = exp env e2
+        in
+            case #1 e1 of
+                EAbs (_, _, _, b) => exp (Known e2 :: deKnown env) b
+              | _ => (EApp (e1, e2), loc)
+        end
+
+      | EAbs (x, dom, ran, e) => (EAbs (x, con env dom, con env ran, exp (Unknown :: env) e), loc)
+
+      | ECApp (e, c) =>
+        let
+            val e = exp env e
+            val c = con env c
+        in
+            case #1 e of
+                ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b
+              | _ => (ECApp (e, c), loc)
+        end
+
+      | ECAbs (x, k, e) => (ECAbs (x, k, exp (UnknownC :: env) e), loc)
+
+      | EKApp (e, k) => (EKApp (exp env e, k), loc)
+      | EKAbs (x, e) => (EKAbs (x, exp env e), loc)
+
+      | ERecord xcs => (ERecord (map (fn (x, e, t) => (con env x, exp env e, con env t)) xcs), loc)
+      | EField (e, c, {field = f, rest = r}) =>
+        let
+            val e = exp env e
+            val c = con env c
+
+            fun default () = (EField (e, c, {field = con env f, rest = con env r}), loc)
+        in
+            case (#1 e, #1 c) of
+                (ERecord xcs, CName x) =>
+                (case List.find (fn ((CName x', _), _, _) => x' = x | _ => false) xcs of
+                     NONE => default ()
+                   | SOME (_, e, _) => e)
+              | _ => default ()
+        end
+
+      | EConcat (e1, c1, e2, c2) => (EConcat (exp env e1, con env c1, exp env e2, con env c2), loc)
+      | ECut (e, c, {field = f, rest = r}) => (ECut (exp env e,
+                                                     con env c,
+                                                     {field = con env f, rest = con env r}), loc)
+      | ECutMulti (e, c, {rest = r}) => (ECutMulti (exp env e, con env c, {rest = con env r}), loc)
+
+      | ECase (e, pes, {disc = d, result = r}) =>
+        let
+            val others = {disc = con env d, result = con env r}
+
+            fun patBinds (p, _) =
+                case p of
+                    PVar _ => 1
+                  | PPrim _ => 0
+                  | PCon (_, _, _, NONE) => 0
+                  | PCon (_, _, _, SOME p) => patBinds p
+                  | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
+
+            fun pat (all as (p, loc)) =
+                case p of
+                    PVar (x, t) => (PVar (x, con env t), loc)
+                  | PPrim _ => all
+                  | PCon (dk, pc, cs, po) =>
+                    (PCon (dk, patCon pc, map (con env) cs, Option.map pat po), loc)
+                  | PRecord xpts => (PRecord (map (fn (x, p, t) => (x, pat p, con env t)) xpts), loc)
+
+            fun push () =
+                (ECase (exp env e,
+                        map (fn (p, e) => (pat p,
+                                           exp (List.tabulate (patBinds p,
+                                                            fn _ => Unknown) @ env) e))
+                            pes, others), loc)
+
+            fun search pes =
+                case pes of
+                    [] => push ()
+                  | (p, body) :: pes =>
+                    case match (env, p, e) of
+                        No => search pes
+                      | Maybe => push ()
+                      | Yes env' => exp env' body
+        in
+            search pes
+        end
+
+      | EWrite e => (EWrite (exp env e), loc)
+      | EClosure (n, es) => (EClosure (n, map (exp env) es), loc)
+
+      | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (Unknown :: env) e2), loc)
+
+      | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc)
+
+fun reduce file =
+    let
+        fun doDecl (d as (_, loc)) =
+            case #1 d of
+                DCon _ => d
+              | DDatatype _ => d
+              | DVal (x, n, t, e, s) =>
+                let
+                    val e = exp [] e
+                in
+                    (DVal (x, n, t, e, s), loc)
+                end
+              | DValRec vis =>
+                (DValRec (map (fn (x, n, t, e, s) => (x, n, t, exp [] e, s)) vis), loc)
+              | DExport _ => d
+              | DTable _ => d
+              | DSequence _ => d
+              | DView _ => d
+              | DDatabase _ => d
+              | DCookie _ => d
+              | DStyle _ => d
+              | DTask (e1, e2) => (DTask (exp [] e1, exp [] e2), loc)
+              | DPolicy e1 => (DPolicy (exp [] e1), loc)
+              | DOnError _ => d
+    in
+        map doDecl file
+    end
+
+val reduceExp = exp []
+val reduceCon = con []
+
+end
diff --git a/src/rpcify.sig b/src/rpcify.sig
new file mode 100644
index 0000000..7da53b7
--- /dev/null
+++ b/src/rpcify.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature RPCIFY = sig
+
+    val frob : Core.file -> Core.file
+
+end
diff --git a/src/rpcify.sml b/src/rpcify.sml
new file mode 100644
index 0000000..551a151
--- /dev/null
+++ b/src/rpcify.sml
@@ -0,0 +1,168 @@
+(* Copyright (c) 2009, 2012-2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Rpcify :> RPCIFY = struct
+
+open Core
+
+structure U = CoreUtil
+structure E = CoreEnv
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+type state = {
+     exported : IS.set,
+     export_decls : decl list
+}
+
+fun frob file =
+    let
+        val (rpcBaseIds, trpcBaseIds) =
+            foldl (fn ((d, _), (rpcIds, trpcIds)) =>
+                      case d of
+                          DVal (_, n, _, (EFfi ("Basis", "rpc"), _), _) =>
+                          (IS.add (rpcIds, n), trpcIds)
+                        | DVal (_, n, _, (EFfi ("Basis", "tryRpc"), _), _) =>
+                          (rpcIds, IS.add (trpcIds, n))
+                        | DVal (_, n, _, (ENamed n', _), _) =>
+                          if IS.member (rpcIds, n') then
+                              (IS.add (rpcIds, n), trpcIds)
+                          else if IS.member (trpcIds, n') then
+                              (rpcIds, IS.add (trpcIds, n))
+                          else
+                              (rpcIds, trpcIds)
+                        | _ => (rpcIds, trpcIds))
+                  (IS.empty, IS.empty) file
+
+        val tfuncs = foldl
+                     (fn ((d, _), tfuncs) =>
+                         let
+                             fun doOne ((x, n, t, e, _), tfuncs) =
+                                 let
+                                     val loc = #2 e
+
+                                     fun crawl (t, e, args) =
+                                         case (#1 t, #1 e) of
+                                             (CApp (_, ran), _) =>
+                                             SOME (x, rev args, ran, e)
+                                           | (TFun (arg, rest), EAbs (x, _, _, e)) =>
+                                             crawl (rest, e, (x, arg) :: args)
+                                           | (TFun (arg, rest), _) =>
+                                             crawl (rest, (EApp (e, (ERel (length args), loc)), loc), ("x", arg) :: args)
+                                           | _ => NONE
+                                 in
+                                     case crawl (t, e, []) of
+                                         NONE => tfuncs
+                                       | SOME sg => IM.insert (tfuncs, n, sg)
+                                 end
+                         in
+                             case d of
+                                 DVal vi => doOne (vi, tfuncs)
+                               | DValRec vis => foldl doOne tfuncs vis
+                               | _ => tfuncs
+                         end)
+                     IM.empty file
+                             
+        fun exp (e, st) =
+            let
+                fun getApp (e', args) =
+                    case e' of
+                        ENamed n => SOME (n, args)
+                      | EApp (e1, e2) => getApp (#1 e1, e2 :: args)
+                      | _ => NONE
+
+                fun newRpc (trans : exp, st : state, fm) =
+                    case getApp (#1 trans, []) of
+                        NONE => (ErrorMsg.errorAt (#2 trans)
+                                                  "RPC code doesn't use a named function or transaction";
+                                 (*Print.preface ("Expression",
+                                                CorePrint.p_exp CoreEnv.empty trans);*)
+                                 (#1 trans, st))
+                      | SOME (n, args) =>
+                        case IM.find (tfuncs, n) of
+                            NONE => ((*Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];*)
+                                     raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n))
+                          | SOME (_, _, ran, _) =>
+                            let
+                                val loc = #2 trans
+
+                                val (exported, export_decls) =
+                                    if IS.member (#exported st, n) then
+                                        (#exported st, #export_decls st)
+                                    else
+                                        (IS.add (#exported st, n),
+                                         (DExport (Rpc ReadWrite, n, false), loc) :: #export_decls st)
+
+                                val st = {exported = exported,
+                                          export_decls = export_decls}
+
+                                val e' = EServerCall (n, args, ran, fm)
+                            in
+                                (e', st)
+                            end
+            in
+                case e of
+                    EApp ((ECApp ((EFfi ("Basis", "rpc"), _), ran), _), trans) => newRpc (trans, st, None)
+                  | EApp ((ECApp ((EFfi ("Basis", "tryRpc"), _), ran), _), trans) => newRpc (trans, st, Error)
+                  | EApp ((ECApp ((ENamed n, _), ran), _), trans) =>
+                    if IS.member (rpcBaseIds, n) then
+                        newRpc (trans, st, None)
+                    else if IS.member (trpcBaseIds, n) then
+                        newRpc (trans, st, Error)
+                    else
+                        (e, st)
+
+                  | _ => (e, st)
+            end
+
+        and doExp (e, st) = U.Exp.foldMap {kind = fn x => x,
+                                           con = fn x => x,
+                                           exp = exp} st (ReduceLocal.reduceExp e)
+
+        fun decl (d, st : state) =
+            let
+                val (d, st) = U.Decl.foldMap {kind = fn x => x,
+                                              con = fn x => x,
+                                              exp = exp,
+                                              decl = fn x => x}
+                              st d
+            in
+                (d :: #export_decls st,
+                 {exported = #exported st,
+                  export_decls = []})
+            end
+
+        val (file, _) = ListUtil.foldlMapConcat decl
+                        {exported = IS.empty,
+                         export_decls = []}
+                        file
+    in
+        file
+    end
+
+end
diff --git a/src/scriptcheck.sig b/src/scriptcheck.sig
new file mode 100644
index 0000000..afb557b
--- /dev/null
+++ b/src/scriptcheck.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SCRIPT_CHECK = sig
+
+    val classify : Mono.file -> Mono.file
+
+end
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
new file mode 100644
index 0000000..0d30ebc
--- /dev/null
+++ b/src/scriptcheck.sml
@@ -0,0 +1,182 @@
+(* Copyright (c) 2009, 2014, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure ScriptCheck :> SCRIPT_CHECK = struct
+
+open Mono
+
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+structure IS = IntBinarySet
+
+val pushBasis = SS.addList (SS.empty,
+                            ["new_channel",
+                             "self"])
+
+datatype rpcmap =
+         Rpc of int (* ID of function definition *)
+       | Module of rpcmap SM.map
+
+fun lookup (r : rpcmap, k : string) =
+    let
+        fun lookup' (r, ks) =
+            case r of
+                Rpc x => SOME x
+              | Module m =>
+                case ks of
+                    [] => NONE
+                  | k :: ks' =>
+                    case SM.find (m, k) of
+                        NONE => NONE
+                      | SOME r' => lookup' (r', ks')
+    in
+        lookup' (r, String.tokens (fn ch => ch = #"/") k)
+    end
+
+fun insert (r : rpcmap, k : string, v) =
+    let
+        fun insert' (r, ks) =
+            case r of
+                Rpc _ => Rpc v
+              | Module m =>
+                case ks of
+                    [] => Rpc v
+                  | k :: ks' =>
+                    let
+                        val r' = case SM.find (m, k) of
+                                     NONE => Module SM.empty
+                                   | SOME r' => r'
+                    in
+                        Module (SM.insert (m, k, insert' (r', ks')))
+                    end
+    in
+        insert' (r, String.tokens (fn ch => ch = #"/") k)
+    end
+
+fun dump (r : rpcmap) =
+    case r of
+        Rpc _ => print "ROOT\n"
+      | Module m => (print "<Module>\n";
+                     SM.appi (fn (k, r') => (print (k ^ ":\n");
+                                             dump r')) m;
+                     print "</Module>\n")
+
+fun classify (ds, ps) =
+    let
+        val proto = Settings.currentProtocol ()
+
+        fun inString {needle, haystack} = String.isSubstring needle haystack
+
+        fun hasClient {basis, rpcs, funcs, push} =
+            MonoUtil.Exp.exists {typ = fn _ => false,
+                                 exp = fn ERecv _ => push
+                                        | EFfiApp ("Basis", x, _) => SS.member (basis, x) 
+                                        | EJavaScript _ => not push
+                                        | ENamed n => IS.member (funcs, n)
+                                        | EServerCall (e, _, _, _) =>
+                                          let
+                                              fun head (e : exp) =
+                                                  case #1 e of
+                                                      EStrcat (e1, _) => head e1
+                                                    | EPrim (Prim.String (_, s)) => SOME s
+                                                    | _ => NONE
+                                          in
+                                              case head e of
+                                                  NONE => true
+                                                | SOME fcall =>
+                                                  case lookup (rpcs, fcall) of
+                                                      NONE => true
+                                                    | SOME n => IS.member (funcs, n)
+                                          end
+                                        | _ => false}
+
+        fun decl ((d, _), rpcs) =
+            case d of
+                DExport (Mono.Rpc _, fcall, n, _, _, _) =>
+                insert (rpcs, fcall, n)
+              | _ => rpcs
+
+        val rpcs = foldl decl (Module SM.empty) ds
+
+        fun decl ((d, _), (pull_ids, push_ids)) =
+            let
+                val hasClientPull = hasClient {basis = SS.empty, rpcs = rpcs, funcs = pull_ids, push = false}
+                val hasClientPush = hasClient {basis = pushBasis, rpcs = rpcs, funcs = push_ids, push = true}
+            in
+                case d of
+                    DVal (_, n, _, e, _) => (if hasClientPull e then
+                                                 IS.add (pull_ids, n)
+                                             else
+                                                 pull_ids,
+                                             if hasClientPush e then
+                                                 IS.add (push_ids, n)
+                                             else
+                                                 push_ids)
+                  | DValRec xes => (if List.exists (fn (_, _, _, e, _) => hasClientPull e) xes then
+                                        foldl (fn ((_, n, _, _, _), pull_ids) => IS.add (pull_ids, n))
+                                              pull_ids xes
+                                    else
+                                        pull_ids,
+                                    if List.exists (fn (_, _, _, e, _) => hasClientPush e) xes then
+                                        foldl (fn ((_, n, _, _, _), push_ids) => IS.add (push_ids, n))
+                                              push_ids xes
+                                    else
+                                        push_ids)
+                  | _ => (pull_ids, push_ids)
+            end
+
+        val (pull_ids, push_ids) = foldl decl (IS.empty, IS.empty) ds
+
+        val foundBad = ref false
+
+        val all_ids = IS.union (pull_ids, push_ids)
+
+        val ps = map (fn n =>
+                         (n, if IS.member (push_ids, n) then
+                                 (if not (#persistent proto) andalso not (!foundBad) then
+                                      (foundBad := true;
+                                       ErrorMsg.error ("This program needs server push, but the current protocol ("
+                                                       ^ #name proto ^ ") doesn't support that."))
+                                  else
+                                      ();
+                                  ServerAndPullAndPush)
+                             else if IS.member (pull_ids, n) then
+                                 ServerAndPull
+                             else
+                                 ServerOnly, AnyDb)) (IS.listItems all_ids)
+    in
+        (ds, ps)
+    end
+
+end
+
diff --git a/src/search.sig b/src/search.sig
new file mode 100644
index 0000000..ac86714
--- /dev/null
+++ b/src/search.sig
@@ -0,0 +1,62 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SEARCH = sig
+
+    datatype ('state, 'abort) result =
+             Return of 'abort
+           | Continue of 'state
+
+    type ('data, 'state, 'abort) mapfolder =
+         'data -> 'state -> ('data * 'state, 'abort) result
+
+    type ('context, 'data, 'state, 'abort) mapfolderB =
+         'context -> 'data -> 'state -> ('data * 'state, 'abort) result
+
+    val return2 : 'data -> 'state -> ('data * 'state, 'abort) result
+
+    val map : ('state1, 'abort) result
+              * ('state1 -> 'state2)
+              -> ('state2, 'abort) result
+
+    val map2 : ('state2 -> ('state1 * 'state2, 'abort) result)
+               * ('state1 -> 'state1')
+               -> ('state2 -> ('state1' * 'state2, 'abort) result)
+
+    val bind : ('state1, 'abort) result
+               * ('state1 -> ('state2, 'abort) result)
+               -> ('state2, 'abort) result
+
+    val bind2 : ('state2 -> ('state1 * 'state2, 'abort) result)
+               * ('state1 -> 'state2 -> ('state1' * 'state2, 'abort) result)
+               -> ('state2 -> ('state1' * 'state2, 'abort) result)
+
+    val bindP : (('state11 * 'state12) * 'state2, 'abort) result
+                * ('state11 -> 'state2 -> ('state11 * 'state2, 'abort) result)
+                -> (('state11 * 'state12) * 'state2, 'abort) result
+
+end
diff --git a/src/search.sml b/src/search.sml
new file mode 100644
index 0000000..563496f
--- /dev/null
+++ b/src/search.sml
@@ -0,0 +1,73 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Search :> SEARCH = struct
+
+datatype ('state, 'abort) result =
+         Return of 'abort
+       | Continue of 'state
+
+type ('data, 'state, 'abort) mapfold_arg =
+     'data * 'state -> ('data * 'state, 'abort) result
+
+type ('data, 'state, 'abort) mapfolder =
+     'data -> 'state -> ('data * 'state, 'abort) result
+
+type ('context, 'data, 'state, 'abort) mapfolderB =
+     'context -> 'data -> 'state -> ('data * 'state, 'abort) result
+
+fun return2 v acc = Continue (v, acc)
+
+fun map (r, f) =
+    case r of
+        Continue acc => Continue (f acc)
+      | Return x => Return x
+
+fun map2 (r, f) acc =
+    case r acc of
+        Continue (x, acc) => Continue (f x, acc)
+      | Return x => Return x
+
+fun bind (r, f) =
+    case r of
+        Continue acc => f acc
+      | Return x => Return x
+
+fun bind2 (r, f) acc =
+    case r acc of
+        Continue (x, acc) => f x acc
+      | Return x => Return x
+
+fun bindP (r, f) =
+    case r of
+        Continue ((x, pos), acc) =>
+        map (f x acc,
+          fn (x', acc') =>
+             ((x', pos), acc'))
+      | Return x => Return x
+
+end
diff --git a/src/settings.sig b/src/settings.sig
new file mode 100644
index 0000000..256a12b
--- /dev/null
+++ b/src/settings.sig
@@ -0,0 +1,309 @@
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SETTINGS = sig
+
+    (* Call this when compiling a new project, e.g. with the Ur/Web daemon or from the SML/NJ REPL.
+     * Some settings stay, but most are reset, especially files cached for the app to serve. *)
+    val reset : unit -> unit
+
+    (* XXX these should be unit -> string too *)
+    val configBin : string ref
+    val configLib : string ref
+    val configSrcLib : string ref
+    val configInclude : string ref
+    val configSitelisp : string ref
+
+    val libUr : unit -> string
+    val libC : unit -> string
+    val libJs : unit -> string
+
+    val setDebug : bool -> unit
+    val getDebug : unit -> bool
+
+    val libFile : string -> string
+    val clibFile : string -> string
+
+    (* How do all application URLs begin? *)
+    val setUrlPrefix : string -> unit
+    val getUrlPrefix : unit -> string
+    val getUrlPrePrefix : unit -> string
+    val getUrlPrefixFull : unit -> string
+    (* The full prefix is the value that was set explicitly, while the "pre"
+     * prefix gets the protocol/host/port part and the unqualified prefix gets
+     * the URI. *)
+
+    (* How many seconds should the server wait before assuming a Comet client has left? *)
+    val setTimeout : int -> unit
+    val getTimeout : unit -> int
+
+    (* Which C header files are needed? *)
+    val setHeaders : string list -> unit
+    val getHeaders : unit -> string list
+
+    (* Which extra JavaScript URLs should be included? *)
+    val setScripts : string list -> unit
+    val getScripts : unit -> string list
+
+    type ffi = string * string
+
+    (* Which FFI types may be sent from clients to servers? *)
+    val setClientToServer : ffi list -> unit
+    val mayClientToServer : ffi -> bool
+
+    (* Which FFI functions have side effects? *)
+    val setEffectful : ffi list -> unit
+    val addEffectful : ffi -> unit
+    val isEffectful : ffi -> bool
+
+    (* Which FFI functions should not have their calls removed or reordered, but cause no lasting effects? *)
+    val setBenignEffectful : ffi list -> unit
+    val addBenignEffectful : ffi -> unit
+    val isBenignEffectful : ffi -> bool
+
+    (* Which FFI functions may only be run in clients? *)
+    val setClientOnly : ffi list -> unit
+    val addClientOnly : ffi -> unit
+    val isClientOnly : ffi -> bool
+
+    (* Which FFI functions may only be run on servers? *)
+    val setServerOnly : ffi list -> unit
+    val addServerOnly : ffi -> unit
+    val isServerOnly : ffi -> bool
+
+    (* Which FFI functions may be run in JavaScript?  (JavaScript function names included) *)
+    val setJsModule : string option -> unit
+    val setJsFuncs : (ffi * string) list -> unit
+    val addJsFunc : ffi * string -> unit
+    val jsFunc : ffi -> string option
+    val allJsFuncs : unit -> (ffi * string) list
+
+    datatype pattern_kind = Exact | Prefix
+    datatype action = Allow | Deny
+    type rule = { action : action, kind : pattern_kind, pattern : string }
+
+    datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
+    type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
+
+    (* Rules for rewriting URLs from canonical forms *)
+    val setRewriteRules : rewrite list -> unit
+    val rewrite : path_kind -> string -> string
+
+    (* Validating URLs and MIME types *)
+    val setUrlRules : rule list -> unit
+    val getUrlRules : unit -> rule list
+    val checkUrl : string -> bool
+
+    val setMimeRules : rule list -> unit
+    val getMimeRules : unit -> rule list
+    val checkMime : string -> bool
+
+    val setRequestHeaderRules : rule list -> unit
+    val getRequestHeaderRules : unit -> rule list
+    val checkRequestHeader : string -> bool
+
+    val setResponseHeaderRules : rule list -> unit
+    val getResponseHeaderRules : unit -> rule list
+    val checkResponseHeader : string -> bool
+
+    val setEnvVarRules : rule list -> unit
+    val getEnvVarRules : unit -> rule list
+    val checkEnvVar : string -> bool
+
+    val setMetaRules : rule list -> unit
+    val getMetaRules : unit -> rule list
+    val checkMeta : string -> bool
+
+    (* Web protocols that generated programs may speak *)
+    type protocol = {
+        name : string,       (* Call it this on the command line *)
+        compile : string,    (* Pass these `gcc -c' arguments *)
+        linkStatic : string, (* Pass these static linker arguments *)
+        linkDynamic : string,(* Pass these dynamic linker arguments *)
+        persistent : bool,   (* Multiple requests per process? *)
+        code : unit -> Print.PD.pp_desc (* Extra code to include in C files *)
+    }
+    val addProtocol : protocol -> unit
+    val setProtocol : string -> unit
+    val currentProtocol : unit -> protocol
+
+    (* Different DBMSes *)
+    datatype sql_type =
+             Int
+           | Float
+           | String
+           | Char
+           | Bool
+           | Time
+           | Blob
+           | Channel
+           | Client
+           | Nullable of sql_type
+
+    val p_sql_ctype : sql_type -> string
+    val isBlob : sql_type -> bool
+    val isNotNull : sql_type -> bool
+
+    datatype failure_mode = Error | None
+
+    type dbms = {
+         name : string,
+         (* Call it this on the command line *)
+         randomFunction : string,
+         (* DBMS's name for random number-generating function *)
+         header : string,
+         (* Include this C header file *)
+         link : string,
+         (* Pass these linker arguments *)
+         p_sql_type : sql_type -> string,
+         init : {dbstring : string,
+                 prepared : (string * int) list,
+                 tables : (string * (string * sql_type) list) list,
+                 views : (string * (string * sql_type) list) list,
+                 sequences : string list} -> Print.PD.pp_desc,
+         (* Define uw_client_init(), uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *)
+         query : {loc : ErrorMsg.span, cols : sql_type list,
+                  doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+                           -> Print.PD.pp_desc}
+                 -> Print.PD.pp_desc,
+         queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
+                          inputs : sql_type list, cols : sql_type list,
+                          doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int,
+                                     typ : sql_type} -> Print.PD.pp_desc)
+                                   -> Print.PD.pp_desc,
+                          nested : bool}
+                         -> Print.PD.pp_desc,
+         dml : ErrorMsg.span * failure_mode -> Print.PD.pp_desc,
+         dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
+                        inputs : sql_type list, mode : failure_mode} -> 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 *),
+         supportsDeleteAs : bool,
+         supportsUpdateAs : bool,
+         createSequence : string -> string,
+         textKeysNeedLengths : bool,
+         supportsNextval : bool,
+         supportsNestedPrepared : bool,
+         sqlPrefix : string,
+         supportsOctetLength : bool,
+         trueString : string,
+         falseString : string,
+         onlyUnion : bool,
+         nestedRelops : bool,
+         windowFunctions : bool,
+         supportsIsDistinctFrom : bool
+    }
+
+    val addDbms : dbms -> unit
+    val setDbms : string -> unit
+    val currentDbms : unit -> dbms
+
+    val setDbstring : string option -> unit
+    val getDbstring : unit -> string option
+
+    val setExe : string option -> unit
+    val getExe : unit -> string option
+
+    val setSql : string option -> unit
+    val getSql : unit -> string option
+
+    val setCoreInline : int -> unit
+    val getCoreInline : unit -> int
+
+    val setMonoInline : int -> unit
+    val getMonoInline : unit -> int
+
+    val setStaticLinking : bool -> unit
+    val getStaticLinking : unit -> bool
+
+    val setBootLinking : bool -> unit
+    val getBootLinking : unit -> bool
+
+    val setDeadlines : bool -> unit
+    val getDeadlines : unit -> bool
+
+    val setSigFile : string option -> unit
+    val getSigFile : unit -> string option
+
+    (* Which GET-able functions should be allowed to have side effects? *)
+    val setSafeGets : string list -> unit
+    val isSafeGet : string -> bool
+
+    val setOnError : (string * string list * string) option -> unit
+    val getOnError : unit -> (string * string list * string) option
+
+    val addLimit : string * int -> unit
+    val limits : unit -> (string * int) list
+
+    val setMinHeap : int -> unit
+    val getMinHeap : unit -> int
+
+    val addAlwaysInline : string -> unit
+    val checkAlwaysInline : string -> bool
+
+    val addNeverInline : string -> unit
+    val checkNeverInline : string -> bool
+
+    val addNoXsrfProtection : string -> unit
+    val checkNoXsrfProtection : string -> bool
+
+    val setTimeFormat : string -> unit
+    val getTimeFormat : unit -> string
+
+    val getCCompiler : unit -> string
+    val setCCompiler : string -> unit
+
+    val setMangleSql : bool -> unit
+    val mangleSql : string -> string
+    val mangleSqlCatalog : string -> string
+    val mangleSqlTable : string -> string
+
+    val setIsHtml5 : bool -> unit
+    val getIsHtml5 : unit -> bool
+
+    val setLessSafeFfi : bool -> unit
+    val getLessSafeFfi : unit -> bool
+
+    val setSqlcache : bool -> unit
+    val getSqlcache : unit -> bool
+
+    val setFilePath : string -> unit
+    (* Sets the directory where we look for files being added below. *)
+
+    val addFile : {Uri : string, LoadFromFilename : string} -> unit
+    val listFiles : unit -> {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector} list
+
+    val addJsFile : string (* filename *) -> unit
+    val listJsFiles : unit -> {Filename : string, Content : string} list
+
+    val setOutputJsFile : string option (* filename *) -> unit
+    val getOutputJsFile : unit -> string option
+end
diff --git a/src/settings.sml b/src/settings.sml
new file mode 100644
index 0000000..a3263c0
--- /dev/null
+++ b/src/settings.sml
@@ -0,0 +1,1012 @@
+(* Copyright (c) 2008-2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Settings :> SETTINGS = struct
+
+val configBin = ref Config.bin
+val configLib = ref Config.lib
+val configSrcLib = ref Config.srclib
+val configInclude = ref Config.includ
+val configSitelisp = ref Config.sitelisp
+
+val configCCompiler = ref Config.ccompiler
+
+fun getCCompiler () = !configCCompiler
+fun setCCompiler cc = configCCompiler := cc
+
+fun libUr () = OS.Path.joinDirFile {dir = !configSrcLib,
+                                    file = "ur"}
+fun libC () = OS.Path.joinDirFile {dir = !configSrcLib,
+                                   file = "c"}
+fun libJs () = OS.Path.joinDirFile {dir = !configSrcLib,
+                                    file = "js"}
+
+fun libFile s = OS.Path.joinDirFile {dir = libUr (),
+                                     file = s}
+
+val urlPrefixFull = ref "/"
+val urlPrefix = ref "/"
+val urlPrePrefix = ref ""
+val timeout = ref 0
+val headers = ref ([] : string list)
+val scripts = ref ([] : string list)
+
+fun getUrlPrefixFull () = !urlPrefixFull
+fun getUrlPrefix () = !urlPrefix
+fun getUrlPrePrefix () = !urlPrePrefix
+fun setUrlPrefix p =
+    let
+        val prefix = if p = "" then
+                         "/"
+                     else if String.sub (p, size p - 1) <> #"/" then
+                         p ^ "/"
+                     else
+                         p
+
+        fun findPrefix n =
+            let
+                val (befor, after) = Substring.splitl (fn ch => ch <> #"/") (Substring.extract (prefix, n, NONE))
+            in
+                if Substring.isEmpty after then
+                    ("", prefix)
+                else
+                    (String.substring (prefix, 0, n) ^ Substring.string befor, Substring.string after)
+            end
+
+        val (prepre, prefix) =
+            if String.isPrefix "http://" prefix then
+                findPrefix 7
+            else if String.isPrefix "https://" prefix then
+                findPrefix 8
+            else
+                ("", prefix)
+    in
+        urlPrefixFull := p;
+        urlPrePrefix := prepre;
+        urlPrefix := prefix
+    end
+
+fun getTimeout () = !timeout
+fun setTimeout n = timeout := n
+
+fun getHeaders () = !headers
+fun setHeaders ls = headers := ls
+
+fun getScripts () = !scripts
+fun setScripts ls = scripts := ls
+
+type ffi = string * string
+
+structure K = struct
+type ord_key = ffi
+fun compare ((m1, x1), (m2, x2)) =
+    Order.join (String.compare (m1, m2),
+             fn () => String.compare (x1, x2))
+end
+
+structure S = BinarySetFn(K)
+structure M = BinaryMapFn(K)
+
+fun basis x = S.addList (S.empty, map (fn x : string => ("Basis", x)) x)
+
+val clientToServerBase = basis ["int",
+                                "float",
+                                "string",
+                                "time",
+                                "file",
+                                "unit",
+                                "option",
+                                "list",
+                                "bool",
+                                "variant"]
+val clientToServer = ref clientToServerBase
+fun setClientToServer ls = clientToServer := S.addList (clientToServerBase, ls)
+fun mayClientToServer x = S.member (!clientToServer, x)
+
+val effectfulBase = basis ["dml",
+                           "nextval",
+                           "setval",
+                           "set_cookie",
+                           "clear_cookie",
+                           "new_channel",
+                           "send",
+                           "htmlifyInt_w",
+                           "htmlifyFloat_w",
+                           "htmlifyString_w",
+                           "htmlifyBool_w",
+                           "htmlifyTime_w",
+                           "attrifyInt_w",
+                           "attrifyFloat_w",
+                           "attrifyString_w",
+                           "attrifyChar_w",
+                           "urlifyInt_w",
+                           "urlifyFloat_w",
+                           "urlifyString_w",
+                           "urlifyBool_w",
+                           "urlifyChannel_w"]
+
+val effectful = ref effectfulBase
+fun setEffectful ls = effectful := S.addList (effectfulBase, ls)
+fun isEffectful ("Sqlcache", _) = true
+  | isEffectful x = S.member (!effectful, x)
+fun addEffectful x = effectful := S.add (!effectful, x)
+
+val benignBase = basis ["get_cookie",
+                        "new_client_source",
+                        "get_client_source",
+                        "set_client_source",
+                        "current",
+                        "alert",
+                        "confirm",
+                        "onError",
+                        "onFail",
+                        "onConnectFail",
+                        "onDisconnect",
+                        "onServerError",
+                        "mouseEvent",
+                        "keyEvent",
+                        "debug",
+                        "rand",
+                        "now",
+                        "getHeader",
+                        "setHeader",
+                        "spawn",
+                        "onClick",
+                        "onDblclick",
+                        "onContextmenu",
+                        "onKeydown",
+                        "onKeypress",
+                        "onKeyup",
+                        "onMousedown",
+                        "onMouseenter",
+                        "onMouseleave",
+                        "onMousemove",
+                        "onMouseout",
+                        "onMouseover",
+                        "onMouseup",
+                        "preventDefault",
+                        "stopPropagation",
+                        "fresh",
+                        "giveFocus",
+                        "currentUrlHasPost",
+                        "currentUrlHasQueryString",
+                        "currentUrl"]
+
+val benign = ref benignBase
+fun setBenignEffectful ls = benign := S.addList (benignBase, ls)
+fun addBenignEffectful x = benign := S.add (!benign, x)
+fun isBenignEffectful x = S.member (!benign, x)
+
+val clientBase = basis ["get_client_source",
+                        "current",
+                        "alert",
+                        "confirm",
+                        "recv",
+                        "sleep",
+                        "spawn",
+                        "onError",
+                        "onFail",
+                        "onConnectFail",
+                        "onDisconnect",
+                        "onServerError",
+                        "mouseEvent",
+                        "keyEvent",
+                        "onClick",
+                        "onContextmenu",
+                        "onDblclick",
+                        "onKeydown",
+                        "onKeypress",
+                        "onKeyup",
+                        "onMousedown",
+                        "onMouseenter",
+                        "onMouseleave",
+                        "onMousemove",
+                        "onMouseout",
+                        "onMouseover",
+                        "onMouseup",
+                        "preventDefault",
+                        "stopPropagation",
+                        "giveFocus"]
+val client = ref clientBase
+fun setClientOnly ls = client := S.addList (clientBase, ls)
+fun addClientOnly x = client := S.add (!client, x)
+fun isClientOnly x = S.member (!client, x)
+
+val serverBase = basis ["requestHeader",
+                        "query",
+                        "dml",
+                        "nextval",
+                        "setval",
+                        "channel",
+                        "send",
+                        "fieldName",
+                        "fieldValue",
+                        "remainingFields",
+                        "firstFormField"]
+val server = ref serverBase
+fun setServerOnly ls = server := S.addList (serverBase, ls)
+fun addServerOnly x = server := S.add (!server, x)
+fun isServerOnly x = S.member (!server, x)
+
+val basisM = foldl (fn ((k, v : string), m) => M.insert (m, ("Basis", k), v)) M.empty
+
+val jsFuncsBase = basisM [("alert", "alert"),
+                          ("stringToTime", "stringToTime"),
+                          ("stringToTime_error", "stringToTime_error"),
+                          ("timef", "strftime"),
+                          ("confirm", "confrm"),
+                          ("get_client_source", "sg"),
+                          ("current", "scur"),
+                          ("htmlifyBool", "bs"),
+                          ("htmlifyFloat", "ts"),
+                          ("htmlifyInt", "ts"),
+                          ("htmlifyString", "eh"),
+                          ("new_client_source", "sc"),
+                          ("set_client_source", "sv"),
+                          ("stringToFloat", "pflo"),
+                          ("stringToInt", "pio"),
+                          ("stringToFloat_error", "pfl"),
+                          ("stringToInt_error", "pi"),
+                          ("urlifyInt", "ts"),
+                          ("urlifyFloat", "ts"),
+                          ("urlifyTime", "ts"),
+                          ("urlifyString", "uf"),
+                          ("urlifyBool", "ub"),
+                          ("recv", "rv"),
+                          ("strcat", "cat"),
+                          ("intToString", "ts"),
+                          ("floatToString", "ts"),
+                          ("charToString", "ts"),
+                          ("onError", "onError"),
+                          ("onFail", "onFail"),
+                          ("onConnectFail", "onConnectFail"),
+                          ("onDisconnect", "onDisconnect"),
+                          ("onServerError", "onServerError"),
+                          ("attrifyString", "atr"),
+                          ("attrifyInt", "ts"),
+                          ("attrifyFloat", "ts"),
+                          ("attrifyBool", "bs"),
+                          ("boolToString", "bs"),
+                          ("str1", "id"),
+                          ("strsub", "sub"),
+                          ("strsuffix", "suf"),
+                          ("strlen", "slen"),
+                          ("strindex", "sidx"),
+                          ("strsindex", "ssidx"),
+                          ("strchr", "schr"),
+                          ("substring", "ssub"),
+                          ("strcspn", "sspn"),
+                          ("strlenGe", "strlenGe"),
+                          ("mouseEvent", "uw_mouseEvent"),
+                          ("keyEvent", "uw_keyEvent"),
+                          ("minTime", "0"),
+                          ("stringToBool_error", "s2be"),
+                          ("stringToBool", "s2b"),
+
+                          ("islower", "isLower"),
+                          ("isupper", "isUpper"),
+                          ("isalpha", "isAlpha"),
+                          ("isdigit", "isDigit"),
+                          ("isalnum", "isAlnum"),
+                          ("isblank", "isBlank"),
+                          ("isspace", "isSpace"),
+                          ("isxdigit", "isXdigit"),
+                          ("isprint", "isPrint"),
+                          ("tolower", "toLower"),
+                          ("toupper", "toUpper"),
+                          ("ord", "ord"),
+
+                          ("checkUrl", "checkUrl"),
+                          ("bless", "bless"),
+                          ("blessData", "blessData"),
+
+                          ("eq_time", "eq"),
+                          ("lt_time", "lt"),
+                          ("le_time", "le"),
+
+                          ("debug", "uw_debug"),
+                          ("naughtyDebug", "uw_debug"),
+
+                          ("floatFromInt", "float"),
+                          ("ceil", "ceil"),
+                          ("trunc", "trunc"),
+                          ("round", "round"),
+                          ("floor", "floor"),
+
+                          ("pow", "pow"),
+                          ("sqrt", "sqrt"),
+                          ("sin", "sin"),
+                          ("cos", "cos"),
+                          ("log", "log"),
+                          ("exp", "exp"),
+                          ("asin", "asin"),
+                          ("acos", "acos"),
+                          ("atan", "atan"),
+                          ("atan2", "atan2"),
+                          ("abs", "abs"),
+
+                          ("now", "now"),
+                          ("timeToString", "showTime"),
+                          ("htmlifyTime", "showTimeHtml"),
+                          ("toSeconds", "toSeconds"),
+                          ("addSeconds", "addSeconds"),
+                          ("diffInSeconds", "diffInSeconds"),
+                          ("toMilliseconds", "toMilliseconds"),
+                          ("fromMilliseconds", "fromMilliseconds"),
+                          ("diffInMilliseconds", "diffInMilliseconds"),
+
+                          ("fromDatetime", "fromDatetime"),
+                          ("datetimeYear", "datetimeYear"),
+                          ("datetimeMonth", "datetimeMonth"),
+                          ("datetimeDay", "datetimeDay"),
+                          ("datetimeHour", "datetimeHour"),
+                          ("datetimeMinute", "datetimeMinute"),
+                          ("datetimeSecond", "datetimeSecond"),
+                          ("datetimeDayOfWeek", "datetimeDayOfWeek"),
+
+
+                          ("onClick", "uw_onClick"),
+                          ("onContextmenu", "uw_onContextmenu"),
+                          ("onDblclick", "uw_onDblclick"),
+                          ("onKeydown", "uw_onKeydown"),
+                          ("onKeypress", "uw_onKeypress"),
+                          ("onKeyup", "uw_onKeyup"),
+                          ("onMousedown", "uw_onMousedown"),
+                          ("onMouseenter", "uw_onMouseenter"),
+                          ("onMouseleave", "uw_onMouseleave"),
+                          ("onMousemove", "uw_onMousemove"),
+                          ("onMouseout", "uw_onMouseout"),
+                          ("onMouseover", "uw_onMouseover"),
+                          ("onMouseup", "uw_onMouseup"),
+                          ("preventDefault", "uw_preventDefault"),
+                          ("stopPropagation", "uw_stopPropagation"),
+
+                          ("fresh", "fresh"),
+
+                          ("atom", "atom"),
+                          ("css_url", "css_url"),
+                          ("property", "property"),
+                          ("giveFocus", "giveFocus"),
+
+                          ("htmlifySpecialChar", "htmlifySpecialChar"),
+                          ("chr", "chr")]
+val jsFuncs = ref jsFuncsBase
+val jsModule = ref (NONE : string option)
+fun setJsModule m = jsModule := m
+fun jsFuncName f =
+    case !jsModule of
+        SOME m => m ^ "." ^ f
+      | NONE => f
+fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, jsFuncName v)) jsFuncsBase ls
+fun jsFunc x = M.find (!jsFuncs, x)
+fun addJsFunc (k, v) = jsFuncs := M.insert (!jsFuncs, k, jsFuncName v)
+fun allJsFuncs () = M.listItemsi (!jsFuncs)
+
+datatype pattern_kind = Exact | Prefix
+datatype action = Allow | Deny
+type rule = { action : action, kind : pattern_kind, pattern : string }
+
+datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
+type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
+
+fun pak2s pak =
+    case pak of
+        Exact => "Exact"
+      | Prefix => "Prefix"
+fun pk2s pk =
+    case pk of
+        Any => "Any"
+      | Url => "Url"
+      | Table => "Table"
+      | Sequence => "Sequence"
+      | View => "View"
+      | Relation => "Relation"
+      | Cookie => "Cookie"
+      | Style => "Style"
+fun r2s (r : rewrite) = pak2s (#kind r) ^ " " ^ pk2s (#pkind r) ^ ", from<" ^ #from r ^ ">, to<" ^ #to r ^ ">"
+
+val rewrites = ref ([] : rewrite list)
+
+fun subsume (pk1, pk2) =
+    pk1 = pk2
+    orelse pk2 = Any
+    orelse pk2 = Relation andalso (pk1 = Table orelse pk1 = Sequence orelse pk1 = View)
+
+fun setRewriteRules ls = rewrites := ls
+fun rewrite pk s =
+    let
+        fun rew (ls : rewrite list) =
+            case ls of
+                [] => s
+              | rewr :: ls =>
+                let
+                    fun match () =
+                        case #kind rewr of
+                            Exact => if #from rewr = s then
+                                         SOME (size s)
+                                     else
+                                         NONE
+                          | Prefix => if String.isPrefix (#from rewr) s then
+                                          SOME (size (#from rewr))
+                                      else
+                                          NONE
+                in
+                    if subsume (pk, #pkind rewr) then
+                        case match () of
+                            NONE => rew ls
+                          | SOME suffixStart =>
+                            let
+                                val s = #to rewr ^ String.extract (s, suffixStart, NONE)
+                            in
+                                if #hyphenate rewr then
+                                    String.translate (fn #"_" => "-" | ch => str ch) s
+                                else
+                                    s
+                            end
+                    else
+                        rew ls
+                end
+    in
+        rew (!rewrites)
+    end
+
+val url = ref ([] : rule list)
+val mime = ref ([] : rule list)
+val request = ref ([] : rule list)
+val response = ref ([] : rule list)
+val env = ref ([] : rule list)
+val meta = ref ([] : rule list)
+
+fun setUrlRules ls = url := ls
+fun setMimeRules ls = mime := ls
+fun setRequestHeaderRules ls = request := ls
+fun setResponseHeaderRules ls = response := ls
+fun setEnvVarRules ls = env := ls
+fun setMetaRules ls = meta := ls
+
+fun getUrlRules () = !url
+fun getMimeRules () = !mime
+fun getRequestHeaderRules () = !request
+fun getResponseHeaderRules () = !response
+fun getEnvVarRules () = !env
+fun getMetaRules () = !meta
+
+fun check f rules s =
+    let
+        fun chk (ls : rule list) =
+            case ls of
+                [] => false
+              | rule :: ls =>
+                let
+                    val matches =
+                        case #kind rule of
+                            Exact => #pattern rule = s
+                          | Prefix => String.isPrefix (#pattern rule) s
+                in
+                    if matches then
+                        case #action rule of
+                            Allow => true
+                          | Deny => false
+                    else
+                        chk ls
+                end
+    in
+        f s andalso chk (!rules)
+    end
+
+val checkUrl = check (fn _ => true) url
+
+val validMime = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"." orelse ch = #"+")
+val validEnv = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #".")
+val validMeta = CharVector.all (fn ch => Char.isAlpha ch orelse ch = #"-")
+
+val checkMime = check validMime mime
+val checkRequestHeader = check validMime request
+val checkResponseHeader = check validMime response
+val checkEnvVar = check validEnv env
+val checkMeta = check validMeta meta
+
+
+type protocol = {
+     name : string,
+     compile : string,
+     linkStatic : string,
+     linkDynamic : string,
+     persistent : bool,
+     code : unit -> Print.PD.pp_desc
+}
+val protocols = ref ([] : protocol list)
+fun addProtocol p = protocols := p :: !protocols
+fun getProtocol s = List.find (fn p => #name p = s) (!protocols)
+
+fun clibFile s = OS.Path.joinDirFile {dir = libC (),
+                                      file = s}
+
+val curProto = ref {name = "",
+                    compile = "",
+                    linkStatic = "",
+                    linkDynamic = "",
+                    persistent = false,
+                    code = fn () => Print.box []}
+fun setProtocol name =
+    case getProtocol name of
+        NONE => raise Fail ("Unknown protocol " ^ name)
+      | SOME p => curProto := p
+fun currentProtocol () = !curProto
+
+val debug = ref false
+fun setDebug b = debug := b
+fun getDebug () = !debug
+
+datatype sql_type =
+         Int
+       | Float
+       | String
+       | Char
+       | Bool
+       | Time
+       | Blob
+       | Channel
+       | Client
+       | Nullable of sql_type
+
+fun p_sql_ctype t =
+    let
+        open Print.PD
+        open Print
+    in
+        case t of
+            Int => "uw_Basis_int"
+          | Float => "uw_Basis_float"
+          | String => "uw_Basis_string"
+          | Char => "uw_Basis_char"
+          | Bool => "uw_Basis_bool"
+          | Time => "uw_Basis_time"
+          | Blob => "uw_Basis_blob"
+          | Channel => "uw_Basis_channel"
+          | Client => "uw_Basis_client"
+          | Nullable String => "uw_Basis_string"
+          | Nullable t => p_sql_ctype t ^ "*"
+    end
+
+fun isBlob Blob = true
+  | isBlob (Nullable t) = isBlob t
+  | isBlob _ = false
+
+fun isNotNull (Nullable _) = false
+  | isNotNull _ = true
+
+datatype failure_mode = Error | None
+
+type dbms = {
+     name : string,
+     randomFunction : string,
+     header : string,
+     link : string,
+     p_sql_type : sql_type -> string,
+     init : {dbstring : string,
+             prepared : (string * int) list,
+             tables : (string * (string * sql_type) list) list,
+             views : (string * (string * sql_type) list) list,
+             sequences : string list} -> Print.PD.pp_desc,
+     query : {loc : ErrorMsg.span, cols : sql_type list,
+              doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+                       -> Print.PD.pp_desc}
+             -> Print.PD.pp_desc,
+     queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
+                      inputs : sql_type list, cols : sql_type list,
+                      doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int,
+                                 typ : sql_type} -> Print.PD.pp_desc)
+                               -> Print.PD.pp_desc,
+                      nested : bool}
+                     -> Print.PD.pp_desc,
+     dml : ErrorMsg.span * failure_mode -> Print.PD.pp_desc,
+     dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
+                    inputs : sql_type list, mode : failure_mode} -> 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,
+     supportsDeleteAs : bool,
+     supportsUpdateAs : bool,
+     createSequence : string -> string,
+     textKeysNeedLengths : bool,
+     supportsNextval : bool,
+     supportsNestedPrepared : bool,
+     sqlPrefix : string,
+     supportsOctetLength : bool,
+     trueString : string,
+     falseString : string,
+     onlyUnion : bool,
+     nestedRelops : bool,
+     windowFunctions: bool,
+     supportsIsDistinctFrom : bool
+}
+
+val dbmses = ref ([] : dbms list)
+val curDb = ref ({name = "",
+                  randomFunction = "",
+                  header = "",
+                  link = "",
+                  p_sql_type = fn _ => "",
+                  init = fn _ => Print.box [],
+                  query = fn _ => Print.box [],
+                  queryPrepared = fn _ => Print.box [],
+                  dml = fn _ => Print.box [],
+                  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 _ => "",
+                  supportsDeleteAs = false,
+                  supportsUpdateAs = false,
+                  createSequence = fn _ => "",
+                  textKeysNeedLengths = false,
+                  supportsNextval = false,
+                  supportsNestedPrepared = false,
+                  sqlPrefix = "",
+                  supportsOctetLength = false,
+                  trueString = "",
+                  falseString = "",
+                  onlyUnion = false,
+                  nestedRelops = false,
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = false} : dbms)
+
+fun addDbms v = dbmses := v :: !dbmses
+fun setDbms s =
+    case List.find (fn db => #name db = s) (!dbmses) of
+        NONE => raise Fail ("Unknown DBMS " ^ s)
+      | SOME db => curDb := db
+fun currentDbms () = !curDb
+
+val dbstring = ref (NONE : string option)
+fun setDbstring so = dbstring := so
+fun getDbstring () = !dbstring
+
+val exe = ref (NONE : string option)
+fun setExe so = exe := so
+fun getExe () = !exe
+
+val sql = ref (NONE : string option)
+fun setSql so = sql := so
+fun getSql () = !sql
+
+val coreInline = ref 5
+fun setCoreInline n = coreInline := n
+fun getCoreInline () = !coreInline
+
+val monoInline = ref 5
+fun setMonoInline n = monoInline := n
+fun getMonoInline () = !monoInline
+
+val staticLinking = ref false
+fun setStaticLinking b = staticLinking := b
+fun getStaticLinking () = !staticLinking
+
+val bootLinking = ref false
+fun setBootLinking b = bootLinking := b
+fun getBootLinking () = !bootLinking
+
+val deadlines = ref false
+fun setDeadlines b = deadlines := b
+fun getDeadlines () = !deadlines
+
+val sigFile = ref (NONE : string option)
+fun setSigFile v = sigFile := v
+fun getSigFile () = !sigFile
+
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val safeGet = ref SS.empty
+fun setSafeGets ls = safeGet := SS.addList (SS.empty, ls)
+fun isSafeGet x = SS.member (!safeGet, x)
+
+val onError = ref (NONE : (string * string list * string) option)
+fun setOnError x = onError := x
+fun getOnError () = !onError
+
+val limits = ["messages", "clients", "headers", "page", "heap", "script",
+              "inputs", "subinputs", "cleanup", "deltas", "transactionals",
+              "globals", "database", "time"]
+
+val limitsList = ref ([] : (string * int) list)
+fun addLimit (v as (name, _)) =
+    if List.exists (fn name' => name' = name) limits then
+        (limitsList := v :: !limitsList;
+         if name = "time" then
+             setDeadlines true
+         else
+             ())
+    else
+        raise Fail ("Unknown limit category '" ^ name ^ "'")
+fun limits () = !limitsList
+
+val minHeap = ref 0
+fun setMinHeap n = if n >= 0 then minHeap := n else raise Fail "Trying to set negative minHeap"
+fun getMinHeap () = !minHeap
+
+val alwaysInline = ref SS.empty
+fun addAlwaysInline s = alwaysInline := SS.add (!alwaysInline, s)
+fun checkAlwaysInline s = SS.member (!alwaysInline, s)
+
+val neverInline = ref SS.empty
+fun addNeverInline s = neverInline := SS.add (!neverInline, s)
+fun checkNeverInline s = SS.member (!neverInline, s)
+
+val noXsrfProtection = ref SS.empty
+fun addNoXsrfProtection s = noXsrfProtection := SS.add (!noXsrfProtection, s)
+fun checkNoXsrfProtection s = SS.member (!noXsrfProtection, s)
+
+val timeFormat = ref "%c"
+fun setTimeFormat v = timeFormat := v
+fun getTimeFormat () = !timeFormat
+
+fun lowercase s =
+    case s of
+        "" => ""
+      | _ => str (Char.toLower (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+fun capitalize s =
+    case s of
+        "" => ""
+      | _ => str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+val allLower = CharVector.map Char.toLower
+
+val mangle = ref true
+fun setMangleSql x = mangle := x
+
+fun mangleSqlTable s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ capitalize s
+        else
+            lowercase s
+
+fun mangleSql s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ s
+        else
+            lowercase s
+
+fun mangleSqlCatalog s =
+    if #name (currentDbms ()) = "mysql" then
+        if !mangle then
+            "uw_" ^ allLower s
+        else
+            allLower s
+    else
+        if !mangle then
+            "uw_" ^ s
+        else
+            lowercase s
+
+val html5 = ref true
+fun setIsHtml5 b = html5 := b
+fun getIsHtml5 () = !html5
+
+val less = ref false
+fun setLessSafeFfi b = less := b
+fun getLessSafeFfi () = !less
+
+val sqlcache = ref false
+fun setSqlcache b = sqlcache := b
+fun getSqlcache () = !sqlcache
+
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val noMimeFile = ref false
+
+fun noMime () =
+    (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types.  Static files will be served with no suggested MIME types.\n");
+     noMimeFile := true;
+     SM.empty)
+
+fun readMimeTypes () =
+    let
+        val inf = FileIO.txtOpenIn "/etc/mime.types"
+
+        fun loop m =
+            case TextIO.inputLine inf of
+                NONE => m
+              | SOME line =>
+                if size line > 0 andalso String.sub (line, 0) = #"#" then
+                    loop m
+                else
+                    case String.tokens Char.isSpace line of
+                        typ :: exts =>
+                        loop (foldl (fn (ext, m) => SM.insert (m, ext, typ)) m exts)
+                      | _ => loop m
+    in
+        loop SM.empty
+        before TextIO.closeIn inf
+    end handle IO.Io _ => noMime ()
+             | OS.SysErr _ => noMime ()
+
+val mimeTypes = ref (NONE : string SM.map option)
+
+fun getMimeTypes () =
+    case !mimeTypes of
+        SOME m => m
+      | NONE =>
+        let
+            val m = readMimeTypes ()
+        in
+            mimeTypes := SOME m;
+            m
+        end
+
+fun mimeTypeOf filename =
+    case OS.Path.ext filename of
+        NONE => (if !noMimeFile then
+                     ()
+                 else
+                     TextIO.output (TextIO.stdErr, "WARNING: No extension found in filename '" ^ filename ^ "'.  Header 'Content-Type' will be omitted in HTTP responses.\n");
+                 NONE)
+      | SOME ext =>
+        let
+            val to = SM.find (getMimeTypes (), ext)
+        in
+            case to of
+                NONE => if !noMimeFile then
+                            ()
+                        else
+                            TextIO.output (TextIO.stdErr, "WARNING: No MIME type known for extension '" ^ ext ^ "'.  Header 'Content-Type' will be omitted in HTTP responses.\n")
+              | _ => ();
+            to
+        end
+
+val files = ref (SM.empty : (string * {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector}) SM.map)
+
+val filePath = ref "."
+
+fun setFilePath path = filePath := path
+
+fun addFile {Uri, LoadFromFilename} =
+    let
+        val path = OS.Path.concat (!filePath, LoadFromFilename)
+    in
+        case SM.find (!files, Uri) of
+            SOME (path', _) =>
+            if OS.Path.mkCanonical path' = OS.Path.mkCanonical path then
+                ()
+            else
+                ErrorMsg.error ("Two different files requested for URI " ^ Uri ^ " ( " ^ path' ^ " vs. " ^ path ^ ")")
+          | NONE =>
+            let
+                val inf = FileIO.binOpenIn path
+            in
+                files := SM.insert (!files,
+                                    Uri,
+                                    (path,
+                                     {Uri = Uri,
+                                      ContentType = mimeTypeOf path,
+                                      LastModified = OS.FileSys.modTime path,
+                                      Bytes = BinIO.inputAll inf}));
+                BinIO.closeIn inf
+            end
+    end handle IO.Io _ =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename)
+             | OS.SysErr (s, _) =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename ^ " (" ^ s ^ ")")
+
+fun listFiles () = map #2 (SM.listItems (!files))
+
+val jsFiles = ref (SM.empty : {Filename : string, Content : string} SM.map)
+
+fun addJsFile LoadFromFilename =
+    let
+        val path = OS.Path.concat (!filePath, LoadFromFilename)
+        val inf = FileIO.txtOpenIn path
+    in
+        jsFiles := SM.insert (!jsFiles,
+                              path,
+                              {Filename = LoadFromFilename,
+                               Content = TextIO.inputAll inf});
+        TextIO.closeIn inf
+    end handle IO.Io _ =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename)
+             | OS.SysErr (s, _) =>
+               ErrorMsg.error ("Error loading file " ^ LoadFromFilename ^ " (" ^ s ^ ")")
+
+fun listJsFiles () = SM.listItems (!jsFiles)
+
+val jsOutput = ref (NONE : string option)
+fun setOutputJsFile so = jsOutput := so
+fun getOutputJsFile () = !jsOutput
+
+fun reset () =
+    (Globals.setResetTime ();
+     urlPrefixFull := "/";
+     urlPrefix := "/";
+     urlPrePrefix := "";
+     timeout := 0;
+     headers := [];
+     scripts := [];
+     clientToServer := clientToServerBase;
+     effectful := effectfulBase;
+     benign := benignBase;
+     client := clientBase;
+     server := serverBase;
+     jsFuncs := jsFuncsBase;
+     rewrites := [];
+     url := [];
+     mime := [];
+     request := [];
+     response := [];
+     env := [];
+     meta := [];
+     debug := false;
+     dbstring := NONE;
+     exe := NONE;
+     sql := NONE;
+     coreInline := 5;
+     monoInline := 5;
+     staticLinking := false;
+     deadlines := false;
+     sigFile := NONE;
+     safeGet := SS.empty;
+     onError := NONE;
+     limitsList := [];
+     minHeap := 0;
+     alwaysInline := SS.empty;
+     neverInline := SS.empty;
+     noXsrfProtection := SS.empty;
+     timeFormat := "%c";
+     mangle := true;
+     html5 := false;
+     less := false;
+     noMimeFile := false;
+     mimeTypes := NONE;
+     files := SM.empty;
+     jsFiles := SM.empty;
+     filePath := ".";
+     jsOutput := NONE)
+
+end
diff --git a/src/sha1.sig b/src/sha1.sig
new file mode 100644
index 0000000..7fda97f
--- /dev/null
+++ b/src/sha1.sig
@@ -0,0 +1,31 @@
+
+(* Implementation the SHA-1 hash function.
+   Written by Tom 7 in 2004; code in the public domain. *)
+
+signature SHA1 =
+sig
+
+  (* Perform the SHA-1 hash function on a message.
+     Returns the 160 bit (20 byte) hash.
+
+     recall that string = CharVector.vector.
+     The input string may contain non-ascii data;
+     the output certainly will. *)
+
+  val hash : string -> string
+
+  (* pass in a stream as stateful function that returns
+     SOME s for some non-empty prefix of the remainder of
+     the stream, or NONE when the stream has ended. *)
+  val hash_stream : (unit -> string option) -> string
+
+  (* XXX move to hashutil *)
+  (* convert a binary string to one built of hex digits *)
+  val bintohex : string -> string
+
+  (* Parse a hexadecimal SHA-1 string. Uppercase and lowercase
+     are permitted. If the string is not the right length or
+     contains invalid characters, returns NONE. *)
+  val parse_hex : string -> string option
+
+end
diff --git a/src/sha1.sml b/src/sha1.sml
new file mode 100644
index 0000000..d962c4e
--- /dev/null
+++ b/src/sha1.sml
@@ -0,0 +1,264 @@
+
+(* RFC-3174 (SHA-1) hashing function.
+   By Tom 7, 2004: Code placed in the public domain.
+*)
+
+structure SHA1 :> SHA1 =
+struct
+  exception Unimplemented
+
+  val xorb = Word32.xorb
+  val andb = Word32.andb
+  val orb  = Word32.orb
+  val <<   = Word32.<<
+  val >>   = Word32.>>
+  val notb = Word32.notb
+  val ++   = Word32.+
+
+  type w32 = word
+  infix xorb andb orb << >> ++
+
+  (* workaround for andb bug in MLton 20010706 *)
+  fun mkbyte w = Word32.mod (w, 0w256)
+
+  fun ROL(X, N : Word.word) = (X << N) orb (X >> (0w32-N))
+
+  fun wc hi lo = (hi << 0w16) orb lo
+
+  fun w2b w = map chr
+    [Word32.toInt (mkbyte (w >> 0w24)),
+     Word32.toInt (mkbyte (w >> 0w16)),
+     Word32.toInt (mkbyte (w >> 0w8)),
+     Word32.toInt (mkbyte w)]
+
+  (* the length (arg in bytes, output in bits)
+     as a 64-bit quantity, big-endian *)
+  fun lenbits l =
+    implode (List.tabulate (4, fn _ => chr 0)) ^
+    implode (w2b (Word32.fromInt (l * 8)))
+
+
+  (* executes f for each index lo..hi-1 inclusive *)
+  fun for lo hi f =
+      if lo >= hi then ()
+      else (ignore (f lo); for (lo + 1) hi f)
+
+  fun ford lo hi b f =
+      if lo >= hi then b
+      else
+        let
+          val b = f (lo, b)
+        in
+          (ford (lo + 1) hi b f)
+        end
+
+  fun doblock (aa, bb, cc, dd, ee) msg =
+    let
+      val K0 = wc 0wx5A82 0wx7999
+      val K1 = wc 0wx6ED9 0wxEBA1
+      val K2 = wc 0wx8F1B 0wxBCDC
+      val K3 = wc 0wxCA62 0wxC1D6
+
+      fun mb n = Word32.fromInt (ord (CharVector.sub(msg, n)))
+
+      val W = Array.array(80, 0w0)
+      fun Ws x = Array.sub(W, x)
+
+      val _ =
+        for 0 16
+        (fn t =>
+         let in
+           Array.update(W, t,
+                        (mb (t * 4    ) << 0w24) orb
+                        (mb (t * 4 + 1) << 0w16) orb
+                        (mb (t * 4 + 2) << 0w8)  orb
+                        (mb (t * 4 + 3)))
+         end)
+
+      val _ =
+        for 16 80
+        (fn t =>
+         let
+           val n =
+             Ws (t-3)  xorb
+             Ws (t-8)  xorb
+             Ws (t-14) xorb
+             Ws (t-16)
+           val zz = ROL(n, 0w1)
+         in
+           Array.update(W, t, zz)
+         end)
+
+
+      val (A, B, C, D, E) = (aa, bb, cc, dd, ee)
+
+
+      fun round lo hi f k ctxt =
+        ford lo hi ctxt
+        (fn (t, ctxt as (A, B, C, D, E)) =>
+         let
+           val temp = ROL(A, 0w5) ++ (f ctxt) ++ E ++ Ws t ++ k
+           val E = D;
+           val D = C;
+           val C = ROL(B, 0w30)
+           val B = A
+           val A = temp
+         in
+           (A, B, C, D, E)
+         end)
+
+      val (A, B, C, D, E) =
+        round 0 20 (fn (A, B, C, D, E) =>
+                    ((B andb C) orb ((notb B) andb D)))
+                   K0 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 20 40 (fn (A, B, C, D, E) =>
+                     (B xorb C xorb D))
+                    K1 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 40 60 (fn (A, B, C, D, E) =>
+                     ((B andb C) orb (B andb D) orb (C andb D)))
+                    K2 (A, B, C, D, E)
+
+      val (A, B, C, D, E) =
+        round 60 80 (fn (A, B, C, D, E) =>
+                     (B xorb C xorb D))
+                    K3 (A, B, C, D, E)
+
+    in
+      (aa ++ A, bb ++ B, cc ++ C, dd ++ D, ee ++ E)
+    end
+
+  datatype 'a stream =
+      Cons of ('a * (unit -> 'a stream))
+    | Nil
+
+  (* turn a stream of oddly chunked strings into
+     one with 512-bit blocks *)
+  fun chunk_512 s =
+    let
+
+      (* the padding required to make a message of length l (bytes)
+         a proper SHA-1 input. Returns either one or two Cons cells.
+         tail is the end of the input (63 bytes or less)
+         l is the total length of the input, *including* the length of the
+         tail end *)
+      fun padding tail l =
+          let val v = l mod 64 in
+            if v < 56 then
+              let val p = 56 - v
+                val padding = implode (List.tabulate (p - 1, fn _ => chr 0))
+              in Cons (tail ^ str (chr 0x80) ^ padding ^ lenbits l,
+                    fn _ => Nil)
+              end
+            else if v < 64 then
+              let val p = 64 - v
+                val padding1 = implode (List.tabulate (p - 1, fn _ => chr 0))
+                val padding2 = implode (List.tabulate (56, fn _ => chr 0))
+              in Cons (tail ^ str (chr 0x80) ^ padding1,
+                    fn _ => Cons (padding2 ^ lenbits l, fn _ => Nil))
+              end
+            else raise Unimplemented (* Impossible? *)
+          end
+
+      (* n is the bytes we've already output.
+         cur is a string (of 64 bytes or less) that will
+         be our next chunk.
+         rest,sofar is a string and index indicating the
+         next bit of data. *)
+      (* PERF Could be more efficient by using an
+         accumulating array instead of a string for cur *)
+      fun ch n cur sofar startat () =
+        (* if we already have 64 bytes, return it *)
+        if size cur = 64
+        then
+          let in
+            Cons(cur, ch (n + 64) "" sofar startat)
+          end
+        else
+          (* do we have any in 'sofar'? *)
+          if startat < size sofar
+          then let
+                 val get = Int.min(size sofar - startat,
+                                   64 - size cur)
+               in
+                 (* be eager, since we need to return something now *)
+                 ch n (cur ^ String.substring(sofar, startat, get))
+                    sofar (startat + get) ()
+               end
+          else
+            (* sofar has been exhausted,
+               so get some from input stream *)
+            (case s () of
+               (* eager, again *)
+               SOME ss => ch n cur ss 0 ()
+             | NONE =>
+                 (* no more data. *)
+                 padding cur (n + size cur))
+    in
+      ch 0 "" "" 0
+    end
+
+  fun hash_stream orig_stream =
+    let
+
+      val stream512 = chunk_512 orig_stream
+
+      (* gets hash context, length of string so far (bytes),
+         and tail of stream *)
+      fun hash_rest stream ctxt =
+        (case stream() of
+           Cons (s, stream) =>
+             let val ctxt = doblock ctxt s
+             in  hash_rest stream ctxt
+             end
+         | Nil => ctxt)
+
+      val init =
+        (wc 0wx6745 0wx2301,
+         wc 0wxefcd 0wxab89,
+         wc 0wx98ba 0wxdcfe,
+         wc 0wx1032 0wx5476,
+         wc 0wxc3d2 0wxe1f0)
+
+      val (a, b, c, d, e) = hash_rest stream512 init
+    in
+      implode (w2b a @ w2b b @ w2b c @ w2b d @ w2b e)
+    end
+
+  fun hash m =
+    hash_stream
+    (let val r = ref true
+     in (fn () =>
+         if !r
+         then (r := false; SOME m)
+         else NONE)
+     end)
+
+  val digits = "0123456789ABCDEF"
+  fun bintohex s =
+    String.translate (fn c =>
+                      implode [CharVector.sub (digits, ord c div 16),
+                               CharVector.sub (digits, ord c mod 16)]) s
+
+  (* ASCII trick: (ch | 4400) % 55 *)
+  fun hexvalue ch =
+    SysWord.toInt (SysWord.orb(SysWord.fromInt(ord ch), SysWord.fromInt 4400)) mod 55
+
+  fun parse_hex s =
+      if size s <> 40
+         orelse not (CharVector.all (fn c => (ord c >= ord #"0" andalso
+                                              ord c <= ord #"9") orelse
+                                     (ord c >= ord #"a" andalso
+                                      ord c <= ord #"f") orelse
+                                     (ord c >= ord #"A" andalso
+                                      ord c <= ord #"F")) s)
+      then NONE
+      else SOME (CharVector.tabulate(20,
+                                     (fn i =>
+                                      chr(hexvalue (String.sub(s, i * 2)) * 16 +
+                                          hexvalue (String.sub(s, i * 2 + 1))))))
+
+end
diff --git a/src/shake.sig b/src/shake.sig
new file mode 100644
index 0000000..2b805de
--- /dev/null
+++ b/src/shake.sig
@@ -0,0 +1,37 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove unused definitions from a file *)
+
+signature SHAKE = sig
+
+    val shake : Core.file -> Core.file
+
+    val sliceDb : bool ref
+    (* Set this to try to delete anything not needed to determine the database schema. *)
+
+end
diff --git a/src/shake.sml b/src/shake.sml
new file mode 100644
index 0000000..051507d
--- /dev/null
+++ b/src/shake.sml
@@ -0,0 +1,229 @@
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove unused definitions from a file *)
+
+structure Shake :> SHAKE = struct
+
+val sliceDb = ref false
+
+open Core
+
+structure U = CoreUtil
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+type free = {
+     con : IS.set,
+     exp : IS.set
+}
+
+val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan)
+val dummye = (EPrim (Prim.String (Prim.Normal, "")), ErrorMsg.dummySpan)
+
+fun tupleC cs = (CTuple cs, ErrorMsg.dummySpan)
+fun tupleE es = (ERecord (map (fn e => (dummyt, e, dummyt)) es), ErrorMsg.dummySpan)
+
+fun shake file =
+    let
+        val usedVarsC = U.Con.fold {kind = fn (_, st) => st,
+                                    con = fn (c, cs) =>
+                                             case c of
+                                                 CNamed n => IS.add (cs, n)
+                                               | _ => cs}
+
+        val usedVars = U.Exp.fold {kind = fn (_, st) => st,
+                                   con = fn (c, st as (es, cs)) =>
+                                            case c of
+                                                CNamed n => (es, IS.add (cs, n))
+                                              | _ => st,
+                                   exp = fn (e, st as (es, cs)) =>
+                                            case e of
+                                                ENamed n => (IS.add (es, n), cs)
+                                              | _ => st}
+
+        val (usedE, usedC) =
+            List.foldl
+                (fn ((DExport (_, n, _), _), st as (usedE, usedC)) =>
+                    if !sliceDb then
+                        st
+                    else
+                        (IS.add (usedE, n), usedC)
+                  | ((DTable (_, _, c, _, pe, pc, ce, cc), _), (usedE, usedC)) =>
+                    let
+                        val usedC = usedVarsC usedC c
+                        val usedC = usedVarsC usedC pc
+                        val usedC = usedVarsC usedC cc
+
+                        val (usedE, usedC) = usedVars (usedE, usedC) pe
+                        val (usedE, usedC) = usedVars (usedE, usedC) ce
+                    in
+                        (usedE, usedC)
+                    end
+                  | ((DView (_, _, _, e, c), _), (usedE, usedC)) =>
+                    let
+                        val usedC = usedVarsC usedC c
+                    in
+                        usedVars (usedE, usedC) e
+                    end
+                  | ((DTask (e1, e2), _), st) =>
+                    if !sliceDb then
+                        st
+                    else
+                        usedVars (usedVars st e1) e2
+                  | ((DPolicy e1, _), st) =>
+                    if !sliceDb then
+                        st
+                    else
+                        usedVars st e1
+                  | ((DOnError n, _), st as (usedE, usedC)) =>
+                    if !sliceDb then
+                        st
+                    else
+                        (IS.add (usedE, n), usedC)
+                  | (_, acc) => acc) (IS.empty, IS.empty) file
+
+        val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
+                                   | ((DDatatype dts, _), (cdef, edef)) =>
+                                     (foldl (fn ((_, n, _, xncs), cdef) =>
+                                                IM.insert (cdef, n, List.mapPartial #3 xncs)) cdef dts, edef)
+                                   | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], t, e)))
+                                   | ((DValRec vis, _), (cdef, edef)) =>
+                                     let
+                                         val all_ns = map (fn (_, n, _, _, _) => n) vis
+                                     in
+                                         (cdef, foldl (fn ((_, n, t, e, _), edef) =>
+                                                          IM.insert (edef, n, (all_ns, t, e))) edef vis)
+                                     end
+                                   | ((DExport _, _), acc) => acc
+                                   | ((DTable (_, n, c, _, e1, c1, e2, c2), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], tupleC [c, c1, c2], tupleE [e1, e2])))
+                                   | ((DSequence (_, n, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
+                                   | ((DView (_, n, _, _, c), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], c, dummye)))
+                                   | ((DDatabase _, _), acc) => acc
+                                   | ((DCookie (_, n, c, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], c, dummye)))
+                                   | ((DStyle (_, n, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
+                                   | ((DTask _, _), acc) => acc
+                                   | ((DPolicy _, _), acc) => acc
+                                   | ((DOnError _, _), acc) => acc)
+                                 (IM.empty, IM.empty) file
+
+        fun kind (_, s) = s
+
+        fun con (c, s) =
+            case c of
+                CNamed n =>
+                if IS.member (#con s, n) then
+                    s
+                else
+                    let
+                        val s' = {con = IS.add (#con s, n),
+                                  exp = #exp s}
+                    in
+                        case IM.find (cdef, n) of
+                            NONE => s'
+                          | SOME cs => foldl (fn (c, s') => shakeCon s' c) s' cs
+                    end
+              | _ => s
+
+        and shakeCon s = U.Con.fold {kind = kind, con = con} s
+
+        (*val () = print "=====\nSHAKE\n=====\n"
+        val current = ref 0*)
+
+        fun exp (e, s) =
+            let
+                fun check n =
+                    if IS.member (#exp s, n) then
+                        s
+                    else
+                        let
+                            val s' = {exp = IS.add (#exp s, n),
+                                      con = #con s}
+                        in
+                            (*print ("Need " ^ Int.toString n ^ " <-- " ^ Int.toString (!current) ^ "\n");*)
+                            case IM.find (edef, n) of
+                                NONE => s'
+                              | SOME (ns, t, e) =>
+                                let
+                                    (*val old = !current
+                                    val () = current := n*)
+                                    val s' = shakeExp (shakeCon s' t) e
+                                in
+                                    (*current := old;*)
+                                    foldl (fn (n, s') => exp (ENamed n, s')) s' ns
+                                end
+                        end
+            in
+                case e of
+                    ENamed n => check n
+                  | EServerCall (n, _, _, _) => check n
+                  | _ => s
+            end
+
+        and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s
+
+        val s = {con = usedC, exp = usedE}
+
+        val s = IS.foldl (fn (n, s) =>
+                             case IM.find (edef, n) of
+                                 NONE => raise Fail "Shake: Couldn't find 'val'"
+                               | SOME (ns, t, e) =>
+                                 let
+                                     (*val () = current := n*)
+                                     val s = shakeExp (shakeCon s t) e
+                                 in
+                                     foldl (fn (n, s) => exp (ENamed n, s)) s ns
+                                 end) s usedE
+
+        val s = IS.foldl (fn (n, s) =>
+                             case IM.find (cdef, n) of
+                                 NONE => raise Fail ("Shake: Couldn't find 'con' " ^ Int.toString n)
+                               | SOME cs => foldl (fn (c, s) => shakeCon s c) s cs) s usedC
+    in
+        List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n)
+                      | (DDatatype dts, _) => List.exists (fn (_, n, _, _) => IS.member (#con s, n)) dts
+                      | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
+                      | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
+                      | (DExport _, _) => not (!sliceDb)
+                      | (DView _, _) => true
+                      | (DSequence _, _) => true
+                      | (DTable _, _) => true
+                      | (DDatabase _, _) => not (!sliceDb)
+                      | (DCookie _, _) => not (!sliceDb)
+                      | (DStyle _, _) => not (!sliceDb)
+                      | (DTask _, _) => not (!sliceDb)
+                      | (DPolicy _, _) => not (!sliceDb)
+                      | (DOnError _, _) => not (!sliceDb)) file
+    end
+
+end
diff --git a/src/sidecheck.sig b/src/sidecheck.sig
new file mode 100644
index 0000000..1e3e227
--- /dev/null
+++ b/src/sidecheck.sig
@@ -0,0 +1,37 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SIDE_CHECK = sig
+
+    val check : Mono.file -> Mono.file
+
+    (* While we're checking, we'll do some other signature-related work, recording
+     * which environment variables are read.  This function conveys the list,
+     * coming from the most recent call to [check]. *)
+    val readEnvVars : unit -> string list
+
+end
diff --git a/src/sidecheck.sml b/src/sidecheck.sml
new file mode 100644
index 0000000..bd11223
--- /dev/null
+++ b/src/sidecheck.sml
@@ -0,0 +1,84 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure SideCheck :> SIDE_CHECK = struct
+
+open Mono
+
+structure E = ErrorMsg
+
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+
+val envVars = ref SS.empty
+
+fun check ds =
+    let
+        val alreadyWarned = ref false
+    in
+        envVars := SS.empty;
+        MonoUtil.File.appLoc (fn (e, loc) =>
+                                 let
+                                     fun error (k as (k1, k2)) =
+                                         if Settings.isClientOnly k then
+                                             let
+                                                 val k2 = case k1 of
+                                                              "Basis" =>
+                                                              (case k2 of
+                                                                   "get_client_source" => "get"
+                                                                 | _ => k2)
+                                                            | _ => k2
+                                             in
+                                                 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
+                                             end
+                                         else
+                                             ()
+                                 in
+                                     case e of
+                                         EFfi k => error k
+                                       | EFfiApp ("Basis", "getenv", [(e, _)]) =>
+                                         (case #1 e of
+                                              EPrim (Prim.String (_, s)) =>
+                                              envVars := SS.add (!envVars, s)
+                                            | _ => if !alreadyWarned then
+                                                       ()
+                                                   else
+                                                       (alreadyWarned := true;
+                                                        TextIO.output (TextIO.stdErr, "WARNING: " ^ ErrorMsg.spanToString loc ^ ": reading from an environment variable not determined at compile time, which can confuse CSRF protection")))
+                                       | EFfiApp (k1, k2, _) => error (k1, k2)
+                                       | _ => ()
+                                 end) ds;
+        ds
+    end
+
+fun readEnvVars () = SS.listItems (!envVars)
+
+end
diff --git a/src/sigcheck.sig b/src/sigcheck.sig
new file mode 100644
index 0000000..565621c
--- /dev/null
+++ b/src/sigcheck.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Make sure that no global variable initializers mention signature generation,
+ * because said generation only makes sense in the context of a page view.
+ * Replace such global variables with functions. *)
+
+signature SIG_CHECK = sig
+
+    val check : Mono.file -> Mono.file
+
+end
diff --git a/src/sigcheck.sml b/src/sigcheck.sml
new file mode 100644
index 0000000..a6ed765
--- /dev/null
+++ b/src/sigcheck.sml
@@ -0,0 +1,97 @@
+(* Copyright (c) 2013, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure SigCheck :> SIG_CHECK = struct
+
+open Mono
+
+structure IS = IntBinarySet
+structure E = ErrorMsg
+
+fun check (ds, sl) =
+    let
+        fun isSiggy siggers =
+            MonoUtil.Decl.exists {typ = fn _ => false,
+                                  decl = fn _ => false,
+                                  exp = fn e =>
+                                        case e of
+                                            ERel n => IS.member (siggers, n)
+                                          | EFfiApp ("Basis", "sigString", _) => true
+                                          | _ => false}
+
+        fun sigify' sigdecs e =
+            case e of
+                ENamed n => if IS.member (sigdecs, n) then
+                                (EApp ((e, E.dummySpan),
+                                       (ERecord [], E.dummySpan)))
+                            else
+                                e
+              | _ => e
+
+        fun sigify sigdecs =
+            MonoUtil.Decl.map {typ = fn x => x,
+                               decl = fn d => d,
+                               exp = sigify' sigdecs}
+
+        fun sigifyE sigdecs =
+            MonoUtil.Exp.map {typ = fn x => x,
+                              exp = sigify' sigdecs}
+
+        fun isFun (e, _) =
+            case e of
+                EAbs _ => true
+              | _ => false
+
+        fun doDecl (d : decl, (siggers, sigdecs)) =
+            case #1 d of
+                DVal (x, n, t, e, s) =>
+                if isSiggy siggers d then
+                    if isFun e then
+                        (sigify sigdecs d, (IS.add (siggers, n), sigdecs))
+                    else
+                        ((DVal (x, n, (TFun ((TRecord [], #2 d), t), #2 d),
+                                (EAbs ("_", (TRecord [], #2 d), t, sigifyE sigdecs e), #2 d),
+                                s), #2 d),
+                         (IS.add (siggers, n),
+                          IS.add (sigdecs, n)))
+                else
+                    (sigify sigdecs d, (siggers, sigdecs))
+              | DValRec vis =>
+                if isSiggy siggers d then
+                    (sigify sigdecs d,
+                     (foldl IS.add' siggers (map #2 vis),
+                      sigdecs))
+                else
+                    (sigify sigdecs d, (siggers, sigdecs))
+              | _ => (sigify sigdecs d, (siggers, sigdecs))
+
+        val (ds, _) = ListUtil.foldlMap doDecl (IS.empty, IS.empty) ds
+    in
+        (ds, sl)
+    end
+
+end
diff --git a/src/source.sml b/src/source.sml
new file mode 100644
index 0000000..2d8c1ed
--- /dev/null
+++ b/src/source.sml
@@ -0,0 +1,192 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Source = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype kind' =
+         KType
+       | KArrow of kind * kind
+       | KName
+       | KRecord of kind
+       | KUnit
+       | KTuple of kind list
+       | KWild
+
+       | KFun of string * kind
+       | KVar of string
+
+withtype kind = kind' located
+
+datatype explicitness =
+         Explicit
+       | Implicit
+
+datatype con' =
+         CAnnot of con * kind
+
+       | TFun of con * con
+       | TCFun of explicitness * string * kind * con
+       | TRecord of con
+       | TDisjoint of con * con * con
+
+       | CVar of string list * string
+       | CApp of con * con
+       | CAbs of string * kind option * con
+
+       | CKAbs of string * con
+       | TKFun of string * con
+
+       | CName of string
+
+       | CRecord of (con * con) list
+       | CConcat of con * con
+       | CMap
+
+       | CUnit
+
+       | CTuple of con list
+       | CProj of con * int
+
+       | CWild of kind
+
+withtype con = con' located
+
+datatype inference =
+         Infer
+       | DontInfer
+       | TypesOnly
+
+datatype sgn_item' =
+         SgiConAbs of string * kind
+       | SgiCon of string * kind option * con
+       | SgiDatatype of (string * string list * (string * con option) list) list
+       | SgiDatatypeImp of string * string list * string
+       | SgiVal of string * con
+       | SgiTable of string * con * exp * exp
+       | SgiStr of string * sgn
+       | SgiSgn of string * sgn
+       | SgiInclude of sgn
+       | SgiConstraint of con * con
+       | SgiClassAbs of string * kind
+       | SgiClass of string * kind * con
+
+and sgn' =
+    SgnConst of sgn_item list
+  | SgnVar of string
+  | SgnFun of string * sgn * sgn
+  | SgnWhere of sgn * string list * string * con
+  | SgnProj of string * string list * string
+
+and pat' =
+    PVar of string
+  | PPrim of Prim.t
+  | PCon of string list * string * pat option
+  | PRecord of (string * pat) list * bool
+  | PAnnot of pat * con
+
+and exp' =
+    EAnnot of exp * con
+
+  | EPrim of Prim.t
+  | EVar of string list * string * inference
+  | EApp of exp * exp
+  | EAbs of string * con option * exp
+  | ECApp of exp * con
+  | ECAbs of explicitness * string * kind * exp
+  | EDisjoint of con * con * exp
+  | EDisjointApp of exp
+
+  | EKAbs of string * exp
+
+  | ERecord of (con * exp) list * bool
+  | EField of exp * con
+  | EConcat of exp * exp
+  | ECut of exp * con
+  | ECutMulti of exp * con
+
+  | EWild
+
+  | ECase of exp * (pat * exp) list
+
+  | ELet of edecl list * exp
+
+and edecl' =
+    EDVal of pat * exp
+  | EDValRec of (string * con option * exp) list
+
+withtype sgn_item = sgn_item' located
+and sgn = sgn' located
+and pat = pat' located
+and exp = exp' located
+and edecl = edecl' located
+
+datatype ffi_mode =
+         Effectful
+       | BenignEffectful
+       | ClientOnly
+       | ServerOnly
+       | JsFunc of string
+
+datatype decl' =
+         DCon of string * kind option * con
+       | DDatatype of (string * string list * (string * con option) list) list
+       | DDatatypeImp of string * string list * string
+       | DVal of pat * exp
+       | DValRec of (string * con option * exp) list
+       | DSgn of string * sgn
+       | DStr of string * sgn option * Time.time option * str * bool (* did this module come from the '-root' directive? *)
+       | DFfiStr of string * sgn * Time.time option
+       | DOpen of string * string list
+       | DConstraint of con * con
+       | DOpenConstraints of string * string list
+       | DExport of str
+       | DTable of string * con * exp * exp
+       | DSequence of string
+       | DView of string * exp
+       | DDatabase of string
+       | DCookie of string * con
+       | DStyle of string
+       | DTask of exp * exp
+       | DPolicy of exp
+       | DOnError of string * string list * string
+       | DFfi of string * ffi_mode list * con
+
+     and str' =
+         StrConst of decl list
+       | StrVar of string
+       | StrProj of str * string
+       | StrFun of string * sgn * sgn option * str
+       | StrApp of str * str
+
+withtype decl = decl' located
+     and str = str' located
+
+type file = decl list
+
+end
diff --git a/src/source_print.sig b/src/source_print.sig
new file mode 100644
index 0000000..f5b0df2
--- /dev/null
+++ b/src/source_print.sig
@@ -0,0 +1,40 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web *)
+
+signature SOURCE_PRINT = sig
+    val p_kind : Source.kind Print.printer
+    val p_explicitness : Source.explicitness Print.printer
+    val p_con : Source.con Print.printer
+    val p_exp : Source.exp Print.printer
+    val p_decl : Source.decl Print.printer
+    val p_edecl : Source.edecl Print.printer
+    val p_sgn_item : Source.sgn_item Print.printer
+    val p_str : Source.str Print.printer
+    val p_file : Source.file Print.printer
+end
diff --git a/src/source_print.sml b/src/source_print.sml
new file mode 100644
index 0000000..e18a82f
--- /dev/null
+++ b/src/source_print.sml
@@ -0,0 +1,728 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Ur/Web *)
+
+structure SourcePrint :> SOURCE_PRINT = struct
+
+open Print.PD
+open Print
+
+open Source
+
+fun p_kind' par (k, _) =
+    case k of
+        KType => string "Type"
+      | KArrow (k1, k2) => parenIf par (box [p_kind' true k1,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_kind k2])
+      | KName => string "Name"
+      | KRecord k => box [string "{", p_kind k, string "}"]
+      | KUnit => string "Unit"
+      | KWild => string "_"
+      | KTuple ks => box [string "(",
+                          p_list_sep (box [space, string "*", space]) p_kind ks,
+                          string ")"]
+
+      | KVar x => string x
+      | KFun (x, k) => box [string x,
+                            space,
+                            string "-->",
+                            space,
+                            p_kind k]
+
+and p_kind k = p_kind' false k
+
+fun p_explicitness e =
+    case e of
+        Explicit => string "::"
+      | Implicit => string ":::"
+
+fun p_con' par (c, _) =
+    case c of
+        CAnnot (c, k) => box [string "(",
+                              p_con c,
+                              space,
+                              string "::",
+                              space,
+                              p_kind k,
+                              string ")"]
+
+      | TFun (t1, t2) => parenIf par (box [p_con' true t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_con t2])
+      | TCFun (e, x, k, c) => parenIf par (box [string x,
+                                                space,
+                                                p_explicitness e,
+                                                space,
+                                                p_kind k,
+                                                space,
+                                                string "->",
+                                                space,
+                                                p_con c])
+      | TRecord (CRecord xcs, _) => box [string "{",
+                                         p_list (fn (x, c) =>
+                                                    box [p_name x,
+                                                         space,
+                                                         string ":",
+                                                         space,
+                                                         p_con c]) xcs,
+                                         string "}"]
+      | TRecord c => box [string "$",
+                          p_con' true c]
+      | TDisjoint (c1, c2, c3) => parenIf par (box [string "[",
+                                                    p_con c1,
+                                                    space,
+                                                    string "~",
+                                                    space,
+                                                    p_con c2,
+                                                    string "]",
+                                                    space,
+                                                    string "=>",
+                                                    space,
+                                                    p_con c3])
+
+      | CVar (ss, s) => p_list_sep (string ".") string (ss @ [s])
+      | CApp (c1, c2) => parenIf par (box [p_con c1,
+                                           space,
+                                           p_con' true c2])
+      | CAbs (x, NONE, c) => parenIf par (box [string "fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_con c])
+      | CAbs (x, SOME k, c) => parenIf par (box [string "fn",
+                                                 space,
+                                                 string x,
+                                                 space,
+                                                 string "::",
+                                                 space,
+                                                 p_kind k,
+                                                 space,
+                                                 string "=>",
+                                                 space,
+                                                 p_con c])
+
+
+      | CName s => box [string "#", string s]
+
+      | CRecord xcs => box [string "[",
+                            p_list (fn (x, c) =>
+                                       box [p_con x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_con c]) xcs,
+                            string "]"]
+      | CConcat (c1, c2) => parenIf par (box [p_con' true c1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_con c2])
+      | CMap => string "map"
+
+      | CUnit => string "()"
+
+      | CWild k => box [string "(_",
+                        space,
+                        string "::",
+                        space,
+                        p_kind k,
+                        string ")"]
+
+      | CTuple cs => box [string "(",
+                          p_list p_con cs,
+                          string ")"]
+      | CProj (c, n) => box [p_con c,
+                             string ".",
+                             string (Int.toString n)]
+
+      | CKAbs (x, c) => box [string x,
+                             space,
+                             string "==>",
+                             space,
+                             p_con c]
+      | TKFun (x, c) => box [string x,
+                             space,
+                             string "-->",
+                             space,
+                             p_con c]
+        
+and p_con c = p_con' false c
+
+and p_name (all as (c, _)) =
+    case c of
+        CName s => string s
+      | _ => p_con all
+
+fun p_pat' par (p, _) =
+    case p of
+        PVar s => string s
+      | PPrim p => Prim.p_t p
+      | PCon (ms, x, NONE) => p_list_sep (string ".") string (ms @ [x])
+      | PCon (ms, x, SOME p) => parenIf par (box [p_list_sep (string ".") string (ms @ [x]),
+                                                  space,
+                                                  p_pat' true p])
+      | PRecord (xps, flex) =>
+        let
+            val pps = map (fn (x, p) => box [string x, space, string "=", space, p_pat p]) xps
+        in
+            box [string "{",
+                 p_list_sep (box [string ",", space]) (fn x => x)
+                 (if flex then
+                      pps @ [string "..."]
+                  else
+                      pps),
+                 string "}"]
+        end
+
+      | PAnnot (p, t) => box [p_pat p,
+                              space,
+                              string ":",
+                              space,
+                              p_con t]
+
+and p_pat x = p_pat' false x
+
+fun p_exp' par (e, _) =
+    case e of
+        EAnnot (e, t) => box [string "(",
+                              p_exp e,
+                              space,
+                              string ":",
+                              space,
+                              p_con t,
+                              string ")"]        
+
+      | EPrim p => Prim.p_t p
+      | EVar (ss, s, _) => p_list_sep (string ".") string (ss @ [s])
+      | EApp (e1, e2) => parenIf par (box [p_exp e1,
+                                           space,
+                                           p_exp' true e2])
+      | EAbs (x, NONE, e) => parenIf par (box [string "fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_exp e])
+      | EAbs (x, SOME t, e) => parenIf par (box [string "fn",
+                                                 space,
+                                                 string x,
+                                                 space,
+                                                 string ":",
+                                                 space,
+                                                 p_con t,
+                                                 space,
+                                                 string "=>",
+                                                 space,
+                                                 p_exp e])
+      | ECApp (e, c) => parenIf par (box [p_exp e,
+                                          space,
+                                          string "[",
+                                          p_con c,
+                                          string "]"])
+      | ECAbs (exp, x, k, e) => parenIf par (box [string "fn",
+                                                  space,
+                                                  string x,
+                                                  space,
+                                                  p_explicitness exp,
+                                                  space,
+                                                  p_kind k,
+                                                  space,
+                                                  string "=>",
+                                                  space,
+                                                  p_exp e])
+      | EDisjoint (c1, c2, e) => parenIf par (box [p_con c1,
+                                                   space,
+                                                   string "~",
+                                                   space,
+                                                   p_con c2,
+                                                   space,
+                                                   string "=>",
+                                                   space,
+                                                   p_exp e])
+      | EDisjointApp e => parenIf par (box [p_exp e,
+                                            space,
+                                            string "!"])
+
+      | ERecord (xes, flex) => box [string "{",
+                                    p_list (fn (x, e) =>
+                                               box [p_name x,
+                                                    space,
+                                                    string "=",
+                                                    space,
+                                                    p_exp e]) xes,
+                                    if flex then
+                                        box [string ",",
+                                             space,
+                                             string "..."]
+                                    else
+                                        box [],
+                                    string "}"]
+      | EField (e, c) => box [p_exp' true e,
+                              string ".",
+                              p_con' true c]
+      | EConcat (e1, e2) => parenIf par (box [p_exp' true e1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_exp' true e2])
+      | ECut (e, c) => parenIf par (box [p_exp' true e,
+                                         space,
+                                         string "--",
+                                         space,
+                                         p_con' true c])
+      | ECutMulti (e, c) => parenIf par (box [p_exp' true e,
+                                              space,
+                                              string "---",
+                                              space,
+                                              p_con' true c])
+      | ECase (e, pes) => parenIf par (box [string "case",
+                                            space,
+                                            p_exp e,
+                                            space,
+                                            string "of",
+                                            space,
+                                            p_list_sep (box [space, string "|", space])
+                                            (fn (p, e) => box [p_pat p,
+                                                               space,
+                                                               string "=>",
+                                                               space,
+                                                               p_exp e]) pes])
+
+      | EWild => string "_"
+
+      | ELet (ds, e) => box [string "let",
+                             newline,
+                             box [p_list_sep newline p_edecl ds],
+                             newline,
+                             string "in",
+                             newline,
+                             box [p_exp e],
+                             newline,
+                             string "end"]
+
+      | EKAbs (x, e) => box [string x,
+                             space,
+                             string "-->",
+                             space,
+                             p_exp e]
+
+and p_exp e = p_exp' false e
+
+and p_edecl (d, _) =
+  case d of
+      EDVal (p, e) => box [string "val",
+                           space,
+                           p_pat p,
+                           space,
+                           string "=",
+                           space,
+                           p_exp e]
+    | EDValRec vis => box [string "val",
+                           space,
+                           string "rec",
+                           space,
+                           p_list_sep (box [newline, string "and", space]) p_vali vis]
+
+and p_vali (x, co, e) =
+    case co of
+        NONE => box [string x,
+                     space,
+                     string "=",
+                     space,
+                     p_exp e]
+      | SOME t => box [string x,
+                       space,
+                       string ":",
+                       space,
+                       p_con t,
+                       space,
+                       string "=",
+                       space,
+                       p_exp e]
+
+
+fun p_datatype (x, xs, cons) =
+    box [string x,
+         p_list_sep (box []) (fn x => box [space, string x]) xs,
+         space,
+         string "=",
+         space,
+         p_list_sep (box [space, string "|", space])
+         (fn (x, NONE) => string x
+           | (x, SOME t) => box [string x, space, string "of", space, p_con t])
+         cons]
+
+fun p_sgn_item (sgi, _) =
+    case sgi of
+        SgiConAbs (x, k) => box [string "con",
+                                 space,
+                                 string x,
+                                 space,
+                                 string "::",
+                                 space,
+                                 p_kind k]
+      | SgiCon (x, NONE, c) => box [string "con",
+                                    space,
+                                    string x,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_con c]
+      | SgiCon (x, SOME k, c) => box [string "con",
+                                      space,
+                                      string x,
+                                      space,
+                                      string "::",
+                                      space,
+                                      p_kind k,
+                                      space,
+                                      string "=",
+                                      space,
+                                      p_con c]
+      | SgiDatatype x => box [string "datatype",
+                              space,
+                              p_list_sep (box [space, string "and", space]) p_datatype x]
+      | SgiDatatypeImp (x, ms, x') =>
+        box [string "datatype",
+             space,
+             string x,
+             space,
+             string "=",
+             space,
+             string "datatype",
+             space,
+             p_list_sep (string ".") string (ms @ [x'])]
+      | SgiVal (x, c) => box [string "val",
+                              space,
+                              string x,
+                              space,
+                              string ":",
+                              space,
+                              p_con c]
+      | SgiTable (x, c, pe, ce) => box [string "table",
+                                        space,
+                                        string x,
+                                        space,
+                                        string ":",
+                                        space,
+                                        p_con c,
+                                        space,
+                                        string "keys",
+                                        space,
+                                        p_exp pe,
+                                        space,
+                                        string "constraints",
+                                        space,
+                                        p_exp ce]
+      | SgiStr (x, sgn) => box [string "structure",
+                                space,
+                                string x,
+                                space,
+                                string ":",
+                                space,
+                                p_sgn sgn]
+      | SgiSgn (x, sgn) => box [string "signature",
+                                space,
+                                string x,
+                                space,
+                                string "=",
+                                space,
+                                p_sgn sgn]
+      | SgiInclude sgn => box [string "include",
+                               space,
+                               p_sgn sgn]
+      | SgiConstraint (c1, c2) => box [string "constraint",
+                                       space,
+                                       p_con c1,
+                                       space,
+                                       string "~",
+                                       space,
+                                       p_con c2]
+      | SgiClassAbs (x, k) => box [string "class",
+                                   space,
+                                   string x,
+                                   space,
+                                   string "::",
+                                   space,
+                                   p_kind k]
+      | SgiClass (x, k, c) => box [string "class",
+                                   space,
+                                   string x,
+                                   space,
+                                   string "::",
+                                   space,
+                                   p_kind k,
+                                   space,
+                                   string "=",
+                                   space,
+                                   p_con c]
+                              
+and p_sgn (sgn, _) =
+    case sgn of
+        SgnConst sgis => box [string "sig",
+                              newline,
+                              p_list_sep newline p_sgn_item sgis,
+                              newline,
+                              string "end"]
+      | SgnVar x => string x
+      | SgnFun (x, sgn, sgn') => box [string "functor",
+                                      space,
+                                      string "(",
+                                      string x,
+                                      space,
+                                      string ":",
+                                      p_sgn sgn,
+                                      string ")",
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn sgn']
+      | SgnWhere (sgn, ms, x, c) => box [p_sgn sgn,
+					 space,
+					 string "where",
+					 space,
+					 string "con",
+					 space,
+					 p_list_sep (string ".")
+						    string (ms @ [x]),
+					 string x,
+					 space,
+					 string "=",
+					 space,
+					 p_con c]
+      | SgnProj (m, ms, x) => p_list_sep (string ".") string (m :: ms @ [x])
+                                   
+
+
+fun p_decl ((d, _) : decl) =
+    case d of
+        DCon (x, NONE, c) => box [string "con",
+                                  space,
+                                  string x,
+                                  space,
+                                  string "=",
+                                  space,
+                                  p_con c]
+      | DCon (x, SOME k, c) => box [string "con",
+                                    space,
+                                    string x,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind k,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_con c]
+      | DDatatype x => box [string "datatype",
+                            space,
+                            p_list_sep (box [space, string "and", space]) p_datatype x]
+      | DDatatypeImp (x, ms, x') =>
+        box [string "datatype",
+             space,
+             string x,
+             space,
+             string "=",
+             space,
+             string "datatype",
+             space,
+             p_list_sep (string ".") string (ms @ [x'])]
+      | DVal (p, e) => box [string "val",
+                            space,
+                            p_pat p,
+                            space,
+                            string "=",
+                            space,
+                            p_exp e]
+      | DValRec vis => box [string "val",
+                            space,
+                            string "rec",
+                            space,
+                            p_list_sep (box [newline, string "and", space]) p_vali vis]
+
+      | DSgn (x, sgn) => box [string "signature",
+                              space,
+                              string x,
+                              space,
+                              string "=",
+                              space,
+                              p_sgn sgn]
+      | DStr (x, NONE, _, str, _) => box [string "structure",
+                                          space,
+                                          string x,
+                                          space,
+                                          string "=",
+                                          space,
+                                          p_str str]
+      | DStr (x, SOME sgn, _, str, _) => box [string "structure",
+                                              space,
+                                              string x,
+                                              space,
+                                              string ":",
+                                              space,
+                                              p_sgn sgn,
+                                              space,
+                                              string "=",
+                                              space,
+                                              p_str str]
+      | DFfiStr (x, sgn, _) => box [string "extern",
+                                    space,
+                                    string "structure",
+                                    space,
+                                    string x,
+                                    space,
+                                    string ":",
+                                    space,
+                                    p_sgn sgn]
+      | DOpen (m, ms) => box [string "open",
+                              space,
+                              p_list_sep (string ".") string (m :: ms)]
+      | DConstraint (c1, c2) => box [string "constraint",
+                                     space,
+                                     p_con c1,
+                                     space,
+                                     string "~",
+                                     space,
+                                     p_con c2]
+      | DOpenConstraints (m, ms) => box [string "open",
+                                         space,
+                                         string "constraints",
+                                         space,
+                                         p_list_sep (string ".") string (m :: ms)]
+
+      | DExport str => box [string "export",
+                            space,
+                            p_str str]
+      | DTable (x, c, pe, ce) => box [string "table",
+                                      space,
+                                      string x,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_con c,
+                                      space,
+                                      string "keys",
+                                      space,
+                                      p_exp pe,
+                                      space,
+                                      string "constraints",
+                                      space,
+                                      p_exp ce]
+      | DSequence x => box [string "sequence",
+                            space,
+                            string x]
+      | DView (x, e) => box [string "view",
+                             space,
+                             string x,
+                             space,
+                             string "=",
+                             space,
+                             p_exp e]
+
+      | DDatabase s => box [string "database",
+                            space,
+                            string s]
+
+      | DCookie (x, c) => box [string "cookie",
+                               space,
+                               string x,
+                               space,
+                               string ":",
+                               space,
+                               p_con c]
+      | DStyle x => box [string "style",
+                         space,
+                         string x]
+      | DTask (e1, e2) => box [string "task",
+                               space,
+                               p_exp e1,
+                               space,
+                               string "=",
+                               space,
+                               p_exp e2]
+      | DPolicy e1 => box [string "policy",
+                           space,
+                           p_exp e1]
+      | DOnError _ => string "ONERROR"
+      | DFfi _ => string "FFI"
+
+and p_str (str, _) =
+    case str of
+        StrConst ds => box [string "struct",
+                            newline,
+                            p_list_sep newline p_decl ds,
+                            newline,
+                            string "end"]
+      | StrVar x => string x
+      | StrProj (str, x) => box [p_str str,
+                                 string ".",
+                                 string x]
+      | StrFun (x, sgn, NONE, str) => box [string "functor",
+                                           space,
+                                           string "(",
+                                           string x,
+                                           space,
+                                           string ":",
+                                           p_sgn sgn,
+                                           string ")",
+                                           space,
+                                           string "=>",
+                                           space,
+                                           p_str str]
+      | StrFun (x, sgn, SOME sgn', str) => box [string "functor",
+                                                space,
+                                                string "(",
+                                                string x,
+                                                space,
+                                                string ":",
+                                                p_sgn sgn,
+                                                string ")",
+                                                space,
+                                                string ":",
+                                                space,
+                                                p_sgn sgn',
+                                                space,
+                                                string "=>",
+                                                space,
+                                                p_str str]
+      | StrApp (str1, str2) => box [p_str str1,
+                                    string "(",
+                                    p_str str2,
+                                    string ")"]
+
+val p_file = p_list_sep newline p_decl
+
+end
diff --git a/src/sources b/src/sources
new file mode 100644
index 0000000..52b1bdd
--- /dev/null
+++ b/src/sources
@@ -0,0 +1,272 @@
+$(SRC)/config.sig
+config.sml
+
+$(SRC)/globals.sig
+$(SRC)/globals.sml
+
+$(SRC)/search.sig
+$(SRC)/search.sml
+
+$(SRC)/list_util.sig
+$(SRC)/list_util.sml
+
+$(SRC)/order.sig
+$(SRC)/order.sml
+
+$(SRC)/errormsg.sig
+$(SRC)/errormsg.sml
+
+$(SRC)/print.sig
+$(SRC)/print.sml
+
+$(SRC)/fileio.sig
+$(SRC)/fileio.sml
+
+$(SRC)/settings.sig
+$(SRC)/settings.sml
+
+$(SRC)/http.sig
+$(SRC)/http.sml
+
+$(SRC)/cgi.sig
+$(SRC)/cgi.sml
+
+$(SRC)/fastcgi.sig
+$(SRC)/fastcgi.sml
+
+$(SRC)/static.sig
+$(SRC)/static.sml
+
+$(SRC)/prim.sig
+$(SRC)/prim.sml
+
+$(SRC)/mysql.sig
+$(SRC)/mysql.sml
+
+$(SRC)/sqlite.sig
+$(SRC)/sqlite.sml
+
+$(SRC)/datatype_kind.sml
+
+$(SRC)/export.sig
+$(SRC)/export.sml
+
+$(SRC)/source.sml
+
+$(SRC)/utf8.sig
+$(SRC)/utf8.sml
+
+../xml/entities.sml
+
+urweb.grm
+urweb.lex
+
+$(SRC)/source_print.sig
+$(SRC)/source_print.sml
+
+$(SRC)/elab.sml
+
+$(SRC)/elab_util.sig
+$(SRC)/elab_util.sml
+
+$(SRC)/elab_env.sig
+$(SRC)/elab_env.sml
+
+$(SRC)/elab_print.sig
+$(SRC)/elab_print.sml
+
+$(SRC)/elab_ops.sig
+$(SRC)/elab_ops.sml
+
+$(SRC)/disjoint.sig
+$(SRC)/disjoint.sml
+
+$(SRC)/elab_err.sig
+$(SRC)/elab_err.sml
+
+$(SRC)/mod_db.sig
+$(SRC)/mod_db.sml
+
+$(SRC)/elaborate.sig
+$(SRC)/elaborate.sml
+
+$(SRC)/unnest.sig
+$(SRC)/unnest.sml
+
+$(SRC)/termination.sig
+$(SRC)/termination.sml
+
+$(SRC)/expl.sml
+
+$(SRC)/expl_util.sig
+$(SRC)/expl_util.sml
+
+$(SRC)/expl_env.sig
+$(SRC)/expl_env.sml
+
+$(SRC)/expl_print.sig
+$(SRC)/expl_print.sml
+
+$(SRC)/explify.sig
+$(SRC)/explify.sml
+
+$(SRC)/core.sml
+
+$(SRC)/core_util.sig
+$(SRC)/core_util.sml
+
+$(SRC)/core_env.sig
+$(SRC)/core_env.sml
+
+$(SRC)/core_print.sig
+$(SRC)/core_print.sml
+
+$(SRC)/expl_rename.sig
+$(SRC)/expl_rename.sml
+
+$(SRC)/corify.sig
+$(SRC)/corify.sml
+
+$(SRC)/reduce_local.sig
+$(SRC)/reduce_local.sml
+
+$(SRC)/shake.sig
+$(SRC)/shake.sml
+
+$(SRC)/core_untangle.sig
+$(SRC)/core_untangle.sml
+
+$(SRC)/especialize.sig
+$(SRC)/especialize.sml
+
+$(SRC)/reduce.sig
+$(SRC)/reduce.sml
+
+$(SRC)/unpoly.sig
+$(SRC)/unpoly.sml
+
+$(SRC)/specialize.sig
+$(SRC)/specialize.sml
+
+$(SRC)/rpcify.sig
+$(SRC)/rpcify.sml
+
+$(SRC)/tag.sig
+$(SRC)/tag.sml
+
+$(SRC)/effectize.sig
+$(SRC)/effectize.sml
+
+$(SRC)/marshalcheck.sig
+$(SRC)/marshalcheck.sml
+
+$(SRC)/css.sig
+$(SRC)/css.sml
+
+$(SRC)/mono.sml
+
+$(SRC)/mono_util.sig
+$(SRC)/mono_util.sml
+
+$(SRC)/mono_env.sig
+$(SRC)/mono_env.sml
+
+$(SRC)/mono_print.sig
+$(SRC)/mono_print.sml
+
+$(SRC)/mono_fooify.sig
+$(SRC)/mono_fooify.sml
+
+$(SRC)/sql.sig
+$(SRC)/sql.sml
+
+$(SRC)/union_find_fn.sml
+$(SRC)/multimap_fn.sml
+
+$(SRC)/list_key_fn.sml
+$(SRC)/option_key_fn.sml
+$(SRC)/pair_key_fn.sml
+$(SRC)/triple_key_fn.sml
+
+$(SRC)/cache.sml
+$(SRC)/toy_cache.sml
+$(SRC)/lru_cache.sml
+
+$(SRC)/monoize.sig
+$(SRC)/monoize.sml
+
+$(SRC)/mono_reduce.sig
+$(SRC)/mono_reduce.sml
+
+$(SRC)/mono_opt.sig
+$(SRC)/mono_opt.sml
+
+$(SRC)/untangle.sig
+$(SRC)/untangle.sml
+
+$(SRC)/mono_shake.sig
+$(SRC)/mono_shake.sml
+
+$(SRC)/fuse.sig
+$(SRC)/fuse.sml
+
+$(SRC)/iflow.sig
+$(SRC)/iflow.sml
+
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
+$(SRC)/name_js.sig
+$(SRC)/name_js.sml
+
+$(SRC)/jscomp.sig
+$(SRC)/jscomp.sml
+
+$(SRC)/pathcheck.sig
+$(SRC)/pathcheck.sml
+
+$(SRC)/sidecheck.sig
+$(SRC)/sidecheck.sml
+
+$(SRC)/sigcheck.sig
+$(SRC)/sigcheck.sml
+
+$(SRC)/mono_inline.sml
+
+$(SRC)/sha1.sig
+$(SRC)/sha1.sml
+
+$(SRC)/cjr.sml
+
+$(SRC)/postgres.sig
+$(SRC)/postgres.sml
+
+$(SRC)/cjr_env.sig
+$(SRC)/cjr_env.sml
+
+$(SRC)/cjr_print.sig
+$(SRC)/cjr_print.sml
+
+$(SRC)/cjrize.sig
+$(SRC)/cjrize.sml
+
+$(SRC)/scriptcheck.sig
+$(SRC)/scriptcheck.sml
+
+$(SRC)/dbmodecheck.sig
+$(SRC)/dbmodecheck.sml
+
+$(SRC)/prepare.sig
+$(SRC)/prepare.sml
+
+$(SRC)/checknest.sig
+$(SRC)/checknest.sml
+
+$(SRC)/compiler.sig
+$(SRC)/compiler.sml
+
+$(SRC)/demo.sig
+$(SRC)/demo.sml
+
+$(SRC)/tutorial.sig
+$(SRC)/tutorial.sml
diff --git a/src/specialize.sig b/src/specialize.sig
new file mode 100644
index 0000000..9b0d1e8
--- /dev/null
+++ b/src/specialize.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program by repeating polymorphic definitions of datatypes *)
+
+signature SPECIALIZE = sig
+
+    val specialize : Core.file -> Core.file
+    
+end
diff --git a/src/specialize.sml b/src/specialize.sml
new file mode 100644
index 0000000..3354525
--- /dev/null
+++ b/src/specialize.sml
@@ -0,0 +1,298 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program by repeating polymorphic definitions of datatypes *)
+
+structure Specialize :> SPECIALIZE = struct
+
+open Core
+
+structure E = CoreEnv
+structure U = CoreUtil
+
+val liftConInCon = E.liftConInCon
+val subConInCon = E.subConInCon
+
+structure CK = struct
+type ord_key = con list
+val compare = Order.joinL U.Con.compare
+end
+
+structure CM = BinaryMapFn(CK)
+structure IM = IntBinaryMap
+
+type datatyp' = {
+     name : int,
+     constructors : int IM.map
+}
+
+type datatyp = {
+     name : string,
+     params : int,
+     constructors : (string * int * con option) list,
+     specializations : datatyp' CM.map
+}
+
+type state = {
+     count : int,
+     datatypes : datatyp IM.map,
+     constructors : int IM.map,
+     decls : (string * int * string list * (string * int * con option) list) list     
+}
+
+fun kind (k, st) = (k, st)
+
+val isOpen = U.Con.exists {kind = fn _ => false,
+                           con = fn c =>
+                                    case c of
+                                        CRel _ => true
+                                      | _ => false}
+
+fun considerSpecialization (st : state, n, args, dt : datatyp) =
+    let
+        val args = map ReduceLocal.reduceCon args
+    in
+        case CM.find (#specializations dt, args) of
+            SOME dt' => (#name dt', #constructors dt', st)
+          | NONE =>
+            let
+                (*val () = Print.prefaces "Args" [("n", Print.PD.string (Int.toString n)),
+                                                ("args", Print.p_list (CorePrint.p_con CoreEnv.empty) args)]*)
+
+                val n' = #count st
+
+                val nxs = length args - 1
+                fun sub t = ListUtil.foldli (fn (i, arg, t) =>
+                                                subConInCon (nxs - i, arg) t) t args
+
+                val (cons, (count, cmap)) =
+                    ListUtil.foldlMap (fn ((x, n, to), (count, cmap)) =>
+                                          let
+                                              val to = Option.map sub to
+                                          in
+                                              ((x, count, to),
+                                               (count + 1,
+                                                IM.insert (cmap, n, count)))
+                                          end) (n' + 1, IM.empty) (#constructors dt)
+
+                val st = {count = count,
+                          datatypes = IM.insert (#datatypes st, n,
+                                                 {name = #name dt,
+                                                  params = #params dt,
+                                                  constructors = #constructors dt,
+                                                  specializations = CM.insert (#specializations dt,
+                                                                               args,
+                                                                               {name = n',
+                                                                                constructors = cmap})}),
+                          constructors = #constructors st,
+                          decls = #decls st}
+
+                val (cons, st) = ListUtil.foldlMap (fn ((x, n, NONE), st) => ((x, n, NONE), st)
+                                                     | ((x, n, SOME t), st) =>
+                                                       let
+                                                           val (t, st) = specCon st t
+                                                       in
+                                                           ((x, n, SOME t), st)
+                                                       end) st cons
+
+                val dt = (#name dt ^ "_s",
+                          n',
+                          [],
+                          cons)
+            in
+                (n', cmap, {count = #count st,
+                            datatypes = #datatypes st,
+                            constructors = #constructors st,
+                            decls = dt :: #decls st})
+            end
+    end
+
+and con (c, st : state) =
+    let
+        fun findApp (c, args) =
+            case c of
+                CApp ((c', _), arg) => findApp (c', arg :: args)
+              | CNamed n => SOME (n, args)
+              | _ => NONE
+    in
+        case findApp (c, []) of
+            SOME (n, args as (_ :: _)) =>
+            if List.exists isOpen args then
+                (c, st)
+            else
+                (case IM.find (#datatypes st, n) of
+                     NONE => (c, st)
+                   | SOME dt =>
+                     if length args <> #params dt then
+                         (c, st)
+                     else
+                         let
+                             val (n, _, st) = considerSpecialization (st, n, args, dt)
+                         in
+                             (CNamed n, st)
+                         end)
+          | _ => (c, st)
+    end
+
+and specCon st = U.Con.foldMap {kind = kind, con = con} st
+
+fun pat (p, st) =
+    case #1 p of
+        PVar _ => (p, st)
+      | PPrim _ => (p, st)
+      | PCon (dk, PConVar pn, args as (_ :: _), po) =>
+        let
+            val (po, st) =
+                case po of
+                    NONE => (NONE, st)
+                  | SOME p =>
+                    let
+                        val (p, st) = pat (p, st)
+                    in
+                        (SOME p, st)
+                    end
+            val p = (PCon (dk, PConVar pn, args, po), #2 p)
+        in
+            if List.exists isOpen args then
+                (p, st)
+            else
+                case IM.find (#constructors st, pn) of
+                    NONE => (p, st)
+                  | SOME n =>
+                    case IM.find (#datatypes st, n) of
+                        NONE => (p, st)
+                      | SOME dt =>
+                        let
+                            val (n, cmap, st) = considerSpecialization (st, n, args, dt)
+                        in
+                            case IM.find (cmap, pn) of
+                                NONE => raise Fail "Specialize: Missing datatype constructor (pat)"
+                              | SOME pn' => ((PCon (dk, PConVar pn', [], po), #2 p), st)
+                        end
+        end
+      | PCon (dk, pc, args, SOME p') =>
+        let
+            val (p', st) = pat (p', st)
+        in
+            ((PCon (dk, pc, args, SOME p'), #2 p), st)
+        end
+      | PCon _ => (p, st)
+      | PRecord xps =>
+        let
+            val (xps, st) = ListUtil.foldlMap (fn ((x, p, t), st) =>
+                                                  let
+                                                      val (p, st) = pat (p, st)
+                                                  in
+                                                      ((x, p, t), st)
+                                                  end)
+                            st xps
+        in
+            ((PRecord xps, #2 p), st)
+        end
+
+fun exp (e, st) =
+    case e of
+        ECon (dk, PConVar pn, args as (_ :: _), eo) =>
+        if List.exists isOpen args then
+            (e, st)
+        else
+            (case IM.find (#constructors st, pn) of
+                 NONE => (e, st)
+               | SOME n =>
+                 case IM.find (#datatypes st, n) of
+                     NONE => (e, st)
+                   | SOME dt =>
+                     let
+                         val (n, cmap, st) = considerSpecialization (st, n, args, dt)
+                     in
+                         case IM.find (cmap, pn) of
+                             NONE => raise Fail "Specialize: Missing datatype constructor"
+                           | SOME pn' => (ECon (dk, PConVar pn', [], eo), st)
+                     end)
+      | ECase (e, pes, r) =>
+        let
+            val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
+                                                  let
+                                                      val (p, st) = pat (p, st)
+                                                  in
+                                                      ((p, e), st)
+                                                  end) st pes
+        in
+            (ECase (e, pes, r), st)
+        end
+      | _ => (e, st)
+
+fun decl (d, st) = (d, st)
+
+val specDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl}
+
+fun specialize file =
+    let
+        fun doDecl (d, st) =
+            let
+                (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
+                val (d, st) = specDecl st d
+            in
+                case #1 d of
+                    DDatatype dts =>
+                    ((case #decls st of
+                          [] => [d]
+                        | dts' => [(DDatatype (dts' @ dts), #2 d)]),
+                     {count = #count st,
+                      datatypes = foldl (fn ((x, n, xs, xnts), dts) =>
+                                            IM.insert (dts, n,
+                                                       {name = x,
+                                                        params = length xs,
+                                                        constructors = xnts,
+                                                        specializations = CM.empty}))
+                                        (#datatypes st) dts,
+                      constructors = foldl (fn ((x, n, xs, xnts), cs) =>
+                                               foldl (fn ((_, n', _), constructors) =>
+                                                         IM.insert (constructors, n', n))
+                                                     cs xnts)
+                                           (#constructors st) dts,
+                      decls = []})
+                  | _ =>
+                    (case #decls st of
+                          [] => [d]
+                        | dts => [(DDatatype dts, #2 d), d],
+                     {count = #count st,
+                      datatypes = #datatypes st,
+                      constructors = #constructors st,
+                      decls = []})
+            end
+
+        val (ds, _) = ListUtil.foldlMapConcat doDecl
+                      {count = U.File.maxName file + 1,
+                       datatypes = IM.empty,
+                       constructors = IM.empty,
+                       decls = []} file
+    in
+        ds
+    end
+
+end
diff --git a/src/sql.sig b/src/sql.sig
new file mode 100644
index 0000000..317c157
--- /dev/null
+++ b/src/sql.sig
@@ -0,0 +1,104 @@
+signature SQL = sig
+
+val debug : bool ref
+
+val sqlcacheMode : bool ref
+
+datatype chunk =
+         String of string
+       | Exp of Mono.exp
+
+val chunkify : Mono.exp -> chunk list
+
+type lvar = int
+
+datatype func =
+         DtCon0 of string
+       | DtCon1 of string
+       | UnCon of string
+       | Other of string
+
+datatype exp =
+         Const of Prim.t
+       | Var of int
+       | Lvar of lvar
+       | Func of func * exp list
+       | Recd of (string * exp) list
+       | Proj of exp * string
+
+datatype cmp =
+         Eq
+       | Ne
+       | Lt
+       | Le
+       | Gt
+       | Ge
+
+datatype reln =
+         Known
+       | Sql of string
+       | PCon0 of string
+       | PCon1 of string
+       | Cmp of cmp
+
+datatype lop =
+         And
+       | Or
+
+datatype prop =
+         True
+       | False
+       | Unknown
+       | Lop of lop * prop * prop
+       | Reln of reln * exp list
+       | Cond of exp * prop
+
+type 'a parser
+
+val parse : 'a parser -> Mono.exp -> 'a option
+
+datatype Rel =
+         RCmp of cmp
+       | RLop of lop
+
+datatype sqexp =
+         SqConst of Prim.t
+       | SqTrue
+       | SqFalse
+       | SqNot of sqexp
+       | Field of string * string
+       | Computed of string
+       | Binop of Rel * sqexp * sqexp
+       | SqKnown of sqexp
+       | Inj of Mono.exp
+       | SqFunc of string * sqexp
+       | Unmodeled
+       | Null
+
+datatype ('a,'b) sum = inl of 'a | inr of 'b
+
+datatype sitem =
+         SqField of string * string
+       | SqExp of sqexp * string
+
+datatype jtype = Inner | Left | Right | Full
+
+datatype fitem =
+         Table of string * string (* table AS name *)
+       | Join of jtype * fitem * fitem * sqexp
+       | Nested of query * string (* query AS name *)
+
+     and query =
+         Query1 of {Select : sitem list, From : fitem list, Where : sqexp option}
+       | Union of query * query
+
+val query : query parser
+
+datatype dml =
+         Insert of string * (string * sqexp) list
+       | Delete of string * sqexp
+       | Update of string * (string * sqexp) list * sqexp
+
+val dml : dml parser
+
+end
diff --git a/src/sql.sml b/src/sql.sml
new file mode 100644
index 0000000..409e205
--- /dev/null
+++ b/src/sql.sml
@@ -0,0 +1,509 @@
+structure Sql :> SQL = struct
+
+open Mono
+
+val debug = ref false
+
+type lvar = int
+
+datatype func =
+         DtCon0 of string
+       | DtCon1 of string
+       | UnCon of string
+       | Other of string
+
+datatype exp =
+         Const of Prim.t
+       | Var of int
+       | Lvar of lvar
+       | Func of func * exp list
+       | Recd of (string * exp) list
+       | Proj of exp * string
+
+datatype cmp =
+         Eq
+       | Ne
+       | Lt
+       | Le
+       | Gt
+       | Ge
+
+datatype reln =
+         Known
+       | Sql of string
+       | PCon0 of string
+       | PCon1 of string
+       | Cmp of cmp
+
+datatype lop =
+         And
+       | Or
+
+datatype prop =
+         True
+       | False
+       | Unknown
+       | Lop of lop * prop * prop
+       | Reln of reln * exp list
+       | Cond of exp * prop
+
+datatype chunk =
+         String of string
+       | Exp of Mono.exp
+
+fun chunkify e =
+    case #1 e of
+        EPrim (Prim.String (_, s)) => [String s]
+      | EStrcat (e1, e2) =>
+        let
+            val chs1 = chunkify e1
+            val chs2 = chunkify e2
+        in
+            case chs2 of
+                String s2 :: chs2' =>
+                (case List.last chs1 of
+                     String s1 => List.take (chs1, length chs1 - 1) @ String (s1 ^ s2) :: chs2'
+                   | _ => chs1 @ chs2)
+              | _ => chs1 @ chs2
+        end
+      | _ => [Exp e]
+
+type 'a parser = chunk list -> ('a * chunk list) option
+
+fun always v chs = SOME (v, chs)
+
+fun parse p s =
+    case p (chunkify s) of
+        SOME (v, []) => SOME v
+      | _ => NONE
+
+fun const s chs =
+    case chs of
+        String s' :: chs => if String.isPrefix s s' then
+                                SOME ((), if size s = size s' then
+                                              chs
+                                          else
+                                              String (String.extract (s', size s, NONE)) :: chs)
+                            else
+                                NONE
+      | _ => NONE
+
+fun follow p1 p2 chs =
+    case p1 chs of
+        NONE => NONE
+      | SOME (v1, chs) =>
+        case p2 chs of
+            NONE => NONE
+          | SOME (v2, chs) => SOME ((v1, v2), chs)
+
+fun wrap p f chs =
+    case p chs of
+        NONE => NONE
+      | SOME (v, chs) => SOME (f v, chs)
+
+fun wrapP p f chs =
+    case p chs of
+        NONE => NONE
+      | SOME (v, chs) =>
+        case f v of
+            NONE => NONE
+          | SOME r => SOME (r, chs)
+
+fun alt p1 p2 chs =
+    case p1 chs of
+        NONE => p2 chs
+      | v => v
+
+fun altL ps =
+    case rev ps of
+        [] => (fn _ => NONE)
+      | p :: ps =>
+        foldl (fn (p1, p2) => alt p1 p2) p ps
+
+fun opt p chs =
+    case p chs of
+        NONE => SOME (NONE, chs)
+      | SOME (v, chs) => SOME (SOME v, chs)
+
+fun skip cp chs =
+    case chs of
+        String "" :: chs => skip cp chs
+      | String s :: chs' => if cp (String.sub (s, 0)) then
+                                skip cp (String (String.extract (s, 1, NONE)) :: chs')
+                            else
+                                SOME ((), chs)
+      | _ => SOME ((), chs)
+
+fun keep cp chs =
+    case chs of
+        String "" :: chs => keep cp chs
+      | String s :: chs' =>
+        let
+            val (befor, after) = Substring.splitl cp (Substring.full s)
+        in
+            if Substring.isEmpty befor then
+                NONE
+            else
+                SOME (Substring.string befor,
+                      if Substring.isEmpty after then
+                          chs'
+                      else
+                          String (Substring.string after) :: chs')
+        end
+      | _ => NONE
+
+(* Used by primSqlcache. *)
+fun optConst s chs =
+    case chs of
+        String s' :: chs => if String.isPrefix s s' then
+                                SOME (s, if size s = size s' then
+                                              chs
+                                          else
+                                              String (String.extract (s', size s, NONE)) :: chs)
+                            else
+                                SOME ("", String s' :: chs)
+      | _ => NONE
+
+fun ws p = wrap (follow (skip (fn ch => ch = #" "))
+                        (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
+
+fun log name p chs =
+    (if !debug then
+         (print (name ^ ": ");
+          app (fn String s => print s
+                | _ => print "???") chs;
+          print "\n")
+     else
+         ();
+     p chs)
+
+fun list p chs =
+    altL [wrap (follow p (follow (ws (const ",")) (list p)))
+               (fn (v, ((), ls)) => v :: ls),
+          wrap (ws p) (fn v => [v]),
+          always []] chs
+
+val ident = keep (fn ch => Char.isAlphaNum ch orelse ch = #"_")
+
+val t_ident = wrapP ident (fn s => if String.isPrefix "T_" s then
+                                       SOME (String.extract (s, 2, NONE))
+                                   else
+                                       NONE)
+val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >= 4 then
+                                        SOME (str (Char.toUpper (String.sub (s, 3)))
+                                              ^ String.extract (s, 4, NONE))
+                                    else
+                                        SOME s)
+
+val field = wrap (follow (opt (follow t_ident (const ".")))
+                         uw_ident)
+                 (fn (SOME (t, ()), f) => (t, f)
+                   | (NONE, f) => ("T", f)) (* Should probably deal with this MySQL/SQLite case better some day. *)
+
+datatype Rel =
+         RCmp of cmp
+       | RLop of lop
+
+datatype sqexp =
+         SqConst of Prim.t
+       | SqTrue
+       | SqFalse
+       | SqNot of sqexp
+       | Field of string * string
+       | Computed of string
+       | Binop of Rel * sqexp * sqexp
+       | SqKnown of sqexp
+       | Inj of Mono.exp
+       | SqFunc of string * sqexp
+       | Unmodeled
+       | Null
+
+fun cmp s r = wrap (const s) (fn () => RCmp r)
+
+val sqbrel = altL [cmp "=" Eq,
+                   cmp "IS NOT DISTINCT FROM" Eq,
+                   cmp "<>" Ne,
+                   cmp "<=" Le,
+                   cmp "<" Lt,
+                   cmp ">=" Ge,
+                   cmp ">" Gt,
+                   wrap (const "AND") (fn () => RLop And),
+                   wrap (const "OR") (fn () => RLop Or)]
+
+datatype ('a, 'b) sum = inl of 'a | inr of 'b
+
+fun string chs =
+    case chs of
+        String s :: chs =>
+        if size s >= 2 andalso String.sub (s, 0) = #"'" then
+            let
+                fun loop (cs, acc) =
+                    case cs of
+                        [] => NONE
+                      | c :: cs =>
+                        if c = #"'" then
+                            SOME (String.implode (rev acc), cs)
+                        else if c = #"\\" then
+                            case cs of
+                                c :: cs => loop (cs, c :: acc)
+                              | _ => raise Fail "Iflow.string: Unmatched backslash escape"
+                        else
+                            loop (cs, c :: acc)
+            in
+                case loop (String.explode (String.extract (s, 1, NONE)), []) of
+                    NONE => NONE
+                  | SOME (s, []) => SOME (s, chs)
+                  | SOME (s, cs) => SOME (s, String (String.implode cs) :: chs)
+            end
+        else
+            NONE
+      | _ => NONE
+
+val prim =
+    altL [wrap (follow (wrapP (follow (keep Char.isDigit) (follow (const ".") (keep Char.isDigit)))
+                              (fn (x, ((), y)) => Option.map Prim.Float (Real64.fromString (x ^ "." ^ y))))
+                       (opt (const "::float8"))) #1,
+          wrap (follow (wrapP (keep Char.isDigit)
+                              (Option.map Prim.Int o Int64.fromString))
+                       (opt (const "::int8"))) #1,
+          wrap (follow (opt (const "E")) (follow string (opt (const "::text"))))
+               ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)]
+
+val primSqlcache =
+    (* Like [prim], but always uses [Prim.String]s. *)
+    let
+        fun wrapS p f = wrap p ((fn s => Prim.String (Prim.Normal, s)) o f)
+    in
+        altL [wrapS (follow (wrap (follow (keep Char.isDigit)
+                                          (follow (const ".") (keep Char.isDigit)))
+                                  (fn (x, ((), y)) => x ^ "." ^ y))
+                            (optConst "::float8"))
+                    op^,
+              wrapS (follow (keep Char.isDigit)
+                            (optConst "::int8"))
+                    op^,
+              wrapS (follow (optConst "E") (follow string (optConst "::text")))
+                    (fn (c1, (s, c2)) => c1 ^ s ^ c2)]
+end
+
+fun known' chs =
+    case chs of
+        Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs)
+      | _ => NONE
+
+fun sqlify chs =
+    case chs of
+        Exp (EFfiApp ("Basis", f, [(e, _)]), _) :: chs =>
+        if String.isPrefix "sqlify" f then
+            SOME (e, chs)
+        else
+            NONE
+      | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
+                         (EPrim (Prim.String (Prim.Normal, "TRUE")), _)),
+                        ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
+                         (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs =>
+        SOME (e, chs)
+
+      | _ => NONE
+
+(* For sqlcache, we only care that we can do string equality on injected Mono
+   expressions, so accept any expression without modifying it. *)
+val sqlifySqlcache =
+ fn Exp e :: chs => SOME (e, chs)
+  | _ => NONE
+
+fun constK s = wrap (const s) (fn () => s)
+
+val funcName = altL [constK "COUNT",
+                     constK "MIN",
+                     constK "MAX",
+                     constK "SUM",
+                     constK "AVG"]
+
+fun arithmetic pExp = follow (const "(")
+                             (follow pExp
+                                     (follow (altL (map const [" + ", " - ", " * ", " / ", " >> ", " << "]))
+                                             (follow pExp (const ")"))))
+
+val unmodeled = altL [const "COUNT(*)",
+                      const "CURRENT_TIMESTAMP"]
+
+val sqlcacheMode = ref false;
+
+fun sqexp chs =
+    log "sqexp"
+    (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
+           wrap (const "TRUE") (fn () => SqTrue),
+           wrap (const "FALSE") (fn () => SqFalse),
+           wrap (follow (const "NULL::") ident) (fn ((), _) => Null),
+           wrap (const "NULL") (fn () => Null),
+           wrap known SqKnown,
+           wrap func SqFunc,
+           wrap field Field,
+           wrap uw_ident Computed,
+           wrap (arithmetic sqexp) (fn _ => Unmodeled),
+           wrap unmodeled (fn () => Unmodeled),
+           wrap (if !sqlcacheMode then sqlifySqlcache else sqlify) Inj,
+           wrap (follow (const "COALESCE(") (follow sqexp (follow (const ",")
+                                                                  (follow (keep (fn ch => ch <> #")")) (const ")")))))
+                (fn ((), (e, _)) => e),
+           wrap (follow (const "(NOT ") (follow sqexp (const ")")))
+                (fn ((), (e, _)) => SqNot e),
+           wrap (follow (ws (const "("))
+                        (follow (wrap
+                                     (follow sqexp
+                                             (alt
+                                                  (wrap
+                                                       (follow (ws sqbrel)
+                                                               (ws sqexp))
+                                                       inl)
+                                                  (always (inr ()))))
+                                     (fn (e1, sm) =>
+                                         case sm of
+                                             inl (bo, e2) => Binop (bo, e1, e2)
+                                           | inr () => e1))
+                                (const ")")))
+                (fn ((), (e, ())) => e)])
+    chs
+
+and known chs = wrap (follow known' (follow (const "(") (follow sqexp (const ")"))))
+                     (fn ((), ((), (e, ()))) => e) chs
+
+and func chs = wrap (follow funcName (follow (const "(") (follow sqexp (const ")"))))
+                    (fn (f, ((), (e, ()))) => (f, e)) chs
+
+datatype sitem =
+         SqField of string * string
+       | SqExp of sqexp * string
+
+val sitem = alt (wrap (follow sqexp (follow (const " AS ") uw_ident))
+                      (fn (e, ((), s)) => SqExp (e, s)))
+                (wrap field SqField)
+
+val select = log "select"
+             (wrap (follow (const "SELECT ") (list sitem))
+                   (fn ((), ls) => ls))
+
+datatype jtype = Inner | Left | Right | Full
+
+datatype fitem =
+         Table of string * string (* table AS name *)
+       | Join of jtype * fitem * fitem * sqexp
+       | Nested of query * string (* query AS name *)
+
+     and query =
+         Query1 of {Select : sitem list, From : fitem list, Where : sqexp option}
+       | Union of query * query
+
+val wher = wrap (follow (ws (const "WHERE ")) sqexp)
+           (fn ((), ls) => ls)
+
+val orderby = log "orderby"
+              (wrap (follow (ws (const "ORDER BY "))
+                            (list (follow sqexp
+                                          (opt (ws (const "DESC"))))))
+                    ignore)
+
+val groupby = log "groupby"
+                  (wrap (follow (ws (const "GROUP BY "))
+                                (list sqexp))
+                        ignore)
+
+val jtype = altL [wrap (const "JOIN") (fn () => Inner),
+                  wrap (const "LEFT JOIN") (fn () => Left),
+                  wrap (const "RIGHT JOIN") (fn () => Right),
+                  wrap (const "FULL JOIN") (fn () => Full)]
+
+fun fitem chs = altL [wrap (follow uw_ident
+                                   (follow (const " AS ")
+                                           t_ident))
+                           (fn (t, ((), f)) => Table (t, f)),
+                      wrap (follow (const "(")
+                                   (follow fitem
+                                           (follow (ws jtype)
+                                                   (follow fitem
+                                                           (follow (const " ON ")
+                                                                   (follow sqexp
+                                                                           (const ")")))))))
+                           (fn ((), (fi1, (jt, (fi2, ((), (se, ())))))) =>
+                               Join (jt, fi1, fi2, se)),
+                      wrap (follow (const "(")
+                                   (follow query
+                                           (follow (const ") AS ") t_ident)))
+                           (fn ((), (q, ((), f))) => Nested (q, f))]
+                     chs
+
+and query1 chs = log "query1"
+                     (wrap (follow (follow select from) (opt wher))
+                           (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher}))
+                     chs
+
+and from chs = log "from"
+                   (wrap (follow (const "FROM ") (list fitem))
+                         (fn ((), ls) => ls))
+                   chs
+
+and query chs = log "query"
+                    (wrap (follow
+                               (alt (wrap (follow (const "((")
+                                                  (follow query
+                                                          (follow (const ") UNION (")
+                                                                  (follow query (const "))")))))
+                                          (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
+                                    (wrap query1 Query1))
+                               (follow (opt groupby) (opt orderby)))
+                          #1)
+                    chs
+
+datatype dml =
+         Insert of string * (string * sqexp) list
+       | Delete of string * sqexp
+       | Update of string * (string * sqexp) list * sqexp
+
+val insert = log "insert"
+             (wrapP (follow (const "INSERT INTO ")
+                            (follow uw_ident
+                                    (follow (const " (")
+                                            (follow (list uw_ident)
+                                                    (follow (const ") VALUES (")
+                                                            (follow (list sqexp)
+                                                                    (const ")")))))))
+              (fn ((), (tab, ((), (fs, ((), (es, ())))))) =>
+                  (SOME (tab, ListPair.zipEq (fs, es)))
+                  handle ListPair.UnequalLengths => NONE))
+
+val delete = log "delete"
+                 (wrap (follow (const "DELETE FROM ")
+                               (follow uw_ident
+                                       (follow (opt (const " AS T_T"))
+                                               (opt (follow (const " WHERE ") sqexp)))))
+                       (fn ((), (tab, (_, wher))) => (tab, case wher of
+                                                               SOME (_, es) => es
+                                                             | NONE => SqTrue)))
+
+val setting = log "setting"
+                  (wrap (follow uw_ident (follow (const " = ") sqexp))
+                        (fn (f, ((), e)) => (f, e)))
+
+val update = log "update"
+                 (wrap (follow (const "UPDATE ")
+                               (follow uw_ident
+                                       (follow (follow (opt (const " AS T_T")) (const " SET "))
+                                               (follow (list setting)
+                                                       (follow (ws (const "WHERE "))
+                                                               sqexp)))))
+                       (fn ((), (tab, (_, (fs, ((), e))))) =>
+                           (tab, fs, e)))
+
+val dml = log "dml"
+              (altL [wrap insert Insert,
+                     wrap delete Delete,
+                     wrap update Update])
+
+datatype querydml =
+         Query of query
+       | Dml of dml
+
+val querydml = log "querydml" (altL [wrap dml Dml, wrap query Query])
+
+end
diff --git a/src/sqlcache.sig b/src/sqlcache.sig
new file mode 100644
index 0000000..e264c1f
--- /dev/null
+++ b/src/sqlcache.sig
@@ -0,0 +1,11 @@
+signature SQLCACHE = sig
+
+val setCache : Cache.cache -> unit
+val getCache : unit -> Cache.cache
+
+val setHeuristic : string -> unit
+
+val getFfiInfo : unit -> {index : int, params : int} list
+val go : Mono.file -> Mono.file
+
+end
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
new file mode 100644
index 0000000..83a264f
--- /dev/null
+++ b/src/sqlcache.sml
@@ -0,0 +1,1732 @@
+structure Sqlcache :> SQLCACHE = struct
+
+
+(*********************)
+(* General Utilities *)
+(*********************)
+
+structure IK = struct type ord_key = int val compare = Int.compare end
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+structure SK = struct type ord_key = string val compare = String.compare end
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+structure IIMM = MultimapFn(structure KeyMap = IM structure ValSet = IS)
+structure SIMM = MultimapFn(structure KeyMap = SM structure ValSet = IS)
+
+fun id x = x
+
+fun iterate f n x = if n < 0
+                    then raise Fail "Can't iterate function negative number of times."
+                    else if n = 0
+                    then x
+                    else iterate f (n-1) (f x)
+
+(* From the MLton wiki. *)
+infix  3 <\     fun x <\ f = fn y => f (x, y)     (* Left section      *)
+infix  3 \>     fun f \> y = f y                  (* Left application  *)
+
+fun mapFst f (x, y) = (f x, y)
+
+(* Option monad. *)
+fun obind (x, f) = Option.mapPartial f x
+fun oguard (b, x) = if b then x () else NONE
+fun omap f = fn SOME x => SOME (f x) | _ => NONE
+fun omap2 f = fn (SOME x, SOME y) => SOME (f (x,y)) | _ => NONE
+fun osequence ys = List.foldr (omap2 op::) (SOME []) ys
+
+fun concatMap f xs = List.concat (map f xs)
+
+val rec cartesianProduct : 'a list list -> 'a list list =
+ fn [] => [[]]
+  | (xs :: xss) => concatMap (fn ys => concatMap (fn x => [x :: ys]) xs)
+                             (cartesianProduct xss)
+
+fun indexOf test =
+    let
+        fun f n =
+         fn [] => NONE
+          | (x::xs) => if test x then SOME n else f (n+1) xs
+    in
+        f 0
+    end
+
+
+(************)
+(* Settings *)
+(************)
+
+open Mono
+
+(* Filled in by [addFlushing]. *)
+val ffiInfoRef : {index : int, params : int} list ref = ref []
+
+fun resetFfiInfo () = ffiInfoRef := []
+
+fun getFfiInfo () = !ffiInfoRef
+
+(* Some FFIs have writing as their only effect, which the caching records. *)
+val ffiEffectful =
+    (* ASK: how can this be less hard-coded? *)
+    let
+        val okayWrites = SS.fromList ["htmlifyInt_w",
+                                      "htmlifyFloat_w",
+                                      "htmlifyString_w",
+                                      "htmlifyBool_w",
+                                      "htmlifyTime_w",
+                                      "attrifyInt_w",
+                                      "attrifyFloat_w",
+                                      "attrifyString_w",
+                                      "attrifyChar_w",
+                                      "urlifyInt_w",
+                                      "urlifyFloat_w",
+                                      "urlifyString_w",
+                                      "urlifyBool_w",
+                                      "urlifyChannel_w"]
+    in
+        (* ASK: is it okay to hardcode Sqlcache functions as effectful? *)
+        fn (m, f) => Settings.isEffectful (m, f)
+                     andalso not (m = "Basis" andalso SS.member (okayWrites, f))
+    end
+
+val cacheRef = ref LruCache.cache
+fun setCache c = cacheRef := c
+fun getCache () = !cacheRef
+
+datatype heuristic = Smart | Always | Never | NoPureAll | NoPureOne | NoCombo
+
+val heuristicRef = ref NoPureOne
+fun setHeuristic h = heuristicRef := (case h of
+                                          "smart" => Smart
+                                        | "always" => Always
+                                        | "never" => Never
+                                        | "nopureall" => NoPureAll
+                                        | "nopureone" => NoPureOne
+                                        | "nocombo" => NoCombo
+                                        | _ => raise Fail "Sqlcache: setHeuristic")
+fun getHeuristic () = !heuristicRef
+
+
+(************************)
+(* Really Useful Things *)
+(************************)
+
+(* Used to have type context for local variables in MonoUtil functions. *)
+val doBind =
+ fn (env, MonoUtil.Exp.RelE (x, t)) => MonoEnv.pushERel env x t NONE
+  | (env, MonoUtil.Exp.NamedE (x, n, t, eo, s)) => MonoEnv.pushENamed env x n t eo s
+  | (env, MonoUtil.Exp.Datatype (x, n, cs)) => MonoEnv.pushDatatype env x n cs
+
+val dummyLoc = ErrorMsg.dummySpan
+
+(* DEBUG *)
+fun printExp msg exp =
+    (Print.preface ("SQLCACHE: " ^ msg ^ ":", MonoPrint.p_exp MonoEnv.empty exp); exp)
+fun printExp' msg exp' = (printExp msg (exp', dummyLoc); exp')
+fun printTyp msg typ =
+    (Print.preface ("SQLCACHE: " ^ msg ^ ":", MonoPrint.p_typ MonoEnv.empty typ); typ)
+fun printTyp' msg typ' = (printTyp msg (typ', dummyLoc); typ')
+fun obindDebug printer (x, f) =
+    case x of
+        NONE => NONE
+      | SOME x' => case f x' of
+                       NONE => (printer (); NONE)
+                     | y => y
+
+
+(*******************)
+(* Effect Analysis *)
+(*******************)
+
+(* TODO: test this. *)
+fun transitiveAnalysis doVal state (decls, _) =
+    let
+        val doDecl =
+         fn ((DVal v, _), state) => doVal (v, state)
+          (* Pass over the list of values a number of times equal to its size,
+             making sure whatever property we're testing propagates everywhere
+             it should. This is analagous to the Bellman-Ford algorithm. *)
+          | ((DValRec vs, _), state) =>
+            iterate (fn state => List.foldl doVal state vs) (length vs) state
+          | (_, state) => state
+    in
+        List.foldl doDecl state decls
+    end
+
+(* Makes an exception for [EWrite] (which is recorded when caching). *)
+fun effectful (effs : IS.set) =
+    let
+        val isFunction =
+         fn (TFun _, _) => true
+          | _ => false
+        fun doExp (env, e) =
+            case e of
+                EPrim _ => false
+              (* For now: variables of function type might be effectful, but
+                 others are fully evaluated and are therefore not effectful. *)
+              | ERel n => isFunction (#2 (MonoEnv.lookupERel env n))
+              | ENamed n => IS.member (effs, n)
+              | EFfi (m, f) => ffiEffectful (m, f)
+              | EFfiApp (m, f, _) => ffiEffectful (m, f)
+              (* These aren't effectful unless a subexpression is. *)
+              | ECon _ => false
+              | ENone _ => false
+              | ESome _ => false
+              | EApp _ => false
+              | EAbs _ => false
+              | EUnop _ => false
+              | EBinop _ => false
+              | ERecord _ => false
+              | EField _ => false
+              | ECase _ => false
+              | EStrcat _ => false
+              (* EWrite is a special exception because we record writes when caching. *)
+              | EWrite _ => false
+              | ESeq _ => false
+              | ELet _ => false
+              | EUnurlify _ => false
+              (* ASK: what should we do about closures? *)
+              (* Everything else is some sort of effect. We could flip this and
+                 explicitly list bits of Mono that are effectful, but this is
+                 conservatively robust to future changes (however unlikely). *)
+              | _ => true
+    in
+        MonoUtil.Exp.existsB {typ = fn _ => false, exp = doExp, bind = doBind}
+    end
+
+(* TODO: test this. *)
+fun effectfulDecls file =
+    transitiveAnalysis (fn ((_, name, _, e, _), effs) =>
+                           if effectful effs MonoEnv.empty e
+                           then IS.add (effs, name)
+                           else effs)
+                       IS.empty
+                       file
+
+
+(*********************************)
+(* Boolean Formula Normalization *)
+(*********************************)
+
+datatype junctionType = Conj | Disj
+
+datatype 'atom formula =
+         Atom of 'atom
+       | Negate of 'atom formula
+       | Combo of junctionType * 'atom formula list
+
+(* Guaranteed to have all negation pushed to the atoms. *)
+datatype 'atom formula' =
+         Atom' of 'atom
+       | Combo' of junctionType * 'atom formula' list
+
+val flipJt = fn Conj => Disj | Disj => Conj
+
+(* Pushes all negation to the atoms.*)
+fun pushNegate (normalizeAtom : bool * 'atom -> 'atom) (negating : bool) =
+ fn Atom x => Atom' (normalizeAtom (negating, x))
+  | Negate f => pushNegate normalizeAtom (not negating) f
+  | Combo (j, fs) => Combo' (if negating then flipJt j else j,
+                             map (pushNegate normalizeAtom negating) fs)
+
+val rec flatten =
+ fn Combo' (_, [f]) => flatten f
+  | Combo' (j, fs) =>
+    Combo' (j, List.foldr (fn (f, acc) =>
+                              case f of
+                                  Combo' (j', fs') =>
+                                  if j = j' orelse length fs' = 1
+                                  then fs' @ acc
+                                  else f :: acc
+                                | _ => f :: acc)
+                          []
+                          (map flatten fs))
+  | f => f
+
+(* [simplify] operates on the desired normal form. E.g., if [junc] is [Disj],
+   consider the list of lists to be a disjunction of conjunctions. *)
+fun normalize' (simplify : 'a list list -> 'a list list)
+               (junc : junctionType) =
+    let
+        fun norm junc =
+            simplify
+            o (fn Atom' x => [[x]]
+                | Combo' (j, fs) =>
+                  let
+                      val fss = map (norm junc) fs
+                  in
+                      if j = junc
+                      then List.concat fss
+                      else map List.concat (cartesianProduct fss)
+                  end)
+    in
+        norm junc
+    end
+
+fun normalize simplify normalizeAtom junc =
+    normalize' simplify junc
+    o flatten
+    o pushNegate normalizeAtom false
+
+fun mapFormula mf =
+ fn Atom x => Atom (mf x)
+  | Negate f => Negate (mapFormula mf f)
+  | Combo (j, fs) => Combo (j, map (mapFormula mf) fs)
+
+fun mapFormulaExps mf = mapFormula (fn (cmp, e1, e2) => (cmp, mf e1, mf e2))
+
+
+(****************)
+(* SQL Analysis *)
+(****************)
+
+structure CmpKey = struct
+
+    type ord_key = Sql.cmp
+
+    val compare =
+     fn (Sql.Eq, Sql.Eq) => EQUAL
+      | (Sql.Eq, _) => LESS
+      | (_, Sql.Eq) => GREATER
+      | (Sql.Ne, Sql.Ne) => EQUAL
+      | (Sql.Ne, _) => LESS
+      | (_, Sql.Ne) => GREATER
+      | (Sql.Lt, Sql.Lt) => EQUAL
+      | (Sql.Lt, _) => LESS
+      | (_, Sql.Lt) => GREATER
+      | (Sql.Le, Sql.Le) => EQUAL
+      | (Sql.Le, _) => LESS
+      | (_, Sql.Le) => GREATER
+      | (Sql.Gt, Sql.Gt) => EQUAL
+      | (Sql.Gt, _) => LESS
+      | (_, Sql.Gt) => GREATER
+      | (Sql.Ge, Sql.Ge) => EQUAL
+
+end
+
+val rec chooseTwos : 'a list -> ('a * 'a) list =
+ fn [] => []
+  | x :: ys => map (fn y => (x, y)) ys @ chooseTwos ys
+
+fun removeRedundant madeRedundantBy zs =
+    let
+        fun removeRedundant' (xs, ys) =
+            case xs of
+                [] => ys
+              | x :: xs' =>
+                removeRedundant' (xs',
+                                  if List.exists (fn y => madeRedundantBy (x, y)) (xs' @ ys)
+                                  then ys
+                                  else x :: ys)
+    in
+        removeRedundant' (zs, [])
+    end
+
+datatype atomExp =
+         True
+       | False
+       | QueryArg of int
+       | DmlRel of int
+       | Prim of Prim.t
+       | Field of string * string
+
+structure AtomExpKey : ORD_KEY = struct
+
+    type ord_key = atomExp
+
+    val compare =
+     fn (True, True) => EQUAL
+      | (True, _) => LESS
+      | (_, True) => GREATER
+      | (False, False) => EQUAL
+      | (False, _) => LESS
+      | (_, False) => GREATER
+      | (QueryArg n1, QueryArg n2) => Int.compare (n1, n2)
+      | (QueryArg _, _) => LESS
+      | (_, QueryArg _) => GREATER
+      | (DmlRel n1, DmlRel n2) => Int.compare (n1, n2)
+      | (DmlRel _, _) => LESS
+      | (_, DmlRel _) => GREATER
+      | (Prim p1, Prim p2) => Prim.compare (p1, p2)
+      | (Prim _, _) => LESS
+      | (_, Prim _) => GREATER
+      | (Field (t1, f1), Field (t2, f2)) =>
+        case String.compare (t1, t2) of
+            EQUAL => String.compare (f1, f2)
+          | ord => ord
+
+end
+
+structure AtomOptionKey = OptionKeyFn(AtomExpKey)
+
+val rec tablesOfQuery =
+ fn Sql.Query1 {From = fitems, ...} => List.foldl SS.union SS.empty (map tableOfFitem fitems)
+  | Sql.Union (q1, q2) => SS.union (tablesOfQuery q1, tablesOfQuery q2)
+and tableOfFitem =
+ fn Sql.Table (t, _) => SS.singleton t
+  | Sql.Nested (q, _) => tablesOfQuery q
+  | Sql.Join (_, f1, f2, _) => SS.union (tableOfFitem f1, tableOfFitem f2)
+
+val tableOfDml =
+ fn Sql.Insert (tab, _) => tab
+  | Sql.Delete (tab, _) => tab
+  | Sql.Update (tab, _, _) => tab
+
+val freeVars =
+    MonoUtil.Exp.foldB
+        {typ = #2,
+         exp = fn (bound, ERel n, vars) => if n < bound
+                                           then vars
+                                           else IS.add (vars, n - bound)
+                | (_, _, vars) => vars,
+         bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1
+                 | (bound, _) => bound}
+        0
+        IS.empty
+
+(* A path is a number of field projections of a variable. *)
+type path = int * string list
+structure PK = PairKeyFn(structure I = IK structure J = ListKeyFn(SK))
+structure PS = BinarySetFn(PK)
+
+val pathOfExp =
+    let
+        fun readFields acc exp =
+            acc
+            <\obind\>
+             (fn fs =>
+                 case #1 exp of
+                     ERel n => SOME (n, fs)
+                   | EField (exp, f) => readFields (SOME (f::fs)) exp
+                   | _ => NONE)
+    in
+        readFields (SOME [])
+    end
+
+fun expOfPath (n, fs) =
+    List.foldl (fn (f, exp) => (EField (exp, f), dummyLoc)) (ERel n, dummyLoc) fs
+
+fun freePaths'' bound exp paths =
+    case pathOfExp (exp, dummyLoc) of
+        NONE => paths
+      | SOME (n, fs) => if n < bound then paths else PS.add (paths, (n - bound, fs))
+
+(* ASK: nicer way? :( *)
+fun freePaths' bound exp =
+    case #1 exp of
+        EPrim _ => id
+      | e as ERel _ => freePaths'' bound e
+      | ENamed _ => id
+      | ECon (_, _, data) => (case data of NONE => id | SOME e => freePaths' bound e)
+      | ENone _ => id
+      | ESome (_, e) => freePaths' bound e
+      | EFfi _ => id
+      | EFfiApp (_, _, args) =>
+        List.foldl (fn ((e, _), acc) => freePaths' bound e o acc) id args
+      | EApp (e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | EAbs (_, _, _, e) => freePaths' (bound + 1) e
+      | EUnop (_, e) => freePaths' bound e
+      | EBinop (_, _, e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | ERecord fields => List.foldl (fn ((_, e, _), acc) => freePaths' bound e o acc) id fields
+      | e as EField _ => freePaths'' bound e
+      | ECase (e, cases, _) =>
+        List.foldl (fn ((p, e), acc) => freePaths' (MonoEnv.patBindsN p + bound) e o acc)
+                   (freePaths' bound e)
+                   cases
+      | EStrcat (e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | EError (e, _) => freePaths' bound e
+      | EReturnBlob {blob, mimeType = e, ...} =>
+        freePaths' bound e o (case blob of NONE => id | SOME e => freePaths' bound e)
+      | ERedirect (e, _) => freePaths' bound e
+      | EWrite e => freePaths' bound e
+      | ESeq (e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | ELet (_, _, e1, e2) => freePaths' bound e1 o freePaths' (bound + 1) e2
+      | EClosure (_, es) => List.foldl (fn (e, acc) => freePaths' bound e o acc) id es
+      | EQuery {query = e1, body = e2, initial = e3, ...} =>
+        freePaths' bound e1 o freePaths' (bound + 2) e2 o freePaths' bound e3
+      | EDml (e, _) => freePaths' bound e
+      | ENextval e => freePaths' bound e
+      | ESetval (e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | EUnurlify (e, _, _) => freePaths' bound e
+      | EJavaScript (_, e) => freePaths' bound e
+      | ESignalReturn e => freePaths' bound e
+      | ESignalBind (e1, e2) => freePaths' bound e1 o freePaths' bound e2
+      | ESignalSource e => freePaths' bound e
+      | EServerCall (e, _, _, _) => freePaths' bound e
+      | ERecv (e, _) => freePaths' bound e
+      | ESleep e => freePaths' bound e
+      | ESpawn e => freePaths' bound e
+
+fun freePaths exp = freePaths' 0 exp PS.empty
+
+datatype unbind = Known of exp | Unknowns of int
+
+datatype cacheArg = AsIs of exp | Urlify of exp
+
+structure InvalInfo :> sig
+    type t
+    type state = {tableToIndices : SIMM.multimap,
+                  indexToInvalInfo : (t * int) IntBinaryMap.map,
+                  ffiInfo : {index : int, params : int} list,
+                  index : int}
+    val empty : t
+    val singleton : Sql.query -> t
+    val query : t -> Sql.query
+    val orderArgs : t * Mono.exp -> cacheArg list option
+    val unbind : t * unbind -> t option
+    val union : t * t -> t
+    val updateState : t * int * state -> state
+end = struct
+
+    (* Variable, field projections, possible wrapped sqlification FFI call. *)
+    type sqlArg = path * (string * string * typ) option
+
+    type subst = sqlArg IM.map
+
+    (* TODO: store free variables as well? *)
+    type t = (Sql.query * subst) list
+
+    type state = {tableToIndices : SIMM.multimap,
+                  indexToInvalInfo : (t * int) IntBinaryMap.map,
+                  ffiInfo : {index : int, params : int} list,
+                  index : int}
+
+    structure AK = PairKeyFn(
+        structure I = PK
+        structure J = OptionKeyFn(TripleKeyFn(
+            structure I = SK
+            structure J = SK
+            structure K = struct type ord_key = Mono.typ val compare = MonoUtil.Typ.compare end)))
+    structure AS = BinarySetFn(AK)
+    structure AM = BinaryMapFn(AK)
+
+    (* Traversal Utilities *)
+    (* TODO: get rid of unused ones. *)
+
+    (* Need lift', etc. because we don't have rank-2 polymorphism. This should
+       probably use a functor (an ML one, not Haskell) but works for now. *)
+    fun traverseSqexp (pure, _, _, _, lift, lift', _, _, lift2, _, _, _, _, _) f =
+        let
+            val rec tr =
+             fn Sql.SqNot se => lift Sql.SqNot (tr se)
+              | Sql.Binop (r, se1, se2) =>
+                lift2 (fn (trse1, trse2) => Sql.Binop (r, trse1, trse2)) (tr se1, tr se2)
+              | Sql.SqKnown se => lift Sql.SqKnown (tr se)
+              | Sql.Inj (e', loc) => lift' (fn fe' => Sql.Inj (fe', loc)) (f e')
+              | Sql.SqFunc (s, se) => lift (fn trse => Sql.SqFunc (s, trse)) (tr se)
+              | se => pure se
+        in
+            tr
+        end
+
+    fun traverseFitem (ops as (_, _, _, pure''', _, _, _, lift''', _, _, _, _, lift2'''', lift2''''')) f =
+        let
+            val rec tr =
+             fn Sql.Table t => pure''' (Sql.Table t)
+              | Sql.Join (jt, fi1, fi2, se) =>
+                lift2'''' (fn ((trfi1, trfi2), trse) => Sql.Join (jt, trfi1, trfi2, trse))
+                          (lift2''''' id (tr fi1, tr fi2), traverseSqexp ops f se)
+              | Sql.Nested (q, s) => lift''' (fn trq => Sql.Nested (trq, s))
+                                             (traverseQuery ops f q)
+        in
+            tr
+        end
+
+    and traverseQuery (ops as (_, pure', pure'', _, _, _, lift'', _, _, lift2', lift2'', lift2''', _, _)) f =
+        let
+            val rec seqList =
+             fn [] => pure'' []
+              | (x::xs) => lift2''' op:: (x, seqList xs)
+            val rec tr =
+             fn Sql.Query1 q =>
+                (* TODO: make sure we don't need to traverse [#Select q]. *)
+                lift2' (fn (trfrom, trwher) => Sql.Query1 {Select = #Select q,
+                                                           From = trfrom,
+                                                           Where = trwher})
+                       (seqList (map (traverseFitem ops f) (#From q)),
+                        case #Where q of
+                            NONE => pure' NONE
+                          | SOME se => lift'' SOME (traverseSqexp ops f se))
+              | Sql.Union (q1, q2) => lift2'' Sql.Union (tr q1, tr q2)
+        in
+            tr
+        end
+
+    (* Include unused tuple elements in argument for convenience of using same
+       argument as [traverseQuery]. *)
+    fun traverseIM (pure, _, _, _, _, _, _, _, _, lift2, _, _, _, _) f =
+        IM.foldli (fn (k, v, acc) => lift2 (fn (acc, w) => IM.insert (acc, k, w)) (acc, f (k,v)))
+                  (pure IM.empty)
+
+    fun traverseSubst (ops as (_, pure', _, _, lift, _, _, _, _, lift2', _, _, _, _)) f =
+        let
+            fun mp ((n, fields), sqlify) =
+                lift (fn ((n', fields'), sqlify') =>
+                         let
+                             fun wrap sq = ((n', fields' @ fields), sq)
+                         in
+                             case (fields', sqlify', fields, sqlify) of
+                                 (_, NONE, _, NONE) => wrap NONE
+                               | (_, NONE, _, sq as SOME _) => wrap sq
+                               (* Last case should suffice because we don't
+                                  project from a sqlified value (which is a
+                                  string). *)
+                               | (_, sq as SOME _, [], NONE) => wrap sq
+                               | _ => raise Fail "Sqlcache: traverseSubst"
+                         end)
+                     (f n)
+        in
+            traverseIM ops (fn (_, v) => mp v)
+        end
+
+    fun monoidOps plus zero =
+        (fn _ => zero, fn _ => zero, fn _ => zero, fn _ => zero,
+         fn _ => fn x => x, fn _ => fn x => x, fn _ => fn x => x, fn _ => fn x => x,
+         fn _ => plus, fn _ => plus, fn _ => plus, fn _ => plus, fn _ => plus, fn _ => plus)
+
+    val optionOps = (SOME, SOME, SOME, SOME,
+                     omap, omap, omap, omap,
+                     omap2, omap2, omap2, omap2, omap2, omap2)
+
+    fun foldMapQuery plus zero = traverseQuery (monoidOps plus zero)
+    val omapQuery = traverseQuery optionOps
+    fun foldMapIM plus zero = traverseIM (monoidOps plus zero)
+    fun omapIM f = traverseIM optionOps f
+    fun foldMapSubst plus zero = traverseSubst (monoidOps plus zero)
+    fun omapSubst f = traverseSubst optionOps f
+
+    val varsOfQuery = foldMapQuery IS.union
+                                   IS.empty
+                                   (fn e' => freeVars (e', dummyLoc))
+
+    fun varsOfSubst subst = foldMapSubst IS.union IS.empty IS.singleton subst
+
+    val varsOfList =
+     fn [] => IS.empty
+      | (q::qs) => varsOfQuery (List.foldl Sql.Union q qs)
+
+    (* Signature Implementation *)
+
+    val empty = []
+
+    fun singleton q = [(q, IS.foldl (fn (n, acc) => IM.insert (acc, n, ((n, []), NONE)))
+                                    IM.empty
+                                    (varsOfQuery q))]
+
+    val union = op@
+
+    fun sqlArgsSet (q, subst) =
+        IM.foldl AS.add' AS.empty subst
+
+    fun sqlArgsMap (qs : t) =
+        let
+            val args =
+                List.foldl (fn ((q, subst), acc) =>
+                               IM.foldl (fn (arg, acc) => AM.insert (acc, arg, ())) acc subst)
+                           AM.empty
+                           qs
+            val countRef = ref (~1)
+            fun count () = (countRef := !countRef + 1; !countRef)
+        in
+            (* Maps each arg to a different consecutive integer, starting from 0. *)
+            AM.map count args
+        end
+
+    fun expOfArg (path, sqlify) =
+        let
+            val exp = expOfPath path
+        in
+            case sqlify of
+                NONE => exp
+              | SOME (m, x, typ) => (EFfiApp (m, x, [(exp, typ)]), dummyLoc)
+        end
+
+    fun orderArgs (qs : t, exp) =
+        let
+            val paths = freePaths exp
+            fun erel n = (ERel n, dummyLoc)
+            val argsMap = sqlArgsMap qs
+            val args = map (expOfArg o #1) (AM.listItemsi argsMap)
+            val invalPaths = List.foldl PS.union PS.empty (map freePaths args)
+            (* TODO: make sure these variables are okay to remove from the argument list. *)
+            val pureArgs = PS.difference (paths, invalPaths)
+            val shouldCache =
+                case getHeuristic () of
+                    Smart =>
+                    (case (qs, PS.numItems pureArgs) of
+                         ((q::qs), 0) =>
+                         let
+                             val args = sqlArgsSet q
+                             val argss = map sqlArgsSet qs
+                             fun test (args, acc) =
+                                 acc
+                                 <\obind\>
+                                  (fn args' =>
+                                      let
+                                          val both = AS.union (args, args')
+                                      in
+                                          (AS.numItems args = AS.numItems both
+                                           orelse AS.numItems args' = AS.numItems both)
+                                          <\oguard\>
+                                           (fn _ => SOME both)
+                                      end)
+                         in
+                             case List.foldl test (SOME args) argss of
+                                 NONE => false
+                               | SOME _ => true
+                         end
+                       | _ => false)
+                  | Always => true
+                  | Never => (case qs of [_] => PS.numItems pureArgs = 0 | _ => false)
+                  | NoPureAll => (case qs of [] => false | _ => true)
+                  | NoPureOne => (case qs of [] => false | _ => PS.numItems pureArgs = 0)
+                  | NoCombo => PS.numItems pureArgs = 0 orelse AM.numItems argsMap = 0
+        in
+            (* Put arguments we might invalidate by first. *)
+            if shouldCache
+            then SOME (map AsIs args @ map (Urlify o expOfPath) (PS.listItems pureArgs))
+            else NONE
+        end
+
+    (* As a kludge, we rename the variables in the query to correspond to the
+       argument of the cache they're part of. *)
+    fun query (qs : t) =
+        let
+            val argsMap = sqlArgsMap qs
+            fun substitute subst =
+             fn ERel n => IM.find (subst, n)
+                          <\obind\>
+                           (fn arg =>
+                               AM.find (argsMap, arg)
+                               <\obind\>
+                                (fn n' => SOME (ERel n')))
+              | _ => raise Fail "Sqlcache: query (a)"
+        in
+            case (map #1 qs) of
+                (q :: qs) =>
+                let
+                    val q = List.foldl Sql.Union q qs
+                    val ns = IS.listItems (varsOfQuery q)
+                    val rename =
+                     fn ERel n => omap ERel (indexOf (fn n' => n' = n) ns)
+                      | _ => raise Fail "Sqlcache: query (b)"
+                in
+                    case omapQuery rename q of
+                        SOME q => q
+                      (* We should never get NONE because indexOf should never fail. *)
+                      | NONE => raise Fail "Sqlcache: query (c)"
+                end
+              (* We should never reach this case because [updateState] won't
+                 put anything in the state if there are no queries. *)
+              | [] => raise Fail "Sqlcache: query (d)"
+        end
+
+    val argOfExp =
+        let
+            fun doFields acc exp =
+                acc
+                <\obind\>
+                 (fn (fs, sqlify) =>
+                     case #1 exp of
+                         ERel n => SOME (n, fs, sqlify)
+                       | EField (exp, f) => doFields (SOME (f::fs, sqlify)) exp
+                       | _ => NONE)
+        in
+         fn (EFfiApp ("Basis", x, [(exp, typ)]), _) =>
+            if String.isPrefix "sqlify" x
+            then omap (fn path => (path, SOME ("Basis", x, typ))) (pathOfExp exp)
+            else NONE
+          | exp => omap (fn path => (path, NONE)) (pathOfExp exp)
+        end
+
+    val unbind1 =
+     fn Known e =>
+        let
+            val replacement = argOfExp e
+        in
+            omapSubst (fn 0 => replacement
+                        | n => SOME ((n-1, []), NONE))
+        end
+      | Unknowns k => omapSubst (fn n => if n < k then NONE else SOME ((n-k, []), NONE))
+
+    fun unbind (qs, ub) =
+        case ub of
+            (* Shortcut if nothing's changing. *)
+            Unknowns 0 => SOME qs
+          | _ => osequence (map (fn (q, subst) => unbind1 ub subst
+                                                  <\obind\>
+                                                   (fn subst' => SOME (q, subst'))) qs)
+
+    fun updateState (qs, numArgs, state as {index, ...} : state) =
+        {tableToIndices = List.foldr (fn ((q, _), acc) =>
+                                         SS.foldl (fn (tab, acc) =>
+                                                      SIMM.insert (acc, tab, index))
+                                                  acc
+                                                  (tablesOfQuery q))
+                                     (#tableToIndices state)
+                                     qs,
+         indexToInvalInfo = IM.insert (#indexToInvalInfo state, index, (qs, numArgs)),
+         ffiInfo = {index = index, params = numArgs} :: #ffiInfo state,
+         index = index + 1}
+
+end
+
+structure UF = UnionFindFn(AtomExpKey)
+
+val rec sqexpToFormula =
+ fn Sql.SqTrue => Combo (Conj, [])
+  | Sql.SqFalse => Combo (Disj, [])
+  | Sql.SqNot e => Negate (sqexpToFormula e)
+  | Sql.Binop (Sql.RCmp c, e1, e2) => Atom (c, e1, e2)
+  | Sql.Binop (Sql.RLop l, p1, p2) => Combo (case l of Sql.And => Conj | Sql.Or => Disj,
+                                             [sqexpToFormula p1, sqexpToFormula p2])
+  | e as Sql.Field f => Atom (Sql.Eq, e, Sql.SqTrue)
+  (* ASK: any other sqexps that can be props? *)
+  | Sql.SqConst prim =>
+    (case prim of
+         (Prim.String (Prim.Normal, s)) =>
+         if s = #trueString (Settings.currentDbms ())
+         then Combo (Conj, [])
+         else if s = #falseString (Settings.currentDbms ())
+         then Combo (Disj, [])
+         else raise Fail "Sqlcache: sqexpToFormula (SqConst a)"
+       | _ => raise Fail "Sqlcache: sqexpToFormula (SqConst b)")
+  | Sql.Computed _ => raise Fail "Sqlcache: sqexpToFormula (Computed)"
+  | Sql.SqKnown _ => raise Fail "Sqlcache: sqexpToFormula (SqKnown)"
+  | Sql.Inj _ => raise Fail "Sqlcache: sqexpToFormula (Inj)"
+  | Sql.SqFunc _ => raise Fail "Sqlcache: sqexpToFormula (SqFunc)"
+  | Sql.Unmodeled => raise Fail "Sqlcache: sqexpToFormula (Unmodeled)"
+  | Sql.Null => raise Fail "Sqlcache: sqexpToFormula (Null)"
+
+fun mapSqexpFields f =
+ fn Sql.Field (t, v) => f (t, v)
+  | Sql.SqNot e => Sql.SqNot (mapSqexpFields f e)
+  | Sql.Binop (r, e1, e2) => Sql.Binop (r, mapSqexpFields f e1, mapSqexpFields f e2)
+  | Sql.SqKnown e => Sql.SqKnown (mapSqexpFields f e)
+  | Sql.SqFunc (s, e) => Sql.SqFunc (s, mapSqexpFields f e)
+  | e => e
+
+fun renameTables tablePairs =
+    let
+        fun rename table =
+            case List.find (fn (_, t) => table = t) tablePairs of
+                NONE => table
+              | SOME (realTable, _) => realTable
+    in
+        mapSqexpFields (fn (t, f) => Sql.Field (rename t, f))
+    end
+
+structure FlattenQuery = struct
+
+    datatype substitution = RenameTable of string | SubstituteExp of Sql.sqexp SM.map
+
+    fun applySubst substTable =
+        let
+            fun substitute (table, field) =
+                case SM.find (substTable, table) of
+                    NONE => Sql.Field (table, field)
+                  | SOME (RenameTable realTable) => Sql.Field (realTable, field)
+                  | SOME (SubstituteExp substField) =>
+                    case SM.find (substField, field) of
+                        NONE => raise Fail "Sqlcache: applySubst"
+                      | SOME se => se
+        in
+            mapSqexpFields substitute
+        end
+
+    fun addToSubst (substTable, table, substField) =
+        SM.insert (substTable,
+                   table,
+                   case substField of
+                       RenameTable _ => substField
+                     | SubstituteExp subst => SubstituteExp (SM.map (applySubst substTable) subst))
+
+    fun newSubst (t, s) = addToSubst (SM.empty, t, s)
+
+    datatype sitem' = Named of Sql.sqexp * string | Unnamed of Sql.sqexp
+
+    type queryFlat = {Select : sitem' list, Where : Sql.sqexp}
+
+    val sitemsToSubst =
+        List.foldl (fn (Named (se, s), acc) => SM.insert (acc, s, se)
+                     | (Unnamed _, _) => raise Fail "Sqlcache: sitemsToSubst")
+                   SM.empty
+
+    fun unionSubst (s1, s2) = SM.unionWith (fn _ => raise Fail "Sqlcache: unionSubst") (s1, s2)
+
+    fun sqlAnd (se1, se2) = Sql.Binop (Sql.RLop Sql.And, se1, se2)
+
+    val rec flattenFitem : Sql.fitem -> (Sql.sqexp * substitution SM.map) list =
+     fn Sql.Table (real, alias) => [(Sql.SqTrue, newSubst (alias, RenameTable real))]
+      | Sql.Nested (q, s) =>
+        let
+            val qfs = flattenQuery q
+        in
+            map (fn (qf, subst) =>
+                    (#Where qf, addToSubst (subst, s, SubstituteExp (sitemsToSubst (#Select qf)))))
+                qfs
+        end
+      | Sql.Join (jt, fi1, fi2, se) =>
+        concatMap (fn ((wher1, subst1)) =>
+                      map (fn (wher2, subst2) =>
+                              let
+                                  val subst = unionSubst (subst1, subst2)
+                              in
+                                  (* ON clause becomes part of the accumulated WHERE. *)
+                                  (sqlAnd (sqlAnd (wher1, wher2), applySubst subst se), subst)
+                              end)
+                          (flattenFitem fi2))
+                  (flattenFitem fi1)
+
+    and flattenQuery : Sql.query -> (queryFlat * substitution SM.map) list =
+     fn Sql.Query1 q =>
+        let
+            val fifss = cartesianProduct (map flattenFitem (#From q))
+        in
+            map (fn fifs =>
+                    let
+                        val subst = List.foldl (fn ((_, subst), acc) => unionSubst (acc, subst))
+                                               SM.empty
+                                               fifs
+                        val wher = List.foldr (fn ((wher, _), acc) => sqlAnd (wher, acc))
+                                              (case #Where q of
+                                                   NONE => Sql.SqTrue
+                                                 | SOME wher => wher)
+                                              fifs
+                    in
+                        (* ASK: do we actually need to pass the substitution through here? *)
+                        (* We use the substitution later, but it's not clear we
+                       need any of its currently present fields again. *)
+                        ({Select = map (fn Sql.SqExp (se, s) => Named (applySubst subst se, s)
+                                         | Sql.SqField tf =>
+                                           Unnamed (applySubst subst (Sql.Field tf)))
+                                       (#Select q),
+                          Where = applySubst subst wher},
+                         subst)
+                    end)
+                fifss
+        end
+      | Sql.Union (q1, q2) => (flattenQuery q1) @ (flattenQuery q2)
+
+end
+
+val flattenQuery = map #1 o FlattenQuery.flattenQuery
+
+fun queryFlatToFormula marker {Select = sitems, Where = wher} =
+    let
+        val fWhere = sqexpToFormula wher
+    in
+        case marker of
+             NONE => fWhere
+           | SOME markFields =>
+             let
+                 val fWhereMarked = mapFormulaExps markFields fWhere
+                 val toSqexp =
+                  fn FlattenQuery.Named (se, _) => se
+                   | FlattenQuery.Unnamed se => se
+                 fun ineq se = Atom (Sql.Ne, se, markFields se)
+                 val fIneqs = Combo (Disj, map (ineq o toSqexp) sitems)
+             in
+                 (Combo (Conj,
+                         [fWhere,
+                          Combo (Disj,
+                                 [Negate fWhereMarked,
+                                  Combo (Conj, [fWhereMarked, fIneqs])])]))
+             end
+    end
+
+fun queryToFormula marker q = Combo (Disj, map (queryFlatToFormula marker) (flattenQuery q))
+
+fun valsToFormula (markLeft, markRight) (table, vals) =
+    Combo (Conj,
+           map (fn (field, v) => Atom (Sql.Eq, markLeft (Sql.Field (table, field)), markRight v))
+               vals)
+
+(* TODO: verify logic for insertion and deletion. *)
+val rec dmlToFormulaMarker =
+ fn Sql.Insert (table, vals) => (valsToFormula (id, id) (table, vals), NONE)
+  | Sql.Delete (table, wher) => (sqexpToFormula (renameTables [(table, "T")] wher), NONE)
+  | Sql.Update (table, vals, wher) =>
+    let
+        val fWhere = sqexpToFormula (renameTables [(table, "T")] wher)
+        fun fVals marks = valsToFormula marks (table, vals)
+        val modifiedFields = SS.addList (SS.empty, map #1 vals)
+        (* TODO: don't use field name hack. *)
+        val markFields =
+            mapSqexpFields (fn (t, v) => if t = table andalso SS.member (modifiedFields, v)
+                                         then Sql.Field (t, v ^ "'")
+                                         else Sql.Field (t, v))
+        val mark = mapFormulaExps markFields
+    in
+        ((Combo (Disj, [Combo (Conj, [fVals (id, markFields), mark fWhere]),
+                        Combo (Conj, [fVals (markFields, id), fWhere])])),
+         SOME markFields)
+    end
+
+fun pairToFormulas (query, dml) =
+    let
+        val (fDml, marker) = dmlToFormulaMarker dml
+    in
+        (queryToFormula marker query, fDml)
+    end
+
+structure ConflictMaps = struct
+
+    structure TK = TripleKeyFn(structure I = CmpKey
+                               structure J = AtomOptionKey
+                               structure K = AtomOptionKey)
+
+    structure TS : ORD_SET = BinarySetFn(TK)
+
+    val toKnownEquality =
+     (* [NONE] here means unkown. Anything that isn't a comparison between two
+        knowns shouldn't be used, and simply dropping unused terms is okay in
+        disjunctive normal form. *)
+     fn (Sql.Eq, SOME e1, SOME e2) => SOME (e1, e2)
+      | _ => NONE
+
+    fun equivClasses atoms : atomExp list list option =
+        let
+            val uf = List.foldl UF.union' UF.empty (List.mapPartial toKnownEquality atoms)
+            val contradiction =
+             fn (cmp, SOME ae1, SOME ae2) => (cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt)
+                                             andalso UF.together (uf, ae1, ae2)
+              (* If we don't know one side of the comparision, not a contradiction. *)
+              | _ => false
+        in
+            not (List.exists contradiction atoms) <\oguard\> (fn _ => SOME (UF.classes uf))
+        end
+
+    fun addToEqs (eqs, n, e) =
+        case IM.find (eqs, n) of
+            (* Comparing to a constant is probably better than comparing to a
+               variable? Checking that existing constants match a new ones is
+               handled by [accumulateEqs]. *)
+            SOME (Prim _) => eqs
+          | _ => IM.insert (eqs, n, e)
+
+    val accumulateEqs =
+     (* [NONE] means we have a contradiction. *)
+     fn (_, NONE) => NONE
+      | ((Prim p1, Prim p2), eqso) =>
+        (case Prim.compare (p1, p2) of
+             EQUAL => eqso
+           | _ => NONE)
+      | ((QueryArg n, Prim p), SOME eqs) => SOME (addToEqs (eqs, n, Prim p))
+      | ((QueryArg n, DmlRel r), SOME eqs) => SOME (addToEqs (eqs, n, DmlRel r))
+      | ((Prim p, QueryArg n), SOME eqs) => SOME (addToEqs (eqs, n, Prim p))
+      | ((DmlRel r, QueryArg n), SOME eqs) => SOME (addToEqs (eqs, n, DmlRel r))
+      (* TODO: deal with equalities between [DmlRel]s and [Prim]s.
+         This would involve guarding the invalidation with a check for the
+         relevant comparisons. *)
+      | (_, eqso) => eqso
+
+    val eqsOfClass : atomExp list -> atomExp IM.map option =
+        List.foldl accumulateEqs (SOME IM.empty)
+        o chooseTwos
+
+    fun toAtomExps rel (cmp, e1, e2) =
+        let
+            val qa =
+             (* Here [NONE] means unkown. *)
+             fn Sql.SqConst p => SOME (Prim p)
+              | Sql.Field tf => SOME (Field tf)
+              | Sql.Inj (EPrim p, _) => SOME (Prim p)
+              | Sql.Inj (ERel n, _) => SOME (rel n)
+              (* We can't deal with anything else, e.g., CURRENT_TIMESTAMP
+                 becomes Sql.Unmodeled, which becomes NONE here. *)
+              | _ => NONE
+        in
+            (cmp, qa e1, qa e2)
+        end
+
+    val negateCmp =
+     fn Sql.Eq => Sql.Ne
+      | Sql.Ne => Sql.Eq
+      | Sql.Lt => Sql.Ge
+      | Sql.Le => Sql.Gt
+      | Sql.Gt => Sql.Le
+      | Sql.Ge => Sql.Lt
+
+    fun normalizeAtom (negating, (cmp, e1, e2)) =
+        (* Restricting to Le/Lt and sorting the expressions in Eq/Ne helps with
+           simplification, where we put the triples in sets. *)
+        case (if negating then negateCmp cmp else cmp) of
+            Sql.Eq => (case AtomOptionKey.compare (e1, e2) of
+                           LESS => (Sql.Eq, e2, e1)
+                         | _ => (Sql.Eq, e1, e2))
+          | Sql.Ne => (case AtomOptionKey.compare (e1, e2) of
+                           LESS => (Sql.Ne, e2, e1)
+                         | _ => (Sql.Ne, e1, e2))
+          | Sql.Lt => (Sql.Lt, e1, e2)
+          | Sql.Le => (Sql.Le, e1, e2)
+          | Sql.Gt => (Sql.Lt, e2, e1)
+          | Sql.Ge => (Sql.Le, e2, e1)
+
+    val markQuery : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula ->
+                    (Sql.cmp * atomExp option * atomExp option) formula =
+        mapFormula (toAtomExps QueryArg)
+
+    val markDml : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula ->
+                  (Sql.cmp * atomExp option * atomExp option) formula =
+        mapFormula (toAtomExps DmlRel)
+
+    (* No eqs should have key conflicts because no variable is in two
+       equivalence classes. *)
+    val mergeEqs : (atomExp IntBinaryMap.map option list
+                    -> atomExp IntBinaryMap.map option) =
+        List.foldr (omap2 (IM.unionWith (fn _ => raise Fail "Sqlcache: ConflictMaps.mergeEqs")))
+                   (SOME IM.empty)
+
+    val simplify =
+        map TS.listItems
+        o removeRedundant (fn (x, y) => TS.isSubset (y, x))
+        o map (fn xs => TS.addList (TS.empty, xs))
+
+    fun dnf (fQuery, fDml) =
+        normalize simplify normalizeAtom Disj (Combo (Conj, [markQuery fQuery, markDml fDml]))
+
+    val conflictMaps =
+        List.mapPartial (mergeEqs o map eqsOfClass)
+        o List.mapPartial equivClasses
+        o dnf
+
+end
+
+val conflictMaps = ConflictMaps.conflictMaps
+
+
+(*************************************)
+(* Program Instrumentation Utilities *)
+(*************************************)
+
+val {check, store, flush, lock, ...} = getCache ()
+
+val dummyTyp = (TRecord [], dummyLoc)
+
+fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc)
+
+val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
+
+val sequence =
+ fn (exp :: exps) =>
+    let
+        val loc = dummyLoc
+    in
+        List.foldl (fn (e', seq) => ESeq ((seq, loc), (e', loc))) exp exps
+    end
+  | _ => raise Fail "Sqlcache: sequence"
+
+(* Always increments negative indices as a hack we use later. *)
+fun incRels inc =
+    MonoUtil.Exp.mapB
+        {typ = fn t' => t',
+         exp = fn bound =>
+                  (fn ERel n => ERel (if n >= bound orelse n < 0 then n + inc else n)
+                    | e' => e'),
+         bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound}
+        0
+
+fun fileTopLevelMapfoldB doTopLevelExp (decls, sideInfo) state =
+    let
+        fun doVal env ((x, n, t, exp, s), state) =
+            let
+                val (exp, state) = doTopLevelExp env exp state
+            in
+                ((x, n, t, exp, s), state)
+            end
+        fun doDecl' env (decl', state) =
+            case decl' of
+                DVal v =>
+                let
+                    val (v, state) = doVal env (v, state)
+                in
+                    (DVal v, state)
+                end
+              | DValRec vs =>
+                let
+                    val (vs, state) = ListUtil.foldlMap (doVal env) state vs
+                in
+                    (DValRec vs, state)
+                end
+              | _ => (decl', state)
+        fun doDecl (decl as (decl', loc), (env, state)) =
+            let
+                val env = MonoEnv.declBinds env decl
+                val (decl', state) = doDecl' env (decl', state)
+            in
+                ((decl', loc), (env, state))
+            end
+        val (decls, (_, state)) = (ListUtil.foldlMap doDecl (MonoEnv.empty, state) decls)
+    in
+        ((decls, sideInfo), state)
+    end
+
+fun fileAllMapfoldB doExp file start =
+    case MonoUtil.File.mapfoldB
+             {typ = Search.return2,
+              exp = fn env => fn e' => fn s => Search.Continue (doExp env e' s),
+              decl = fn _ => Search.return2,
+              bind = doBind}
+             MonoEnv.empty file start of
+        Search.Continue x => x
+      | Search.Return _ => raise Fail "Sqlcache: fileAllMapfoldB"
+
+fun fileMap doExp file = #1 (fileAllMapfoldB (fn _ => fn e => fn _ => (doExp e, ())) file ())
+
+(* TODO: make this a bit prettier.... *)
+(* TODO: factour out identical subexpressions to the same variable.... *)
+val simplifySql =
+    let
+        fun factorOutNontrivial text =
+            let
+                val loc = dummyLoc
+                val strcat =
+                 fn (e1, (EPrim (Prim.String (Prim.Normal, "")), _)) => e1
+                  | ((EPrim (Prim.String (Prim.Normal, "")), _), e2) => e2
+                  | (e1, e2) => (EStrcat (e1, e2), loc)
+                val chunks = Sql.chunkify text
+                val (newText, newVariables) =
+                    (* Important that this is foldr (to oppose foldl below). *)
+                    List.foldr
+                        (fn (chunk, (qText, newVars)) =>
+                            (* Variable bound to the head of newVars will have the lowest index. *)
+                            case chunk of
+                                (* EPrim should always be a string in this case. *)
+                                Sql.Exp (e as (EPrim _, _)) => (strcat (e, qText), newVars)
+                              | Sql.Exp e =>
+                                let
+                                    val n = length newVars
+                                in
+                                    (* This is the (n+1)th new variable, so there are
+                                       already n new variables bound, so we increment
+                                       indices by n. *)
+                                    (strcat ((ERel (~(n+1)), loc), qText), incRels n e :: newVars)
+                                end
+                              | Sql.String s => (strcat (stringExp s, qText), newVars))
+                        (stringExp "", [])
+                        chunks
+                fun wrapLets e' =
+                    (* Important that this is foldl (to oppose foldr above). *)
+                    List.foldl (fn (v, e') => ELet ("sqlArg", stringTyp, v, (e', loc)))
+                               e'
+                               newVariables
+                val numArgs = length newVariables
+            in
+                (newText, wrapLets, numArgs)
+            end
+        fun doExp exp' =
+            let
+                val text = case exp' of
+                               EQuery {query = text, ...} => text
+                             | EDml (text, _) => text
+                             | _ => raise Fail "Sqlcache: simplifySql (a)"
+                val (newText, wrapLets, numArgs) = factorOutNontrivial text
+                val newExp' = case exp' of
+                                 EQuery q => EQuery {query = newText,
+                                                     exps = #exps q,
+                                                     tables = #tables q,
+                                                     state = #state q,
+                                                     body = #body q,
+                                                     initial = #initial q}
+                               | EDml (_, failureMode) => EDml (newText, failureMode)
+                               | _ => raise Fail "Sqlcache: simplifySql (b)"
+            in
+                (* Increment once for each new variable just made. This is
+                   where we use the negative De Bruijn indices hack. *)
+                (* TODO: please don't use that hack. As anyone could have
+                   predicted, it was incomprehensible a year later.... *)
+                wrapLets (#1 (incRels numArgs (newExp', dummyLoc)))
+            end
+    in
+        fileMap (fn exp' => case exp' of
+                                EQuery _ => doExp exp'
+                              | EDml _ => doExp exp'
+                              | _ => exp')
+    end
+
+
+(**********************)
+(* Mono Type Checking *)
+(**********************)
+
+fun typOfExp' (env : MonoEnv.env) : exp' -> typ option =
+ fn EPrim p => SOME (TFfi ("Basis", case p of
+                                        Prim.Int _ => "int"
+                                      | Prim.Float _ => "double"
+                                      | Prim.String _ => "string"
+                                      | Prim.Char _ => "char"),
+                     dummyLoc)
+  | ERel n => SOME (#2 (MonoEnv.lookupERel env n))
+  | ENamed n => SOME (#2 (MonoEnv.lookupENamed env n))
+  (* ASK: okay to make a new [ref] each time? *)
+  | ECon (dk, PConVar nCon, _) =>
+    let
+        val (_, _, nData) = MonoEnv.lookupConstructor env nCon
+        val (_, cs) = MonoEnv.lookupDatatype env nData
+    in
+        SOME (TDatatype (nData, ref (dk, cs)), dummyLoc)
+    end
+  | ECon (_, PConFfi {mod = s, datatyp, ...}, _) => SOME (TFfi (s, datatyp), dummyLoc)
+  | ENone t => SOME (TOption t, dummyLoc)
+  | ESome (t, _) => SOME (TOption t, dummyLoc)
+  | EFfi _ => NONE
+  | EFfiApp _ => NONE
+  | EApp (e1, e2) => (case typOfExp env e1 of
+                          SOME (TFun (_, t), _) => SOME t
+                        | _ => NONE)
+  | EAbs (_, t1, t2, _) => SOME (TFun (t1, t2), dummyLoc)
+  (* ASK: is this right? *)
+  | EUnop (unop, e) => (case unop of
+                            "!" => SOME (TFfi ("Basis", "bool"), dummyLoc)
+                          | "-" => typOfExp env e
+                          | _ => NONE)
+  (* ASK: how should this (and other "=> NONE" cases) work? *)
+  | EBinop _ => NONE
+  | ERecord fields => SOME (TRecord (map (fn (s, _, t) => (s, t)) fields), dummyLoc)
+  | EField (e, s) => (case typOfExp env e of
+                          SOME (TRecord fields, _) =>
+                          omap #2 (List.find (fn (s', _) => s = s') fields)
+                        | _ => NONE)
+  | ECase (_, _, {result, ...}) => SOME result
+  | EStrcat _ => SOME (TFfi ("Basis", "string"), dummyLoc)
+  | EWrite _ => SOME (TRecord [], dummyLoc)
+  | ESeq (_, e) => typOfExp env e
+  | ELet (s, t, e1, e2) => typOfExp (MonoEnv.pushERel env s t (SOME e1)) e2
+  | EClosure _ => NONE
+  | EUnurlify (_, t, _) => SOME t
+  | EQuery {state, ...} => SOME state
+  | e => NONE
+
+and typOfExp env (e', loc) = typOfExp' env e'
+
+
+(***********)
+(* Caching *)
+(***********)
+
+type state = InvalInfo.state
+
+datatype subexp = Cachable of InvalInfo.t * (state -> exp * state) | Impure of exp
+
+val isImpure =
+ fn Cachable _ => false
+  | Impure _ => true
+
+val runSubexp : subexp * state -> exp * state =
+ fn (Cachable (_, f), state) => f state
+  | (Impure e, state) => (e, state)
+
+val invalInfoOfSubexp =
+ fn Cachable (invalInfo, _) => invalInfo
+  | Impure _ => raise Fail "Sqlcache: invalInfoOfSubexp"
+
+fun cacheWrap (env, exp, typ, args, index) =
+    let
+        val loc = dummyLoc
+        val rel0 = (ERel 0, loc)
+    in
+        case MonoFooify.urlify env (rel0, typ) of
+            NONE => NONE
+          | SOME urlified =>
+            let
+                (* We ensure before this step that all arguments aren't effectful.
+                   by turning them into local variables as needed. *)
+                val argsInc = map (incRels 1) args
+                val check = (check (index, args), loc)
+                val store = (store (index, argsInc, urlified), loc)
+            in
+                SOME (ECase (check,
+                             [((PNone stringTyp, loc),
+                               (ELet ("q", typ, exp, (ESeq (store, rel0), loc)), loc)),
+                              ((PSome (stringTyp, (PVar ("hit", stringTyp), loc)), loc),
+                               (* Boolean is false because we're not unurlifying from a cookie. *)
+                               (EUnurlify (rel0, typ, false), loc))],
+                             {disc = (TOption stringTyp, loc), result = typ}))
+            end
+    end
+
+val expSize = MonoUtil.Exp.fold {typ = #2, exp = fn (_, n) => n+1} 0
+
+(* TODO: pick a number. *)
+val sizeWorthCaching = 5
+
+val worthCaching =
+ fn EQuery _ => true
+  | exp' => expSize (exp', dummyLoc) > sizeWorthCaching
+
+fun cacheExp (env, exp', invalInfo, state : state) =
+    case worthCaching exp' <\oguard\> (fn _ => typOfExp' env exp') of
+        NONE => NONE
+      | SOME (TFun _, _) => NONE
+      | SOME typ =>
+        InvalInfo.orderArgs (invalInfo, (exp', dummyLoc))
+        <\obind\>
+         (fn args =>
+             List.foldr (fn (arg, acc) =>
+                            acc
+                            <\obind\>
+                             (fn args' =>
+                                 (case arg of
+                                      AsIs exp => SOME exp
+                                    | Urlify exp =>
+                                      (typOfExp env exp)
+                                      <\obind\>
+                                       (fn typ => MonoFooify.urlify env (exp, typ)))
+                                 <\obind\>
+                                  (fn arg' => SOME (arg' :: args'))))
+                        (SOME [])
+                        args
+             <\obind\>
+              (fn args' =>
+                  cacheWrap (env, (exp', dummyLoc), typ, args', #index state)
+                  <\obind\>
+                   (fn cachedExp =>
+                       SOME (cachedExp,
+                             InvalInfo.updateState (invalInfo, length args', state)))))
+
+fun cacheQuery (effs, env, q) : subexp =
+    let
+        (* We use dummyTyp here. I think this is okay because databases don't
+           store (effectful) functions, but perhaps there's some pathalogical
+           corner case missing.... *)
+        fun safe bound =
+            not
+            o effectful effs
+                        (iterate (fn env => MonoEnv.pushERel env "_" dummyTyp NONE)
+                                 bound
+                                 env)
+        val {query = queryText, initial, body, ...} = q
+        val attempt =
+            (* Ziv misses Haskell's do notation.... *)
+            (safe 0 queryText andalso safe 0 initial andalso safe 2 body)
+            <\oguard\>
+             (fn _ =>
+                 Sql.parse Sql.query queryText
+                 <\obind\>
+                  (fn queryParsed =>
+                      let
+                          val invalInfo = InvalInfo.singleton queryParsed
+                          fun mkExp state =
+                              case cacheExp (env, EQuery q, invalInfo, state) of
+                                  NONE => ((EQuery q, dummyLoc), state)
+                                | SOME (cachedExp, state) => ((cachedExp, dummyLoc), state)
+                      in
+                          SOME (Cachable (invalInfo, mkExp))
+                      end))
+    in
+        case attempt of
+            NONE => Impure (EQuery q, dummyLoc)
+          | SOME subexp => subexp
+    end
+
+fun cacheTree (effs : IS.set) ((env, exp as (exp', loc)), state) =
+    let
+        fun wrapBindN (f : exp list -> exp')
+                      (args : ((MonoEnv.env * exp) * unbind) list) =
+            let
+                val (subexps, state) =
+                    ListUtil.foldlMap (cacheTree effs)
+                                      state
+                                      (map #1 args)
+                fun mkExp state = mapFst (fn exps => (f exps, loc))
+                                         (ListUtil.foldlMap runSubexp state subexps)
+                val attempt =
+                    if List.exists isImpure subexps
+                    then NONE
+                    else (List.foldl (omap2 InvalInfo.union)
+                                     (SOME InvalInfo.empty)
+                                     (ListPair.map
+                                          (fn (subexp, (_, unbinds)) =>
+                                              InvalInfo.unbind (invalInfoOfSubexp subexp, unbinds))
+                                          (subexps, args)))
+                             <\obind\>
+                              (fn invalInfo =>
+                                  SOME (Cachable (invalInfo,
+                                                  fn state =>
+                                                     case cacheExp (env,
+                                                                    f (map (#2 o #1) args),
+                                                                    invalInfo,
+                                                                    state) of
+                                                         NONE => mkExp state
+                                                       | SOME (e', state) => ((e', loc), state)),
+                                        state))
+            in
+                case attempt of
+                    SOME (subexp, state) => (subexp, state)
+                  | NONE => mapFst Impure (mkExp state)
+            end
+        fun wrapBind1 f arg =
+            wrapBindN (fn [arg] => f arg
+                        | _ => raise Fail "Sqlcache: cacheTree (a)") [arg]
+        fun wrapBind2 f (arg1, arg2) =
+            wrapBindN (fn [arg1, arg2] => f (arg1, arg2)
+                        | _ => raise Fail "Sqlcache: cacheTree (b)") [arg1, arg2]
+        fun wrapN f es = wrapBindN f (map (fn e => ((env, e), Unknowns 0)) es)
+        fun wrap1 f e = wrapBind1 f ((env, e), Unknowns 0)
+        fun wrap2 f (e1, e2) = wrapBind2 f (((env, e1), Unknowns 0), ((env, e2), Unknowns 0))
+    in
+        case exp' of
+            ECon (dk, pc, SOME e) => wrap1 (fn e => ECon (dk, pc, SOME e)) e
+          | ESome (t, e) => wrap1 (fn e => ESome (t, e)) e
+          | EFfiApp (s1, s2, args) =>
+            if ffiEffectful (s1, s2)
+            then (Impure exp, state)
+            else wrapN (fn es =>
+                           EFfiApp (s1, s2, ListPair.map (fn (e, (_, t)) => (e, t)) (es, args)))
+                       (map #1 args)
+          | EApp (e1, e2) => wrap2 EApp (e1, e2)
+          | EAbs (s, t1, t2, e) =>
+            wrapBind1 (fn e => EAbs (s, t1, t2, e))
+                      ((MonoEnv.pushERel env s t1 NONE, e), Unknowns 1)
+          | EUnop (s, e) => wrap1 (fn e => EUnop (s, e)) e
+          | EBinop (bi, s, e1, e2) => wrap2 (fn (e1, e2) => EBinop (bi, s, e1, e2)) (e1, e2)
+          | ERecord fields =>
+            wrapN (fn es => ERecord (ListPair.map (fn (e, (s, _, t)) => (s, e, t)) (es, fields)))
+                  (map #2 fields)
+          | EField (e, s) => wrap1 (fn e => EField (e, s)) e
+          | ECase (e, cases, {disc, result}) =>
+            wrapBindN (fn (e::es) =>
+                          ECase (e,
+                                 (ListPair.map (fn (e, (p, _)) => (p, e)) (es, cases)),
+                                 {disc = disc, result = result})
+                        | _ => raise Fail "Sqlcache: cacheTree (c)")
+                      (((env, e), Unknowns 0)
+                       :: map (fn (p, e) =>
+                                  ((MonoEnv.patBinds env p, e), Unknowns (MonoEnv.patBindsN p)))
+                              cases)
+          | EStrcat (e1, e2) => wrap2 EStrcat (e1, e2)
+          (* We record page writes, so they're cachable. *)
+          | EWrite e => wrap1 EWrite e
+          | ESeq (e1, e2) => wrap2 ESeq (e1, e2)
+          | ELet (s, t, e1, e2) =>
+            wrapBind2 (fn (e1, e2) => ELet (s, t, e1, e2))
+                      (((env, e1), Unknowns 0),
+                       ((MonoEnv.pushERel env s t (SOME e1), e2), Known e1))
+          (* ASK: | EClosure (n, es) => ? *)
+          | EUnurlify (e, t, b) => wrap1 (fn e => EUnurlify (e, t, b)) e
+          | EQuery q => (cacheQuery (effs, env, q), state)
+          | _ => (if effectful effs env exp
+                  then Impure exp
+                  else Cachable (InvalInfo.empty,
+                                 fn state =>
+                                    case cacheExp (env, exp', InvalInfo.empty, state) of
+                                        NONE => ((exp', loc), state)
+                                      | SOME (exp', state) => ((exp', loc), state)),
+                  state)
+    end
+
+fun addCaching file =
+    let
+        val effs = effectfulDecls file
+        fun doTopLevelExp env exp state = runSubexp (cacheTree effs ((env, exp), state))
+    in
+        (fileTopLevelMapfoldB doTopLevelExp
+                              file
+                              {tableToIndices = SIMM.empty,
+                               indexToInvalInfo = IM.empty,
+                               ffiInfo = [],
+                               index = 0},
+         effs)
+    end
+
+
+(************)
+(* Flushing *)
+(************)
+
+structure Invalidations = struct
+
+    val loc = dummyLoc
+
+    val optionAtomExpToExp =
+     fn NONE => (ENone stringTyp, loc)
+      | SOME e => (ESome (stringTyp,
+                          (case e of
+                               DmlRel n => ERel n
+                             | Prim p => EPrim p
+                             (* TODO: make new type containing only these two. *)
+                             | _ => raise Fail "Sqlcache: Invalidations.optionAtomExpToExp",
+                           loc)),
+                   loc)
+
+    fun eqsToInvalidation numArgs eqs =
+        List.tabulate (numArgs, (fn n => IM.find (eqs, n)))
+
+    (* Tests if [ys] makes [xs] a redundant cache invalidation. [NONE] here
+       represents unknown, which means a wider invalidation. *)
+    val rec madeRedundantBy : atomExp option list * atomExp option list -> bool =
+     fn ([], []) => true
+      | (_ :: xs, NONE :: ys) => madeRedundantBy (xs, ys)
+      | (SOME x :: xs, SOME y :: ys) => (case AtomExpKey.compare (x, y) of
+                                             EQUAL => madeRedundantBy (xs, ys)
+                                           | _ => false)
+      | _ => false
+
+    fun invalidations ((invalInfo, numArgs), dml) =
+        let
+            val query = InvalInfo.query invalInfo
+        in
+            (map (map optionAtomExpToExp)
+             o removeRedundant madeRedundantBy
+             o map (eqsToInvalidation numArgs)
+             o conflictMaps)
+                (pairToFormulas (query, dml))
+        end
+
+end
+
+val invalidations = Invalidations.invalidations
+
+fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state), effs) =
+    let
+        val flushes = List.concat
+                      o map (fn (i, argss) => map (fn args => flush (i, args)) argss)
+        val doExp =
+         fn dmlExp as EDml (dmlText, failureMode) =>
+            let
+                val inval =
+                    case Sql.parse Sql.dml dmlText of
+                        SOME dmlParsed =>
+                        SOME (map (fn i => case IM.find (indexToInvalInfo, i) of
+                                                SOME invalInfo =>
+                                                (i, invalidations (invalInfo, dmlParsed))
+                                              (* TODO: fail more gracefully. *)
+                                              (* This probably means invalidating everything.... *)
+                                              | NONE => raise Fail "Sqlcache: addFlushing (a)")
+                                  (SIMM.findList (tableToIndices, tableOfDml dmlParsed)))
+                      | NONE => NONE
+            in
+                case inval of
+                    (* TODO: fail more gracefully. *)
+                    NONE => (Print.preface ("DML", MonoPrint.p_exp MonoEnv.empty dmlText);
+                             raise Fail "Sqlcache: addFlushing (b)")
+                  | SOME invs => sequence (flushes invs @ [dmlExp])
+            end
+          | e' => e'
+        val file = fileMap doExp file
+
+    in
+        ffiInfoRef := ffiInfo;
+        file
+    end
+
+
+(***********)
+(* Locking *)
+(***********)
+
+(* TODO: do this less evilly by not relying on specific FFI names, please? *)
+fun locksNeeded (lockMap : {store : IIMM.multimap, flush : IIMM.multimap}) =
+    MonoUtil.Exp.fold
+        {typ = #2,
+         exp = fn (EFfiApp ("Sqlcache", x, _), state as {store, flush}) =>
+                  (case Int.fromString (String.extract (x, 5, NONE)) of
+                       NONE => state
+                     | SOME index =>
+                       if String.isPrefix "flush" x
+                       then {store = store, flush = IS.add (flush, index)}
+                       else if String.isPrefix "store" x
+                       then {store = IS.add (store, index), flush = flush}
+                       else state)
+         | (ENamed n, {store, flush}) =>
+           {store = IS.union (store, IIMM.findSet (#store lockMap, n)),
+            flush = IS.union (flush, IIMM.findSet (#flush lockMap, n))}
+         | (_, state) => state}
+        {store = IS.empty, flush = IS.empty}
+
+fun lockMapOfFile file =
+    transitiveAnalysis
+        (fn ((_, name, _, e, _), state) =>
+            let
+                val locks = locksNeeded state e
+            in
+                {store = IIMM.insertSet (#store state, name, #store locks),
+                 flush = IIMM.insertSet (#flush state, name, #flush locks)}
+            end)
+        {store = IIMM.empty, flush = IIMM.empty}
+        file
+
+fun exports (decls, _) =
+    List.foldl (fn ((DExport (_, _, n, _, _, _), _), ns) => IS.add (ns, n)
+                 | (_, ns) => ns)
+               IS.empty
+               decls
+
+fun wrapLocks (locks, (exp', loc)) =
+    case exp' of
+        EAbs (s, t1, t2, exp) => (EAbs (s, t1, t2, wrapLocks (locks, exp)), loc)
+      | _ => (List.foldr (fn (l, e') => sequence [lock l, e']) exp' locks, loc)
+
+fun addLocking file =
+    let
+        val lockMap = lockMapOfFile file
+        fun lockList {store, flush} =
+            let
+                val ls = map (fn i => (i, true)) (IS.listItems flush)
+                         @ map (fn i => (i, false)) (IS.listItems (IS.difference (store, flush)))
+            in
+                ListMergeSort.sort (fn ((i, _), (j, _)) => i > j) ls
+            end
+        fun locksOfName n =
+            lockList {flush = IIMM.findSet (#flush lockMap, n),
+                      store = IIMM.findSet (#store lockMap, n)}
+        val locksOfExp = lockList o locksNeeded lockMap
+        val expts = exports file
+        fun doVal (v as (x, n, t, exp, s)) =
+            if IS.member (expts, n)
+            then (x, n, t, wrapLocks ((locksOfName n), exp), s)
+            else v
+        val doDecl =
+         fn (DVal v, loc) => (DVal (doVal v), loc)
+          | (DValRec vs, loc) => (DValRec (map doVal vs), loc)
+          | (DTask (exp1, exp2), loc) => (DTask (exp1, wrapLocks (locksOfExp exp2, exp2)), loc)
+          | decl => decl
+    in
+        mapFst (map doDecl) file
+    end
+
+
+(************************)
+(* Compiler Entry Point *)
+(************************)
+
+val inlineSql =
+    let
+        val doExp =
+         (* TODO: EQuery, too? *)
+         (* ASK: should this live in [MonoOpt]? *)
+         fn EDml ((ECase (disc, cases, {disc = dTyp, ...}), loc), failureMode) =>
+            let
+                val newCases = map (fn (p, e) => (p, (EDml (e, failureMode), loc))) cases
+            in
+                ECase (disc, newCases, {disc = dTyp, result = (TRecord [], loc)})
+            end
+          | e => e
+    in
+        fileMap doExp
+    end
+
+fun insertAfterDatatypes ((decls, sideInfo), newDecls) =
+    let
+        val (datatypes, others) = List.partition (fn (DDatatype _, _) => true | _ => false) decls
+    in
+        (datatypes @ newDecls @ others, sideInfo)
+    end
+
+val go' = addLocking o addFlushing o addCaching o simplifySql o inlineSql
+
+fun go file =
+    let
+        (* TODO: do something nicer than [Sql] being in one of two modes. *)
+        val () = (resetFfiInfo (); Sql.sqlcacheMode := true)
+        val file = go' file
+        (* Important that this happens after [MonoFooify.urlify] calls! *)
+        val fmDecls = MonoFooify.getNewFmDecls ()
+        val () = Sql.sqlcacheMode := false
+        val file = insertAfterDatatypes (file, rev fmDecls)
+    in
+        MonoReduce.reduce file
+    end
+
+end
diff --git a/src/sqlite.sig b/src/sqlite.sig
new file mode 100644
index 0000000..97475a0
--- /dev/null
+++ b/src/sqlite.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SQLITE = sig
+
+end
diff --git a/src/sqlite.sml b/src/sqlite.sml
new file mode 100644
index 0000000..a9b6389
--- /dev/null
+++ b/src/sqlite.sml
@@ -0,0 +1,855 @@
+ (* Copyright (c) 2009-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure SQLite :> SQLITE = struct
+
+open Settings
+open Print.PD
+open Print
+
+fun p_sql_type t =
+    case t of
+        Int => "integer"
+      | Float => "real"
+      | String => "text"
+      | Char => "text"
+      | Bool => "integer"
+      | Time => "text"
+      | Blob => "blob"
+      | Channel => "integer"
+      | Client => "integer"
+      | Nullable t => p_sql_type t
+
+val ident = String.translate (fn #"'" => "PRIME"
+                               | ch => str ch)
+
+fun checkRel (table, checkNullable) (s, xts) =
+    let
+        val q = "SELECT COUNT(*) FROM sqlite_master WHERE type = '" ^ table ^ "' AND name = '"
+                ^ s ^ "'"
+    in
+        box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+             string q,
+             string "\", -1, &stmt, NULL) != SQLITE_OK) {",
+             newline,
+             box [string "sqlite3_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Query preparation failed:<br />",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "while ((res = sqlite3_step(stmt)) == SQLITE_BUSY)",
+             newline,
+             box [string "sleep(1);",
+                  newline],
+             newline,
+             string "if (res == SQLITE_DONE) {",
+             newline,
+             box [string "sqlite3_finalize(stmt);",
+                  newline,
+                  string "sqlite3_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"No row returned:<br />",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "if (res != SQLITE_ROW) {",
+             newline,
+             box [string "sqlite3_finalize(stmt);",
+                  newline,
+                  string "sqlite3_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Error getting row:<br />",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (sqlite3_column_count(stmt) != 1) {",
+             newline,
+             box [string "sqlite3_finalize(stmt);",
+                  newline,
+                  string "sqlite3_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Bad column count:<br />",
+                  string q,
+                  string "\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "if (sqlite3_column_int(stmt, 0) != 1) {",
+             newline,
+             box [string "sqlite3_finalize(stmt);",
+                  newline,
+                  string "sqlite3_close(conn->conn);",
+                  newline,
+                  string "uw_error(ctx, FATAL, \"Table '",
+                  string s,
+                  string "' does not exist.\");",
+                  newline],
+             string "}",
+             newline,
+             newline,
+             string "sqlite3_finalize(stmt);",
+             newline]
+    end
+
+fun init {dbstring, prepared = ss, tables, views, sequences} =
+    let
+        val db = ref dbstring
+    in
+        app (fn s =>
+                case String.fields (fn ch => ch = #"=") s of
+                    [name, value] =>
+                    (case name of
+                         "dbname" => db := value
+                       | _ => ())
+                  | _ => ()) (String.tokens Char.isSpace dbstring);
+
+        box [string "typedef struct {",
+             newline,
+             box [string "sqlite3 *conn;",
+                  newline,
+                  p_list_sepi (box [])
+                              (fn i => fn _ =>
+                                          box [string "sqlite3_stmt *p",
+                                               string (Int.toString i),
+                                               string ";",
+                                               newline])
+                              ss],
+             string "} uw_conn;",
+             newline,
+             newline,
+
+             string "static void uw_client_init(void) {",
+             newline,
+             box [string "uw_sqlfmtInt = \"%lld%n\";",
+                  newline,
+                  string "uw_sqlfmtFloat = \"%.16g%n\";",
+                  newline,
+                  string "uw_Estrings = 0;",
+                  newline,
+                  string "uw_sql_type_annotations = 0;",
+                  newline,
+                  string "uw_sqlsuffixString = \"\";",
+                  newline,
+                  string "uw_sqlsuffixChar = \"\";",
+                  newline,
+                  string "uw_sqlsuffixBlob = \"\";",
+                  newline,
+                  string "uw_sqlfmtUint4 = \"%u%n\";",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             if #persistent (currentProtocol ()) then
+                 box [string "static void uw_db_validate(uw_context ctx) {",
+                      newline,
+                      string "uw_conn *conn = uw_get_db(ctx);",
+                      newline,
+                      string "sqlite3_stmt *stmt;",
+                      newline,
+                      string "int res;",
+                      newline,
+                      newline,
+                      p_list_sep newline (checkRel ("table", true)) tables,
+                      p_list_sep newline (fn name => checkRel ("table", true)
+                                                              (name, [("id", Settings.Client)])) sequences,
+                      p_list_sep newline (checkRel ("view", false)) views,
+                      string "}",
+                      newline,
+                      newline,
+
+                      string "static void uw_db_prepare(uw_context ctx) {",
+                      newline,
+                      string "uw_conn *conn = uw_get_db(ctx);",
+                      newline,
+                      newline,
+
+                      p_list_sepi newline (fn i => fn (s, _) =>
+                                                      let
+                                                          fun uhoh this s args =
+                                                              box [p_list_sepi (box [])
+                                                                               (fn j => fn () =>
+                                                                                           box [string
+                                                                                                    "sqlite3_finalize(conn->p",
+                                                                                                string (Int.toString j),
+                                                                                                string ");",
+                                                                                                newline])
+                                                                               (List.tabulate (i, fn _ => ())),
+                                                                   box (if this then
+                                                                            [string
+                                                                                 "sqlite3_finalize(conn->p",
+                                                                             string (Int.toString i),
+                                                                             string ");",
+                                                                             newline]
+                                                                        else
+                                                                            []),
+                                                                   string "sqlite3_close(conn->conn);",
+                                                                   newline,
+                                                                   string "uw_error(ctx, FATAL, \"",
+                                                                   string s,
+                                                                   string "\"",
+                                                                   p_list_sep (box []) (fn s => box [string ", ",
+                                                                                                     string s]) args,
+                                                                   string ");",
+                                                                   newline]
+                                                      in
+                                                          box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+                                                               string (Prim.toCString s),
+                                                               string "\", -1, &conn->p",
+                                                               string (Int.toString i),
+                                                               string ", NULL) != SQLITE_OK) {",
+                                                               newline,
+                                                               box [string "char msg[1024];",
+                                                                    newline,
+                                                                    string "strncpy(msg, sqlite3_errmsg(conn->conn), 1024);",
+                                                                    newline,
+                                                                    string "msg[1023] = 0;",
+                                                                    newline,
+                                                                    uhoh false ("Error preparing statement: "
+                                                                                ^ Prim.toCString s ^ "<br />%s") ["msg"]],
+                                                               string "}",
+                                                               newline]
+                                                      end)
+                                  ss,
+
+                      string "}"]
+             else
+                 box [string "static void uw_db_prepare(uw_context ctx) { }",
+                      newline,
+                      string "static void uw_db_validate(uw_context ctx) { }"],
+             newline,
+             newline,
+
+             string "static void uw_db_init(uw_context ctx) {",
+             newline,
+             string "sqlite3 *sqlite;",
+             newline,
+             string "sqlite3_stmt *stmt;",
+             newline,
+             string "uw_conn *conn;",
+             newline,
+             newline,
+             string "if (sqlite3_open(\"",
+             string (!db),
+             string "\", &sqlite) != SQLITE_OK) uw_error(ctx, FATAL, ",
+             string "\"Can't open SQLite database.\");",
+             newline,
+             newline,
+             string "if (uw_database_max < SIZE_MAX) {",
+             newline,
+             box [string "char buf[100];",
+                  newline,
+                  newline,
+
+                  string "sprintf(buf, \"PRAGMA max_page_count = %llu\", (unsigned long long)(uw_database_max / 1024));",
+                  newline,
+                  newline,
+
+                  string "if (sqlite3_prepare_v2(sqlite, buf, -1, &stmt, NULL) != SQLITE_OK) {",
+                  newline,
+                  box [string "sqlite3_close(sqlite);",
+                       newline,
+                       string "uw_error(ctx, FATAL, \"Can't prepare max_page_count query for SQLite database\");",
+                       newline],
+                  string "}",
+                  newline,
+                  newline,
+
+                  string "if (sqlite3_step(stmt) != SQLITE_ROW) {",
+                  newline,
+                  box [string "sqlite3_finalize(stmt);",
+                       newline,
+                       string "sqlite3_close(sqlite);",
+                       newline,
+                       string "uw_error(ctx, FATAL, \"Can't set max_page_count parameter for SQLite database\");",
+                       newline],
+                  string "}",
+                  newline,
+                  newline,
+
+                  string "sqlite3_finalize(stmt);",
+                  newline],
+             string "}",
+             newline,
+             newline,
+
+             string "conn = calloc(1, sizeof(uw_conn));",
+             newline,
+             string "conn->conn = sqlite;",
+             newline,
+             string "uw_set_db(ctx, conn);",
+             newline,
+             string "uw_db_validate(ctx);",
+             newline,
+             string "uw_db_prepare(ctx);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static void uw_db_close(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             p_list_sepi (box [])
+                         (fn i => fn _ =>
+                                     box [string "if (conn->p",
+                                          string (Int.toString i),
+                                          string ") sqlite3_finalize(conn->p",
+                                          string (Int.toString i),
+                                          string ");",
+                                          newline])
+                         ss,
+             string "sqlite3_close(conn->conn);",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static int uw_db_begin(uw_context ctx, int could_write) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             newline,
+             string "if (sqlite3_exec(conn->conn, \"BEGIN\", NULL, NULL, NULL) == SQLITE_OK)",
+             newline,
+             box [string "return 0;",
+                  newline],
+             string "else {",
+             newline,
+             box [string "fprintf(stderr, \"Begin error: %s<br />\", sqlite3_errmsg(conn->conn));",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "}",
+             newline,
+             string "static int uw_db_commit(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "if (sqlite3_exec(conn->conn, \"COMMIT\", NULL, NULL, NULL) == SQLITE_OK)",
+             newline,
+             box [string "return 0;",
+                  newline],
+             string "else {",
+             newline,
+             box [string "fprintf(stderr, \"Commit error: %s<br />\", sqlite3_errmsg(conn->conn));",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "}",
+             newline,
+             newline,
+
+             string "static int uw_db_rollback(uw_context ctx) {",
+             newline,
+             string "uw_conn *conn = uw_get_db(ctx);",
+             newline,
+             string "if (sqlite3_exec(conn->conn, \"ROLLBACK\", NULL, NULL, NULL) == SQLITE_OK)",
+             newline,
+             box [string "return 0;",
+                  newline],
+             string "else {",
+             newline,
+             box [string "fprintf(stderr, \"Rollback error: %s<br />\", sqlite3_errmsg(conn->conn));",
+                  newline,
+                  string "return 1;",
+                  newline],
+             string "}",
+             newline,
+             string "}",
+             newline,
+             newline]
+    end
+
+val fmt = "\"%Y-%m-%d %H:%M:%S\""
+
+fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
+    let
+        fun p_unsql t =
+            case t of
+                Int => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
+              | Float => box [string "sqlite3_column_double(stmt, ", string (Int.toString i), string ")"]
+              | String =>
+                if wontLeakStrings then
+                    box [string "(uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string ")"]
+                else
+                    box [string "uw_strdup(ctx, (uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
+              | Char => box [string "sqlite3_column_text(stmt, ", string (Int.toString i), string ")[0]"]
+              | Bool => box [string "(uw_Basis_bool)sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
+              | Time => box [string "uw_Basis_stringToTimef_error(ctx, ",
+                             string fmt,
+                             string ", (uw_Basis_string)sqlite3_column_text(stmt, ",
+                             string (Int.toString i),
+                             string "))"]
+              | Blob => box [string "({",
+                             newline,
+                             string "char *data = (char *)sqlite3_column_blob(stmt, ",
+                             string (Int.toString i),
+                             string ");",
+                             newline,
+                             string "int len = sqlite3_column_bytes(stmt, ",
+                             string (Int.toString i),
+                             string ");",
+                             newline,
+                             string "uw_Basis_blob b = {len, uw_memdup(ctx, data, len)};",
+                             newline,
+                             string "b;",
+                             newline,
+                             string "})"]
+              | Channel => box [string "({",
+                                newline,
+                                string "sqlite3_int64 n = sqlite3_column_int64(stmt, ",
+                                string (Int.toString i),
+                                string ");",
+                                newline,
+                                string "uw_Basis_channel ch = {n >> 32, n & 0xFFFFFFFF};",
+                                newline,
+                                string "ch;",
+                                newline,
+                                string "})"]
+              | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
+
+              | Nullable _ => raise Fail "Postgres: Recursive Nullable"
+
+        fun getter t =
+            case t of
+                Nullable t =>
+                box [string "(sqlite3_column_type(stmt, ",
+                     string (Int.toString i),
+                     string ") == SQLITE_NULL ? NULL : ",
+                     case t of
+                         String => getter t
+                       | _ => box [string "({",
+                                   newline,
+                                   string (p_sql_ctype t),
+                                   space,
+                                   string "*tmp = uw_malloc(ctx, sizeof(",
+                                   string (p_sql_ctype t),
+                                   string "));",
+                                   newline,
+                                   string "*tmp = ",
+                                   getter t,
+                                   string ";",
+                                   newline,
+                                   string "tmp;",
+                                   newline,
+                                   string "})"],
+                     string ")"]
+              | _ =>
+                box [string "(sqlite3_column_type(stmt, ",
+                     string (Int.toString i),
+                     string ") == SQLITE_NULL ? ",
+                     box [string "({",
+                          string (p_sql_ctype t),
+                          space,
+                          string "tmp;",
+                          newline,
+                          string "uw_error(ctx, FATAL, \"",
+                          string (ErrorMsg.spanToString loc),
+                          string ": Unexpectedly NULL field #",
+                          string (Int.toString i),
+                          string "\");",
+                          newline,
+                          string "tmp;",
+                          newline,
+                          string "})"],
+                     string " : ",
+                     p_unsql t,
+                     string ")"]
+    in
+        getter t
+    end
+
+fun queryCommon {loc, query, cols, doCols} =
+    box [string "int r;",
+         newline,
+
+         string "sqlite3_reset(stmt);",
+         newline,
+
+         string "uw_end_region(ctx);",
+         newline,
+         string "while ((r = sqlite3_step(stmt)) == SQLITE_ROW) {",
+         newline,
+         doCols p_getcol,
+         string "}",
+         newline,
+         newline,
+
+         string "if (r == SQLITE_BUSY) {",
+         box [string "sleep(1);",
+              newline,
+              string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
+         string (ErrorMsg.spanToString loc),
+         string ": query step failed: %s<br />%s\", ",
+         query,
+         string ", sqlite3_errmsg(conn->conn));",
+         newline,
+         newline]
+
+fun query {loc, cols, doCols} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "sqlite3_stmt *stmt;",
+         newline,
+         newline,
+         string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", sqlite3_errmsg(conn->conn), query);",
+         newline,
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+         newline,
+         newline,
+
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
+
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+val p_pre_inputs =
+    p_list_sepi (box [])
+                (fn i => fn t =>
+                            case t of
+                                Char => box [string "char arg",
+                                             string (Int.toString (i + 1)),
+                                             string "s = {arg",
+                                             string (Int.toString (i + 1)),
+                                             string ", 0};",
+                                             newline]
+                              | _ => box [])
+
+fun p_inputs loc =
+    p_list_sepi (box [])
+                (fn i => fn t =>
+                            let
+                                fun bind (t, arg) =
+                                    case t of
+                                        Int => box [string "sqlite3_bind_int64(stmt, ",
+                                                    string (Int.toString (i + 1)),
+                                                    string ", ",
+                                                    arg,
+                                                    string ")"]
+                                      | Float => box [string "sqlite3_bind_double(stmt, ",
+                                                      string (Int.toString (i + 1)),
+                                                      string ", ",
+                                                      arg,
+                                                      string ")"]
+                                      | String => box [string "sqlite3_bind_text(stmt, ",
+                                                       string (Int.toString (i + 1)),
+                                                       string ", ",
+                                                       arg,
+                                                       string ", -1, SQLITE_TRANSIENT)"]
+                                      | Char => box [string "sqlite3_bind_text(stmt, ",
+                                                     string (Int.toString (i + 1)),
+                                                     string ", ",
+                                                     arg,
+                                                     string "s, -1, SQLITE_TRANSIENT)"]
+                                      | Bool => box [string "sqlite3_bind_int(stmt, ",
+                                                     string (Int.toString (i + 1)),
+                                                     string ", ",
+                                                     arg,
+                                                     string ")"]
+                                      | Time => box [string "sqlite3_bind_text(stmt, ",
+                                                     string (Int.toString (i + 1)),
+                                                     string ", uw_Basis_timef(ctx, ",
+                                                     string fmt,
+                                                     string ", ",
+                                                     arg,
+                                                     string "), -1, SQLITE_TRANSIENT)"]
+                                      | Blob => box [string "sqlite3_bind_blob(stmt, ",
+                                                     string (Int.toString (i + 1)),
+                                                     string ", ",
+                                                     arg,
+                                                     string ".data, ",
+                                                     arg,
+                                                     string ".size, SQLITE_TRANSIENT)"]
+                                      | Channel => box [string "sqlite3_bind_int64(stmt, ",
+                                                        string (Int.toString (i + 1)),
+                                                        string ", ((sqlite3_int64)",
+                                                        arg,
+                                                        string ".cli << 32) | ",
+                                                        arg,
+                                                        string ".chn)"]
+                                      | Client => box [string "sqlite3_bind_int(stmt, ",
+                                                       string (Int.toString (i + 1)),
+                                                       string ", ",
+                                                       arg,
+                                                       string ")"]
+                                      | Nullable t => box [string "(",
+                                                           arg,
+                                                           string " == NULL ? sqlite3_bind_null(stmt, ",
+                                                           string (Int.toString (i + 1)),
+                                                           string ") : ",
+                                                           bind (t, case t of
+                                                                        String => arg
+                                                                      | _ => box [string "(*", arg, string ")"]),
+                                                           string ")"]
+                            in
+                                box [string "if (",
+                                     bind (t, box [string "arg", string (Int.toString (i + 1))]),
+                                     string " != SQLITE_OK) uw_error(ctx, FATAL, \"",
+                                     string (ErrorMsg.spanToString loc),
+                                     string ": Error binding parameter #",
+                                     string (Int.toString (i + 1)),
+                                     string ": %s\", sqlite3_errmsg(conn->conn));",
+                                     newline]
+                            end)
+
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         p_pre_inputs inputs,
+         if nested then
+             box [string "sqlite3_stmt *stmt;",
+                  newline]
+         else
+             box [string "sqlite3_stmt *stmt = conn->p",
+                  string (Int.toString id),
+                  string ";",
+                  newline,
+                  newline,
+
+                  string "if (stmt == NULL) {",
+                  newline],
+
+         string "if (sqlite3_prepare_v2(conn->conn, \"",
+         string (Prim.toCString query),
+         string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
+         string (Prim.toCString query),
+         string "<br />%s\", sqlite3_errmsg(conn->conn));",
+         newline,
+         if nested then
+             box [string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+                  newline]
+         else
+             box [string "conn->p",
+                  string (Int.toString id),
+                  string " = stmt;",
+                  newline,
+                  string "}",
+                  newline,
+                  newline,
+                  string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
+                  newline,
+                  string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
+                  newline],
+         newline,
+
+         p_inputs loc inputs,
+         newline,
+
+         queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
+                                                                            string (Prim.toCString query),
+                                                                            string "\""]},
+
+         string "uw_pop_cleanup(ctx);",
+         newline,
+         if nested then
+             box []
+         else
+             box [string "uw_pop_cleanup(ctx);",
+                  newline]]
+
+fun dmlCommon {loc, dml, mode} =
+    box [string "int r;",
+         newline,
+
+         string "if ((r = sqlite3_step(stmt)) == SQLITE_BUSY) {",
+         box [string "sleep(1);",
+              newline,
+              string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "if (r != SQLITE_DONE) ",
+         case mode of
+             Settings.Error => box [string "uw_error(ctx, FATAL, \"",
+                                    string (ErrorMsg.spanToString loc),
+                                    string ": DML step failed: %s<br />%s\", ",
+                                    dml,
+                                    string ", sqlite3_errmsg(conn->conn));"]
+           | Settings.None => string "uw_set_error_message(ctx, sqlite3_errmsg(conn->conn));",
+         newline]
+
+fun dml (loc, mode) =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "sqlite3_stmt *stmt;",
+         newline,
+         newline,
+         string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", dml, sqlite3_errmsg(conn->conn));",
+         newline,
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+         newline,
+         newline,
+
+         dmlCommon {loc = loc, dml = string "dml", mode = mode},
+
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         p_pre_inputs inputs,
+         string "sqlite3_stmt *stmt = conn->p",
+         string (Int.toString id),
+         string ";",
+         newline,
+         newline,
+
+         string "if (stmt == NULL) {",
+         newline,
+         box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+              string (Prim.toCString dml),
+              string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
+              string (Prim.toCString dml),
+              string "<br />%s\", sqlite3_errmsg(conn->conn));",
+              newline,
+              string "conn->p",
+              string (Int.toString id),
+              string " = stmt;",
+              newline],
+         string "}",
+         newline,
+
+         string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
+         newline,
+         string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
+         newline,
+
+         p_inputs loc inputs,
+         newline,
+
+         dmlCommon {loc = loc, dml = box [string "\"",
+                                          string (Prim.toCString dml),
+                                          string "\""], mode = mode},
+
+         string "uw_pop_cleanup(ctx);",
+         newline,
+         string "uw_pop_cleanup(ctx);",
+         newline]
+
+fun nextval {loc, seqE, seqName} =
+    box [string "uw_conn *conn = uw_get_db(ctx);",
+         newline,
+         string "char *insert = ",
+         case seqName of
+             SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES (NULL)\"")
+           | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
+                          seqE,
+                          string ", \" VALUES ()\"))"],
+         string ";",
+         newline,
+         string "char *delete = ",
+         case seqName of
+             SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
+           | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
+                          seqE,
+                          string ")"],
+         string ";",
+         newline,
+         newline,
+
+         string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed: %s\", sqlite3_errmsg(conn->conn));",
+         newline,
+         string "n = sqlite3_last_insert_rowid(conn->conn);",
+         newline,
+         string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed: %s\", sqlite3_errmsg(conn->conn));",
+         newline]
+
+fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
+fun setval _ = raise Fail "SQLite.setval called"
+
+fun sqlifyString s = "'" ^ String.translate (fn #"'" => "''"
+                                              | #"\000" => ""
+                                              | ch => str ch)
+                                            s ^ "'"
+
+fun p_cast (s, _) = s
+
+fun p_blank _ = "?"
+
+val () = addDbms {name = "sqlite",
+                  randomFunction = "RANDOM",
+                  header = Config.sqheader,
+                  link = "-lsqlite3",
+                  init = init,
+                  p_sql_type = p_sql_type,
+                  query = query,
+                  queryPrepared = queryPrepared,
+                  dml = dml,
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared,
+                  setval = setval,
+                  sqlifyString = sqlifyString,
+                  p_cast = p_cast,
+                  p_blank = p_blank,
+                  supportsDeleteAs = false,
+                  supportsUpdateAs = false,
+                  createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTOINCREMENT)",
+                  textKeysNeedLengths = false,
+                  supportsNextval = false,
+                  supportsNestedPrepared = false,
+                  sqlPrefix = "",
+                  supportsOctetLength = false,
+                  trueString = "1",
+                  falseString = "0",
+                  onlyUnion = false,
+                  nestedRelops = false,
+                  windowFunctions = false,
+                  supportsIsDistinctFrom = false}
+
+end
diff --git a/src/static.sig b/src/static.sig
new file mode 100644
index 0000000..f809a6d
--- /dev/null
+++ b/src/static.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature STATIC = sig
+
+end
diff --git a/src/static.sml b/src/static.sml
new file mode 100644
index 0000000..c74d4e3
--- /dev/null
+++ b/src/static.sml
@@ -0,0 +1,41 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Static :> STATIC = struct
+
+open Settings
+open Print.PD Print
+
+val () = addProtocol {name = "static",
+                      compile = "",
+                      linkStatic = "liburweb_static.a",
+                      linkDynamic = "-lurweb_static",
+                      persistent = false,
+                      code = fn () => box [string "void uw_global_custom() { }",
+                                           newline]}
+
+end
diff --git a/src/suffix.mlb b/src/suffix.mlb
new file mode 100644
index 0000000..7f2d065
--- /dev/null
+++ b/src/suffix.mlb
@@ -0,0 +1,2 @@
+
+end
diff --git a/src/tag.sig b/src/tag.sig
new file mode 100644
index 0000000..c19a353
--- /dev/null
+++ b/src/tag.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature TAG = sig
+
+    val tag : Core.file -> Core.file
+
+end
diff --git a/src/tag.sml b/src/tag.sml
new file mode 100644
index 0000000..94e5d44
--- /dev/null
+++ b/src/tag.sml
@@ -0,0 +1,356 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Tag :> TAG = struct
+
+open Core
+
+structure U = CoreUtil
+structure E = CoreEnv
+
+structure IM = IntBinaryMap
+structure SM = BinaryMapFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+structure UnionFind :> sig
+              type t
+              val empty : t
+              val equate : t * int * int -> t
+              val equal : t * int * int -> bool
+              val rep : t * int -> int
+          end = struct
+
+type t = int IM.map
+
+val empty = IM.empty
+
+fun rep (t, n) =
+    case IM.find (t, n) of
+        NONE => n
+      | SOME n' => rep (t, n')
+
+fun equate (t, n1, n2) =
+    let
+        val r1 = rep (t, n1)
+        val r2 = rep (t, n2)
+    in
+        if r1 = r2 then
+            t
+        else
+            IM.insert (t, r1, r2)
+    end
+
+fun equal (t, n1, n2) = rep (t, n1) = rep (t, n2)
+
+end
+
+fun kind (k, s) = (k, s)
+fun con (c, s) = (c, s)
+
+fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for multiple modes (link, form, RPC handler).");
+                     TextIO.output (TextIO.stdErr,
+                                    "Make sure that the signature of the containing module hides any form/RPC handlers.\n"))
+
+fun exp uf env (e, s) =
+    let
+        fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) =
+            let
+                val loc = #2 e
+
+                val eOrig = e
+
+                fun unravel (e, _) =
+                    case e of
+                        ENamed n => (n, [])
+                      | EApp (e1, e2) =>
+                        let
+                            val (n, es) = unravel e1
+                        in
+                            (n, es @ [e2])
+                        end
+                      | _ => (ErrorMsg.errorAt loc ("Invalid " ^ newAttr
+                                                    ^ " expression");
+                              Print.epreface ("Expression",
+                                              CorePrint.p_exp env eOrig);
+                              (0, []))
+
+                val (f, args) = unravel e
+            in
+                if f = 0 then
+                    (e, (count, tags, byTag, newTags))
+                else
+                    let
+                        val f = UnionFind.rep (uf, f)
+
+                        val (cn, count, tags, newTags) =
+                            case IM.find (tags, f) of
+                                NONE =>
+                                (count, count + 1, IM.insert (tags, f, count),
+                                 (ek, f, count) :: newTags)
+                              | SOME cn => (cn, count, tags, newTags)
+
+                        val (_, _, _, s) = E.lookupENamed env f
+
+                        val byTag = case SM.find (byTag, s) of
+                                        NONE => SM.insert (byTag, s, (ek, f))
+                                      | SOME (ek', f') =>
+                                        (if f = f' then
+                                             ()
+                                         else
+                                             ErrorMsg.errorAt loc 
+                                                              ("Duplicate HTTP tag "
+                                                               ^ s);
+                                         if ek = ek' then
+                                             ()
+                                         else
+                                             both (loc, s);
+                                         byTag)
+
+                        val e = (EClosure (cn, args), loc)
+                    in
+                        (e, (count, tags, byTag, newTags))
+                    end
+            end
+    in
+        case e of
+            EApp (
+            (EApp (
+             (EApp (
+              (EApp (
+               (EApp (
+                (EApp (
+                 (EApp (
+                  (ECApp (
+                   (ECApp (
+                    (ECApp (
+                     (ECApp (
+                      (ECApp (
+                       (ECApp (
+                        (ECApp (
+                         (ECApp (
+                          (EFfi ("Basis", "tag"),
+                           loc), given), _), absent), _), outer), _), inner), _),
+                      useOuter), _), useInner), _), bindOuter), _), bindInner), _),
+                  class), _),
+                 dynClass), _),
+                style), _),
+               dynStyle), _),
+              attrs), _),
+             tag), _),
+            xml) =>
+            (case attrs of
+                 (ERecord xets, _) =>
+                 let
+                     val (xets, s) =
+                         ListUtil.foldlMap (fn ((x, e, t), s) =>
+                                               let
+                                                   fun tagIt' (ek, newAttr) =
+                                                       let
+                                                           val (e', s) = tagIt (e, ek, newAttr, s)
+                                                           val t = (CFfi ("Basis", "string"), loc)
+                                                       in
+                                                           (((CName newAttr, loc), e', t), s)
+                                                       end
+                                               in
+                                                   case x of
+                                                       (CName "Link", _) => tagIt' (Link ReadCookieWrite, "Link")
+                                                     | (CName "Action", _) => tagIt' (Action ReadWrite, "Action")
+                                                     | _ => ((x, e, t), s)
+                                               end)
+                                           s xets
+                 in
+                     (EApp (
+                      (EApp (
+                       (EApp (
+                        (EApp (
+                         (EApp (
+                          (EApp (
+                           (EApp (
+                            (ECApp (
+                             (ECApp (
+                              (ECApp (
+                               (ECApp (
+                                (ECApp (
+                                 (ECApp (
+                                  (ECApp (
+                                   (ECApp (
+                                    (EFfi ("Basis", "tag"),
+                                     loc), given), loc), absent), loc), outer), loc), inner), loc),
+                                useOuter), loc), useInner), loc), bindOuter), loc), bindInner), loc),
+                            class), loc), dynClass), loc), style), loc), dynStyle), loc),
+                        (ERecord xets, loc)), loc),
+                       tag), loc),
+                      xml), s)
+                 end
+               | _ => (e, s))
+
+          | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s)
+
+          | EFfiApp ("Basis", "url", [(e, t)]) =>
+            let
+                val (e, s) = tagIt (e, Link ReadCookieWrite, "Url", s)
+            in
+                (EFfiApp ("Basis", "url", [(e, t)]), s)
+            end
+
+          | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s)
+
+          | EFfiApp ("Basis", "effectfulUrl", [(e, t)]) =>
+            let
+                val (e, s) = tagIt (e, Extern ReadCookieWrite, "Url", s)
+            in
+                (EFfiApp ("Basis", "url", [(e, t)]), s)
+            end
+
+          | EApp ((ENamed n, _), e') =>
+            let
+                val (_, _, eo, _) = E.lookupENamed env n
+            in
+                case eo of
+                    SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) =>
+                    let
+                        val (e, s) = tagIt (e', Link ReadCookieWrite, "Url", s)
+                    in
+                        (EFfiApp ("Basis", "url", [(e, t)]), s)
+                    end
+                  | _ => (e, s)
+            end
+
+          | _ => (e, s)
+    end
+
+fun decl (d, s) = (d, s)
+
+fun tag file =
+    let
+        val count = U.File.maxName file
+
+        fun doDecl (d as (d', loc), (env, count, tags, byTag, uf)) =
+            case d' of
+                DExport (ek, n, _) =>
+                let
+                    val (_, _, _, s) = E.lookupENamed env n
+                in
+                    case SM.find (byTag, s) of
+                        NONE => ([d], (env, count, tags, byTag, uf))
+                      | SOME (ek', n') =>
+                        (if ek = ek' then
+                             ()
+                         else
+                             both (loc, s);
+                         ([], (env, count, tags, byTag, uf)))
+                end
+              | _ =>
+                let
+                    val env' = E.declBinds env d
+                    val env'' = case d' of
+                                    DValRec _ => env'
+                                  | _ => env
+
+                    val (d, (count, tags, byTag, newTags)) =
+                        U.Decl.foldMap {kind = kind,
+                                        con = con,
+                                        exp = exp uf env'',
+                                        decl = decl}
+                                       (count, tags, byTag, []) d
+
+                    val env = env'
+
+                    val newDs = map
+                                    (fn (ek, f, cn) =>
+                                        let
+                                            val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
+
+                                            fun unravel (all as (t, _)) =
+                                                case t of
+                                                    TFun (dom, ran) =>
+                                                    let
+                                                        val (args, result) = unravel ran
+                                                    in
+                                                        (dom :: args, result)
+                                                    end
+                                                  | _ => ([], all)
+
+                                            val (fnam, t, _, tag) = E.lookupENamed env f
+                                            val (args, result) = unravel t
+
+                                            val (abs, t) =
+                                                case args of
+                                                    [] =>
+                                                    let
+                                                        val app = (EApp ((ENamed f, loc), (ERecord [], loc)), loc)
+                                                        val body = (EWrite app, loc)
+                                                    in
+                                                        (body,
+                                                         (TFun (unit, unit), loc))
+                                                    end
+                                                  | _ =>
+                                                    let
+                                                        val (app, _) = foldl (fn (t, (app, n)) =>
+                                                                                 ((EApp (app, (ERel n, loc)), loc),
+                                                                                  n - 1))
+                                                                             ((ENamed f, loc), length args - 1) args
+                                                        val app = (EApp (app, (ERecord [], loc)), loc)
+                                                        val body = (EWrite app, loc)
+                                                        val t = (TFun (unit, unit), loc)
+                                                        val (abs, _, t) = foldr (fn (t, (abs, n, rest)) =>
+                                                                                    ((EAbs ("x" ^ Int.toString n,
+                                                                                            t,
+                                                                                            rest,
+                                                                                            abs), loc),
+                                                                                     n + 1,
+                                                                                     (TFun (t, rest), loc)))
+                                                                                (body, 0, t) args
+                                                    in
+                                                        (abs, t)
+                                                    end
+                                        in
+                                            (("wrap_" ^ fnam, cn, t, abs, tag),
+                                             (DExport (ek, cn, false), loc))
+                                        end) newTags
+
+                    val (newVals, newExports) = ListPair.unzip newDs
+
+                    val ds = case d of
+                                 (DValRec vis, _) => [(DValRec (vis @ newVals), loc)]
+                               | _ => map (fn vi => (DVal vi, loc)) newVals @ [d]
+
+                    val uf = case d' of
+                                 DVal (_, n1, _, (ENamed n2, _), _) => UnionFind.equate (uf, n1, n2)
+                                 | _ => uf
+                in
+                    (ds @ newExports, (env, count, tags, byTag, uf))
+                end
+
+        val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty, UnionFind.empty) file
+    in
+        file
+    end
+
+end
diff --git a/src/termination.sig b/src/termination.sig
new file mode 100644
index 0000000..1de00f1
--- /dev/null
+++ b/src/termination.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature TERMINATION = sig
+
+    val check : Elab.file -> unit
+
+end
diff --git a/src/termination.sml b/src/termination.sml
new file mode 100644
index 0000000..f0ec46d
--- /dev/null
+++ b/src/termination.sml
@@ -0,0 +1,396 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Termination :> TERMINATION = struct
+
+open Elab
+
+structure E = ElabEnv
+structure IM = IntBinaryMap
+structure IS = IntBinarySet
+
+datatype pedigree =
+         Func of int
+       | Arg of int * int * con
+       | Subarg of int * int * con
+       | Rabble
+
+fun p2s p =
+    case p of
+        Func i => "Func" ^ Int.toString i
+      | Arg (i, j, _) => "Arg" ^ Int.toString i ^ "," ^ Int.toString j
+      | Subarg (i, j, _) => "Subarg" ^ Int.toString i ^ "," ^ Int.toString j
+      | Rabble => "Rabble"
+
+fun declOk' env (d, loc) =
+    case d of
+        DValRec vis =>
+        let
+            val nfns = length vis
+
+            val fenv = ListUtil.foldli (fn (i, (_, j, _, _), fenv) => IM.insert (fenv, j, i)) IM.empty vis
+
+            fun namesEq ((c1, _), (c2, _)) =
+                case (c1, c2) of
+                    (CName s1, CName s2) => s1 = s2
+                  | (CRel n1, CRel n2) => n1 = n2
+                  | (CNamed n1, CNamed n2) => n1 = n2
+                  | (CModProj n1, CModProj n2) => n1 = n2
+                  | _ => false
+
+            fun patCon pc =
+                let
+                    fun unravel (t, _) =
+                        case t of
+                            TCFun (_, _, _, t) => unravel t
+                          | TFun (dom, _) => dom
+                          | _ => raise Fail "Termination: Unexpected constructor type"
+                in
+                    case pc of
+                        PConVar i =>
+                        let
+                            val (_, t) = E.lookupENamed env i
+                        in
+                            unravel t
+                        end
+                      | PConProj (m1, ms, x) =>
+                        let
+                            val (str, sgn) = E.chaseMpath env (m1, ms)
+                        in
+                            case E.projectVal env {str = str, sgn = sgn, field = x} of
+                                NONE => raise Fail "Termination: Bad constructor projection"
+                              | SOME t => unravel t
+                        end
+                end
+
+            fun pat penv (p, (pt, _)) =
+                let
+                    fun con (i, j, pc, pt') = pat penv (Subarg (i, j, patCon pc), pt')
+
+                    fun record (i, j, t, xps) =
+                        case t of
+                            (TRecord (CRecord (_, xts), _), _) =>
+                            foldl (fn ((x, pt', _), penv) =>
+                                      let
+                                          val p' =
+                                              case List.find (fn (x', _) =>
+                                                                 namesEq ((CName x, ErrorMsg.dummySpan), x')) xts of
+                                                  NONE => Rabble
+                                                | SOME (_, t) => Subarg (i, j, t)
+                                      in
+                                          pat penv (p', pt')
+                                      end) penv xps
+                          | _ => foldl (fn ((_, pt', _), penv) => pat penv (Rabble, pt')) penv xps
+                in
+                    case (p, pt) of
+                        (_, PVar _) => p :: penv
+                      | (_, PPrim _) => penv
+                      | (_, PCon (_, _, _, NONE)) => penv
+                      | (Arg (i, j, _), PCon (_, pc, _, SOME pt')) => con (i, j, pc, pt')
+                      | (Subarg (i, j, _), PCon (_, pc, _, SOME pt')) => con (i, j, pc, pt')
+                      | (_, PCon (_, _, _, SOME pt')) => pat penv (Rabble, pt')
+                      | (Arg (i, j, t), PRecord xps) => record (i, j, t, xps)
+                      | (Subarg (i, j, t), PRecord xps) => record (i, j, t, xps)
+                      | (_, PRecord xps) => foldl (fn ((_, pt', _), penv) => pat penv (Rabble, pt')) penv xps
+                end
+
+            fun exp parent (penv, calls) e =
+                let
+                    val default = (Rabble, calls)
+
+                    fun apps () =
+                        let
+                            fun combiner calls e =
+                                case #1 e of
+                                    EApp ((ECApp (
+                                           (ECApp (
+                                            (ECApp (
+                                             (ECApp (
+                                              (ECApp (
+                                               (ECApp (
+                                                (ECApp (
+                                                 (ECApp (
+                                                  (EModProj (m, [], "tag"), _),
+                                                  _), _),
+                                                 _), _),
+                                                _), _),
+                                               _), _),
+                                              _), _),
+                                             _), _),
+                                            _), _),
+                                           _), _),
+                                          (ERecord xets, _)) =>
+                                    let
+                                        val checkName =
+                                            case E.lookupStrNamed env m of
+                                                  ("Basis", _) => (fn x : con => case #1 x of
+                                                                                     CName s => s = "Link"
+                                                                                                orelse s = "Action"
+                                                                                   | _ => false)
+                                                | _ => (fn _ => false)
+
+                                        val calls = foldl (fn ((x, e, _), calls) =>
+                                                              if checkName x then
+                                                                  calls
+                                                              else
+                                                                  #2 (exp parent (penv, calls) e)) calls xets
+                                    in
+                                        (Rabble, [Rabble], calls)
+                                    end
+
+                                  | EApp (e1, e2) =>
+                                    let
+                                        val (p1, ps, calls) = combiner calls e1
+                                        val (p2, calls) = exp parent (penv, calls) e2
+
+                                        val p = case p1 of
+                                                    Rabble => Rabble
+                                                  | Arg _ => Rabble
+                                                  | Subarg (i, j, (TFun (_, ran), _)) => Subarg (i, j, ran)
+                                                  | Subarg _ => Rabble
+                                                  | Func _ => Rabble
+                                    in
+                                        (p, ps @ [p2], calls)
+                                    end
+                                  | ECApp (e, _) =>
+                                    let
+                                        val (p, ps, calls) = combiner calls e
+
+                                        val p = case p of
+                                                    Rabble => Rabble
+                                                  | Arg _ => Rabble
+                                                  | Subarg (i, j, (TCFun (_, _, _, ran), _)) => Subarg (i, j, ran)
+                                                  | Subarg _ => Rabble
+                                                  | Func _ => Rabble
+                                    in
+                                        (p, ps, calls)
+                                    end
+                                  | EKApp (e, _) => combiner calls e
+                                  | _ =>
+                                    let
+                                        val (p, calls) = exp parent (penv, calls) e
+                                    in
+                                        (*Print.prefaces "Head" [("e", ElabPrint.p_exp env e)];
+                                        print (p2s p ^ "\n");*)
+                                        (p, [p], calls)
+                                    end
+
+                            val (p, ps, calls) = combiner calls e
+
+                            val calls =
+                                case ps of
+                                    [] => raise Fail "Termination: Empty ps"
+                                  | f :: ps =>
+                                    case f of
+                                        Func i => (parent, i, ps) :: calls
+                                      | _ => calls
+                        in
+                            (p, calls)
+                        end
+                in
+                    case #1 e of
+                        EPrim _ => default
+                      | ERel n => (List.nth (penv, n), calls)
+                      | ENamed n =>
+                        let
+                            val p = case IM.find (fenv, n) of
+                                        NONE => Rabble
+                                      | SOME n' => Func n'
+                        in
+                            (p, calls)
+                        end
+                      | EModProj _ => default
+
+                      | EApp _ => apps ()
+                      | EAbs (_, _, _, e) => 
+                        let
+                            val (_, calls) = exp parent (Rabble :: penv, calls) e
+                        in
+                            (Rabble, calls)
+                        end
+                      | ECApp _ => apps ()
+                      | ECAbs (_, _, _, e) =>
+                        let
+                            val (_, calls) = exp parent (penv, calls) e
+                        in
+                            (Rabble, calls)
+                        end
+                      | EKApp _ => apps ()
+                      | EKAbs (_, e) =>
+                        let
+                            val (_, calls) = exp parent (penv, calls) e
+                        in
+                            (Rabble, calls)
+                        end
+
+                      | ERecord xets =>
+                        let
+                            val calls = foldl (fn ((_, e, _), calls) => #2 (exp parent (penv, calls) e)) calls xets
+                        in
+                            (Rabble, calls)
+                        end
+                      | EField (e, x, _) =>
+                        let
+                            val (p, calls) = exp parent (penv, calls) e
+                            val p =
+                                case p of
+                                    Subarg (i, j, (TRecord (CRecord (_, xts), _), _)) =>
+                                    (case List.find (fn (x', _) => namesEq (x, x')) xts of
+                                         NONE => Rabble
+                                       | SOME (_, t) => Subarg (i, j, t))
+                                  | _ => Rabble
+                        in
+                            (p, calls)
+                        end
+                      | ECut (e, _, _) =>
+                        let
+                            val (_, calls) = exp parent (penv, calls) e
+                        in
+                            (Rabble, calls)
+                        end
+                      | ECutMulti (e, _, _) =>
+                        let
+                            val (_, calls) = exp parent (penv, calls) e
+                        in
+                            (Rabble, calls)
+                        end
+                      | EConcat (e1, _, e2, _) =>
+                        let
+                            val (_, calls) = exp parent (penv, calls) e1
+                            val (_, calls) = exp parent (penv, calls) e2
+                        in
+                            (Rabble, calls)
+                        end
+
+                      | ECase (e, pes, _) =>
+                        let
+                            val (p, calls) = exp parent (penv, calls) e
+
+                            val calls = foldl (fn ((pt, e), calls) =>
+                                                  let
+                                                      val penv = pat penv (p, pt)
+                                                      val (_, calls) = exp parent (penv, calls) e
+                                                  in
+                                                      calls
+                                                  end) calls pes
+                        in
+                            (Rabble, calls)
+                        end
+
+                      | EError => (Rabble, calls)
+                      | EUnif (ref (SOME e)) => exp parent (penv, calls) e
+                      | EUnif (ref NONE) => (Rabble, calls)
+
+                      | ELet (eds, e, _) =>
+                        let
+                            fun extPenv ((ed, _), penv) =
+                                case ed of
+                                    EDVal _ => Rabble :: penv
+                                  | EDValRec vis => foldl (fn (_, penv) => Rabble :: penv) penv vis
+                        in
+                            exp parent (foldl extPenv penv eds, calls) e
+                        end
+                end
+
+            fun doVali (i, (_, f, _, e), calls) =
+                let
+                    fun unravel (e, j, penv) =
+                        case #1 e of
+                            EAbs (_, t, _, e) =>
+                            unravel (e, j + 1, Arg (i, j, t) :: penv)
+                          | ECAbs (_, _, _, e) =>
+                            unravel (e, j, penv)
+                          | _ => (j, #2 (exp f (penv, calls) e))
+                in
+                    unravel (e, 0, [])
+                end
+
+            val (ns, calls) = ListUtil.foldliMap doVali [] vis
+
+            fun isRecursive (from, to, _) =
+                let
+                    fun search (at, soFar) =
+                        at = from
+                        orelse List.exists (fn (from', to', _) =>
+                                               from' = at
+                                               andalso not (IS.member (soFar, to'))
+                                               andalso search (to', IS.add (soFar, to')))
+                                           calls
+                in
+                    search (to, IS.empty)
+                end
+
+            val calls = List.filter isRecursive calls
+
+            fun search (ns, choices) =
+                case ns of
+                    [] =>
+                    let
+                        val choices = rev choices
+                    in
+                        List.all (fn (_, f, args) =>
+                                     let
+                                         val recArg = List.nth (choices, f)
+                                                      
+                                         fun isDatatype (t, _) =
+                                             case t of
+                                                 CNamed _ => true
+                                               | CModProj _ => true
+                                               | CApp (t, _) => isDatatype t
+                                               | _ => false
+                                     in
+                                         length args > recArg andalso
+                                         case List.nth (args, recArg) of
+                                             Subarg (i, j, t) => isDatatype t andalso j = List.nth (choices, i)
+                                           | _ => false
+                                     end) calls
+                    end
+                  | n :: ns' =>
+                    let
+                        fun search' i =
+                            i < n andalso (search (ns', i :: choices) orelse search' (i + 1))
+                    in
+                        search' 0
+                    end
+        in
+            if search (ns, []) then
+                ()
+            else
+                ErrorMsg.errorAt loc "Can't prove termination of recursive function(s)"
+        end
+
+      | DStr (_, _, _, (StrConst ds, _)) => ignore (foldl declOk env ds)
+
+      | _ => ()
+
+and declOk (d, env) =
+    (declOk' env d;
+     E.declBinds env d)
+
+fun check ds = ignore (foldl declOk E.empty ds)
+
+end
diff --git a/src/toy_cache.sml b/src/toy_cache.sml
new file mode 100644
index 0000000..5c5aa45
--- /dev/null
+++ b/src/toy_cache.sml
@@ -0,0 +1,207 @@
+structure ToyCache : sig
+    val cache : Cache.cache
+end = struct
+
+
+(* Mono *)
+
+open Mono
+
+val dummyLoc = ErrorMsg.dummySpan
+val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
+val optionStringTyp = (TOption stringTyp, dummyLoc)
+fun withTyp typ = map (fn exp => (exp, typ))
+
+fun ffiAppCache' (func, index, argTyps) =
+    EFfiApp ("Sqlcache", func ^ Int.toString index, argTyps)
+
+fun check (index, keys) =
+    ffiAppCache' ("check", index, withTyp stringTyp keys)
+
+fun store (index, keys, value) =
+    ffiAppCache' ("store", index, (value, stringTyp) :: withTyp stringTyp keys)
+
+fun flush (index, keys) =
+    ffiAppCache' ("flush", index, withTyp optionStringTyp keys)
+
+fun lock (index, keys) =
+    raise Fail "ToyCache doesn't yet implement lock"
+
+
+(* Cjr *)
+
+open Print
+open Print.PD
+
+fun setupQuery {index, params} =
+    let
+
+        val i = Int.toString index
+
+        fun paramRepeat itemi sep =
+            let
+                fun f n =
+                    if n < 0 then ""
+                    else if n = 0 then itemi (Int.toString 0)
+                    else f (n-1) ^ sep ^ itemi (Int.toString n)
+            in
+                f (params - 1)
+            end
+
+        fun paramRepeatInit itemi sep =
+            if params = 0 then "" else sep ^ paramRepeat itemi sep
+
+        val args = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", "
+
+        val decls = paramRepeat (fn p => "uw_Basis_string param" ^ i ^ "_"
+                                         ^ p ^ " = NULL;")
+                                "\n"
+
+        val sets = paramRepeat (fn p => "param" ^ i ^ "_" ^ p
+                                        ^ " = strdup(p" ^ p ^ ");")
+                               "\n"
+
+        val frees = paramRepeat (fn p => "free(param" ^ i ^ "_" ^ p ^ ");")
+                                "\n"
+
+        val eqs = paramRepeatInit (fn p => "strcmp(param" ^ i ^ "_" ^ p
+                                           ^ ", p" ^ p ^ ")")
+                                  " || "
+
+        (* Using [!=] instead of [==] to mimic [strcmp]. *)
+        val eqsNull = paramRepeatInit (fn p => "(p" ^ p ^ " == NULL || "
+                                               ^ "!strcmp(param" ^ i ^ "_"
+                                               ^ p ^ ", p" ^ p ^ "))")
+                                      " && "
+
+    in
+        Print.box
+            [string "static char *cacheQuery",
+             string i,
+             string " = NULL;",
+             newline,
+             string "static char *cacheWrite",
+             string i,
+             string " = NULL;",
+             newline,
+             string decls,
+             newline,
+             string "static uw_Basis_string uw_Sqlcache_check",
+             string i,
+             string "(uw_context ctx",
+             string args,
+             string ") {",
+             newline,
+             string "if (cacheWrite",
+             string i,
+             (* ASK: is returning the pointer okay? Should we duplicate? *)
+             string " == NULL",
+             string eqs,
+             string ") {",
+             newline,
+             string "puts(\"SQLCACHE: miss ",
+             string i,
+             string ".\");",
+             newline,
+             string "uw_recordingStart(ctx);",
+             newline,
+             string "return NULL;",
+             newline,
+             string "} else {",
+             newline,
+             string "puts(\"SQLCACHE: hit ",
+             string i,
+             string ".\");",
+             newline,
+             string " if (cacheWrite",
+             string i,
+             string " != NULL) { uw_write(ctx, cacheWrite",
+             string i,
+             string "); }",
+             newline,
+             string "return cacheQuery",
+             string i,
+             string ";",
+             newline,
+             string "} };",
+             newline,
+             string "static uw_unit uw_Sqlcache_store",
+             string i,
+             string "(uw_context ctx, uw_Basis_string s",
+             string args,
+             string ") {",
+             newline,
+             string "free(cacheQuery",
+             string i,
+             string "); free(cacheWrite",
+             string i,
+             string ");",
+             newline,
+             string frees,
+             newline,
+             string "cacheQuery",
+             string i,
+             string " = strdup(s); cacheWrite",
+             string i,
+             string " = uw_recordingRead(ctx);",
+             newline,
+             string sets,
+             newline,
+             string "puts(\"SQLCACHE: store ",
+             string i,
+             string ".\");",
+             newline,
+             string "return uw_unit_v;",
+             newline,
+             string "};",
+             newline,
+             string "static uw_unit uw_Sqlcache_flush",
+             string i,
+             string "(uw_context ctx",
+             string args,
+             string ") {",
+             newline,
+             string "if (cacheQuery",
+             string i,
+             string " != NULL",
+             string eqsNull,
+             string ") {",
+             newline,
+             string "free(cacheQuery",
+             string i,
+             string ");",
+             newline,
+             string "cacheQuery",
+             string i,
+             string " = NULL;",
+             newline,
+             string "free(cacheWrite",
+             string i,
+             string ");",
+             newline,
+             string "cacheWrite",
+             string i,
+             string " = NULL;",
+             newline,
+             string "puts(\"SQLCACHE: flush ",
+             string i,
+             string ".\");}",
+             newline,
+             string "else { puts(\"SQLCACHE: keep ",
+             string i,
+             string ".\"); } return uw_unit_v;",
+             newline,
+             string "};",
+             newline,
+             newline]
+    end
+
+val setupGlobal = string "/* No global setup for toy cache. */"
+
+
+(* Bundled up. *)
+
+val cache = {check = check, store = store, flush = flush, lock = lock,
+             setupQuery = setupQuery, setupGlobal = setupGlobal}
+
+end
diff --git a/src/triple_key_fn.sml b/src/triple_key_fn.sml
new file mode 100644
index 0000000..ba77c60
--- /dev/null
+++ b/src/triple_key_fn.sml
@@ -0,0 +1,15 @@
+functor TripleKeyFn (structure I : ORD_KEY
+                     structure J : ORD_KEY
+                     structure K : ORD_KEY)
+        : ORD_KEY where type ord_key = I.ord_key * J.ord_key * K.ord_key = struct
+
+type ord_key = I.ord_key * J.ord_key * K.ord_key
+
+fun compare ((i1, j1, k1), (i2, j2, k2)) =
+    case I.compare (i1, i2) of
+        EQUAL => (case J.compare (j1, j2) of
+                      EQUAL => K.compare (k1, k2)
+                    | ord => ord)
+      | ord => ord
+
+end
diff --git a/src/tutorial.sig b/src/tutorial.sig
new file mode 100644
index 0000000..cda9b01
--- /dev/null
+++ b/src/tutorial.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature TUTORIAL = sig
+
+    val make : string -> unit
+
+end
diff --git a/src/tutorial.sml b/src/tutorial.sml
new file mode 100644
index 0000000..0c2f908
--- /dev/null
+++ b/src/tutorial.sml
@@ -0,0 +1,322 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Tutorial :> TUTORIAL = struct
+
+fun readAll inf =
+    let
+        fun loop acc =
+            case TextIO.inputLine inf of
+                NONE => Substring.full (String.concat (rev acc))
+              | SOME line => loop (line :: acc)
+    in
+        loop []
+        before TextIO.closeIn inf
+    end
+
+val readAllFile = readAll o FileIO.txtOpenIn
+
+fun fixupFile (fname, title) =
+    let
+        val source = readAllFile "/tmp/final.html"
+        val outf = TextIO.openOut (OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
+                                                       path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}})
+
+        val (befor, after) = Substring.position "<title>" source
+
+        fun proseLoop source =
+            let
+                val (befor, after) = Substring.splitl (fn ch => ch <> #"&") source
+            in
+                if Substring.isEmpty after then
+                    TextIO.outputSubstr (outf, source)
+                else if Substring.size after >= 4 andalso Substring.string (Substring.slice (after, 1, SOME 3)) = "lt;" then
+                    (TextIO.outputSubstr (outf, befor);
+                     TextIO.output (outf, "<");
+                     proseLoop (Substring.slice (after, 4, NONE)))
+                else if Substring.size after >= 4 andalso Substring.string (Substring.slice (after, 1, SOME 3)) = "gt;" then
+                    (TextIO.outputSubstr (outf, befor);
+                     TextIO.output (outf, ">");
+                     proseLoop (Substring.slice (after, 4, NONE)))
+                else if Substring.size after >= 5 andalso Substring.string (Substring.slice (after, 1, SOME 4)) = "amp;" then
+                    (TextIO.outputSubstr (outf, befor);
+                     TextIO.output (outf, "&");
+                     proseLoop (Substring.slice (after, 5, NONE)))
+                else
+                    raise Fail "Unsupported HTML escape"
+            end
+
+        fun loop source =
+            let
+                val (befor, after) = Substring.position "<span class=\"comment-delimiter\">(* </span><span class=\"comment\">" source
+            in
+                if Substring.isEmpty after then
+                   TextIO.outputSubstr (outf, source)
+                else
+                    let
+                        val (befor', after) = Substring.position " </span><span class=\"comment-delimiter\">*)</span>"
+                                                                 (Substring.slice (after, 64, NONE))
+                    in
+                        if Substring.isEmpty after then
+                            TextIO.outputSubstr (outf, source)
+                        else
+                            (TextIO.outputSubstr (outf, befor);
+                             TextIO.output (outf, "</pre>");
+                             if Substring.size befor' >= 1 andalso Substring.sub (befor', 0) = #"*" then
+                                 (TextIO.output (outf, "<h2>");
+                                  proseLoop (Substring.slice (befor', 2, NONE));
+                                  TextIO.output (outf, "</h2>"))
+                             else
+                                 (TextIO.output (outf, "<div class=\"prose\">");
+                                  proseLoop befor';
+                                  TextIO.output (outf, "</div>"));
+                             TextIO.output (outf, "<pre>");
+                             loop (Substring.slice (after, 49, NONE)))
+                    end
+            end
+    in
+        if Substring.isEmpty after then
+            raise Fail ("Missing <title> for " ^ title)
+        else
+            (TextIO.outputSubstr (outf, befor);
+             TextIO.output (outf, "<style type=\"text/css\">\n");
+             TextIO.output (outf, "<!--\n");
+             TextIO.output (outf, "\tdiv.prose {\n");
+             TextIO.output (outf, "\t\tfont-family: Arial;\n");
+             TextIO.output (outf, "\t\tbackground-color: #CCFFCC;\n");
+             TextIO.output (outf, "\t\tborder-style: solid;\n");
+             TextIO.output (outf, "\t\tpadding: 5px;\n");
+             TextIO.output (outf, "\t\tfont-size: larger;\n");
+             TextIO.output (outf, "\t}\n");
+             TextIO.output (outf, "\th2 {\n");
+             TextIO.output (outf, "\t\tfont-family: Arial;\n");
+             TextIO.output (outf, "\t\tfont-size: 20pt;\n");
+             TextIO.output (outf, "\t\tbackground-color: #99FF99;\n");
+             TextIO.output (outf, "\t\tpadding: 5px;\n");
+             TextIO.output (outf, "\t}\n");
+             TextIO.output (outf, "\ta:link {\n");
+             TextIO.output (outf, "\t\ttext-decoration: underline;\n");
+             TextIO.output (outf, "\t\tcolor: blue;\n");
+             TextIO.output (outf, "\t}\n");
+             TextIO.output (outf, "\ta:visited {\n");
+             TextIO.output (outf, "\t\ttext-decoration: underline;\n");
+             TextIO.output (outf, "\t\tcolor: red;\n");
+             TextIO.output (outf, "\t}\n");
+             TextIO.output (outf, "-->\n");
+             TextIO.output (outf, "</style>\n");
+             TextIO.output (outf, "<title>");
+             TextIO.output (outf, title);
+             let
+                 val (befor, after) = Substring.position "</title>" after
+             in
+                 if Substring.isEmpty after then
+                     raise Fail ("Missing </title> for " ^ title)
+                 else
+                     let
+                         val (befor, after) = Substring.position "<body>" after
+                     in
+                         if Substring.isEmpty after then
+                             raise Fail ("Missing <body> for " ^ title)
+                         else
+                             (TextIO.outputSubstr (outf, befor);
+                              TextIO.output (outf, "<body><h1>");
+                              TextIO.output (outf, title);
+                              TextIO.output (outf, "</h1>");
+                              loop (Substring.slice (after, 6, NONE)))
+                     end
+             end;
+             TextIO.closeOut outf)
+    end
+
+fun doUr fname =
+    let
+        val inf = FileIO.txtOpenIn fname
+
+        val title = case TextIO.inputLine inf of
+                        NONE => raise Fail ("No title comment at start of " ^ fname)
+                      | SOME title => title
+
+        val title = String.substring (title, 3, size title - 7)
+
+        val eval = TextIO.openOut "/tmp/eval.ur"
+        val gen = TextIO.openOut "/tmp/gen.ur"
+
+        fun untilEnd source =
+            let
+                val (befor, after) = Substring.position "(* end *)" source
+            in
+                if Substring.isEmpty after then
+                    (source, Substring.full "")
+                else
+                    (befor, Substring.slice (after, 9, NONE))
+            end
+
+        fun doDirectives (count, source) =
+            let
+                val safe = String.translate (fn #"<" => "&lt;"
+                                              | #"&" => "&amp;"
+                                              | #"{" => "&#123;"
+                                              | #"(" => "&#40;"
+                                              | #"\n" => "&#40;*NL*)\n"
+                                              | #" " => "&#40;*NL*) "
+                                              | ch => str ch) o Substring.string
+
+                val (befor, after) = Substring.position "(* begin " source
+
+                fun default () = (TextIO.outputSubstr (eval, source);
+                                  TextIO.output (gen, safe source))
+            in
+                if Substring.isEmpty after then
+                    default ()
+                else
+                    let
+                        val (command, after) = Substring.splitl (not o Char.isSpace) (Substring.slice (after, 9, NONE))
+                    in
+                        if Substring.isEmpty after then
+                            default ()
+                        else
+                            let
+                                val (_, rest) = Substring.position "*)" after
+                            in
+                                if Substring.isEmpty rest then
+                                    default ()
+                                else
+                                    let
+                                        val (arg, source) = untilEnd (Substring.slice (rest, 3, NONE))
+                                        val () = (TextIO.outputSubstr (eval, befor);
+                                                  TextIO.output (gen, safe befor))
+                                        val (count, skip) =
+                                            case Substring.string command of
+                                                "hide" => (TextIO.outputSubstr (eval, arg);
+                                                           (count, true))
+                                              | "eval" => (TextIO.output (eval, "val _eval");
+                                                           TextIO.output (eval, Int.toString count);
+                                                           TextIO.output (eval, " = ");
+                                                           TextIO.outputSubstr (eval, arg);
+                                                           TextIO.output (eval, "\n\n");
+
+                                                           TextIO.output (gen, safe arg);
+                                                           TextIO.output (gen, "== {[_eval");
+                                                           TextIO.output (gen, Int.toString count);
+                                                           TextIO.output (gen, "]}");
+
+                                                           (count + 1, false))
+                                              | s => raise Fail ("Unknown tutorial directive: " ^ s)
+                                    in
+                                        doDirectives (count, if skip then
+                                                                 #2 (Substring.splitl Char.isSpace source)
+                                                             else
+                                                                 source)
+                                    end
+                            end
+                    end
+            end
+    in
+        doDirectives (0, readAll inf);
+        TextIO.closeOut gen;
+
+        TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>");
+        TextIO.outputSubstr (eval, readAllFile "/tmp/gen.ur");
+        TextIO.output (eval, "</body></xml>");
+        TextIO.closeOut eval;
+
+        if Compiler.compile "/tmp/eval" then
+            let
+                val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"])
+                val inf = Unix.textInstreamOf proc
+                val s = readAll inf
+                val _ = Unix.reap proc
+
+                val (befor, after) = Substring.position "<body>" s
+            in
+                if Substring.isEmpty after then
+                    print ("Bad output for " ^ fname ^ "! [1]\n")
+                else
+                    let
+                        val after = Substring.slice (after, 6, NONE)
+                        val (befor, after) = Substring.position "</body>" after
+                    in
+                        if Substring.isEmpty after then
+                            print ("Bad output for " ^ fname ^ "! [2]\n")
+                        else
+                            let
+                                val outf = TextIO.openOut "/tmp/final.ur"
+
+                                fun eatNls source =
+                                    let
+                                        val (befor, after) = Substring.position "(*NL*)" source
+                                    in
+                                        if Substring.isEmpty after then
+                                            TextIO.outputSubstr (outf, source)
+                                        else
+                                            (TextIO.outputSubstr (outf, befor);
+                                             eatNls (Substring.slice (after, 6, NONE)))
+                                    end
+
+                                val cmd = "emacs --eval \"(progn "
+                                          ^ "(global-font-lock-mode t) "
+                                          ^ "(add-to-list 'load-path \\\""
+                                          ^ !Settings.configSitelisp
+                                          ^ "/\\\") "
+                                          ^ "(load \\\"urweb-mode-startup\\\") "
+                                          ^ "(urweb-mode) "
+                                          ^ "(find-file \\\"/tmp/final2.ur\\\") "
+                                          ^ "(switch-to-buffer (htmlize-buffer)) "
+                                          ^ "(write-file \\\"/tmp/final.html\\\") "
+                                          ^ "(kill-emacs))\""
+                            in
+                                eatNls befor;
+                                TextIO.closeOut outf;
+                                ignore (OS.Process.system "sed -e 's/&lt;/</g;s/&amp;/\\&/g' </tmp/final.ur >/tmp/final2.ur");
+                                ignore (OS.Process.system cmd);
+                                fixupFile (fname, title)
+                            end
+                    end
+            end
+        else
+            ()
+    end
+
+fun make dirname =
+    let
+        val dir = OS.FileSys.openDir dirname
+
+        fun doDir () =
+            case OS.FileSys.readDir dir of
+                NONE => OS.FileSys.closeDir dir
+              | SOME fname =>
+                (if OS.Path.ext fname = SOME "ur" then
+                     doUr (OS.Path.joinDirFile {dir = dirname, file = fname})
+                 else
+                     ();
+                 doDir ())
+    in
+        Settings.setProtocol "static";
+        doDir ()
+    end
+
+end
diff --git a/src/union_find_fn.sml b/src/union_find_fn.sml
new file mode 100644
index 0000000..7880591
--- /dev/null
+++ b/src/union_find_fn.sml
@@ -0,0 +1,58 @@
+functor UnionFindFn(K : ORD_KEY) :> sig
+    type unionFind
+    val empty : unionFind
+    val union : unionFind * K.ord_key * K.ord_key -> unionFind
+    val union' : (K.ord_key * K.ord_key) * unionFind -> unionFind
+    val together : unionFind * K.ord_key * K.ord_key -> bool
+    val classes : unionFind -> K.ord_key list list
+end = struct
+
+structure M = BinaryMapFn(K)
+structure S = BinarySetFn(K)
+
+datatype entry =
+         Set of S.set
+       | Pointer of K.ord_key
+
+(* First map is the union-find tree, second stores equivalence classes. *)
+type unionFind = entry M.map ref * S.set M.map
+
+val empty : unionFind = (ref M.empty, M.empty)
+
+fun findPair (uf, x) =
+    case M.find (!uf, x) of
+        NONE => (S.singleton x, x)
+      | SOME (Set set) => (set, x)
+      | SOME (Pointer parent) =>
+        let
+            val (set, rep) = findPair (uf, parent)
+        in
+            uf := M.insert (!uf, x, Pointer rep);
+            (set, rep)
+        end
+
+fun find ((uf, _), x) = (S.listItems o #1 o findPair) (uf, x)
+
+fun classes (_, cs) = (map S.listItems o M.listItems) cs
+
+fun together ((uf, _), x, y) = case K.compare (#2 (findPair (uf, x)), #2 (findPair (uf, y))) of
+                                   EQUAL => true
+                                 | _ => false
+
+fun union ((uf, cs), x, y) =
+    let
+        val (xSet, xRep) = findPair (uf, x)
+        val (ySet, yRep) = findPair (uf, y)
+        val xySet = S.union (xSet, ySet)
+    in
+        (ref (M.insert (M.insert (!uf, yRep, Pointer xRep),
+                        xRep, Set xySet)),
+         M.insert (case M.find (cs, yRep) of
+                       NONE => cs
+                     | SOME _ => #1 (M.remove (cs, yRep)),
+                   xRep, xySet))
+    end
+
+fun union' ((x, y), uf) = union (uf, x, y)
+
+end
diff --git a/src/unnest.sig b/src/unnest.sig
new file mode 100644
index 0000000..6508a78
--- /dev/null
+++ b/src/unnest.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove nested function definitions *)
+
+signature UNNEST = sig
+
+    val unnest : Elab.file -> Elab.file
+    
+end
diff --git a/src/unnest.sml b/src/unnest.sml
new file mode 100644
index 0000000..7469ffd
--- /dev/null
+++ b/src/unnest.sml
@@ -0,0 +1,567 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove nested function definitions *)
+
+structure Unnest :> UNNEST = struct
+
+open Elab
+
+structure E = ElabEnv
+structure U = ElabUtil
+
+structure IS = IntBinarySet
+
+fun liftExpInExp by =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + by)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
+val subExpInExp =
+    U.Exp.mapB {kind = fn _ => fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      if xn' = xn then
+                                           #1 rep
+                                      else
+                                          e
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, E.liftExpInExp 0 rep)
+                        | ((xn, rep), U.Exp.RelC _) => (xn, E.liftConInExp 0 rep)
+                        | (ctx, _) => ctx}
+
+val fvsKind = U.Kind.foldB {kind = fn (kb, k, kvs) =>
+                                      case k of
+                                          KRel n =>
+                                          if n >= kb then
+                                              IS.add (kvs, n - kb)
+                                          else
+                                              kvs
+                                        | _ => kvs,
+                          bind = fn (kb, b) => kb + 1}
+                         0 IS.empty
+
+val fvsCon = U.Con.foldB {kind = fn ((kb, _), k, st as (kvs, cvs)) =>
+                                    case k of
+                                        KRel n =>
+                                        if n >= kb then
+                                            (IS.add (kvs, n - kb), cvs)
+                                        else
+                                            st
+                                      | _ => st,
+                          con = fn ((_, cb), c, st as (kvs, cvs)) =>
+                                   case c of
+                                       CRel n =>
+                                       if n >= cb then
+                                           (kvs, IS.add (cvs, n - cb))
+                                       else
+                                           st
+                                     | _ => st,
+                          bind = fn (ctx as (kb, cb), b) =>
+                                    case b of
+                                        U.Con.RelK _ => (kb + 1, cb + 1)
+                                      | U.Con.RelC _ => (kb, cb + 1)
+                                      | _ => ctx}
+                         (0, 0) (IS.empty, IS.empty)
+
+fun fvsExp nr = U.Exp.foldB {kind = fn ((kb, _, _), k, st as (kvs, cvs, evs)) =>
+                                       case k of
+                                           KRel n =>
+                                           if n >= kb then
+                                               (IS.add (kvs, n - kb), cvs, evs)
+                                           else
+                                               st
+                                         | _ => st,
+                             con = fn ((kb, cb, eb), c, st as (kvs, cvs, evs)) =>
+                                      case c of
+                                          CRel n =>
+                                          if n >= cb then
+                                              (kvs, IS.add (cvs, n - cb), evs)
+                                          else
+                                              st
+                                        | _ => st,
+                             exp = fn ((kb, cb, eb), e, st as (kvs, cvs, evs)) =>
+                                      case e of
+                                          ERel n =>
+                                          if n >= eb then
+                                              (kvs, cvs, IS.add (evs, n - eb))
+                                          else
+                                              st
+                                        | _ => st,
+                             bind = fn (ctx as (kb, cb, eb), b) =>
+                                       case b of
+                                           U.Exp.RelK _ => (kb + 1, cb, eb)
+                                         | U.Exp.RelC _ => (kb, cb + 1, eb)
+                                         | U.Exp.RelE _ => (kb, cb, eb + 1)
+                                         | _ => ctx}
+                            (0, 0, nr) (IS.empty, IS.empty, IS.empty)
+
+fun positionOf (x : int) ls =
+    let
+        fun po n ls =
+            case ls of
+                [] => raise Fail "Unnest.positionOf"
+              | x' :: ls' =>
+                if x' = x then
+                    n
+                else
+                    po (n + 1) ls'
+    in
+        po 0 ls
+        handle Fail _ => raise Fail ("Unnest.positionOf("
+                                     ^ Int.toString x
+                                     ^ ", "
+                                     ^ String.concatWith ";" (map Int.toString ls)
+                                     ^ ")")
+    end
+
+fun squishCon (kfv, cfv) =
+    U.Con.mapB {kind = fn (kb, _) => fn k =>
+                                        case k of
+                                            KRel n =>
+                                            if n >= kb then
+                                                KRel (positionOf (n - kb) kfv + kb)
+                                            else
+                                                k
+                                          | _ => k,
+                con = fn (_, cb) => fn c =>
+                                       case c of
+                                           CRel n =>
+                                           if n >= cb then
+                                               CRel (positionOf (n - cb) cfv + cb)
+                                           else
+                                               c
+                                         | _ => c,
+                bind = fn (ctx as (kb, cb), b) =>
+                          case b of
+                              U.Con.RelK _ => (kb + 1, cb)
+                            | U.Con.RelC _ => (kb, cb + 1)
+                            | _ => ctx}
+               (0, 0)
+
+fun squishExp (nr, kfv, cfv, efv) =
+    U.Exp.mapB {kind = fn (kb, _, _) => fn k =>
+                                           case k of
+                                               KRel n =>
+                                               if n >= kb then
+                                                   KRel (positionOf (n - kb) kfv + kb)
+                                               else
+                                                   k
+                                             | _ => k,
+                con = fn (_, cb, _) => fn c =>
+                                          case c of
+                                              CRel n =>
+                                              if n >= cb then
+                                                  CRel (positionOf (n - cb) cfv + cb)
+                                              else
+                                                  c
+                                            | _ => c,
+                exp = fn (_, _, eb) => fn e =>
+                                          case e of
+                                              ERel n =>
+                                              if n >= eb then
+                                                  ERel (positionOf (n - eb) efv + eb - nr)
+                                              else
+                                                  e
+                                            | _ => e,
+                bind = fn (ctx as (kb, cb, eb), b) =>
+                          case b of
+                              U.Exp.RelK _ => (kb + 1, cb, eb)
+                            | U.Exp.RelC _ => (kb, cb + 1, eb)
+                            | U.Exp.RelE _ => (kb, cb, eb + 1)
+                            | _ => ctx}
+               (0, 0, nr)
+
+type state = {
+     maxName : int,
+     decls : (string * int * con * exp) list
+}
+
+fun kind (_, k, st) = (k, st)
+
+val basis = ref 0
+
+fun exp ((ns, ks, ts), e as old, st : state) =
+    case e of
+        ELet (eds, e, t) =>
+        let
+            (*val () = Print.prefaces "Letto" [("e", ElabPrint.p_exp E.empty (old, ErrorMsg.dummySpan))]*)
+
+            fun doSubst' (e, subs) = foldl (fn (p, e) => subExpInExp p e) e subs
+
+            fun doSubst (e, subs, by) =
+                let
+                    val e = doSubst' (e, subs)
+                in
+                    liftExpInExp (~by) (length subs) e
+                end
+
+            fun functionInside (t : con) =
+                case #1 t of
+                    TFun _ => true
+                  | CApp ((CModProj (basis', [], "transaction"), _), _) => basis' = !basis
+                  | _ => false
+
+            val eds = map (fn ed =>
+                              case #1 ed of
+                                  EDVal ((PVar (x, _), _), t, e) =>
+                                  if functionInside t then
+                                      (EDValRec [(x, t, E.liftExpInExp 0 e)], #2 ed)
+                                  else
+                                      ed
+                                | _ => ed) eds
+
+            val (eds, (ts, maxName, ds, subs, by)) =
+                ListUtil.foldlMapConcat
+                (fn (ed, (ts, maxName, ds, subs, by)) =>
+                    case #1 ed of
+                        EDVal (p, t, e) =>
+                        let
+                            val e = doSubst (e, subs, by)
+
+                            fun doVars ((p, _), ts) =
+                                case p of
+                                    PVar xt => xt :: ts
+                                  | PPrim _ => ts
+                                  | PCon (_, _, _, NONE) => ts
+                                  | PCon (_, _, _, SOME p) => doVars (p, ts)
+                                  | PRecord xpcs =>
+                                    foldl (fn ((_, p, _), ts) => doVars (p, ts))
+                                          ts xpcs
+
+                            fun bindOne subs = ((0, (ERel 0, #2 ed))
+                                                :: map (fn (n, e) => (n + 1, E.liftExpInExp 0 e)) subs)
+
+                            fun bindMany (n, subs) =
+                                case n of
+                                    0 => subs
+                                  | _ => bindMany (n - 1, bindOne subs)
+                        in
+                            ([(EDVal (p, t, e), #2 ed)],
+                             (doVars (p, ts),
+                              maxName, ds,
+                              bindMany (E.patBindsN p, subs),
+                              by))
+                        end
+                      | EDValRec vis =>
+                        let
+                            val loc = #2 ed
+
+                            val nr = length vis
+                            val subsLocal = List.filter (fn (_, (ERel _, _)) => false
+                                                          | _ => true) subs
+                            val subsLocal = map (fn (n, e) => (n + nr, liftExpInExp nr 0 e))
+                                                subsLocal
+
+                            val vis = map (fn (x, t, e) =>
+                                              (x, t, doSubst' (e, subsLocal))) vis
+
+                            val (kfv, cfv, efv) =
+                                foldl (fn ((_, t, e), (kfv, cfv, efv)) =>
+                                          let
+                                              val (kfv', cfv', efv') = fvsExp nr e
+                                              (*val () = Print.prefaces "fvsExp"
+                                                         [("e", ElabPrint.p_exp E.empty e),
+                                                          ("cfv", Print.PD.string
+                                                                      (Int.toString (IS.numItems cfv'))),
+                                                          ("efv", Print.PD.string
+                                                                      (Int.toString (IS.numItems efv')))]*)
+                                              val (kfv'', cfv'') = fvsCon t
+                                          in
+                                              (IS.union (kfv, IS.union (kfv', kfv'')),
+                                               IS.union (cfv, IS.union (cfv', cfv'')),
+                                               IS.union (efv, efv'))
+                                          end)
+                                      (IS.empty, IS.empty, IS.empty) vis
+
+                            (*val () = Print.prefaces "Letto" [("e", ElabPrint.p_exp E.empty (old, ErrorMsg.dummySpan))]*)
+                            (*val () = print ("A: " ^ Int.toString (length ts) ^ ", " ^ Int.toString (length ks) ^ "\n")*)
+                            (*val () = app (fn (x, t) =>
+                                             Print.prefaces "Var" [("x", Print.PD.string x),
+                                                                   ("t", ElabPrint.p_con E.empty t)]) ts
+                            val () = IS.app (fn n => print ("Free: " ^ Int.toString n ^ "\n")) efv*)
+
+                            val kfv = IS.foldl (fn (x, kfv) =>
+                                                   let
+                                                       (*val () = print (Int.toString x ^ "\n")*)
+                                                       val (_, k) = List.nth (ks, x)
+                                                   in
+                                                       IS.union (kfv, fvsKind k)
+                                                   end)
+                                               kfv cfv
+
+                            val kfv = IS.foldl (fn (x, kfv) =>
+                                                   let
+                                                       (*val () = print (Int.toString x ^ "\n")*)
+                                                       val (_, t) = List.nth (ts, x)
+                                                   in
+                                                       IS.union (kfv, #1 (fvsCon t))
+                                                   end)
+                                               kfv efv
+
+                            val cfv = IS.foldl (fn (x, cfv) =>
+                                                   let
+                                                       (*val () = print (Int.toString x ^ "\n")*)
+                                                       val (_, t) = List.nth (ts, x)
+                                                   in
+                                                       IS.union (cfv, #2 (fvsCon t))
+                                                   end)
+                                               cfv efv
+                            (*val () = print "B\n"*)
+
+                            val (vis, maxName) =
+                                ListUtil.foldlMap (fn ((x, t, e), maxName) =>
+                                                      ((x, maxName, t, e),
+                                                       maxName + 1))
+                                maxName vis
+
+                            val subs = map (fn (n, e) => (n + nr,
+                                                          case e of
+                                                              (ERel _, _) => e
+                                                            | _ => liftExpInExp nr 0 e))
+                                           subs
+
+                            val subs' = ListUtil.mapi (fn (i, (_, n, _, _)) =>
+                                                          let
+                                                              val e = (ENamed n, loc)
+
+                                                              val e = IS.foldr (fn (x, e) =>
+                                                                                   (EKApp (e, (KRel x, loc)), loc))
+                                                                               e kfv
+
+                                                              val e = IS.foldr (fn (x, e) =>
+                                                                                   (ECApp (e, (CRel x, loc)), loc))
+                                                                               e cfv
+
+                                                              val e = IS.foldr (fn (x, e) =>
+                                                                                   (EApp (e, (ERel (nr + x), loc)),
+                                                                                    loc))
+                                                                               e efv
+                                                          in
+                                                              (nr - i - 1, e)
+                                                          end)
+                                                      vis
+
+                            val kfv = IS.listItems kfv
+                            val cfv = IS.listItems cfv
+                            val efv = IS.listItems efv
+
+                            val subs = subs' @ subs
+
+                            val vis = map (fn (x, n, t, e) =>
+                                              let
+                                                  (*val () = Print.prefaces "preSubst"
+                                                                          [("e", ElabPrint.p_exp E.empty e)]*)
+                                                  val e = doSubst' (e, subs')
+
+                                                  (*val () = Print.prefaces "squishCon"
+                                                                          [("t", ElabPrint.p_con E.empty t)]*)
+                                                  val t = squishCon (kfv, cfv) t
+                                                  (*val () = Print.prefaces "squishExp"
+                                                                          [("e", ElabPrint.p_exp E.empty e)]*)
+                                                  val e = squishExp (nr, kfv, cfv, efv) e
+
+                                                  (*val () = print ("Avail: " ^ Int.toString (length ts) ^ "\n")*)
+                                                  val (e, t) = foldl (fn (ex, (e, t)) =>
+                                                                         let
+                                                                             (*val () = print (Int.toString ex ^ "\n")*)
+                                                                             val (name, t') = List.nth (ts, ex)
+                                                                             val t' = squishCon (kfv, cfv) t'
+                                                                         in
+                                                                             ((EAbs (name,
+                                                                                     t',
+                                                                                     t,
+                                                                                     e), loc),
+                                                                              (TFun (t',
+                                                                                     t), loc))
+                                                                         end)
+                                                                     (e, t) efv
+                                                  (*val () = print "Done\n"*)
+
+                                                  val (e, t) = foldl (fn (cx, (e, t)) =>
+                                                                         let
+                                                                             val (name, k) = List.nth (ks, cx)
+                                                                         in
+                                                                             ((ECAbs (Explicit,
+                                                                                      name,
+                                                                                      k,
+                                                                                      e), loc),
+                                                                              (TCFun (Explicit,
+                                                                                      name,
+                                                                                      k,
+                                                                                      t), loc))
+                                                                         end)
+                                                                     (e, t) cfv
+
+                                                  val (e, t) = foldl (fn (kx, (e, t)) =>
+                                                                         let
+                                                                             val name = List.nth (ns, kx)
+                                                                         in
+                                                                             ((EKAbs (name,
+                                                                                      e), loc),
+                                                                              (TKFun (name,
+                                                                                      t), loc))
+                                                                         end)
+                                                                     (e, t) kfv
+                                              in
+                                                  (*Print.prefaces "Have a vi"
+                                                                 [("x", Print.PD.string x),
+                                                                  ("e", ElabPrint.p_exp ElabEnv.empty e)];*)
+                                                  ("$" ^ x, n, t, e)
+                                              end)
+                                          vis
+
+                            val ts = List.revAppend (map (fn (x, _, t, _) => (x, t)) vis, ts)
+                        in
+                            ([], (ts, maxName, vis @ ds, subs, by + nr))
+                        end)
+                (ts, #maxName st, #decls st, [], 0) eds
+
+            val e' = doSubst (e, subs, by)
+        in
+            (*Print.prefaces "Before" [("e", ElabPrint.p_exp ElabEnv.empty e),
+                                     ("se", ElabPrint.p_exp ElabEnv.empty (doSubst' (e, subs))),
+                                     ("e'", ElabPrint.p_exp ElabEnv.empty e')];*)
+            (*Print.prefaces "Let" [("Before", ElabPrint.p_exp ElabEnv.empty (old, ErrorMsg.dummySpan)),
+                                  ("After", ElabPrint.p_exp ElabEnv.empty (ELet (eds, e', t), ErrorMsg.dummySpan))];*)
+            (ELet (eds, e', t),
+             {maxName = maxName,
+              decls = ds})
+            (*(ELet (eds, doSubst (liftExpInExp (~(length subs - numRemaining)) (length subs) e) subs),*)
+        end
+
+      | _ => (e, st)
+
+fun default (ctx, d, st) = (d, st)
+
+fun bind ((ns, ks, ts), b) =
+    case b of
+        U.Decl.RelK x => (x :: ns, ks, ts)
+      | U.Decl.RelC p => (ns, p :: ks, map (fn (name, t) => (name, E.liftConInCon 0 t)) ts)
+      | U.Decl.RelE p => (ns, ks, p :: ts)
+      | _ => (ns, ks, ts)                        
+
+val unnestDecl = U.Decl.foldMapB {kind = kind,
+                                  con = default,
+                                  exp = exp,
+                                  sgn_item = default,
+                                  sgn = default,
+                                  str = default,
+                                  decl = default,
+                                  bind = bind}
+                                 ([], [], [])
+
+fun unnest file =
+    let
+        fun doDecl (all as (d, loc), st : state) =
+            let
+                fun default () = ([all], st)
+                fun explore () =
+                    let
+                        val (d, st) = unnestDecl st all
+
+                        val ds =
+                            case #1 d of
+                                DValRec vis => [(DValRec (vis @ #decls st), #2 d)]
+                              | _ => [(DValRec (#decls st), #2 d), d]
+                    in
+                        (ds,
+                         {maxName = #maxName st,
+                          decls = []})
+                    end
+            in
+                case d of
+                    DCon _ => default ()
+                  | DDatatype _ => default ()
+                  | DDatatypeImp _ => default ()
+                  | DVal _ => explore ()
+                  | DValRec _ => explore ()
+                  | DSgn _ => default ()
+                  | DStr (x, n, sgn, str) =>
+                    let
+                        val (str, st) = doStr (str, st)
+                    in
+                        ([(DStr (x, n, sgn, str), loc)], st)
+                    end
+                  | DFfiStr ("Basis", n, _) => (basis := n; default ())
+                  | DFfiStr _ => default ()
+                  | DConstraint _ => default ()
+                  | DExport _ => default ()
+                  | DTable _ => default ()
+                  | DSequence _ => default ()
+                  | DView _ => default ()
+                  | DDatabase _ => default ()
+                  | DCookie _ => default ()
+                  | DStyle _ => default ()
+                  | DTask _ => explore ()
+                  | DPolicy _ => explore ()
+                  | DOnError _ => default ()
+                  | DFfi _ => default ()
+            end
+
+        and doStr (all as (str, loc), st) =
+            let
+                fun default () = (all, st)
+            in
+                case str of
+                    StrConst ds =>
+                    let
+                        val (ds, st) = ListUtil.foldlMapConcat doDecl st ds
+                    in
+                        ((StrConst ds, loc), st)
+                    end
+                  | StrVar _ => default ()
+                  | StrProj _ => default ()
+                  | StrFun (x, n, dom, ran, str) =>
+                    let
+                        val (str, st) = doStr (str, st)
+                    in
+                        ((StrFun (x, n, dom, ran, str), loc), st)
+                    end
+                  | StrApp _ => default ()
+                  | StrError => raise Fail "Unnest: StrError"
+            end
+
+        val (ds, _) = ListUtil.foldlMapConcat doDecl
+                      {maxName = U.File.maxName file + 1,
+                       decls = []} file
+    in
+        ds
+    end
+
+end
diff --git a/src/unpoly.sig b/src/unpoly.sig
new file mode 100644
index 0000000..aba3825
--- /dev/null
+++ b/src/unpoly.sig
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program by repeating polymorphic function definitions *)
+
+signature UNPOLY = sig
+
+    val unpoly : Core.file -> Core.file
+    
+end
diff --git a/src/unpoly.sml b/src/unpoly.sml
new file mode 100644
index 0000000..549de5d
--- /dev/null
+++ b/src/unpoly.sml
@@ -0,0 +1,336 @@
+(* Copyright (c) 2008-2010, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Simplify a Core program by repeating polymorphic function definitions *)
+
+structure Unpoly :> UNPOLY = struct
+
+open Core
+
+structure E = CoreEnv
+structure U = CoreUtil
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+
+(** The actual specialization *)
+
+val liftConInCon = E.liftConInCon
+val subConInCon = E.subConInCon
+
+val liftConInExp = E.liftConInExp
+val subConInExp = E.subConInExp
+
+val isOpen = U.Con.existsB {kind = fn _ => false,
+                            con = fn (n, c) =>
+                                     case c of
+                                         CRel n' => n' >= n
+                                       | _ => false,
+                            bind = fn (n, b) =>
+                                      case b of
+                                          U.Con.RelC _ => n + 1
+                                        | _ => n} 0
+
+fun unpolyNamed (xn, rep) =
+    U.Exp.map {kind = fn k => k,
+               con = fn c => c,
+               exp = fn e =>
+                        case e of
+                            ECApp (e', _) =>
+                            let
+                                fun isTheOne (e, _) =
+                                    case e of
+                                        ENamed xn' => xn' = xn
+                                      | ECApp (e, _) => isTheOne e
+                                      | _ => false
+                            in
+                                if isTheOne e' then
+                                    rep
+                                else
+                                    e
+                            end
+                          | _ => e}
+
+structure M = BinaryMapFn(struct
+                          type ord_key = con list
+                          val compare = Order.joinL U.Con.compare
+                          end)
+
+type func = {
+     kinds : kind list,
+     defs : (string * int * con * exp * string) list,
+     replacements : int M.map
+}
+
+type state = {
+     funcs : func IM.map,
+     decls : decl list,
+     nextName : int
+}
+
+fun kind (k, st) = (k, st)
+
+fun con (c, st) = (c, st)
+
+fun exp (e, st : state) =
+    case e of
+        ECApp _ =>
+        let
+            fun unravel (e, cargs) =
+                case e of
+                    ECApp ((e, _), c) => unravel (e, c :: cargs)
+                  | ENamed n => SOME (n, rev cargs)
+                  | _ => NONE
+        in
+            case unravel (e, []) of
+                NONE => (e, st)
+              | SOME (n, cargs) =>
+                if List.exists isOpen cargs then
+                    (e, st)
+                else
+                    case IM.find (#funcs st, n) of
+                        NONE => (e, st)
+                      | SOME {kinds = ks, defs = vis, replacements} =>
+                        let
+                            val cargs = map ReduceLocal.reduceCon cargs
+                        in
+                            case M.find (replacements, cargs) of
+                                SOME n => (ENamed n, st)
+                              | NONE =>
+                                let
+                                    val old_vis = vis
+                                    val (vis, (thisName, nextName)) =
+                                        ListUtil.foldlMap
+                                            (fn ((x, n', t, e, s), (thisName, nextName)) =>
+                                                ((x, nextName, n', t, e, s),
+                                                 (if n' = n then nextName else thisName,
+                                                  nextName + 1)))
+                                            (0, #nextName st) vis
+
+                                    fun specialize (x, n, n_old, t, e, s) =
+                                        let
+                                            fun trim (t, e, cargs) =
+                                                case (t, e, cargs) of
+                                                    ((TCFun (_, _, t), _),
+                                                     (ECAbs (_, _, e), _),
+                                                     carg :: cargs) =>
+                                                    let
+                                                        val t = subConInCon (length cargs, carg) t
+                                                        val e = subConInExp (length cargs, carg) e
+                                                    in
+                                                        trim (t, e, cargs)
+                                                    end
+                                                  | (_, _, []) => SOME (t, e)
+                                                  | _ => NONE
+                                        in
+                                            (*Print.prefaces "specialize"
+                                                             [("n", Print.PD.string (Int.toString n)),
+                                                              ("nold", Print.PD.string (Int.toString n_old)),
+                                                              ("t", CorePrint.p_con CoreEnv.empty t),
+                                                              ("e", CorePrint.p_exp CoreEnv.empty e),
+                                                              ("|cargs|", Print.PD.string (Int.toString (length cargs)))];*)
+                                            Option.map (fn (t, e) => (x, n, n_old, t, e, s))
+                                                       (trim (t, e, cargs))
+                                        end
+
+                                    val vis = List.map specialize vis
+                                in
+                                    if List.exists (not o Option.isSome) vis orelse length cargs > length ks then
+                                        (e, st)
+                                    else
+                                        let
+                                            val vis = List.mapPartial (fn x => x) vis
+
+                                            val vis = map (fn (x, n, n_old, t, e, s) =>
+                                                              (x ^ "_unpoly", n, n_old, t, e, s)) vis
+                                            val vis' = map (fn (x, n, _, t, e, s) =>
+                                                               (x, n, t, e, s)) vis
+
+                                            val funcs = foldl (fn ((_, n, n_old, _, _, _), funcs) =>
+                                                                  let
+                                                                      val replacements = case IM.find (funcs, n_old) of
+                                                                                             NONE => M.empty
+                                                                                           | SOME {replacements = r,
+                                                                                                   ...} => r
+                                                                  in
+                                                                      IM.insert (funcs, n_old,
+                                                                                 {kinds = ks,
+                                                                                  defs = old_vis,
+                                                                                  replacements = M.insert (replacements,
+                                                                                                           cargs,
+                                                                                                           n)})
+                                                                  end) (#funcs st) vis
+
+                                            val ks' = List.drop (ks, length cargs)
+
+                                            val st = {funcs = foldl (fn (vi, funcs) =>
+                                                                        IM.insert (funcs, #2 vi,
+                                                                                   {kinds = ks',
+                                                                                    defs = vis',
+                                                                                    replacements = M.empty}))
+                                                                    funcs vis',
+                                                      decls = #decls st,
+                                                      nextName = nextName}
+
+                                            val (vis', st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>
+                                                                                   let
+                                                                                       val (e, st) = polyExp (e, st)
+                                                                                   in
+                                                                                       ((x, n, t, e, s), st)
+                                                                                   end)
+                                                                               st vis'
+                                        in
+                                            (ENamed thisName,
+                                             {funcs = #funcs st,
+                                              decls = (DValRec vis', ErrorMsg.dummySpan) :: #decls st,
+                                              nextName = #nextName st})
+                                        end
+                                end
+                        end
+        end
+      | _ => (e, st)
+
+and polyExp (x, st) = U.Exp.foldMap {kind = kind, con = con, exp = exp} st x
+
+fun decl (d, st : state) =
+    let
+        fun unravel (e, cargs) =
+            case e of
+                (ECAbs (_, k, e), _) =>
+                unravel (e, k :: cargs)
+              | _ => rev cargs
+    in
+        case d of
+            DVal (vi as (x, n, t, e, s)) =>
+            let
+                val cargs = unravel (e, [])
+
+                val ns = IS.singleton n
+            in
+                (d, {funcs = IM.insert (#funcs st, n, {kinds = cargs,
+                                                       defs = [vi],
+                                                       replacements = M.empty}),
+                     decls = #decls st,
+                     nextName = #nextName st})
+            end
+          | DValRec (vis as ((x, n, t, e, s) :: rest)) =>
+            let
+                val cargs = unravel (e, [])
+
+                fun unravel (e, cargs) =
+                    case (e, cargs) of
+                        ((ECAbs (_, k, e), _), k' :: cargs) =>
+                        U.Kind.compare (k, k') = EQUAL
+                        andalso unravel (e, cargs)
+                      | (_, []) => true
+                      | _ => false
+                             
+                fun deAbs (e, cargs) =
+                    case (e, cargs) of
+                        ((ECAbs (_, _, e), _), _ :: cargs) => deAbs (e, cargs)
+                      | (_, []) => e
+                      | _ => raise Fail "Unpoly: deAbs"
+
+            in
+                if List.exists (fn vi => not (unravel (#4 vi, cargs))) rest then
+                    (d, st)
+                else
+                    let
+                        val ns = IS.addList (IS.empty, map #2 vis)
+                        val nargs = length cargs
+
+                        (** Verifying lack of polymorphic recursion *)
+
+                        fun kind _ = false
+                        fun con _ = false
+
+                        fun exp (cn, e) =
+                            case e of
+                                orig as ECApp (e, c) =>
+                                let
+                                    fun isIrregular (e, pos) =
+                                        case #1 e of
+                                            ENamed n =>
+                                            IS.member (ns, n)
+                                            andalso
+                                            (case #1 c of
+                                                 CRel i => i <> nargs - pos + cn
+                                               | _ => true)
+                                          | ECApp (e, _) => isIrregular (e, pos + 1)
+                                          | _ => false
+                                in
+                                    isIrregular (e, 1)
+                                end
+                              | _ => false
+
+                        fun bind (cn, b) =
+                            case b of
+                                U.Exp.RelC _ => cn+1
+                              | _ => cn
+
+                        val irregular = U.Exp.existsB {kind = kind, con = con, exp = exp, bind = bind} 0
+                    in
+                        if List.exists (fn x => irregular (deAbs (#4 x, cargs))) vis then
+                            (d, st)
+                        else
+                            (d, {funcs = foldl (fn (vi, funcs) =>
+                                                   IM.insert (funcs, #2 vi, {kinds = cargs,
+                                                                             defs = vis,
+                                                                             replacements = M.empty}))
+                                               (#funcs st) vis,
+                                 decls = #decls st,
+                                 nextName = #nextName st})
+                    end
+            end
+
+          | _ => (d, st)
+    end
+
+val polyDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl}
+
+fun unpoly file =
+    let
+        fun doDecl (d : decl, st : state) =
+            let
+                val (d, st) = polyDecl st d
+            in
+                (rev (d :: #decls st),
+                 {funcs = #funcs st,
+                  decls = [],
+                  nextName = #nextName st})
+            end
+
+        val (ds, _) = ListUtil.foldlMapConcat doDecl
+                      {funcs = IM.empty,
+                       decls = [],
+                       nextName = U.File.maxName file + 1} file
+    in
+        ds
+    end
+
+end
diff --git a/src/untangle.sig b/src/untangle.sig
new file mode 100644
index 0000000..522cc6d
--- /dev/null
+++ b/src/untangle.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature UNTANGLE = sig
+
+    val untangle : Mono.file -> Mono.file
+
+end
diff --git a/src/untangle.sml b/src/untangle.sml
new file mode 100644
index 0000000..bcb90ed
--- /dev/null
+++ b/src/untangle.sml
@@ -0,0 +1,214 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Untangle :> UNTANGLE = struct
+
+open Mono
+
+structure U = MonoUtil
+structure E = MonoEnv
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+fun typ (k, s) = s
+
+fun exp (e, s) =
+    case e of
+        ENamed n => IS.add (s, n)
+
+      | _ => s
+
+fun untangle (file : file) =
+    let
+        fun decl (dAll as (d, loc)) =
+            case d of
+                DValRec vis =>
+                let
+                    val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) =>
+                                              IS.add (thisGroup, n)) IS.empty vis
+
+                    val used = foldl (fn ((_, n, _, e, _), used) =>
+                                       let
+                                           val usedHere = U.Exp.fold {typ = typ,
+                                                                      exp = exp} IS.empty e
+                                       in
+                                           IM.insert (used, n, IS.intersection (usedHere, thisGroup))
+                                       end)
+                               IM.empty vis
+
+                    fun p_graph reachable =
+                        IM.appi (fn (n, reachableHere) =>
+                                    (print (Int.toString n);
+                                     print ":";
+                                     IS.app (fn n' => (print " ";
+                                                       print (Int.toString n'))) reachableHere;
+                                     print "\n")) reachable
+
+                    (*val () = print "used:\n"
+                    val () = p_graph used*)
+
+                    fun expand reachable =
+                        let
+                            val changed = ref false
+
+                            val reachable =
+                                IM.mapi (fn (n, reachableHere) =>
+                                            IS.foldl (fn (n', reachableHere) =>
+                                                         let
+                                                             val more = valOf (IM.find (reachable, n'))
+                                                         in
+                                                             if IS.isEmpty (IS.difference (more, reachableHere)) then
+                                                                 reachableHere
+                                                             else
+                                                                 (changed := true;
+                                                                  IS.union (more, reachableHere))
+                                                         end)
+                                                     reachableHere reachableHere) reachable
+                        in
+                            (reachable, !changed)
+                        end
+
+                    fun iterate reachable =
+                        let
+                            val (reachable, changed) = expand reachable
+                        in
+                            if changed then
+                                iterate reachable
+                            else
+                                reachable
+                        end
+
+                    val reachable = iterate used
+
+                    (*val () = print "reachable:\n"
+                    val () = p_graph reachable*)
+
+                    fun sccs (nodes, acc) =
+                        case IS.find (fn _ => true) nodes of
+                            NONE => acc
+                          | SOME rep =>
+                            let
+                                val reachableHere = valOf (IM.find (reachable, rep))
+
+                                val (nodes, scc) = IS.foldl (fn (node, (nodes, scc)) =>
+                                                                if node = rep then
+                                                                    (nodes, scc)
+                                                                else
+                                                                    let
+                                                                        val reachableThere =
+                                                                            valOf (IM.find (reachable, node))
+                                                                    in
+                                                                        if IS.member (reachableThere, rep) then
+                                                                            (IS.delete (nodes, node),
+                                                                             IS.add (scc, node))
+                                                                        else
+                                                                            (nodes, scc)
+                                                                    end)
+                                                   (IS.delete (nodes, rep), IS.singleton rep) reachableHere
+                            in
+                                sccs (nodes, scc :: acc)
+                            end
+
+                    val sccs = sccs (thisGroup, [])
+                    (*val () = app (fn nodes => (print "SCC:";
+                                               IS.app (fn i => (print " ";
+                                                                print (Int.toString i))) nodes;
+                                               print "\n")) sccs*)
+
+                    fun depends nodes1 nodes2 =
+                        let
+                            val node1 = valOf (IS.find (fn _ => true) nodes1)
+                            val node2 = valOf (IS.find (fn _ => true) nodes2)
+                            val reachable1 = valOf (IM.find (reachable, node1))
+                        in
+                            IS.member (reachable1, node2)
+                        end
+
+                    fun findReady (sccs, passed) =
+                        case sccs of
+                            [] => raise Fail "Untangle: Unable to topologically sort 'val rec'"
+                          | nodes :: sccs =>
+                            if List.exists (depends nodes) passed
+                               orelse List.exists (depends nodes) sccs then
+                                findReady (sccs, nodes :: passed)
+                            else
+                                (nodes, List.revAppend (passed, sccs))
+
+                    fun topo (sccs, acc) =
+                        case sccs of
+                            [] => rev acc
+                          | _ =>
+                            let
+                                val (node, sccs) = findReady (sccs, [])
+                            in
+                                topo (sccs, node :: acc)
+                            end
+
+                    val sccs = topo (sccs, [])
+                    (*val () = app (fn nodes => (print "SCC':";
+                                               IS.app (fn i => (print " ";
+                                                                print (Int.toString i))) nodes;
+                                               print "\n")) sccs*)
+
+                    fun isNonrec nodes =
+                        case IS.find (fn _ => true) nodes of
+                            NONE => NONE
+                          | SOME node =>
+                            let
+                                val nodes = IS.delete (nodes, node)
+                                val reachableHere = valOf (IM.find (reachable, node))
+                            in
+                                if IS.isEmpty nodes then
+                                    if IS.member (reachableHere, node) then
+                                        NONE
+                                    else
+                                        SOME node
+                                else
+                                    NONE
+                            end
+
+                    val ds = map (fn nodes =>
+                                     case isNonrec nodes of
+                                         SOME node =>
+                                         let
+                                             val vi = valOf (List.find (fn (_, n, _, _, _) => n = node) vis)
+                                         in
+                                             (DVal vi, loc)
+                                         end
+                                       | NONE =>
+                                         (DValRec (List.filter (fn (_, n, _, _, _) => IS.member (nodes, n)) vis), loc))
+                                 sccs
+                in
+                    ds
+                end
+              | _ => [dAll]
+    in
+        (ListUtil.mapConcat decl (#1 file), #2 file)
+    end
+
+end
diff --git a/src/urweb.grm b/src/urweb.grm
new file mode 100644
index 0000000..afebff0
--- /dev/null
+++ b/src/urweb.grm
@@ -0,0 +1,2394 @@
+(* Copyright (c) 2008-2016, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Grammar for Ur/Web programs *)
+
+open Source
+
+val s = ErrorMsg.spanOf
+val dummy = ErrorMsg.dummySpan
+
+fun capitalize "" = ""
+  | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
+fun makeAttr s =
+    case s of
+        "type" => "Typ"
+      | "name" => "Nam"
+      | _ => capitalize (String.translate (fn ch => if ch = #"-" then "_" else str ch) s)
+
+fun entable t =
+    case #1 t of
+        TRecord c => c
+      | _ => t
+
+datatype select_item =
+         Field of con * con
+       | Exp of con option * exp
+       | Fields of con * con
+       | StarFields of con
+
+datatype select =
+         Star
+       | Items of select_item list
+
+datatype group_item =
+         GField of con * con
+       | GFields of con * con
+
+fun eqTnames ((c1, _), (c2, _)) =
+    case (c1, c2) of
+        (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
+      | (CName x1, CName x2) => x1 = x2
+      | _ => false
+
+fun nameString (c, _) =
+    case c of
+        CName s => s
+      | CVar (_, x) => x
+      | _ => "?"
+
+datatype tableMode =
+         Unknown
+       | Everything
+       | Selective of con
+
+fun amend_select loc (si, (count, tabs, exps)) =
+    case si of
+        Field (tx, fx) =>
+        let
+            val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)
+
+            val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                      if eqTnames (tx, tx') then
+                                                          case c' of
+                                                              Everything =>
+                                                              (ErrorMsg.errorAt loc
+                                                                                "Mixing specific-field and '*' selection of fields from same table";
+                                                               ((tx', c'), found))
+                                                            | Unknown =>
+                                                              ((tx', Selective c), true)
+                                                            | Selective c' =>
+                                                              ((tx', Selective (CConcat (c, c'), loc)), true)
+                                                      else
+                                                          ((tx', c'), found))
+                                                  false tabs
+        in
+            if found then
+                ()
+            else
+                ErrorMsg.errorAt loc ("Select of field " ^ nameString fx ^ " from unbound table " ^ nameString tx);
+            
+            (count, tabs, exps)
+        end
+      | Fields (tx, fs) =>
+        let
+            val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                      if eqTnames (tx, tx') then
+                                                          case c' of
+                                                              Everything =>
+                                                              (ErrorMsg.errorAt loc
+                                                                                "Mixing specific-field and '*' selection of fields from same table";
+                                                               ((tx', c'), found))
+                                                            | Selective c' =>
+                                                              ((tx', Selective (CConcat (fs, c'), loc)), true)
+                                                            | Unknown =>
+                                                              ((tx', Selective fs), true)
+                                                      else
+                                                          ((tx', c'), found))
+                                                  false tabs
+        in
+            if found then
+                ()
+            else
+                ErrorMsg.errorAt loc "Select of field from unbound table";
+            
+            (count, tabs, exps)
+        end
+      | StarFields tx =>
+        if List.exists (fn (tx', c') => eqTnames (tx, tx') andalso case c' of
+                                                                       Unknown => false
+                                                                     | _ => true) tabs then
+            (ErrorMsg.errorAt loc "Selection with '*' from table already mentioned in same SELECT clause";
+             (count, tabs, exps))
+        else if List.all (fn (tx', c') => not (eqTnames (tx, tx'))) tabs then
+            (ErrorMsg.errorAt loc "Select of all fields from unbound table";
+             (count, tabs, exps))
+        else
+            (count, map (fn (tx', c') => (tx', if eqTnames (tx, tx') then Everything else c')) tabs, exps)
+      | Exp (SOME c, e) => (count, tabs, (c, e) :: exps)
+      | Exp (NONE, e) => (count+1, tabs, ((CName (Int.toString count), loc), e) :: exps)
+
+fun amend_group loc (gi, tabs) =
+    let
+        val (tx, c) = case gi of
+                          GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
+                        | GFields (tx, fxs) => (tx, fxs)
+
+        val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                  if eqTnames (tx, tx') then
+                                                      ((tx', (CConcat (c, c'), loc)), true)
+                                                  else
+                                                      ((tx', c'), found))
+                                              false tabs
+    in
+        if found then
+            ()
+        else
+            ErrorMsg.errorAt loc "Select of field from unbound table";
+
+        tabs
+    end
+
+fun sql_inject (v, loc) =
+    (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc)
+
+fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_binary", Infer), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+    in
+        (EApp (e, sqlexp2), loc)
+    end
+
+fun sql_unary (oper, sqlexp, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_unary", Infer), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+    in
+        (EApp (e, sqlexp), loc)
+    end
+
+fun sql_relop (oper, all, sqlexp1, sqlexp2, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_relop", Infer), loc)
+        val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+        val e = (EApp (e, (EVar (["Basis"], if all then "True" else "False", Infer), loc)), loc)
+        val e = (EApp (e, sqlexp1), loc)
+    in
+        (EApp (e, sqlexp2), loc)
+    end
+
+fun sql_nfunc (oper, loc) =
+    let
+        val e = (EVar (["Basis"], "sql_nfunc", Infer), loc)
+    in
+        (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
+    end
+
+fun native_unop (oper, e1, loc) =
+    let
+        val e = (EVar (["Basis"], oper, Infer), loc)
+    in
+        (EApp (e, e1), loc)
+    end
+
+fun native_op (oper, e1, e2, loc) =
+    let
+        val e = (EVar (["Basis"], oper, Infer), loc)
+        val e = (EApp (e, e1), loc)
+    in
+        (EApp (e, e2), loc)
+    end
+
+fun top_binop (oper, e1, e2, loc) =
+    let
+        val e = (EVar (["Top"], oper, Infer), loc)
+        val e = (EApp (e, e1), loc)
+    in
+        (EApp (e, e2), loc)
+    end
+
+val inDml = ref false
+
+fun tagIn bt =
+    case bt of
+        "table" => "tabl"
+      | "url" => "url_"
+      | "datetime-local" => "datetime_local"
+      | "cdatetime-local" => "cdatetime_local"
+      | _ => bt
+
+datatype prop_kind = Delete | Update
+
+datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * string * exp
+
+fun patType loc (p : pat) =
+    case #1 p of
+        PAnnot (_, t) => t
+      | _ => (CWild (KType, loc), loc)
+
+fun tnamesOf (e, _) =
+    case e of
+        EApp (e1, e2) => tnamesOf e1 @ tnamesOf e2
+      | ECApp (e, c as (CName _, _)) =>
+        let
+            fun isFt (e, _) =
+                case e of
+                    EVar (["Basis"], "sql_from_table", _) => true
+                  | EVar ([], "sql_from_table", _) => true
+                  | ECApp (e, _) => isFt e
+                  | EApp (e, _) => isFt e
+                  | EDisjointApp e => isFt e
+                  | _ => false
+        in
+            (if isFt e then [c] else []) @ tnamesOf e
+        end
+      | ECApp (e, _) => tnamesOf e
+      | EDisjointApp e => tnamesOf e
+      | _ => []
+
+fun classOut (s, pos) =
+    let
+        val s = case s of
+                    "table" => "tabl"
+                  | _ => s
+    in
+        (EVar ([], String.translate (fn #"-" => "_" | ch => str ch) s, Infer), pos)
+    end
+
+fun parseClass s pos =
+    case String.tokens Char.isSpace s of
+        [] => (EVar (["Basis"], "null", Infer), pos)
+      | class :: classes =>
+        foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "classes", Infer), pos), e), pos), classOut (s, pos)), pos))
+                (classOut (class, pos)) classes
+
+fun parseValue s pos =
+    if String.isPrefix "url(" s andalso String.isSuffix ")" s then
+        let
+            val s = String.substring (s, 4, size s - 5)
+
+            val s = if size s >= 2
+                       andalso ((String.isPrefix "\"" s andalso String.isSuffix "\"" s)
+                                orelse (String.isPrefix "'" s andalso String.isSuffix "'" s)) then
+                        String.substring (s, 1, size s - 2)
+                    else
+                        s
+        in
+            (EApp ((EVar (["Basis"], "css_url", Infer), pos),
+                   (EApp ((EVar (["Basis"], "bless", Infer), pos),
+                          (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)), pos)
+        end
+    else
+        (EApp ((EVar (["Basis"], "atom", Infer), pos),
+               (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)
+
+fun parseProperty s pos =
+    let
+        val (befor, after) = Substring.splitl (fn ch => ch <> #":") (Substring.full s)
+    in
+        if Substring.isEmpty after then
+            (ErrorMsg.errorAt pos ("Invalid CSS property syntax: " ^ s);
+             (EPrim (Prim.String (Prim.Normal, "")), pos))
+        else
+            foldl (fn (value, e) => (EApp ((EApp ((EVar (["Basis"], "value", Infer), pos), e), pos), parseValue value pos), pos))
+                (EApp ((EVar (["Basis"], "property", Infer), pos),
+                       (EPrim (Prim.String (Prim.Normal, Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos)
+                (String.tokens Char.isSpace (Substring.string (Substring.slice (after, 1, NONE))))
+    end
+
+fun parseStyle s pos =
+    case String.tokens (fn ch => ch = #";") s of
+        [] => (EVar (["Basis"], "noStyle", Infer), pos)
+      | props =>
+        foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "oneProperty", Infer), pos), e), pos), parseProperty s pos), pos))
+                (EVar (["Basis"], "noStyle", Infer), pos) props
+
+fun applyWindow loc e window =
+    let
+        val (pb, ob) = getOpt (window, ((EVar (["Basis"], "sql_no_partition", Infer), dummy),
+                                        (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), dummy),
+                                                (CWild (KRecord (KType, dummy), dummy), dummy)),
+                                         dummy)))
+        val e' = (EVar (["Basis"], "sql_window_function", Infer), loc)
+        val e' = (EApp (e', e), loc)
+        val e' = (EApp (e', pb), loc)
+    in
+        (EApp (e', ob), loc)
+    end
+
+fun patternOut (e : exp) =
+    case #1 e of
+        EWild => (PVar "_", #2 e)
+      | EVar ([], x, Infer) =>
+        if Char.isUpper (String.sub (x, 0)) then
+            (PCon ([], x, NONE), #2 e)
+        else
+            (PVar x, #2 e)
+      | EVar (xs, x, Infer) =>
+        if Char.isUpper (String.sub (x, 0)) then
+            (PCon (xs, x, NONE), #2 e)
+        else
+            (ErrorMsg.errorAt (#2 e) "Badly capitalized constructor name in pattern";
+             (PVar "_", #2 e))
+      | EPrim p => (PPrim p, #2 e)
+      | EApp ((EVar (xs, x, Infer), _), e') =>
+        (PCon (xs, x, SOME (patternOut e')), #2 e)
+      | ERecord (xes, flex) =>
+        (PRecord (map (fn (x, e') =>
+                          let
+                              val x =
+                                  case #1 x of
+                                      CName x => x
+                                    | _ => (ErrorMsg.errorAt (#2 e) "Field name not constant in pattern";
+                                            "")
+                          in
+                              (x, patternOut e')
+                          end) xes, flex), #2 e)
+      | EAnnot (e', t) =>
+        (PAnnot (patternOut e', t), #2 e)
+      | _ => (ErrorMsg.errorAt (#2 e) "This is an expression but not a pattern.";
+              (PVar "_", #2 e))
+
+%%
+%header (functor UrwebLrValsFn(structure Token : TOKEN))
+
+%term 
+   EOF
+ | STRING of string | INT of Int64.int | FLOAT of Real64.real | CHAR of char
+ | SYMBOL of string | CSYMBOL of string
+ | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
+ | EQ | COMMA | COLON | DCOLON | DCOLONWILD | TCOLON | TCOLONWILD | DOT | HASH | UNDER | UNDERUNDER | BAR
+ | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT
+ | CON | LTYPE | VAL | REC | AND | FUN | MAP | UNIT | KUNIT | CLASS | FFI
+ | DATATYPE | OF
+ | TYPE | NAME
+ | ARROW | LARROW | DARROW | STAR | SEMI | KARROW | DKARROW | BANG
+ | FN | PLUSPLUS | MINUSMINUS | MINUSMINUSMINUS | DOLLAR | TWIDDLE | CARET
+ | LET | IN
+ | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | SQL | SELECT1
+ | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | VIEW
+ | COOKIE | STYLE | TASK | POLICY
+ | CASE | IF | THEN | ELSE | ANDALSO | ORELSE
+
+ | XML_BEGIN of string | XML_END | XML_BEGIN_END of string
+ | NOTAGS of string 
+ | BEGIN_TAG of string | END_TAG of string
+
+ | SELECT | DISTINCT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
+ | UNION | INTERSECT | EXCEPT
+ | LIMIT | OFFSET | ALL
+ | TRUE | FALSE | CAND | OR | NOT
+ | COUNT | AVG | SUM | MIN | MAX | RANK | PARTITION | OVER
+ | ASC | DESC | RANDOM
+ | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS | COALESCE | LIKE
+ | CURRENT_TIMESTAMP
+ | NE | LT | LE | GT | GE
+ | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
+ | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
+ | CIF | CTHEN | CELSE
+ | FWDAPP | REVAPP | COMPOSE | ANDTHEN
+ | BACKTICK_PATH of string
+
+%nonterm
+   file of decl list
+ | decls of decl list
+ | decl of decl list
+ | vali of string * con option * exp
+ | valis of (string * con option * exp) list
+ | copt of con option
+
+ | dargs of string list
+ | barOpt of unit
+ | dcons of (string * con option) list
+ | dtype of string * string list * (string * con option) list
+ | dtypes of (string * string list * (string * con option) list) list
+ | dcon of string * con option
+
+ | pkopt of exp
+ | pk of exp
+ | commaOpt of unit
+
+ | cst of exp
+ | csts of exp
+ | cstopt of exp
+
+ | ckl of (string * kind option) list
+
+ | pmode of prop_kind * exp
+ | pkind of prop_kind
+ | prule of exp
+ | pmodes of (prop_kind * exp) list
+
+ | sgn of sgn
+ | sgntm of sgn
+ | sgi of sgn_item
+ | sgis of sgn_item list
+
+ | str of str
+
+ | kind of kind
+ | ktuple of kind list
+ | kcolon of explicitness
+ | kopt of kind option
+
+ | path of string list * string
+ | cpath of string list * string
+ | spath of str
+ | mpath of string list
+
+ | cexp of con
+ | cexpO of con option
+ | capps of con
+ | cterm of con
+ | ctuple of con list
+ | ctuplev of con list
+ | ident of con
+ | idents of con list
+ | rcon of (con * con) list
+ | rconn of (con * con) list
+ | rcone of (con * con) list
+ | cargs of con * kind -> con * kind
+ | cargl of con * kind -> con * kind
+ | cargl2 of con * kind -> con * kind
+ | carg of con * kind -> con * kind
+ | cargp of con * kind -> con * kind
+
+ | eexp of exp
+ | eapps of exp
+ | eterm of exp
+ | etuple of exp list
+ | rexp of (con * exp) list * bool
+ | rpath of con
+ | xml of exp
+ | xmlOne of exp
+ | xmlOpt of exp
+ | tag of (string * exp) * exp option * exp option * exp option * exp
+ | tagHead of string * exp
+ | bind of pat * con option * exp
+ | edecl of edecl
+ | edecls of edecl list
+
+ | earg of exp * con -> exp * con
+ | eargp of exp * con -> exp * con
+ | earga of exp * con -> exp * con
+ | eargs of exp * con -> exp * con
+ | eargl of exp * con -> exp * con
+ | eargl2 of bool * (exp * con -> exp * con)
+
+ | branch of pat * exp
+ | branchs of (pat * exp) list
+ | pat of pat
+ | patS of pat
+ | pterm of pat
+ | rpat of (string * pat) list * bool
+ | ptuple of pat list
+
+ | attrs of exp option * exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list
+ | attr of attr
+ | attrv of exp
+
+ | query of exp
+ | query1 of exp
+ | dopt of exp
+ | tables of con list * exp
+ | fitem of con list * exp
+ | tname of con
+ | tnameW of con * con
+ | tnames of (con * con) * (con * con) list
+ | tnames' of (con * con) * (con * con) list
+ | table of con * exp
+ | table' of con * exp
+ | tident of con
+ | fident of con
+ | seli of select_item
+ | selis of select_item list
+ | select of select
+ | sqlexp of exp
+ | window of (exp * exp) option
+ | pbopt of exp
+ | wopt of exp
+ | groupi of group_item
+ | groupis of group_item list
+ | gopt of group_item list option
+ | hopt of exp
+ | obopt of exp
+ | obitem of exp * exp
+ | obexps of exp
+ | popt of unit
+ | diropt of exp
+ | lopt of exp
+ | ofopt of exp
+ | sqlint of exp
+ | sqlagg of string
+ | fname of exp
+
+ | texp of exp
+ | fields of con list
+ | sqlexps of exp list
+ | fsets of (con * exp) list
+ | enterDml of unit
+ | leaveDml of unit
+
+ | ffi_mode of ffi_mode
+ | ffi_modes of ffi_mode list
+
+
+%verbose                                (* print summary of errors *)
+%pos int                                (* positions *)
+%start file
+%pure
+%eop EOF
+%noshift EOF
+
+%name Urweb
+
+%right KARROW
+%nonassoc DKARROW
+%right SEMI
+%nonassoc LARROW
+%nonassoc IF THEN ELSE
+%nonassoc DARROW
+%left ANDALSO
+%left ORELSE
+%nonassoc COLON
+%nonassoc DCOLON TCOLON DCOLONWILD TCOLONWILD
+%left UNION INTERSECT EXCEPT ALL
+%right COMMA
+%right JOIN INNER CROSS OUTER LEFT RIGHT FULL
+%right OR
+%right CAND
+%nonassoc EQ NE LT LE GT GE IS LIKE
+%right ARROW
+
+%left REVAPP
+%right FWDAPP
+%left BACKTICK_PATH
+%right COMPOSE ANDTHEN
+
+%right CARET PLUSPLUS
+%left MINUSMINUS MINUSMINUSMINUS
+%left PLUS MINUS
+%left STAR DIVIDE MOD
+%left NOT
+%nonassoc TWIDDLE
+%nonassoc DOLLAR
+%left DOT
+%nonassoc LBRACE RBRACE
+
+%%
+
+file   : decls                          (decls)
+       | SIG sgis                       ([(DSgn ("?", (SgnConst sgis, s (SIGleft, sgisright))),
+                                           s (SIGleft, sgisright))])
+
+decls  :                                ([])
+       | decl decls                     (decl @ decls)
+
+decl   : CON SYMBOL cargl2 kopt EQ cexp (let
+                                             val loc = s (CONleft, cexpright)
+
+                                             val k = Option.getOpt (kopt, (KWild, loc))
+                                             val (c, k) = cargl2 (cexp, k)
+                                         in
+                                             [(DCon (SYMBOL, SOME k, c), loc)]
+                                         end)
+       | LTYPE SYMBOL cargl2 EQ cexp    (let
+                                             val loc = s (LTYPEleft, cexpright)
+
+                                             val k = (KWild, loc)
+                                             val (c, k) = cargl2 (cexp, k)
+                                         in
+                                             [(DCon (SYMBOL, SOME k, c), loc)]
+                                         end)
+       | DATATYPE dtypes                ([(DDatatype dtypes, s (DATATYPEleft, dtypesright))])
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => [(DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))]
+                   | _ => raise Fail "Arguments specified for imported datatype")
+       | VAL pat eargl2 copt EQ eexp    (let
+                                            fun justVar (p : pat) =
+                                                case #1 p of
+                                                    PVar x => SOME x
+                                                  | PAnnot (p', _) => justVar p'
+                                                  | _ => NONE
+
+                                            val loc = s (VALleft, eexpright)
+                                        in
+                                            case justVar pat of
+                                                SOME x =>
+                                                let
+                                                    val t = Option.getOpt (copt, (CWild (KType, loc), loc))
+                                                    val (e, t) = #2 eargl2 (eexp, t)
+                                                    val pat =
+                                                        case #1 t of
+                                                            CWild _ => pat
+                                                          | _ => (PAnnot (pat, t), loc)
+                                                in
+                                                    [(DVal (pat, e), loc)]
+                                                end
+                                              | NONE =>
+                                                let
+                                                    val pat =
+                                                        case copt of
+                                                            SOME t => (PAnnot (pat, t), loc)
+                                                          | _ => pat
+                                                in
+                                                    (if #1 eargl2 then
+                                                         ErrorMsg.errorAt loc "Additional arguments not allowed after pattern"
+                                                     else
+                                                         ());
+                                                    [(DVal (pat, eexp), loc)]
+                                                end
+                                        end)
+       | VAL REC valis                  ([(DValRec valis, s (VALleft, valisright))])
+       | FUN valis                      ([(DValRec valis, s (FUNleft, valisright))])
+
+       | SIGNATURE CSYMBOL EQ sgn       ([(DSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright))])
+       | STRUCTURE CSYMBOL EQ str       ([(DStr (CSYMBOL, NONE, NONE, str, false), s (STRUCTUREleft, strright))])
+       | STRUCTURE CSYMBOL COLON sgn EQ str ([(DStr (CSYMBOL, SOME sgn, NONE, str, false), s (STRUCTUREleft, strright))])
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN EQ str
+                                        ([(DStr (CSYMBOL1, NONE, NONE,
+                                                 (StrFun (CSYMBOL2, sgn1, NONE, str), s (FUNCTORleft, strright)), false),
+                                           s (FUNCTORleft, strright))])
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn EQ str
+                                        ([(DStr (CSYMBOL1, NONE, NONE,
+                                                 (StrFun (CSYMBOL2, sgn1, SOME sgn2, str), s (FUNCTORleft, strright)), false),
+                                           s (FUNCTORleft, strright))])
+       | OPEN mpath                     (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [1]"
+                                           | m :: ms => [(DOpen (m, ms), s (OPENleft, mpathright))])
+       | OPEN mpath LPAREN str RPAREN   (let
+                                             val loc = s (OPENleft, RPARENright)
+
+                                             val m = case mpath of
+                                                         [] => raise Fail "Impossible mpath parse [4]"
+                                                       | m :: ms =>
+                                                         foldl (fn (m, str) => (StrProj (str, m), loc))
+                                                         (StrVar m, loc) ms
+                                         in
+                                             [(DStr ("anon", NONE, NONE, (StrApp (m, str), loc), false), loc),
+                                              (DOpen ("anon", []), loc)]
+                                         end)
+       | OPEN CONSTRAINTS mpath         (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [3]"
+                                           | m :: ms => [(DOpenConstraints (m, ms), s (OPENleft, mpathright))])
+       | CONSTRAINT cterm TWIDDLE cterm ([(DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))])
+       | EXPORT spath                   ([(DExport spath, s (EXPORTleft, spathright))])
+       | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt([(DTable (SYMBOL, entable cterm, pkopt, cstopt),
+                                                 s (TABLEleft, cstoptright))])
+       | SEQUENCE SYMBOL                ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
+       | VIEW SYMBOL EQ query           ([(DView (SYMBOL, query),
+                                           s (VIEWleft, queryright))])
+       | VIEW SYMBOL EQ LBRACE eexp RBRACE ([(DView (SYMBOL, eexp),
+                                           s (VIEWleft, RBRACEright))])
+       | COOKIE SYMBOL COLON cexp       ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))])
+       | STYLE SYMBOL                   ([(DStyle SYMBOL, s (STYLEleft, SYMBOLright))])
+       | TASK eapps EQ eexp             ([(DTask (eapps, eexp), s (TASKleft, eexpright))])
+       | POLICY eexp                    ([(DPolicy eexp, s (POLICYleft, eexpright))])
+       | FFI SYMBOL ffi_modes COLON cexp([(DFfi (SYMBOL, ffi_modes, cexp), s (FFIleft, cexpright))])
+
+dtype  : SYMBOL dargs EQ barOpt dcons   (SYMBOL, dargs, dcons)
+
+dtypes : dtype                          ([dtype])
+       | dtype AND dtypes               (dtype :: dtypes)
+
+kopt   :                                (NONE)
+       | DCOLON kind                    (SOME kind)
+       | DCOLONWILD                     (SOME (KWild, s (DCOLONWILDleft, DCOLONWILDright)))
+
+dargs  :                                ([])
+       | SYMBOL dargs                   (SYMBOL :: dargs)
+
+barOpt :                                ()
+       | BAR                            ()
+
+dcons  : dcon                           ([dcon])
+       | dcon BAR dcons                 (dcon :: dcons)
+
+dcon   : CSYMBOL                        (CSYMBOL, NONE)
+       | CSYMBOL OF cexp                (CSYMBOL, SOME cexp)
+
+vali   : SYMBOL eargl2 copt EQ eexp     (let
+                                             val loc = s (SYMBOLleft, eexpright)
+                                             val t = Option.getOpt (copt, (CWild (KType, loc), loc))
+
+                                             val (e, t) = #2 eargl2 (eexp, t)
+                                         in
+                                             (SYMBOL, SOME t, e)
+                                         end)
+
+copt   :                                (NONE)
+       | COLON cexp                     (SOME cexp)
+
+cstopt :                                (EVar (["Basis"], "no_constraint", Infer), dummy)
+       | csts                           (csts)
+
+csts   : CCONSTRAINT tname cst          (let
+                                             val loc = s (CCONSTRAINTleft, cstright)
+                                                       
+                                             val e = (EVar (["Basis"], "one_constraint", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             (EApp (e, cst), loc)
+                                         end)
+       | csts COMMA csts                (let
+                                             val loc = s (csts1left, csts2right)
+
+                                             val e = (EVar (["Basis"], "join_constraints", Infer), loc)
+                                             val e = (EApp (e, csts1), loc)
+                                         in
+                                             (EApp (e, csts2), loc)
+                                         end)
+       | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
+
+cst    : UNIQUE tnames                  (let
+                                             val loc = s (UNIQUEleft, tnamesright)
+                                                       
+                                             val e = (EVar (["Basis"], "unique", Infer), loc)
+                                             val e = (ECApp (e, #1 (#1 tnames)), loc)
+                                             val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
+                                         in
+                                             e
+                                         end)
+
+       | CHECK sqlexp                   (let
+                                             val loc = s (CHECKleft, sqlexpright)
+                                         in
+                                             (EApp ((EVar (["Basis"], "check", Infer), loc),
+                                                    sqlexp), loc)
+                                         end)
+
+       | FOREIGN KEY tnames REFERENCES texp LPAREN tnames' RPAREN pmodes
+                                        (let
+                                             val loc = s (FOREIGNleft, pmodesright)
+
+                                             val mat = ListPair.foldrEq
+                                                       (fn ((nm1, _), (nm2, _), mat) =>
+                                                           let
+                                                               val e = (EVar (["Basis"], "mat_cons", Infer), loc)
+                                                               val e = (ECApp (e, nm1), loc)
+                                                               val e = (ECApp (e, nm2), loc)
+                                                           in
+                                                               (EApp (e, mat), loc)
+                                                           end)
+                                                       (EVar (["Basis"], "mat_nil", Infer), loc)
+                                                       (#1 tnames :: #2 tnames, #1 tnames' :: #2 tnames')
+                                                 handle ListPair.UnequalLengths =>
+                                                        (ErrorMsg.errorAt loc ("Unequal foreign key list lengths ("
+                                                                               ^ Int.toString (1 + length (#2 tnames))
+                                                                               ^ " vs. "
+                                                                               ^ Int.toString (1 + length (#2 tnames'))
+                                                                               ^ ")");
+                                                         (EVar (["Basis"], "mat_nil", Infer), loc))
+
+                                             fun findMode mode =
+                                                 let
+                                                     fun findMode' pmodes =
+                                                         case pmodes of
+                                                             [] => (EVar (["Basis"], "no_action", Infer), loc)
+                                                           | (mode', rule) :: pmodes' =>
+                                                             if mode' = mode then
+                                                                 (if List.exists (fn (mode', _) => mode' = mode)
+                                                                                 pmodes' then
+                                                                      ErrorMsg.errorAt loc "Duplicate propagation rule"
+                                                                  else
+                                                                      ();
+                                                                  rule)
+                                                             else
+                                                                 findMode' pmodes'
+                                                 in
+                                                     findMode' pmodes
+                                                 end
+
+                                             val e = (EVar (["Basis"], "foreign_key", Infer), loc)
+                                             val e = (EApp (e, mat), loc)
+                                             val e = (EApp (e, texp), loc)
+                                         in
+                                             (EApp (e, (ERecord ([((CName "OnDelete", loc),
+                                                                   findMode Delete),
+                                                                  ((CName "OnUpdate", loc),
+                                                                   findMode Update)], false), loc)), loc)
+                                         end)
+
+       | LBRACE eexp RBRACE             (eexp)
+
+tnameW : tname                          (let
+                                             val loc = s (tnameleft, tnameright)
+                                         in
+                                             (tname, (CWild (KType, loc), loc))
+                                         end)
+
+tnames : tnameW                         (tnameW, [])
+       | LPAREN tnames' RPAREN          (tnames')
+
+tnames': tnameW                         (tnameW, [])
+       | tnameW COMMA tnames'           (#1 tnames', tnameW :: #2 tnames')
+
+pmode  : ON pkind prule                 (pkind, prule)
+
+pkind  : DELETE                         (Delete)
+       | UPDATE                         (Update)
+
+prule  : NO ACTION                      (EVar (["Basis"], "no_action", Infer), s (NOleft, ACTIONright))
+       | RESTRICT                       (EVar (["Basis"], "restrict", Infer), s (RESTRICTleft, RESTRICTright))
+       | CASCADE                        (EVar (["Basis"], "cascade", Infer), s (CASCADEleft, CASCADEright))
+       | SET NULL                       (EVar (["Basis"], "set_null", Infer), s (SETleft, NULLright))
+
+pmodes :                                ([])
+       | pmode pmodes                   (pmode :: pmodes)
+
+commaOpt:                               ()
+        | COMMA                         ()
+
+pk     : LBRACE LBRACE eexp RBRACE RBRACE (eexp)
+       | tnames                         (let
+                                             val loc = s (tnamesleft, tnamesright)
+
+                                             val e = (EVar (["Basis"], "primary_key", TypesOnly), loc)
+                                             val e = (ECApp (e, #1 (#1 tnames)), loc)
+                                             val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
+                                             val e = (EDisjointApp e, loc)
+                                             val e = (EDisjointApp e, loc)
+
+                                             val witness = map (fn (c, _) =>
+                                                                   (c, (EWild, loc)))
+                                                           (#1 tnames :: #2 tnames)
+                                             val witness = (ERecord (witness, false), loc)
+                                         in
+                                             (EApp (e, witness), loc)
+                                         end)
+
+pkopt  :                                (EVar (["Basis"], "no_primary_key", Infer), dummy)
+       | PRIMARY KEY pk                 (pk)
+
+valis  : vali                           ([vali])
+       | vali AND valis                 (vali :: valis)
+
+sgn    : sgntm                          (sgntm)
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
+                                        (SgnFun (CSYMBOL, sgn1, sgn2), s (FUNCTORleft, sgn2right))
+
+sgntm  : SIG sgis END                   (SgnConst sgis, s (SIGleft, ENDright))
+       | mpath                          (case mpath of
+                                             [] => raise Fail "Impossible mpath parse [2]"
+                                           | [x] => SgnVar x
+                                           | m :: ms => SgnProj (m,
+                                                                 List.take (ms, length ms - 1),
+                                                                 List.nth (ms, length ms - 1)),
+                                         s (mpathleft, mpathright))
+       | sgntm WHERE CON path EQ cexp   (SgnWhere (sgntm, #1 path, #2 path, cexp), s (sgntmleft, cexpright))
+       | sgntm WHERE LTYPE path EQ cexp (SgnWhere (sgntm, #1 path, #2 path, cexp), s (sgntmleft, cexpright))
+       | LPAREN sgn RPAREN              (sgn)
+
+cexpO  :                                (NONE)
+       | EQ cexp                        (SOME cexp)
+
+sgi    : LTYPE SYMBOL                   ((SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))),
+                                          s (LTYPEleft, SYMBOLright)))
+       | CON SYMBOL cargl2 kopt cexpO   (let
+                                             val loc = s (CONleft, cexpOright)
+
+                                             val k = Option.getOpt (kopt, (KWild, loc))
+                                         in
+                                             case cexpO of
+                                                 NONE => (SgiConAbs (SYMBOL, k), loc)
+                                               | SOME cexp =>
+                                                 let
+                                                     val (c, k) = cargl2 (cexp, k)
+                                                 in
+                                                     (SgiCon (SYMBOL, SOME k, c), loc)
+                                                 end
+                                         end)
+       | LTYPE SYMBOL cargl2 cexpO      (let
+                                             val loc = s (LTYPEleft, cexpOright)
+
+                                             val k = (KWild, loc)
+                                         in
+                                             case cexpO of
+                                                 NONE => (SgiConAbs (SYMBOL, k), loc)
+                                               | SOME cexp =>
+                                                 let
+                                                     val (c, k) = cargl2 (cexp, k)
+                                                 in
+                                                     (SgiCon (SYMBOL, SOME k, c), loc)
+                                                 end
+                                         end)
+       | DATATYPE dtypes                ((SgiDatatype dtypes, s (DATATYPEleft, dtypesright)))
+       | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
+                (case dargs of
+                     [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
+                   | _ => raise Fail "Arguments specified for imported datatype")
+       | VAL SYMBOL COLON cexp          ((SgiVal (SYMBOL, cexp), s (VALleft, cexpright)))
+
+       | STRUCTURE CSYMBOL COLON sgn    ((SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright)))
+       | SIGNATURE CSYMBOL EQ sgn       ((SgiSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright)))
+       | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
+                                        ((SgiStr (CSYMBOL1,
+                                                  (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))),
+                                          s (FUNCTORleft, sgn2right)))
+       | INCLUDE sgn                    ((SgiInclude sgn, s (INCLUDEleft, sgnright)))
+       | CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)))
+       | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt (let
+                                                    val loc = s (TABLEleft, ctermright)
+                                                in
+                                                    (SgiTable (SYMBOL, entable cterm, pkopt, cstopt), loc)
+                                                end)
+       | SEQUENCE SYMBOL                (let
+                                             val loc = s (SEQUENCEleft, SYMBOLright)
+                                             val t = (CVar (["Basis"], "sql_sequence"), loc)
+                                         in
+                                             (SgiVal (SYMBOL, t), loc)
+                                         end)
+       | VIEW SYMBOL COLON cexp         (let
+                                             val loc = s (VIEWleft, cexpright)
+                                             val t = (CVar (["Basis"], "sql_view"), loc)
+                                             val t = (CApp (t, entable cexp), loc)
+                                         in
+                                             (SgiVal (SYMBOL, t), loc)
+                                         end)
+       | CLASS SYMBOL                   (let
+                                             val loc = s (CLASSleft, SYMBOLright)
+                                             val k = (KArrow ((KType, loc), (KType, loc)), loc)
+                                         in
+                                             (SgiClassAbs (SYMBOL, k), loc)
+                                         end)
+       | CLASS SYMBOL DCOLON kind       (let
+                                             val loc = s (CLASSleft, kindright)
+                                         in
+                                             (SgiClassAbs (SYMBOL, kind), loc)
+                                         end)
+       | CLASS SYMBOL EQ cexp           (let
+                                             val loc = s (CLASSleft, cexpright)
+                                         in
+                                             (SgiClass (SYMBOL, (KWild, loc), cexp), loc)
+                                         end)
+       | CLASS SYMBOL DCOLON kind EQ cexp (let
+                                               val loc = s (CLASSleft, cexpright)
+                                           in
+                                               (SgiClass (SYMBOL, kind, cexp), loc)
+                                           end)
+       | CLASS SYMBOL SYMBOL EQ cexp    (let
+                                             val loc = s (CLASSleft, cexpright)
+                                             val k = (KWild, loc)
+                                             val c = (CAbs (SYMBOL2, SOME k, cexp), loc)
+                                         in
+                                             (SgiClass (SYMBOL1, k, c), s (CLASSleft, cexpright))
+                                         end)
+       | CLASS SYMBOL LPAREN SYMBOL DCOLON kind RPAREN EQ cexp    (let
+                                             val loc = s (CLASSleft, cexpright)
+                                             val c = (CAbs (SYMBOL2, SOME kind, cexp), loc)
+                                         in
+                                             (SgiClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))
+                                         end)
+       | COOKIE SYMBOL COLON cexp       (let
+                                             val loc = s (COOKIEleft, cexpright)
+                                             val t = (CApp ((CVar (["Basis"], "http_cookie"), loc),
+                                                            entable cexp), loc)
+                                         in
+                                             (SgiVal (SYMBOL, t), loc)
+                                         end)
+       | STYLE SYMBOL                   (let
+                                             val loc = s (STYLEleft, SYMBOLright)
+                                             val t = (CVar (["Basis"], "css_class"), loc)
+                                         in
+                                             (SgiVal (SYMBOL, t), loc)
+                                         end)
+
+sgis   :                                ([])
+       | sgi sgis                       (sgi :: sgis)
+
+str    : STRUCT decls END               (StrConst decls, s (STRUCTleft, ENDright))
+       | spath                          (spath)
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN DARROW str
+                                        (StrFun (CSYMBOL, sgn, NONE, str), s (FUNCTORleft, strright))
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn DARROW str
+                                        (StrFun (CSYMBOL, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))
+       | spath LPAREN str RPAREN        (StrApp (spath, str), s (spathleft, RPARENright))
+
+spath  : CSYMBOL                        (StrVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | spath DOT CSYMBOL              (StrProj (spath, CSYMBOL), s (spathleft, CSYMBOLright))
+
+kind   : TYPE                           (KType, s (TYPEleft, TYPEright))
+       | NAME                           (KName, s (NAMEleft, NAMEright))
+       | LBRACE kind RBRACE             (KRecord kind, s (LBRACEleft, RBRACEright))
+       | kind ARROW kind                (KArrow (kind1, kind2), s (kind1left, kind2right))
+       | LPAREN kind RPAREN             (#1 kind, s (LPARENleft, RPARENright))
+       | KUNIT                          (KUnit, s (KUNITleft, KUNITright))
+       | UNDERUNDER                     (KWild, s (UNDERUNDERleft, UNDERUNDERright))
+       | LPAREN ktuple RPAREN           (KTuple ktuple, s (LPARENleft, RPARENright))
+       | CSYMBOL                        (KVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | CSYMBOL KARROW kind            (KFun (CSYMBOL, kind), s (CSYMBOLleft, kindright))
+
+ktuple : kind STAR kind                 ([kind1, kind2])
+       | kind STAR ktuple               (kind :: ktuple)
+
+capps  : cterm                          (cterm)
+       | capps cterm                    (CApp (capps, cterm), s (cappsleft, ctermright))
+
+cexp   : capps                          (capps)
+       | cexp ARROW cexp                (TFun (cexp1, cexp2), s (cexp1left, cexp2right))
+       | SYMBOL kcolon kind ARROW cexp  (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright))
+       | CSYMBOL KARROW cexp            (TKFun (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
+
+       | cexp PLUSPLUS cexp             (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
+
+       | FN cargs DARROW cexp           (#1 (cargs (cexp, (KWild, s (FNleft, cexpright)))))
+       | LBRACK cexp TWIDDLE cexp RBRACK DARROW cexp (TDisjoint (cexp1, cexp2, cexp3), s (LBRACKleft, cexp3right))
+       | CSYMBOL DKARROW cexp           (CKAbs (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
+
+       | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright))
+
+       | UNDER DCOLON kind              (CWild kind, s (UNDERleft, UNDERright))
+       | ctuple                         (let
+                                             val loc = s (ctupleleft, ctupleright)
+                                         in
+                                             (TRecord (CRecord (ListUtil.mapi (fn (i, c) =>
+                                                                                  ((CName (Int.toString (i + 1)), loc),
+                                                                                   c)) ctuple),
+                                                       loc), loc)
+                                         end)
+
+kcolon : DCOLON                         (Explicit)
+       | TCOLON                         (Implicit)
+
+cargs  : carg                           (carg)
+       | cargl                          (cargl)
+
+cargl  : cargp cargp                    (cargp1 o cargp2)
+       | cargp cargl                    (cargp o cargl)
+
+cargl2 :                                (fn x => x)
+       | cargp cargl2                   (cargp o cargl2)
+
+carg   : SYMBOL DCOLON kind             (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, kindright)
+                                            in
+                                                ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | UNDER DCOLON kind              (fn (c, k) =>
+                                            let
+                                                val loc = s (UNDERleft, kindright)
+                                            in
+                                                ((CAbs ("_", SOME kind, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | SYMBOL DCOLONWILD              (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, DCOLONWILDright)
+                                                val kind = (KWild, loc)
+                                            in
+                                                ((CAbs (SYMBOL, NONE, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | UNDER DCOLONWILD               (fn (c, k) =>
+                                            let
+                                                val loc = s (UNDERleft, DCOLONWILDright)
+                                                val kind = (KWild, loc)
+                                            in
+                                                ((CAbs ("_", NONE, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | cargp                          (cargp)
+
+cargp  : SYMBOL                         (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, SYMBOLright)
+                                            in
+                                                ((CAbs (SYMBOL, NONE, c), loc),
+                                                 (KArrow ((KWild, loc), k), loc))
+                                            end)
+       | UNDER                          (fn (c, k) =>
+                                            let
+                                                val loc = s (UNDERleft, UNDERright)
+                                            in
+                                                ((CAbs ("_", NONE, c), loc),
+                                                 (KArrow ((KWild, loc), k), loc))
+                                            end)
+       | LPAREN SYMBOL kopt ckl RPAREN (fn (c, k) =>
+                                              let
+                                                  val loc = s (LPARENleft, RPARENright)
+                                                  val ckl = (SYMBOL, kopt) :: ckl
+                                                  val ckl = map (fn (x, ko) => (x, case ko of
+                                                                                       NONE => (KWild, loc)
+                                                                                     | SOME k => k)) ckl
+                                              in
+                                                  case ckl of
+                                                      [(x, k')] => ((CAbs (SYMBOL, SOME k', c), loc),
+                                                                    (KArrow (k', k), loc))
+                                                    | _ =>
+                                                      let
+                                                          val k' = (KTuple (map #2 ckl), loc)
+
+                                                          val c = foldr (fn ((x, k), c) =>
+                                                                            (CAbs (x, SOME k, c), loc)) c ckl
+                                                          val v = (CVar ([], "$x"), loc)
+                                                          val c = ListUtil.foldli (fn (i, _, c) =>
+                                                                                      (CApp (c, (CProj (v, i + 1), loc)),
+                                                                                       loc)) c ckl
+                                                      in
+                                                          ((CAbs ("$x", SOME k', c), loc),
+                                                           (KArrow (k', k), loc))
+                                                      end
+                                              end)
+
+ckl    :                                ([])
+       | COMMA SYMBOL kopt ckl          ((SYMBOL, kopt) :: ckl)
+
+path   : SYMBOL                         ([], SYMBOL)
+       | CSYMBOL DOT path               (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
+
+cpath  : CSYMBOL                        ([], CSYMBOL)
+       | CSYMBOL DOT cpath              (let val (ms, x) = cpath in (CSYMBOL :: ms, x) end)
+
+mpath  : CSYMBOL                        ([CSYMBOL])
+       | CSYMBOL DOT mpath              (CSYMBOL :: mpath)
+
+cterm  : LPAREN cexp RPAREN             (#1 cexp, s (LPARENleft, RPARENright))
+       | LBRACK rcon RBRACK             (CRecord rcon, s (LBRACKleft, RBRACKright))
+       | LBRACK rconn RBRACK            (CRecord rconn, s (LBRACKleft, RBRACKright))
+       | LBRACE rcone RBRACE            (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)),
+					 s (LBRACEleft, RBRACEright))
+       | DOLLAR cterm                   (TRecord cterm, s (DOLLARleft, ctermright))
+       | HASH CSYMBOL                   (CName CSYMBOL, s (HASHleft, CSYMBOLright))
+       | HASH INT                       (CName (Int64.toString INT), s (HASHleft, INTright))
+
+       | path                           (CVar path, s (pathleft, pathright))
+       | path DOT INT                   (CProj ((CVar path, s (pathleft, pathright)), Int64.toInt INT),
+                                         s (pathleft, INTright))
+       | UNDER                          (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright))
+       | MAP                            (CMap, s (MAPleft, MAPright))
+       | UNIT                           (CUnit, s (UNITleft, UNITright))
+       | LPAREN ctuplev RPAREN          (CTuple ctuplev, s (LPARENleft, RPARENright))
+
+ctuplev: cexp COMMA cexp                ([cexp1, cexp2])
+       | cexp COMMA ctuplev             (cexp :: ctuplev)
+
+ctuple : capps STAR capps               ([capps1, capps2])
+       | capps STAR ctuple              (capps :: ctuple)
+
+rcon   :                                ([])
+       | rpath EQ cexp                  ([(rpath, cexp)])
+       | rpath EQ cexp COMMA rcon       ((rpath, cexp) :: rcon)
+
+rconn  : rpath                          ([(rpath, (CUnit, s (rpathleft, rpathright)))])
+       | rpath COMMA rconn              ((rpath, (CUnit, s (rpathleft, rpathright))) :: rconn)
+
+rcone  :                                ([])
+       | rpath COLON cexp               ([(rpath, cexp)])
+       | rpath COLON cexp COMMA rcone   ((rpath, cexp) :: rcone)
+
+ident  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | INT                            (CName (Int64.toString INT), s (INTleft, INTright))
+       | SYMBOL                         (CVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
+
+eapps  : eterm                          (eterm)
+       | eapps eterm                    (EApp (eapps, eterm), s (eappsleft, etermright))
+       | eapps LBRACK cexp RBRACK       (ECApp (eapps, cexp), s (eappsleft, RBRACKright))
+       | eapps BANG                     (EDisjointApp eapps, s (eappsleft, BANGright))
+
+eexp   : eapps                          (case #1 eapps of
+                                             EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String (_, s)), loc)) => parseClass s loc
+                                           | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String (_, s)), loc)) => parseStyle s loc
+                                           | _ => eapps)
+       | FN eargs DARROW eexp           (let
+                                             val loc = s (FNleft, eexpright)
+                                         in
+                                             #1 (eargs (eexp, (CWild (KType, loc), loc)))
+                                         end)
+       | CSYMBOL DKARROW eexp           (EKAbs (CSYMBOL, eexp), s (CSYMBOLleft, eexpright))
+       | eexp COLON cexp                (EAnnot (eexp, cexp), s (eexpleft, cexpright))
+       | eexp MINUSMINUS cexp           (ECut (eexp, cexp), s (eexpleft, cexpright))
+       | eexp MINUSMINUSMINUS cexp      (ECutMulti (eexp, cexp), s (eexpleft, cexpright))
+       | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
+       | IF eexp THEN eexp ELSE eexp    (let
+                                             val loc = s (IFleft, eexp3right)
+                                         in
+                                             (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
+                                                             ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
+                                         end)
+       | bind SEMI eexp                 (let
+                                             val loc = s (bindleft, eexpright)
+                                             val (p, to, e1) = bind
+                                             val e = (EVar (["Basis"], "bind", Infer), loc)
+                                             val e = (EApp (e, e1), loc)
+
+                                             val f = case #1 p of
+                                                         PVar v => (EAbs (v, to, eexp), loc)
+                                                       | _ => (EAbs ("$x", to,
+                                                                     (ECase ((EVar ([], "$x", Infer), loc),
+                                                                             [(p, eexp)]), loc)), loc)
+                                         in
+                                             (EApp (e, f), loc)
+                                         end)
+       | eexp EQ eexp                   (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp NE eexp                   (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | MINUS eterm                    (native_unop ("neg", eterm, s (MINUSleft, etermright)))
+       | eexp PLUS eexp                 (native_op ("plus", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp MINUS eexp                (native_op ("minus", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eapps STAR eexp                (native_op ("times", eapps, eexp, s (eappsleft, eexpright)))
+       | eexp DIVIDE eexp               (native_op ("divide", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp MOD eexp                  (native_op ("mod", eexp1, eexp2, s (eexp1left, eexp2right)))
+
+       | eexp LT eexp                   (native_op ("lt", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp LE eexp                   (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp GT eexp                   (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp GE eexp                   (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
+
+       | eexp FWDAPP eexp               (EApp (eexp1, eexp2), s (eexp1left, eexp2right))
+       | eexp REVAPP eexp               (EApp (eexp2, eexp1), s (eexp1left, eexp2right))
+       | eexp COMPOSE eexp              (top_binop ("compose", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp ANDTHEN eexp              (top_binop ("compose", eexp2, eexp1, s (eexp1left, eexp2right)))
+       | eexp BACKTICK_PATH eexp        (let
+                                                val path = String.tokens (fn ch => ch = #".") BACKTICK_PATH
+                                                val pathModules = List.take (path, (length path -1))
+                                                val pathOp = List.last path
+
+                                                val e = (EVar (pathModules, pathOp, Infer)
+                                                        , s (BACKTICK_PATHleft, BACKTICK_PATHright))
+                                                val e = (EApp (e, eexp1), s (eexp1left, BACKTICK_PATHright))
+                                        in
+                                                (EApp (e, eexp2), s (eexp1left, eexp2right))
+                                        end)
+
+       | eexp ANDALSO eexp              (let
+                                             val loc = s (eexp1left, eexp2right)
+                                         in
+                                             (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc),
+                                                              eexp2),
+                                                             ((PCon (["Basis"], "False", NONE), loc),
+                                                              (EVar (["Basis"], "False", Infer), loc))]), loc)
+                                         end)
+       | eexp ORELSE eexp               (let
+                                             val loc = s (eexp1left, eexp2right)
+                                         in
+                                             (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc),
+                                                              (EVar (["Basis"], "True", Infer), loc)),
+                                                             ((PCon (["Basis"], "False", NONE), loc),
+                                                              eexp2)]), loc)
+                                         end)
+
+       | eexp PLUSPLUS eexp             (EConcat (eexp1, eexp2), s (eexp1left, eexp2right))
+
+       | eexp CARET eexp                (native_op ("strcat", eexp1, eexp2, s (eexp1left, eexp2right)))
+
+       | eapps DCOLON eexp              (let
+                                             val loc = s (eappsleft, eexpright)
+                                         in
+                                             (EApp ((EVar (["Basis"], "Cons", Infer), loc),
+                                                    (ERecord ([((CName "1", loc),
+                                                                eapps),
+                                                               ((CName "2", loc),
+                                                                eexp)], false), loc)), loc)
+                                         end)
+
+bind   : eapps LARROW eapps             (patternOut eapps1, NONE, eapps2)
+       | eapps                          (let
+                                             val loc = s (eappsleft, eappsright)
+                                         in
+                                             ((PVar "_", loc), SOME (TRecord (CRecord [], loc), loc), eapps)
+                                         end)
+
+eargs  : earg                           (earg)
+       | eargl                          (eargl)
+
+eargl  : eargp eargp                    (eargp1 o eargp2)
+       | eargp eargl                    (eargp o eargl)
+
+eargl2 :                                (false, fn x => x)
+       | eargp eargl2                   (true, eargp o #2 eargl2)
+
+earg   : patS                           (fn (e, t) =>
+                                            let
+                                                val loc = s (patSleft, patSright)
+                                                val pt = patType loc patS
+
+                                                val e' = case #1 patS of
+                                                             PVar x => (EAbs (x, NONE, e), loc)
+                                                           | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
+                                                           | _ => (EAbs ("$x", SOME pt,
+                                                                         (ECase ((EVar ([], "$x", DontInfer),
+                                                                                  loc),
+                                                                                 [(patS, e)]), loc)), loc)
+                                            in
+                                                (e', (TFun (pt, t), loc))
+                                            end)
+       | earga                          (earga)
+
+eargp  : pterm                          (fn (e, t) =>
+                                            let
+                                                val loc = s (ptermleft, ptermright)
+                                                val pt = patType loc pterm
+
+                                                val e' = case #1 pterm of
+                                                             PVar x => (EAbs (x, NONE, e), loc)
+                                                           | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
+                                                           | _ => (EAbs ("$x", SOME pt,
+                                                                         (ECase ((EVar ([], "$x", DontInfer),
+                                                                                  loc),
+                                                                                 [(pterm, e)]), loc)), loc)
+                                            in
+                                                (e', (TFun (pt, t), loc))
+                                            end)
+       | earga                          (earga)
+
+earga  : LBRACK SYMBOL RBRACK            (fn (e, t) =>
+                                             let
+                                                 val loc = s (LBRACKleft, RBRACKright)
+                                                 val kind = (KWild, loc)
+                                             in
+                                                 ((ECAbs (Implicit, SYMBOL, kind, e), loc),
+                                                  (TCFun (Implicit, SYMBOL, kind, t), loc))
+                                             end)
+       | LBRACK SYMBOL DCOLONWILD RBRACK (fn (e, t) =>
+                                             let
+                                                 val loc = s (LBRACKleft, RBRACKright)
+                                                 val kind = (KWild, loc)
+                                             in
+                                                 ((ECAbs (Explicit, SYMBOL, kind, e), loc),
+                                                  (TCFun (Explicit, SYMBOL, kind, t), loc))
+                                             end)
+       | LBRACK SYMBOL kcolon kind RBRACK(fn (e, t) =>
+                                             let
+                                                 val loc = s (LBRACKleft, RBRACKright)
+                                             in
+                                                 ((ECAbs (kcolon, SYMBOL, kind, e), loc),
+                                                  (TCFun (kcolon, SYMBOL, kind, t), loc))
+                                             end)
+       | LBRACK SYMBOL TCOLONWILD RBRACK (fn (e, t) =>
+                                             let
+                                                 val loc = s (LBRACKleft, RBRACKright)
+                                                 val kind = (KWild, loc)
+                                             in
+                                                 ((ECAbs (Implicit, SYMBOL, kind, e), loc),
+                                                  (TCFun (Implicit, SYMBOL, kind, t), loc))
+                                             end)
+       | LBRACK cexp TWIDDLE cexp RBRACK(fn (e, t) =>
+                                            let
+                                                val loc = s (LBRACKleft, RBRACKright)
+                                            in
+                                                ((EDisjoint (cexp1, cexp2, e), loc),
+                                                 (TDisjoint (cexp1, cexp2, t), loc))
+                                            end)
+       | LBRACK CSYMBOL RBRACK          (fn (e, t) =>
+                                               let
+                                                   val loc = s (CSYMBOLleft, CSYMBOLright)
+                                               in
+                                                   ((EKAbs (CSYMBOL, e), loc),
+                                                    (TKFun (CSYMBOL, t), loc))
+                                               end)
+
+eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
+       | LPAREN etuple RPAREN           (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                         in
+                                             (ERecord (ListUtil.mapi (fn (i, e) =>
+                                                                         ((CName (Int.toString (i + 1)), loc),
+                                                                          e)) etuple, false), loc)
+                                         end)
+
+       | path                           (EVar (#1 path, #2 path, Infer), s (pathleft, pathright))
+       | cpath                          (EVar (#1 cpath, #2 cpath, Infer), s (cpathleft, cpathright))
+       | AT path                        (EVar (#1 path, #2 path, TypesOnly), s (ATleft, pathright))
+       | AT AT path                     (EVar (#1 path, #2 path, DontInfer), s (AT1left, pathright))
+       | AT cpath                       (EVar (#1 cpath, #2 cpath, TypesOnly), s (ATleft, cpathright))
+       | AT AT cpath                    (EVar (#1 cpath, #2 cpath, DontInfer), s (AT1left, cpathright))
+       | LBRACE rexp RBRACE             (ERecord rexp, s (LBRACEleft, RBRACEright))
+       | LBRACE RBRACE                  (ERecord ([], false), s (LBRACEleft, RBRACEright))
+       | UNIT                           (ERecord ([], false), s (UNITleft, UNITright))
+
+       | INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
+       | STRING                         (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
+       | CHAR                           (EPrim (Prim.Char CHAR), s (CHARleft, CHARright))
+
+       | path DOT idents                (let
+                                             val loc = s (pathleft, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   (EVar (#1 path, #2 path, Infer), s (pathleft, pathright)) idents
+                                         end)
+       | LPAREN eexp RPAREN DOT idents  (let
+                                             val loc = s (LPARENleft, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   eexp idents
+                                         end)
+       | AT path DOT idents             (let
+                                             val loc = s (ATleft, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   (EVar (#1 path, #2 path, TypesOnly), s (pathleft, pathright)) idents
+                                         end)
+       | AT AT path DOT idents          (let
+                                             val loc = s (AT1left, identsright)
+                                         in
+                                             foldl (fn (ident, e) =>
+                                                       (EField (e, ident), loc))
+                                                   (EVar (#1 path, #2 path, DontInfer), s (pathleft, pathright)) idents
+                                         end)
+
+       | XML_BEGIN xml XML_END          (let
+                                             val loc = s (XML_BEGINleft, XML_ENDright)
+                                         in
+                                             if XML_BEGIN = "xml" then
+                                                 ()
+                                             else
+                                                 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
+                                             xml
+                                         end)
+       | XML_BEGIN XML_END              (let
+                                             val loc = s (XML_BEGINleft, XML_ENDright)
+                                         in
+                                             if XML_BEGIN = "xml" then
+                                                 ()
+                                             else
+                                                 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
+                                             (EApp ((EVar (["Basis"], "cdata", Infer), loc),
+                                                    (EPrim (Prim.String (Prim.Html, "")), loc)),
+                                              loc)
+                                         end)
+       | XML_BEGIN_END                  (let
+                                             val loc = s (XML_BEGIN_ENDleft, XML_BEGIN_ENDright)
+                                         in
+                                             if XML_BEGIN_END = "xml" then
+                                                 ()
+                                             else
+                                                 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
+                                             (EApp ((EVar (["Basis"], "cdata", Infer), loc),
+                                                    (EPrim (Prim.String (Prim.Html, "")), loc)),
+                                              loc)
+                                         end)
+
+       | LPAREN query RPAREN            (query)
+       | LPAREN CWHERE sqlexp RPAREN    (sqlexp)
+       | LPAREN SQL sqlexp RPAREN       (sqlexp)
+       | LPAREN FROM tables RPAREN      (#2 tables)
+       | LPAREN SELECT1 query1 RPAREN   (query1)
+
+       | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
+                                        (let
+                                             val loc = s (LPAREN1left, RPAREN3right)
+
+                                             val e = (EVar (["Basis"], "insert", Infer), loc)
+                                             val e = (EApp (e, texp), loc)
+                                         in
+                                             if length fields <> length sqlexps then
+                                                 ErrorMsg.errorAt loc ("Length mismatch in INSERT field specification ("
+                                                                       ^ Int.toString (length fields)
+                                                                       ^ " vs. " ^ Int.toString (length sqlexps) ^ ")")
+                                             else
+                                                 ();
+                                             (EApp (e, (ERecord (ListPair.zip (fields, sqlexps), false), loc)), loc)
+                                         end)
+       | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN
+                                        (let
+                                             val loc = s (LPARENleft, RPARENright)
+
+                                             val e = (EVar (["Basis"], "update", Infer), loc)
+                                             val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc)
+                                             val e = (EApp (e, (ERecord (fsets, false), loc)), loc)
+                                             val e = (EApp (e, texp), loc)
+                                         in
+                                             (EApp (e, sqlexp), loc)
+                                         end)
+       | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN
+                                        (let
+                                             val loc = s (LPARENleft, RPARENright)
+
+                                             val e = (EVar (["Basis"], "delete", Infer), loc)
+                                             val e = (EApp (e, texp), loc)
+                                         in
+                                             (EApp (e, sqlexp), loc)
+                                         end)
+
+       | UNDER                          (EWild, s (UNDERleft, UNDERright))
+
+       | LET edecls IN eexp END         (ELet (edecls, eexp), s (LETleft, ENDright))
+       | LET eexp WHERE edecls END      (ELet (edecls, eexp), s (LETleft, ENDright))
+
+       | LBRACK RBRACK                  (EVar (["Basis"], "Nil", Infer), s (LBRACKleft, RBRACKright))
+
+edecls :                                ([])
+       | edecl edecls                   (edecl :: edecls)
+
+edecl  : VAL pat EQ eexp                ((EDVal (pat, eexp), s (VALleft, eexpright)))
+       | VAL REC valis                  ((EDValRec valis, s (VALleft, valisright)))
+       | FUN valis                      ((EDValRec valis, s (FUNleft, valisright)))
+
+enterDml :                              (inDml := true)
+leaveDml :                              (inDml := false)
+
+texp   : SYMBOL                         (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
+       | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
+
+fields : fident                         ([fident])
+       | fident COMMA fields            (fident :: fields)
+
+sqlexps: sqlexp                         ([sqlexp])
+       | sqlexp COMMA sqlexps           (sqlexp :: sqlexps)
+
+fsets  : fident EQ sqlexp               ([(fident, sqlexp)])
+       | fident EQ sqlexp COMMA fsets   ((fident, sqlexp) :: fsets)
+
+idents : ident                          ([ident])
+       | ident DOT idents               (ident :: idents)
+
+etuple : eexp COMMA eexp                ([eexp1, eexp2])
+       | eexp COMMA etuple              (eexp :: etuple)
+
+branch : pat DARROW eexp                (pat, eexp)
+
+branchs:                                ([])
+       | BAR branch branchs             (branch :: branchs)
+
+patS   : pterm                          (pterm)
+       | pterm DCOLON patS              (let
+                                             val loc = s (ptermleft, patSright)
+                                         in
+                                             (PCon (["Basis"], "Cons", SOME (PRecord ([("1", pterm),
+                                                                                       ("2", patS)], false), loc)),
+                                              loc)
+                                         end)
+       | patS COLON cexp                (PAnnot (patS, cexp), s (patSleft, cexpright))
+
+pat    : patS                           (patS)
+       | cpath pterm                    (PCon (#1 cpath, #2 cpath, SOME pterm), s (cpathleft, ptermright))
+
+pterm  : SYMBOL                         (PVar SYMBOL, s (SYMBOLleft, SYMBOLright))
+       | cpath                          (PCon (#1 cpath, #2 cpath, NONE), s (cpathleft, cpathright))
+       | UNDER                          (PVar "_", s (UNDERleft, UNDERright))
+       | INT                            (PPrim (Prim.Int INT), s (INTleft, INTright))
+       | MINUS INT                      (PPrim (Prim.Int (~INT)), s (MINUSleft, INTright))
+       | STRING                         (PPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
+       | CHAR                           (PPrim (Prim.Char CHAR), s (CHARleft, CHARright))
+       | LPAREN pat RPAREN              (pat)
+       | LBRACE RBRACE                  (PRecord ([], false), s (LBRACEleft, RBRACEright))
+       | UNIT                           (PRecord ([], false), s (UNITleft, UNITright))
+       | LBRACE rpat RBRACE             (PRecord rpat, s (LBRACEleft, RBRACEright))
+       | LPAREN ptuple RPAREN           (PRecord (ListUtil.mapi (fn (i, p) => (Int.toString (i + 1), p)) ptuple,
+                                                  false),
+                                         s (LPARENleft, RPARENright))
+       | LBRACK RBRACK                  (PCon (["Basis"], "Nil", NONE), s (LBRACKleft, RBRACKright))
+
+rpat   : CSYMBOL EQ pat                 ([(CSYMBOL, pat)], false)
+       | INT EQ pat                     ([(Int64.toString INT, pat)], false)
+       | DOTDOTDOT                      ([], true)
+       | CSYMBOL EQ pat COMMA rpat      ((CSYMBOL, pat) :: #1 rpat, #2 rpat)
+       | INT EQ pat COMMA rpat          ((Int64.toString INT, pat) :: #1 rpat, #2 rpat)
+
+ptuple : pat COMMA pat                  ([pat1, pat2])
+       | pat COMMA ptuple               (pat :: ptuple)
+
+rexp   : DOTDOTDOT                      ([], true)
+       | rpath EQ eexp                  ([(rpath, eexp)], false)
+       | rpath EQ eexp COMMA rexp       ((rpath, eexp) :: #1 rexp, #2 rexp)
+
+rpath  : path                           (CVar path, s (pathleft, pathright))
+       | CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+
+xml    : xmlOne xml                     (let
+                                             val pos = s (xmlOneleft, xmlright)
+                                         in
+                                             (EApp ((EApp (
+                                                     (EVar (["Basis"], "join", Infer), pos),
+                                                  xmlOne), pos),
+                                                    xml), pos)
+                                         end)
+       | xmlOne                         (xmlOne)
+
+xmlOpt : xml                            (xml)
+       |                                (EApp ((EVar (["Basis"], "cdata", Infer), dummy),
+                                               (EPrim (Prim.String (Prim.Html, "")), dummy)),
+                                         dummy)
+
+xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)),
+                                               (EPrim (Prim.String (Prim.Html, NOTAGS)), s (NOTAGSleft, NOTAGSright))),
+                                         s (NOTAGSleft, NOTAGSright))
+       | tag DIVIDE GT                  (let
+                                             val pos = s (tagleft, GTright)
+
+                                             val cdata =
+                                                 if #1 (#1 tag) = "submit" orelse #1 (#1 tag) = "dyn" then
+                                                     let
+                                                         val e = (EVar (["Basis"], "cdata", DontInfer), pos)
+                                                         val e = (ECApp (e, (CWild (KWild, pos), pos)), pos)
+                                                     in
+                                                         (ECApp (e, (CRecord [], pos)), pos)
+                                                     end
+                                                 else
+                                                     (EVar (["Basis"], "cdata", Infer), pos)
+
+                                             val cdata = (EApp (cdata,
+                                                                (EPrim (Prim.String (Prim.Html, "")), pos)),
+                                                          pos)
+                                         in
+                                             (EApp (#5 tag, cdata), pos)
+                                         end)
+         
+       | tag GT xmlOpt END_TAG          (let
+                                             fun tagOut s =
+                                                 case s of
+                                                     "tabl" => "table"
+                                                   | _ => s
+
+                                             val pos = s (tagleft, GTright)
+                                             val et = tagIn END_TAG
+                                         in
+                                             if #1 (#1 tag) = et then
+                                                 if et = "form" then
+                                                     let
+                                                         val e = (EVar (["Basis"], "form", Infer), pos)
+                                                         val e = (EApp (e, case #4 tag of
+                                                                               NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                                             | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
+                                                         val e = (EApp (e, case #2 tag of
+                                                                               NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                                             | SOME (EPrim (Prim.String (_, s)), _) => (EApp ((EVar (["Basis"], "Some", Infer), pos), parseClass s pos), pos)
+                                                                             | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
+                                                     in
+                                                         case #3 tag of
+                                                             NONE => ()
+                                                           | SOME _ => ErrorMsg.errorAt pos "<form> does not support 'dynClass' attribute";
+                                                         (EApp (e, xmlOpt), pos)
+                                                     end
+                                                 else if et = "subform" orelse et = "subforms" then
+                                                     (EApp (#2 (#1 tag),
+                                                            xmlOpt), pos)
+                                                 else if et = "entry" then
+                                                     (EApp ((EVar (["Basis"], "entry", Infer), pos),
+                                                            xmlOpt), pos)
+                                                 else
+                                                     (EApp (#5 tag, xmlOpt), pos)
+                                             else
+                                                 (if ErrorMsg.anyErrors () then
+                                                      ()
+                                                  else
+                                                      ErrorMsg.errorAt pos ("Begin tag <"
+                                                                            ^ tagOut (#1 (#1 tag))
+                                                                            ^ "> and end tag </"
+                                                                            ^ tagOut et
+                                                                            ^ "> don't match.");
+                                                  (EWild, pos))
+                                         end)
+       | LBRACE eexp RBRACE             (eexp)
+       | LBRACE LBRACK eexp RBRACK RBRACE (let
+                                             val loc = s (LBRACEleft, RBRACEright)
+                                             val e = (EVar (["Top"], "txt", Infer), loc)
+                                         in
+                                             (EApp (e, eexp), loc)
+                                         end)
+
+tag    : tagHead attrs                  (let
+                                             val pos = s (tagHeadleft, attrsright)
+
+                                             val e = (EVar (["Basis"], "tag", Infer), pos)
+                                             val eo = case #1 attrs of
+                                                          NONE => (EVar (["Basis"], "null", Infer), pos)
+                                                        | SOME (EPrim (Prim.String (_, s)), pos) => parseClass s pos
+                                                        | SOME e => e
+                                             val e = (EApp (e, eo), pos)
+                                             val eo = case #2 attrs of
+                                                          NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                        | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
+                                                                           e), pos)
+                                             val e = (EApp (e, eo), pos)
+                                             val eo = case #3 attrs of
+                                                          NONE => (EVar (["Basis"], "noStyle", Infer), pos)
+                                                        | SOME (EPrim (Prim.String (_, s)), pos) => parseStyle s pos
+                                                        | SOME e => e
+                                             val e = (EApp (e, eo), pos)
+                                             val eo = case #4 attrs of
+                                                          NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                        | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
+                                                                           e), pos)
+                                             val e = (EApp (e, eo), pos)
+
+                                             val atts = case #6 attrs of
+                                                            [] => #7 attrs
+                                                          | data :: datas =>
+                                                            let
+                                                                fun doOne (kind, name, value) =
+                                                                    let
+                                                                        val e = (EVar (["Basis"], "data_attr", Infer), pos)
+                                                                        val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos)
+                                                                        val e = (EApp (e, (EPrim (Prim.String (Prim.Normal, name)), pos)), pos)
+                                                                    in
+                                                                        (EApp (e, value), pos)
+                                                                    end
+
+                                                                val datas' = foldl (fn (nv, acc) =>
+                                                                                       let
+                                                                                           val e = (EVar (["Basis"], "data_attrs", Infer), pos)
+                                                                                           val e = (EApp (e, acc), pos)
+                                                                                       in
+                                                                                           (EApp (e, doOne nv), pos)
+                                                                                       end) (doOne data) datas
+                                                            in
+                                                                ((CName "Data", pos), datas') :: #7 attrs
+                                                            end
+
+                                             val e = (EApp (e, (ERecord (atts, false), pos)), pos)
+                                             val e = (EApp (e, (EApp (#2 tagHead,
+                                                                      (ERecord ([], false), pos)), pos)), pos)
+                                         in
+                                             (tagHead, #1 attrs, #2 attrs, #5 attrs, e)
+                                         end)
+
+tagHead: BEGIN_TAG                      (let
+                                             val bt = tagIn BEGIN_TAG
+                                             val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
+                                         in
+                                             (bt,
+                                              (EVar ([], bt, Infer), pos))
+                                         end)
+       | tagHead LBRACE cexp RBRACE     (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
+                                          
+attrs  :                                (NONE, NONE, NONE, NONE, NONE, [], [])
+       | attr attrs                     (let
+                                             val loc = s (attrleft, attrsright)
+                                         in
+                                             case attr of
+                                                 Class e =>
+                                                 (case #1 attrs of
+                                                      NONE => ()
+                                                    | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
+                                                  (SOME e, #2 attrs, #3 attrs, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
+                                               | DynClass e =>
+                                                 (case #2 attrs of
+                                                      NONE => ()
+                                                    | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
+                                                  (#1 attrs, SOME e, #3 attrs, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
+                                               | Style e =>
+                                                 (case #3 attrs of
+                                                      NONE => ()
+                                                    | SOME _ => ErrorMsg.errorAt loc "Multiple styles specified for tag";
+                                                  (#1 attrs, #2 attrs, SOME e, #4 attrs, #5 attrs, #6 attrs, #7 attrs))
+                                               | DynStyle e =>
+                                                 (case #4 attrs of
+                                                      NONE => ()
+                                                    | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
+                                                  (#1 attrs, #2 attrs, #3 attrs, SOME e, #5 attrs, #6 attrs, #7 attrs))
+                                               | Data xe =>
+                                                 (#1 attrs, #2 attrs, #3 attrs, #4 attrs, #5 attrs, xe :: #6 attrs, #7 attrs)
+                                               | Normal xe =>
+                                                 (#1 attrs, #2 attrs, #3 attrs, #4 attrs, (case #1 (#1 xe) of
+                                                                                               CName "Id" => SOME (#2 xe)
+                                                                                             | _ => #5 attrs), #6 attrs, xe :: #7 attrs)
+                                         end)
+
+attr   : SYMBOL EQ attrv                (case SYMBOL of
+					     "class" => Class attrv
+					   | "dynClass" => DynClass attrv
+                                           | "style" => Style attrv
+					   | "dynStyle" => DynStyle attrv
+					   | _ =>
+                                             if String.isPrefix "data-" SYMBOL then
+                                                 Data ("data", String.extract (SYMBOL, 5, NONE), attrv)
+                                             else if String.isPrefix "aria-" SYMBOL then
+                                                 Data ("aria", String.extract (SYMBOL, 5, NONE), attrv)
+                                             else
+                                                 let
+                                                     val sym = makeAttr SYMBOL
+                                                 in
+                                                     Normal ((CName sym, s (SYMBOLleft, SYMBOLright)),
+                                                             if (sym = "Href" orelse sym = "Src")
+                                                                andalso (case #1 attrv of
+                                                                             EPrim _ => true
+                                                                           | _ => false) then
+                                                                 let
+                                                                     val loc = s (attrvleft, attrvright)
+                                                                 in
+                                                                     (EApp ((EVar (["Basis"], "bless", Infer), loc),
+                                                                            attrv), loc)
+                                                                 end
+                                                             else if sym = "Nam"
+                                                                andalso (case #1 attrv of
+                                                                             EPrim _ => true
+                                                                           | _ => false) then
+                                                                 let
+                                                                     val loc = s (attrvleft, attrvright)
+                                                                 in
+                                                                     (EApp ((EVar (["Basis"], "blessMeta", Infer), loc),
+                                                                            attrv), loc)
+                                                                 end
+                                                             else
+                                                                 attrv)
+                                                 end)
+       | SYMBOL                         (let
+                                             val loc = s (SYMBOLleft, SYMBOLright)
+                                         in
+                                             Normal ((CName (makeAttr SYMBOL), loc),
+                                                     (EVar (["Basis"], "True", Infer), loc))
+                                         end)
+                
+attrv  : INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
+       | STRING                         (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))
+       | LBRACE eexp RBRACE             (eexp)
+
+query  : query1 obopt lopt ofopt        (let
+                                             val loc = s (query1left, query1right)
+
+                                             val re = (ERecord ([((CName "Rows", loc),
+                                                                  query1),
+                                                                 ((CName "OrderBy", loc),
+                                                                  obopt),
+                                                                 ((CName "Limit", loc),
+                                                                  lopt),
+                                                                 ((CName "Offset", loc),
+                                                                  ofopt)], false), loc)
+                                         in
+                                             (EApp ((EVar (["Basis"], "sql_query", Infer), loc), re), loc)
+                                         end)
+
+dopt   :                                (EVar (["Basis"], "False", Infer), dummy)
+       | DISTINCT                       (EVar (["Basis"], "True", Infer),
+                                         s (DISTINCTleft, DISTINCTright))
+
+query1 : SELECT dopt select FROM tables wopt gopt hopt
+                                        (let
+                                             val loc = s (SELECTleft, tablesright)
+
+                                             val (empties, sel, exps) =
+                                                 case select of
+                                                     Star => ([],
+                                                              map (fn nm =>
+                                                                      (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
+                                                                                     loc),
+                                                                                    (CRecord [], loc)],
+                                                                            loc))) (#1 tables),
+                                                              [])
+                                                   | Items sis =>
+                                                     let
+                                                         val tabs = map (fn nm => (nm, Unknown)) (#1 tables)
+                                                         val (_, tabs, exps) = foldl (amend_select loc)
+                                                                                     (1, tabs, []) sis
+                                                         val empties = List.mapPartial (fn (nm, c) =>
+                                                                                           case c of
+                                                                                               Unknown => SOME nm
+                                                                                             | Selective (CRecord [], _) => SOME nm
+                                                                                             | _ => NONE) tabs
+                                                     in
+                                                         (empties,
+                                                          map (fn (nm, c) => (nm,
+                                                                              case c of
+                                                                                  Everything =>
+                                                                                  (CTuple [(CWild (KRecord (KType, loc), loc), loc),
+                                                                                           (CRecord [], loc)], loc)
+                                                                                | _ =>
+                                                                                  let
+                                                                                      val c = case c of
+                                                                                                  Selective c => c
+                                                                                                | _ => (CRecord [], loc)
+                                                                                  in
+                                                                                      (CTuple [c,
+                                                                                               (CWild (KRecord (KType, loc), loc),
+                                                                                                loc)], loc)
+                                                                                  end)) tabs,
+                                                          exps)
+                                                     end
+
+                                             val exps = map (fn (c, e) => (c, (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc))) exps
+
+                                             val sel = (CRecord sel, loc)
+
+                                             val grp = case gopt of
+                                                           NONE => (ECApp ((EVar (["Basis"], "sql_subset_all",
+                                                                                  Infer), loc),
+                                                                           (CWild (KRecord (KRecord (KType, loc), loc),
+                                                                                   loc), loc)), loc)
+                                                         | SOME gis =>
+                                                           let
+                                                               val tabs = map (fn nm =>
+                                                                                  (nm, (CRecord [], loc))) (#1 tables)
+                                                               val tabs = foldl (amend_group loc) tabs gis
+
+                                                               val tabs = map (fn (nm, c) =>
+                                                                                  (nm,
+                                                                                   (CTuple [c,
+                                                                                            (CWild (KRecord (KType, loc),
+                                                                                                    loc),
+                                                                                             loc)], loc))) tabs
+                                                           in
+                                                               (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
+                                                                       (CRecord tabs, loc)), loc)
+                                                           end
+
+                                             val e = (EVar (["Basis"], "sql_query1", Infer), loc)
+                                             val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
+                                                                 loc)), loc)
+                                             val re = (ERecord ([((CName "Distinct", loc),
+                                                                  dopt),
+                                                                 ((CName "From", loc),
+                                                                  #2 tables),
+                                                                 ((CName "Where", loc),
+                                                                  wopt),
+                                                                 ((CName "GroupBy", loc),
+                                                                  grp),
+                                                                 ((CName "Having", loc),
+                                                                  hopt),
+                                                                 ((CName "SelectFields", loc),
+                                                                  (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
+                                                                          sel), loc)),
+                                                                 ((CName "SelectExps", loc),
+                                                                  (ERecord (exps, false), loc))], false), loc)
+
+                                             val e = (EApp (e, re), loc)
+                                         in
+                                             e
+                                         end)
+       | query1 UNION query1            (sql_relop ("union", false, query11, query12, s (query11left, query12right)))
+       | query1 INTERSECT query1        (sql_relop ("intersect", false, query11, query12, s (query11left, query12right)))
+       | query1 EXCEPT query1           (sql_relop ("except", false, query11, query12, s (query11left, query12right)))
+       | query1 UNION ALL query1        (sql_relop ("union", true, query11, query12, s (query11left, query12right)))
+       | query1 INTERSECT ALL query1    (sql_relop ("intersect", true, query11, query12, s (query11left, query12right)))
+       | query1 EXCEPT ALL query1       (sql_relop ("except", true, query11, query12, s (query11left, query12right)))
+       | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
+
+tables : fitem                          (fitem)
+       | fitem COMMA tables             (let
+                                             val loc = s (fitemleft, tablesright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_comma", Infer), loc)
+                                             val e = (EApp (e, #2 fitem), loc)
+                                         in
+                                             (#1 fitem @ #1 tables,
+                                              (EApp (e, #2 tables), loc))
+                                         end)
+
+fitem  : table'                         ([#1 table'], #2 table')
+       | LBRACE LBRACE eexp RBRACE RBRACE (tnamesOf eexp, eexp)
+       | fitem JOIN fitem ON sqlexp     (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem INNER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem CROSS JOIN fitem         (let
+                                             val loc = s (fitem1left, fitem2right)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                             val tru = sql_inject (EVar (["Basis"], "True", Infer), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, tru), loc))
+                                         end)
+       | fitem LEFT JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_left_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem LEFT OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_left_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem RIGHT JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem RIGHT OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem FULL JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | fitem FULL OUTER JOIN fitem ON sqlexp (let
+                                             val loc = s (fitem1left, sqlexpright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
+                                             val e = (EApp (e, #2 fitem1), loc)
+                                             val e = (EApp (e, #2 fitem2), loc)
+                                         in
+                                             (#1 fitem1 @ #1 fitem2,
+                                              (EApp (e, sqlexp), loc))
+                                         end)
+       | LPAREN query RPAREN AS tname   (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             ([tname], (EApp (e, query), loc))
+                                         end)
+       | LPAREN LBRACE LBRACE eexp RBRACE RBRACE RPAREN AS tname   (let
+                                             val loc = s (LPARENleft, RPARENright)
+                                                       
+                                             val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             ([tname], (EApp (e, eexp), loc))
+                                         end)
+       | LPAREN fitem RPAREN            (fitem)
+
+tname  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE cexp RBRACE             (cexp)
+
+table  : SYMBOL                         ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
+                                         (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
+       | SYMBOL AS tname                (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
+       | LBRACE LBRACE eexp RBRACE RBRACE AS tname    (tname, eexp)
+
+table' : table                          (let
+                                             val loc = s (tableleft, tableright)
+                                             val e = (EVar (["Basis"], "sql_from_table", Infer), loc)
+                                             val e = (ECApp (e, #1 table), loc)
+                                         in
+                                             (#1 table, (EApp (e, #2 table), loc))
+                                         end)
+
+tident : SYMBOL                         (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
+       | CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
+
+fident : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | LBRACE cexp RBRACE             (cexp)
+
+seli   : tident DOT fident              (Field (tident, fident))
+       | sqlexp                         (Exp (NONE, sqlexp))
+       | sqlexp AS fident               (Exp (SOME fident, sqlexp))
+       | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp))
+       | tident DOT STAR                (StarFields tident)
+
+selis  : seli                           ([seli])
+       | seli COMMA selis               (seli :: selis)
+
+select : STAR                           (Star)
+       | selis                          (Items selis)
+
+sqlexp : TRUE                           (sql_inject (EVar (["Basis"], "True", Infer),
+                                                     s (TRUEleft, TRUEright)))
+       | FALSE                          (sql_inject (EVar (["Basis"], "False", Infer),
+                                                     s (FALSEleft, FALSEright)))
+
+       | INT                            (sql_inject (EPrim (Prim.Int INT),
+                                                     s (INTleft, INTright)))
+       | FLOAT                          (sql_inject (EPrim (Prim.Float FLOAT),
+                                                     s (FLOATleft, FLOATright)))
+       | STRING                         (sql_inject (EPrim (Prim.String (Prim.Normal, STRING)),
+                                                     s (STRINGleft, STRINGright)))
+       | CURRENT_TIMESTAMP              (sql_nfunc ("current_timestamp",
+                                                    s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))
+
+       | tident DOT fident              (let
+                                             val loc = s (tidentleft, fidentright)
+                                             val e = (EVar (["Basis"], "sql_field", Infer), loc)
+                                             val e = (ECApp (e, tident), loc)
+                                         in
+                                             (ECApp (e, fident), loc)
+                                         end)
+       | CSYMBOL                         (let
+                                             val loc = s (CSYMBOLleft, CSYMBOLright)
+                                          in
+                                              if !inDml then
+                                                  let
+                                                      val e = (EVar (["Basis"], "sql_field", Infer), loc)
+                                                      val e = (ECApp (e, (CName "T", loc)), loc)
+                                                  in
+                                                      (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                                  end
+                                              else
+                                                  let
+                                                      val e = (EVar (["Basis"], "sql_exp", Infer), loc)
+                                                  in
+                                                      (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                                  end
+                                          end)
+
+       | LBRACE eexp RBRACE             (eexp)
+
+       | sqlexp EQ sqlexp               (sql_binary ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp NE sqlexp               (sql_binary ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LT sqlexp               (sql_binary ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp LE sqlexp               (sql_binary ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GT sqlexp               (sql_binary ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp GE sqlexp               (sql_binary ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | sqlexp PLUS sqlexp             (sql_binary ("plus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp MINUS sqlexp            (sql_binary ("minus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp STAR sqlexp             (sql_binary ("times", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp DIVIDE sqlexp           (sql_binary ("div", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp MOD sqlexp              (sql_binary ("mod", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | sqlexp CAND sqlexp             (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+       | sqlexp OR sqlexp               (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | sqlexp LIKE sqlexp             (sql_binary ("like", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
+
+       | NOT sqlexp                     (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
+       | MINUS sqlexp                   (sql_unary ("neg", sqlexp, s (MINUSleft, sqlexpright)))
+
+       | sqlexp IS NULL                 (let
+                                             val loc = s (sqlexpleft, NULLright)
+                                         in
+                                             (EApp ((EVar (["Basis"], "sql_is_null", Infer), loc),
+                                                    sqlexp), loc)
+                                         end)
+
+       | CIF sqlexp CTHEN sqlexp CELSE sqlexp (let
+                                                   val loc = s (CIFleft, sqlexp3right)
+                                                   val e = (EVar (["Basis"], "sql_if_then_else", Infer), loc) 
+                                               in
+                                                   (EApp ((EApp ((EApp (e, sqlexp1), loc), sqlexp2), loc), sqlexp3), loc)
+                                               end)
+
+       | LBRACE LBRACK eexp RBRACK RBRACE  (sql_inject (#1 eexp,
+                                                        s (LBRACEleft, RBRACEright)))
+       | LPAREN sqlexp RPAREN           (sqlexp)
+
+       | NULL                           (sql_inject ((EVar (["Basis"], "None", Infer), 
+                                                      s (NULLleft, NULLright))))
+
+       | COUNT LPAREN STAR RPAREN window(let
+                                             val loc = s (COUNTleft, windowright)
+                                         in
+                                             case window of
+                                                 NONE => (EVar (["Basis"], "sql_count", Infer), loc)
+                                               | SOME _ => applyWindow loc (EVar (["Basis"], "sql_window_count", Infer), loc) window
+                                         end)
+       | COUNT LPAREN sqlexp RPAREN window(let
+                                               val loc = s (COUNTleft, RPARENright)
+                                               val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
+                                           in
+                                               case window of
+                                                   NONE =>
+                                                   let
+                                                       val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
+                                                                      e), loc)
+                                                   in
+                                                       (EApp (e, sqlexp), loc)
+                                                   end
+                                                 | SOME _ =>
+                                                   let
+                                                       val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
+                                                       val e = (EApp ((EVar (["Basis"], "sql_window_aggregate", Infer), loc),
+                                                                      e), loc)
+                                                   in
+                                                       applyWindow loc (EApp (e, sqlexp), loc) window
+                                                   end
+                                           end)
+       | sqlagg LPAREN sqlexp RPAREN window (let
+                                                 val loc = s (sqlaggleft, RPARENright)
+                                                           
+                                                 val e = (EVar (["Basis"], "sql_" ^ sqlagg, Infer), loc)
+                                             in
+                                                 case window of
+                                                     NONE =>
+                                                     let
+                                                         val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
+                                                                        e), loc)
+                                                     in
+                                                         (EApp (e, sqlexp), loc)
+                                                     end
+                                                   | SOME _ =>
+                                                     let
+                                                         val e = (EApp ((EVar (["Basis"], "sql_window_aggregate", Infer), loc),
+                                                                        e), loc)
+                                                     in
+                                                         applyWindow loc (EApp (e, sqlexp), loc) window
+                                                     end
+                                             end)
+       | RANK UNIT window               (let
+                                             val loc = s (RANKleft, windowright)
+                                         in
+                                             applyWindow loc (EVar (["Basis"], "sql_rank", Infer), loc) window
+                                         end)
+       | COALESCE LPAREN sqlexp COMMA sqlexp RPAREN
+                                        (let
+                                             val loc = s (COALESCEright, sqlexp2right)
+                                             val e = (EVar (["Basis"], "sql_coalesce", Infer), loc)
+                                             val e = (EApp (e, sqlexp1), loc)
+                                         in
+                                             (EApp (e, sqlexp2), loc)
+                                         end)
+       | fname LPAREN sqlexp RPAREN     (let
+                                             val loc = s (fnameleft, RPARENright)
+
+                                             val e = (EVar (["Basis"], "sql_ufunc", Infer), loc)
+                                             val e = (EApp (e, fname), loc)
+                                         in
+                                             (EApp (e, sqlexp), loc)
+                                         end)
+       | LPAREN query RPAREN            (let
+                                             val loc = s (LPARENleft, RPARENright)
+
+                                             val e = (EVar (["Basis"], "sql_subquery", Infer), loc)
+                                         in
+                                             (EApp (e, query), loc)
+                                         end)
+
+window :                                (NONE)
+       | OVER LPAREN pbopt obopt RPAREN (SOME (pbopt, obopt))
+
+pbopt  :                                ((EVar (["Basis"], "sql_no_partition", Infer), dummy))
+       | PARTITION BY sqlexp            (let
+                                             val loc = s (PARTITIONleft, sqlexpright)
+
+                                             val e = (EVar (["Basis"], "sql_partition", Infer), loc)
+                                         in
+                                             (EApp (e, sqlexp), loc)
+                                         end)
+
+fname  : SYMBOL                         (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
+       | LBRACE eexp RBRACE             (eexp)
+
+wopt   :                                (sql_inject (EVar (["Basis"], "True", Infer),
+                                                     dummy))
+       | CWHERE sqlexp                  (sqlexp)
+
+groupi : tident DOT fident              (GField (tident, fident))
+       | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (GFields (tident, cexp))
+
+groupis: groupi                         ([groupi])
+       | groupi COMMA groupis           (groupi :: groupis)
+
+gopt   :                                (NONE)
+       | GROUP BY groupis               (SOME groupis)
+
+hopt   :                                (sql_inject (EVar (["Basis"], "True", Infer),
+                                                     dummy))
+       | HAVING sqlexp                  (sqlexp)
+
+obopt  :                                (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), dummy),
+                                                (CWild (KRecord (KType, dummy), dummy), dummy)),
+                                         dummy)
+       | ORDER BY obexps                (obexps)
+       | ORDER BY LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
+
+obitem : sqlexp diropt                  (sqlexp, diropt)
+
+obexps : obitem                         (let
+                                             val loc = s (obitemleft, obitemright)
+
+                                             val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), loc),
+                                                              (CWild (KRecord (KType, loc), loc), loc)),
+                                                       loc)
+                                             val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
+                                                            #1 obitem), loc)
+                                             val e = (EApp (e, #2 obitem), loc)
+                                         in
+                                             (EApp (e, e'), loc)
+                                         end)
+       | obitem COMMA obexps            (let
+                                             val loc = s (obitemleft, obexpsright)
+
+                                             val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
+                                                            #1 obitem), loc)
+                                             val e = (EApp (e, #2 obitem), loc)
+                                         in
+                                             (EApp (e, obexps), loc)
+                                         end)
+       | RANDOM popt                    (EVar (["Basis"], "sql_order_by_random", Infer), s (RANDOMleft, poptright))
+
+popt   :                                ()
+       | LPAREN RPAREN                  ()
+       | UNIT                           ()
+
+diropt :                                (EVar (["Basis"], "sql_asc", Infer), dummy)
+       | ASC                            (EVar (["Basis"], "sql_asc", Infer), s (ASCleft, ASCright))
+       | DESC                           (EVar (["Basis"], "sql_desc", Infer), s (DESCleft, DESCright))
+       | LBRACE eexp RBRACE             (eexp)
+
+lopt   :                                 (EVar (["Basis"], "sql_no_limit", Infer), dummy)
+       | LIMIT ALL                       (EVar (["Basis"], "sql_no_limit", Infer), dummy)
+       | LIMIT sqlint                    (let
+                                              val loc = s (LIMITleft, sqlintright)
+                                          in
+                                              (EApp ((EVar (["Basis"], "sql_limit", Infer), loc), sqlint), loc)
+                                          end)
+
+ofopt  :                                 (EVar (["Basis"], "sql_no_offset", Infer), dummy)
+       | OFFSET sqlint                   (let
+                                              val loc = s (OFFSETleft, sqlintright)
+                                          in
+                                              (EApp ((EVar (["Basis"], "sql_offset", Infer), loc), sqlint), loc)
+                                          end)
+
+sqlint : INT                             (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | LBRACE eexp RBRACE              (eexp)
+
+sqlagg : AVG                             ("avg")
+       | SUM                             ("sum")
+       | MIN                             ("min")
+       | MAX                             ("max")
+
+ffi_mode : SYMBOL                        (case SYMBOL of
+                                              "effectful" => Effectful
+                                            | "benignEffectful" => BenignEffectful
+                                            | "clientOnly" => ClientOnly
+                                            | "serverOnly" => ServerOnly
+                                            | _ => (ErrorMsg.errorAt (s (SYMBOLleft, SYMBOLright)) "Invalid FFI mode"; Effectful))
+         | SYMBOL STRING                 (case SYMBOL of
+                                              "jsFunc" => JsFunc STRING
+                                            | _ => (ErrorMsg.errorAt (s (SYMBOLleft, SYMBOLright)) "Invalid FFI mode"; Effectful))
+
+ffi_modes :                              ([])
+          | ffi_mode ffi_modes           (ffi_mode :: ffi_modes)
diff --git a/src/urweb.lex b/src/urweb.lex
new file mode 100644
index 0000000..368b9f1
--- /dev/null
+++ b/src/urweb.lex
@@ -0,0 +1,579 @@
+(* -*- mode: sml-lex -*- *)
+
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Lexing info for Ur/Web programs *)
+
+type pos = int
+type svalue = Tokens.svalue
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult = (svalue,pos) Tokens.token
+
+val commentOut = ref (fn () => ())
+
+local
+  val commentLevel = ref 0
+  val commentPos = ref 0
+in
+  fun reset () =
+      (commentLevel := 0;
+       commentPos := 0)
+
+  fun enterComment pos =
+      (if !commentLevel = 0 then
+           commentPos := pos
+       else
+           ();
+       commentLevel := !commentLevel + 1)
+
+  fun exitComment () =
+      (ignore (commentLevel := !commentLevel - 1);
+       if !commentLevel = 0 then
+           !commentOut ()
+       else
+           ())
+
+  fun eof () =
+    let
+      val pos = ErrorMsg.lastLineStart ()
+    in
+      if !commentLevel > 0 then
+          ErrorMsg.errorAt' (!commentPos, !commentPos) "Unterminated comment"
+      else
+          ();
+      Tokens.EOF (pos, pos)
+    end
+end
+
+val strEnder = ref #"\""
+val str = ref ([] : char list)
+val strStart = ref 0
+
+local
+    val initSig = ref false
+    val offset = ref 0
+in
+
+fun initialSig () = initSig := true
+
+fun pos yypos = yypos - !offset
+
+fun newline yypos =
+    if !initSig then
+        (initSig := false;
+         offset := yypos + 1)
+    else
+        ErrorMsg.newline (pos yypos)
+
+end
+
+val xmlTag = ref ([] : string list)
+val xmlString = ref true
+val braceLevels = ref ([] : ((unit -> unit) * int) list)
+
+fun pushLevel s = braceLevels := (s, 1) :: (!braceLevels)
+
+fun enterBrace () =
+    case !braceLevels of
+	(s, i) :: rest => braceLevels := (s, i+1) :: rest
+      | _ => ()
+
+fun exitBrace () =
+    case !braceLevels of
+	(s, i) :: rest =>
+	if i = 1 then
+	    (braceLevels := rest;
+	     s ())
+	else
+	    braceLevels := (s, i-1) :: rest
+      | _ => ()
+
+fun initialize () = (reset ();
+                     xmlTag := [];
+		     xmlString := false)
+
+
+structure StringMap = BinaryMapFn(struct
+                                  type ord_key = string
+                                  val compare = String.compare
+                                  end)
+
+val entities = foldl (fn ((key, value), entities) => StringMap.insert (entities, key, value))
+                     StringMap.empty Entities.all
+
+fun unescape loc s =
+    let
+        fun process (s, acc) =
+            let
+                val (befor, after) = Substring.splitl (fn ch => ch <> #"&") s
+            in
+                if Substring.size after = 0 then
+                    Substring.concat (rev (s :: acc))
+                else
+                    let
+                        val after = Substring.slice (after, 1, NONE)
+                        val (befor', after') = Substring.splitl (fn ch => ch <> #";") after
+                    in
+                        if Substring.size after' = 0 then
+                            (ErrorMsg.errorAt' loc "Missing ';' after '&'";
+                             "")
+                        else
+                            let
+                                val pre = befor
+                                val code = befor'
+                                val s = Substring.slice (after', 1, NONE)
+
+                                val special =
+                                    if Substring.size code > 0 andalso Substring.sub (code, 0) = #"#"
+                                       andalso CharVectorSlice.all Char.isDigit (Substring.slice (code, 1, NONE)) then
+                                        let
+                                            val code = Substring.string (Substring.slice (code, 1, NONE))
+                                        in
+                                            Option.map Utf8.encode (Int.fromString code)
+                                        end
+                                    else
+                                        Option.map Utf8.encode (StringMap.find (entities, Substring.string code))
+                            in
+                                case special of
+                                    NONE => (ErrorMsg.errorAt' loc ("Unsupported XML character entity "
+                                                                        ^ Substring.string code);
+                                             "")
+                                  | SOME sp => process (s, Substring.full sp :: pre :: acc)
+                            end
+                    end
+            end
+    in
+        process (Substring.full s, [])
+    end
+
+%%
+%header (functor UrwebLexFn(structure Tokens : Urweb_TOKENS));
+%full
+%s COMMENT STRING CHAR XML XMLTAG;
+
+id = [a-z_][A-Za-z0-9_']*;
+xmlid = [A-Za-z][A-Za-z0-9_-]*;
+cid = [A-Z][A-Za-z0-9_']*;
+ws = [\ \t\012\r];
+intconst = [0-9]+;
+realconst = [0-9]+\.[0-9]*;
+hexconst = 0x[0-9A-F]+;
+notags = ([^<{\n(]|(\([^\*<{\n]))+;
+xcom = ([^\-]|(-[^\-]))+;
+oint = [0-9][0-9][0-9];
+xint = x[0-9a-fA-F][0-9a-fA-F];
+
+%%
+
+<INITIAL,COMMENT,XMLTAG>
+      \n              => (newline yypos;
+                          continue ());
+<XML> \n              => (newline yypos;
+                          Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
+
+<INITIAL> {ws}+       => (lex ());
+
+<INITIAL> "(*"        => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN INITIAL);
+                          enterComment (pos yypos);
+                          continue ());
+<XML> "(*"            => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN XML);
+                          enterComment (pos yypos);
+                          continue ());
+<XMLTAG> "(*"         => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN XMLTAG);
+                          enterComment (pos yypos);
+                          continue ());
+<INITIAL,XML,XMLTAG>
+             "*)"     => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
+			  continue ());
+
+<COMMENT> "(*"        => (enterComment (pos yypos);
+                          continue ());
+<COMMENT> "*)"        => (exitComment ();
+			  continue ());
+
+<XML> "<!--" {xcom} "-->" => (continue ());
+
+<STRING,CHAR> "\\\""  => (str := #"\"" :: !str; continue());
+<STRING,CHAR> "\\'"   => (str := #"'" :: !str; continue());
+<STRING,CHAR> "\\n"   => (str := #"\n" :: !str; continue());
+<STRING,CHAR> "\\r"   => (str := #"\r" :: !str; continue());
+<STRING,CHAR> "\\\\"  => (str := #"\\" :: !str; continue());
+<STRING,CHAR> "\\t"   => (str := #"\t" :: !str; continue());
+<STRING,CHAR> "\n"    => (newline yypos;
+			  str := #"\n" :: !str; continue());
+<STRING,CHAR> "\\" {oint} => (case StringCvt.scanString (Int.scan StringCvt.OCT)
+                                                        (String.extract (yytext, 1, NONE)) of
+                                  NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
+                                | SOME n => str := chr n :: !str;
+                              continue());
+<STRING,CHAR> "\\" {xint} => (case StringCvt.scanString (Int.scan StringCvt.HEX)
+                                                        (String.extract (yytext, 2, NONE)) of
+                                  NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
+                                | SOME n => str := chr n :: !str;
+                              continue());
+
+<INITIAL> "#\""       => (YYBEGIN CHAR; strEnder := #"\""; strStart := pos yypos; str := []; continue());
+
+<CHAR> .              => (let
+                              val ch = String.sub (yytext, 0)
+                          in
+                              if ch = !strEnder then
+                                  let
+                                      val s = String.implode (List.rev (!str))
+                                  in
+			              YYBEGIN INITIAL;
+                                      if size s = 1 then
+			                  Tokens.CHAR (String.sub (s, 0), !strStart, pos yypos + 1)
+                                      else
+                                          (ErrorMsg.errorAt' (yypos, yypos)
+                                                             "Character constant is zero or multiple characters";
+                                           continue ())
+                                  end
+                              else
+                                  (str := ch :: !str;
+                                   continue ())
+                          end);
+
+<INITIAL> "\""        => (YYBEGIN STRING; strEnder := #"\""; strStart := pos yypos; str := []; continue());
+<INITIAL> "'"         => (YYBEGIN STRING; strEnder := #"'"; strStart := pos yypos; str := []; continue());
+
+<STRING> .            => (let
+                              val ch = String.sub (yytext, 0)
+                          in
+                              if ch = !strEnder then
+                                  (if !xmlString then
+			               (xmlString := false; YYBEGIN XMLTAG)
+			           else
+			               YYBEGIN INITIAL;
+			           Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1))
+                              else
+                                  (str := ch :: !str;
+                                   continue ())
+                          end);
+
+<INITIAL> "<" {xmlid} "/>"=>(let
+			      val tag = String.substring (yytext, 1, size yytext - 3)
+			  in
+			      Tokens.XML_BEGIN_END (tag, yypos, yypos + size yytext)
+			  end);
+<INITIAL> "<" {xmlid} ">"=> (let
+			      val tag = String.substring (yytext, 1, size yytext - 2)
+			  in
+			      YYBEGIN XML;
+			      xmlTag := tag :: (!xmlTag);
+			      Tokens.XML_BEGIN (tag, yypos, yypos + size yytext)
+			  end);
+<XML> "</" {xmlid} ">" => (let
+			      val id = String.substring (yytext, 2, size yytext - 3)
+			  in
+			      case !xmlTag of
+			          id' :: rest =>
+			          if id = id' then
+				      (YYBEGIN INITIAL;
+				       xmlTag := rest;
+				       Tokens.XML_END (yypos, yypos + size yytext))
+			          else
+				      Tokens.END_TAG (id, yypos, yypos + size yytext)
+			        | _ =>
+			          Tokens.END_TAG (id, yypos, yypos + size yytext)
+			  end);
+
+<XML> "<" {xmlid}     => (YYBEGIN XMLTAG;
+			  Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE),
+					    yypos, yypos + size yytext));
+
+<XMLTAG> "/"          => (Tokens.DIVIDE (yypos, yypos + size yytext));
+<XMLTAG> ">"          => (YYBEGIN XML;
+			  Tokens.GT (yypos, yypos + size yytext));
+
+<XMLTAG> {ws}+        => (lex ());
+
+<XMLTAG> {xmlid}      => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
+<XMLTAG> "="          => (Tokens.EQ (yypos, yypos + size yytext));
+
+<XMLTAG> {intconst}   => (case Int64.fromString yytext of
+                            SOME x => Tokens.INT (x, yypos, yypos + size yytext)
+                          | NONE   => (ErrorMsg.errorAt' (yypos, yypos)
+                                       ("Expected int, received: " ^ yytext);
+                                       continue ()));
+<XMLTAG> {realconst}  => (case Real.fromString yytext of
+                            SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext)
+                          | NONE   => (ErrorMsg.errorAt' (yypos, yypos)
+                                       ("Expected float, received: " ^ yytext);
+                                       continue ()));
+<XMLTAG> "\""         => (YYBEGIN STRING;
+			  xmlString := true; strEnder := #"\"";
+			  strStart := yypos; str := []; continue ());
+
+<XMLTAG> "{"          => (YYBEGIN INITIAL;
+			  pushLevel (fn () => YYBEGIN XMLTAG);
+			  Tokens.LBRACE (yypos, yypos + 1));
+<XMLTAG> "("          => (YYBEGIN INITIAL;
+			  pushLevel (fn () => YYBEGIN XMLTAG);
+			  Tokens.LPAREN (yypos, yypos + 1));
+
+<XMLTAG> .            => (ErrorMsg.errorAt' (yypos, yypos)
+                          ("illegal XML tag character: \"" ^ yytext ^ "\"");
+                          continue ());
+
+<XML> "{"             => (YYBEGIN INITIAL;
+			  pushLevel (fn () => YYBEGIN XML);
+			  Tokens.LBRACE (yypos, yypos + 1));
+
+<XML> {notags}        => (Tokens.NOTAGS (unescape (yypos, yypos + size yytext) yytext, yypos, yypos + size yytext));
+
+<XML> "("             => (Tokens.NOTAGS ("(", yypos, yypos + size yytext));
+
+<XML> .               => (ErrorMsg.errorAt' (yypos, yypos)
+                          ("illegal XML character: \"" ^ yytext ^ "\"");
+                          continue ());
+
+<INITIAL> "()"        => (Tokens.UNIT (pos yypos, pos yypos + size yytext));
+<INITIAL> "("         => (Tokens.LPAREN (pos yypos, pos yypos + size yytext));
+<INITIAL> ")"         => (Tokens.RPAREN (pos yypos, pos yypos + size yytext));
+<INITIAL> "["         => (Tokens.LBRACK (pos yypos, pos yypos + size yytext));
+<INITIAL> "]"         => (Tokens.RBRACK (pos yypos, pos yypos + size yytext));
+<INITIAL> "{"         => (enterBrace ();
+                          Tokens.LBRACE (pos yypos, pos yypos + size yytext));
+<INITIAL> "}"         => (exitBrace ();
+                          Tokens.RBRACE (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "-->"       => (Tokens.KARROW (pos yypos, pos yypos + size yytext));
+<INITIAL> "->"        => (Tokens.ARROW (pos yypos, pos yypos + size yytext));
+<INITIAL> "==>"       => (Tokens.DKARROW (pos yypos, pos yypos + size yytext));
+<INITIAL> "=>"        => (Tokens.DARROW (pos yypos, pos yypos + size yytext));
+<INITIAL> "++"        => (Tokens.PLUSPLUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "--"        => (Tokens.MINUSMINUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "---"       => (Tokens.MINUSMINUSMINUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "^"         => (Tokens.CARET (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "&&"        => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext));
+<INITIAL> "||"        => (Tokens.ORELSE (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "<<<"       => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext));
+<INITIAL> ">>>"       => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "<|"        => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext));
+<INITIAL> "|>"        => (Tokens.REVAPP (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "`" ({cid} ".")* {id} "`"  => (Tokens.BACKTICK_PATH ( (* strip backticks *)
+                                                              substring (yytext,1,size yytext -2),
+                                                              pos yypos, pos yypos + size yytext));
+
+<INITIAL> "="         => (Tokens.EQ (pos yypos, pos yypos + size yytext));
+<INITIAL> "<>"        => (Tokens.NE (pos yypos, pos yypos + size yytext));
+<INITIAL> "<"         => (Tokens.LT (pos yypos, pos yypos + size yytext));
+<INITIAL> ">"         => (Tokens.GT (pos yypos, pos yypos + size yytext));
+<INITIAL> "<="        => (Tokens.LE (pos yypos, pos yypos + size yytext));
+<INITIAL> ">="        => (Tokens.GE (pos yypos, pos yypos + size yytext));
+<INITIAL> ","         => (Tokens.COMMA (pos yypos, pos yypos + size yytext));
+<INITIAL> ":::_"      => (Tokens.TCOLONWILD (pos yypos, pos yypos + size yytext));
+<INITIAL> ":::"       => (Tokens.TCOLON (pos yypos, pos yypos + size yytext));
+<INITIAL> "::_"       => (Tokens.DCOLONWILD (pos yypos, pos yypos + size yytext));
+<INITIAL> "::"        => (Tokens.DCOLON (pos yypos, pos yypos + size yytext));
+<INITIAL> ":"         => (Tokens.COLON (pos yypos, pos yypos + size yytext));
+<INITIAL> "..."       => (Tokens.DOTDOTDOT (pos yypos, pos yypos + size yytext));
+<INITIAL> "."         => (Tokens.DOT (pos yypos, pos yypos + size yytext));
+<INITIAL> "$"         => (Tokens.DOLLAR (pos yypos, pos yypos + size yytext));
+<INITIAL> "#"         => (Tokens.HASH (pos yypos, pos yypos + size yytext));
+<INITIAL> "__"        => (Tokens.UNDERUNDER (pos yypos, pos yypos + size yytext));
+<INITIAL> "_"         => (Tokens.UNDER (pos yypos, pos yypos + size yytext));
+<INITIAL> "~"         => (Tokens.TWIDDLE (pos yypos, pos yypos + size yytext));
+<INITIAL> "|"         => (Tokens.BAR (pos yypos, pos yypos + size yytext));
+<INITIAL> "*"         => (Tokens.STAR (pos yypos, pos yypos + size yytext));
+<INITIAL> "<-"        => (Tokens.LARROW (pos yypos, pos yypos + size yytext));
+<INITIAL> ";"         => (Tokens.SEMI (pos yypos, pos yypos + size yytext));
+<INITIAL> "!"         => (Tokens.BANG (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "+"         => (Tokens.PLUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "-"         => (Tokens.MINUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "/"         => (Tokens.DIVIDE (yypos, yypos + size yytext));
+<INITIAL> "%"         => (Tokens.MOD (pos yypos, pos yypos + size yytext));
+<INITIAL> "@"         => (Tokens.AT (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "con"       => (Tokens.CON (pos yypos, pos yypos + size yytext));
+<INITIAL> "type"      => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
+<INITIAL> "datatype"  => (Tokens.DATATYPE (pos yypos, pos yypos + size yytext));
+<INITIAL> "of"        => (Tokens.OF (pos yypos, pos yypos + size yytext));
+<INITIAL> "val"       => (Tokens.VAL (pos yypos, pos yypos + size yytext));
+<INITIAL> "rec"       => (Tokens.REC (pos yypos, pos yypos + size yytext));
+<INITIAL> "and"       => (Tokens.AND (pos yypos, pos yypos + size yytext));
+<INITIAL> "fun"       => (Tokens.FUN (pos yypos, pos yypos + size yytext));
+<INITIAL> "fn"        => (Tokens.FN (pos yypos, pos yypos + size yytext));
+<INITIAL> "map"       => (Tokens.MAP (pos yypos, pos yypos + size yytext));
+<INITIAL> "case"      => (Tokens.CASE (pos yypos, pos yypos + size yytext));
+<INITIAL> "if"        => (Tokens.IF (pos yypos, pos yypos + size yytext));
+<INITIAL> "then"      => (Tokens.THEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "else"      => (Tokens.ELSE (pos yypos, pos yypos + size yytext));
+
+
+<INITIAL> "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext));
+<INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext));
+<INITIAL> "struct"    => (Tokens.STRUCT (pos yypos, pos yypos + size yytext));
+<INITIAL> "sig"       => (if yypos <= 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext));
+<INITIAL> "let"       => (Tokens.LET (pos yypos, pos yypos + size yytext));
+<INITIAL> "in"        => (Tokens.IN (pos yypos, pos yypos + size yytext));
+<INITIAL> "end"       => (Tokens.END (pos yypos, pos yypos + size yytext));
+<INITIAL> "functor"   => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext));
+<INITIAL> "where"     => (Tokens.WHERE (pos yypos, pos yypos + size yytext));
+<INITIAL> "include"   => (Tokens.INCLUDE (pos yypos, pos yypos + size yytext));
+<INITIAL> "open"      => (Tokens.OPEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "constraint"=> (Tokens.CONSTRAINT (pos yypos, pos yypos + size yytext));
+<INITIAL> "constraints"=> (Tokens.CONSTRAINTS (pos yypos, pos yypos + size yytext));
+<INITIAL> "export"    => (Tokens.EXPORT (pos yypos, pos yypos + size yytext));
+<INITIAL> "table"     => (Tokens.TABLE (pos yypos, pos yypos + size yytext));
+<INITIAL> "sequence"  => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext));
+<INITIAL> "view"      => (Tokens.VIEW (pos yypos, pos yypos + size yytext));
+<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> "task"      => (Tokens.TASK (pos yypos, pos yypos + size yytext));
+<INITIAL> "policy"    => (Tokens.POLICY (pos yypos, pos yypos + size yytext));
+<INITIAL> "ffi"       => (Tokens.FFI (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));
+<INITIAL> "Unit"      => (Tokens.KUNIT (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "SELECT"    => (Tokens.SELECT (pos yypos, pos yypos + size yytext));
+<INITIAL> "DISTINCT"  => (Tokens.DISTINCT (pos yypos, pos yypos + size yytext));
+<INITIAL> "FROM"      => (Tokens.FROM (pos yypos, pos yypos + size yytext));
+<INITIAL> "AS"        => (Tokens.AS (pos yypos, pos yypos + size yytext));
+<INITIAL> "WHERE"     => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));
+<INITIAL> "SQL"       => (Tokens.SQL (pos yypos, pos yypos + size yytext));
+<INITIAL> "GROUP"     => (Tokens.GROUP (pos yypos, pos yypos + size yytext));
+<INITIAL> "ORDER"     => (Tokens.ORDER (pos yypos, pos yypos + size yytext));
+<INITIAL> "BY"        => (Tokens.BY (pos yypos, pos yypos + size yytext));
+<INITIAL> "HAVING"    => (Tokens.HAVING (pos yypos, pos yypos + size yytext));
+<INITIAL> "LIMIT"     => (Tokens.LIMIT (pos yypos, pos yypos + size yytext));
+<INITIAL> "OFFSET"    => (Tokens.OFFSET (pos yypos, pos yypos + size yytext));
+<INITIAL> "ALL"       => (Tokens.ALL (pos yypos, pos yypos + size yytext));
+<INITIAL> "SELECT1"   => (Tokens.SELECT1 (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "JOIN"      => (Tokens.JOIN (pos yypos, pos yypos + size yytext));
+<INITIAL> "INNER"     => (Tokens.INNER (pos yypos, pos yypos + size yytext));
+<INITIAL> "CROSS"     => (Tokens.CROSS (pos yypos, pos yypos + size yytext));
+<INITIAL> "OUTER"     => (Tokens.OUTER (pos yypos, pos yypos + size yytext));
+<INITIAL> "LEFT"      => (Tokens.LEFT (pos yypos, pos yypos + size yytext));
+<INITIAL> "RIGHT"     => (Tokens.RIGHT (pos yypos, pos yypos + size yytext));
+<INITIAL> "FULL"      => (Tokens.FULL (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "UNION"     => (Tokens.UNION (pos yypos, pos yypos + size yytext));
+<INITIAL> "INTERSECT" => (Tokens.INTERSECT (pos yypos, pos yypos + size yytext));
+<INITIAL> "EXCEPT"    => (Tokens.EXCEPT (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "TRUE"      => (Tokens.TRUE (pos yypos, pos yypos + size yytext));
+<INITIAL> "FALSE"     => (Tokens.FALSE (pos yypos, pos yypos + size yytext));
+<INITIAL> "AND"       => (Tokens.CAND (pos yypos, pos yypos + size yytext));
+<INITIAL> "OR"        => (Tokens.OR (pos yypos, pos yypos + size yytext));
+<INITIAL> "NOT"       => (Tokens.NOT (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "COUNT"     => (Tokens.COUNT (pos yypos, pos yypos + size yytext));
+<INITIAL> "AVG"       => (Tokens.AVG (pos yypos, pos yypos + size yytext));
+<INITIAL> "SUM"       => (Tokens.SUM (pos yypos, pos yypos + size yytext));
+<INITIAL> "MIN"       => (Tokens.MIN (pos yypos, pos yypos + size yytext));
+<INITIAL> "MAX"       => (Tokens.MAX (pos yypos, pos yypos + size yytext));
+<INITIAL> "RANK"      => (Tokens.RANK (pos yypos, pos yypos + size yytext));
+<INITIAL> "PARTITION" => (Tokens.PARTITION (pos yypos, pos yypos + size yytext));
+<INITIAL> "OVER"      => (Tokens.OVER (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "IF"        => (Tokens.CIF (pos yypos, pos yypos + size yytext));
+<INITIAL> "THEN"      => (Tokens.CTHEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "ELSE"      => (Tokens.CELSE (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "ASC"       => (Tokens.ASC (pos yypos, pos yypos + size yytext));
+<INITIAL> "DESC"      => (Tokens.DESC (pos yypos, pos yypos + size yytext));
+<INITIAL> "RANDOM"    => (Tokens.RANDOM (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "INSERT"    => (Tokens.INSERT (pos yypos, pos yypos + size yytext));
+<INITIAL> "INTO"      => (Tokens.INTO (pos yypos, pos yypos + size yytext));
+<INITIAL> "VALUES"    => (Tokens.VALUES (pos yypos, pos yypos + size yytext));
+<INITIAL> "UPDATE"    => (Tokens.UPDATE (pos yypos, pos yypos + size yytext));
+<INITIAL> "SET"       => (Tokens.SET (pos yypos, pos yypos + size yytext));
+<INITIAL> "DELETE"    => (Tokens.DELETE (pos yypos, pos yypos + size yytext));
+<INITIAL> "NULL"      => (Tokens.NULL (pos yypos, pos yypos + size yytext));
+<INITIAL> "IS"        => (Tokens.IS (pos yypos, pos yypos + size yytext));
+<INITIAL> "COALESCE"  => (Tokens.COALESCE (pos yypos, pos yypos + size yytext));
+<INITIAL> "LIKE"      => (Tokens.LIKE (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
+<INITIAL> "UNIQUE"    => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));
+<INITIAL> "CHECK"     => (Tokens.CHECK (pos yypos, pos yypos + size yytext));
+<INITIAL> "PRIMARY"   => (Tokens.PRIMARY (pos yypos, pos yypos + size yytext));
+<INITIAL> "FOREIGN"   => (Tokens.FOREIGN (pos yypos, pos yypos + size yytext));
+<INITIAL> "KEY"       => (Tokens.KEY (pos yypos, pos yypos + size yytext));
+<INITIAL> "ON"        => (Tokens.ON (pos yypos, pos yypos + size yytext));
+<INITIAL> "NO"        => (Tokens.NO (pos yypos, pos yypos + size yytext));
+<INITIAL> "ACTION"    => (Tokens.ACTION (pos yypos, pos yypos + size yytext));
+<INITIAL> "RESTRICT"  => (Tokens.RESTRICT (pos yypos, pos yypos + size yytext));
+<INITIAL> "CASCADE"   => (Tokens.CASCADE (pos yypos, pos yypos + size yytext));
+<INITIAL> "REFERENCES"=> (Tokens.REFERENCES (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
+
+<INITIAL> "_LOC_" => (let val strLoc = ErrorMsg.spanToString (ErrorMsg.spanOf
+                                            (pos yypos, pos yypos + size yytext))
+                      in
+                          Tokens.STRING (strLoc, pos yypos, pos yypos + size yytext)
+                      end);
+
+<INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
+<INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
+
+<INITIAL> {hexconst}  => (let val digits = String.extract (yytext, 2, NONE)
+                              val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
+                                      handle Overflow => NONE
+                          in
+                          case v of
+                              SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
+                            | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
+                                                           ("Expected hexInt, received: " ^ yytext);
+                                         continue ())
+                         end);
+
+<INITIAL> {intconst}  => (let val v = (Int64.fromString yytext) handle Overflow => NONE
+                          in 
+                          case v of
+                              SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
+                            | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
+                                                           ("Expected int, received: " ^ yytext);
+                                         continue ())
+                         end);
+<INITIAL> {realconst} => (case Real64.fromString yytext of
+                            SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
+                          | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
+                                       ("Expected float, received: " ^ yytext);
+                                       continue ()));
+
+<COMMENT> .           => (continue());
+
+<INITIAL> .           => (ErrorMsg.errorAt' (pos yypos, pos yypos)
+                                            ("illegal character: \"" ^ yytext ^ "\"");
+                          continue ());
diff --git a/src/utf8.sig b/src/utf8.sig
new file mode 100644
index 0000000..4198f60
--- /dev/null
+++ b/src/utf8.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* UTF-8 conversion *)
+
+signature UTF8 = sig
+    val encode : int -> string
+end
diff --git a/src/utf8.sml b/src/utf8.sml
new file mode 100644
index 0000000..cbd2fa5
--- /dev/null
+++ b/src/utf8.sml
@@ -0,0 +1,59 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* UTF-8 conversion *)
+
+structure Utf8 :> UTF8 = struct
+
+fun byte n = str (chr (Word.toInt n))
+
+fun encode n =
+    if n <= 0 then
+        raise Fail "Invalid character to UTF-8-encode"
+    else if n <= 0x7F then
+        str (chr n)
+    else if n <= 0x7FF then
+        let
+            val w = Word.fromInt n
+            val b1 = Word.orb (Word.fromInt (128 + 64), Word.>> (w, Word.fromInt 6))
+            val b2 = Word.orb (Word.fromInt 128, Word.andb (w, Word.fromInt 63))
+        in
+            byte b1 ^ byte b2
+        end
+    else if n <= 0xFFFF then
+        let
+            val w = Word.fromInt n
+            val b1 = Word.orb (Word.fromInt (128 + 64 + 32), Word.>> (w, Word.fromInt 12))
+            val b2 = Word.orb (Word.fromInt 128, Word.andb (Word.>> (w, Word.fromInt 6), Word.fromInt 63))
+            val b3 = Word.orb (Word.fromInt 128, Word.andb (w, Word.fromInt 63))
+        in
+            byte b1 ^ byte b2 ^ byte b3
+        end
+    else
+        raise Fail "Exceeded supported range for UTF-8 characters"
+
+end
diff --git a/tests/DynChannel.ur b/tests/DynChannel.ur
new file mode 100644
index 0000000..d368878
--- /dev/null
+++ b/tests/DynChannel.ur
@@ -0,0 +1,29 @@
+table channels : {Id : int, Channel:channel xbody}
+
+fun dosend (s:string) : transaction unit =
+  c <- oneRow1 (SELECT * FROM channels);
+  debug ("Sending " ^ s ^ " through the channel...");
+  send c.Channel <xml>{[s]}</xml>
+
+fun mkchannel {} : transaction xbody =
+  c <- channel;
+  s <- source <xml/>;
+  dml( DELETE FROM channels WHERE Id >= 0);
+  dml( INSERT INTO channels(Id, Channel) VALUES(0, {[c]}) );
+  return <xml>
+    <button value="Send" onclick={fn _ => rpc(dosend "blabla")}/>
+    <active code={spawn(x <- recv c; alert ("Got something from the channel"); set s x); return <xml/>}/>
+    <dyn signal={signal s}/>
+  </xml>
+
+fun main {} : transaction page =
+  s <- source <xml/>;
+  return <xml>
+    <head/>
+    <body>
+      <button value="Register" onclick={fn _ =>
+        x <- rpc(mkchannel {}); set s x
+      }/>
+      <dyn signal={signal s}/>
+    </body>
+  </xml>
diff --git a/tests/DynChannel.urp b/tests/DynChannel.urp
new file mode 100644
index 0000000..08d6d1a
--- /dev/null
+++ b/tests/DynChannel.urp
@@ -0,0 +1,6 @@
+database dbname=DynChannel.db
+sql DynChannel.sql
+debug
+
+$/list
+DynChannel
diff --git a/tests/Makefile b/tests/Makefile
new file mode 100644
index 0000000..5313d12
--- /dev/null
+++ b/tests/Makefile
@@ -0,0 +1,4 @@
+all: test.o
+
+test.o: test.c
+	gcc -c test.c -o test.o
diff --git a/tests/README b/tests/README
new file mode 100644
index 0000000..753dc0d
--- /dev/null
+++ b/tests/README
@@ -0,0 +1,2 @@
+Most of these tests are broken, which is why they are masked out for the official code releases.
+Use at your own risk, and expect no support from anyone!
diff --git a/tests/aborter.sql b/tests/aborter.sql
new file mode 100644
index 0000000..ab6110f
--- /dev/null
+++ b/tests/aborter.sql
@@ -0,0 +1,3 @@
+CREATE TABLE uw_Aborter_t(uw_a int8 NOT NULL);
+ 
+ 
\ No newline at end of file
diff --git a/tests/aborter.ur b/tests/aborter.ur
new file mode 100644
index 0000000..0921bdf
--- /dev/null
+++ b/tests/aborter.ur
@@ -0,0 +1,5 @@
+table t : {A : int}
+
+fun main () : transaction page =
+    () <- dml (INSERT INTO t (A) VALUES (0));
+    return (error <xml>No way, Jose!</xml>)
diff --git a/tests/aborter.urp b/tests/aborter.urp
new file mode 100644
index 0000000..fc1925a
--- /dev/null
+++ b/tests/aborter.urp
@@ -0,0 +1,4 @@
+database dbname=aborter
+sql aborter.sql
+
+aborter
diff --git a/tests/aborter2.ur b/tests/aborter2.ur
new file mode 100644
index 0000000..a7270ba
--- /dev/null
+++ b/tests/aborter2.ur
@@ -0,0 +1,7 @@
+table t : { X : int }
+
+fun main () : transaction page =
+    v <- query (SELECT * FROM t)
+         (fn r (_ : int) => return (error <xml>Shot down!</xml>))
+         0;
+    return <xml>Result: {[v]}</xml>
diff --git a/tests/aborter2.urp b/tests/aborter2.urp
new file mode 100644
index 0000000..edc6c7d
--- /dev/null
+++ b/tests/aborter2.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=aborter
+sql aborter2.sql
+
+aborter2
diff --git a/tests/active.ur b/tests/active.ur
new file mode 100644
index 0000000..e5fa68d
--- /dev/null
+++ b/tests/active.ur
@@ -0,0 +1,14 @@
+fun counter' () =
+    s <- source 0;
+    return <xml>
+      <dyn signal={n <- signal s; return (txt n)}/>
+      <button onclick={fn _ => n <- get s; set s (n + 1)}/>
+    </xml>
+
+fun counter () = <xml><active code={counter' ()}/></xml>
+
+fun main () : transaction page = return <xml><body>
+  {counter ()}
+  <hr/>
+  {counter ()}
+</body></xml>
diff --git a/tests/activeBlock.ur b/tests/activeBlock.ur
new file mode 100644
index 0000000..5560edd
--- /dev/null
+++ b/tests/activeBlock.ur
@@ -0,0 +1,10 @@
+fun main () : transaction page = return <xml><body>
+  <active code={s <- source ""; return <xml>
+    <dyn signal={s <- signal s; return (txt s)}/>
+    <button onclick={fn _ => set s "Hi!"}/>
+  </xml>}/>
+
+  <active code={sleep 1; return <xml>Hi!</xml>}/>
+
+  <active code={spawn (sleep 1; alert "Hi!"); return <xml>Success</xml>}/>
+</body></xml>
diff --git a/tests/activeEmpty.ur b/tests/activeEmpty.ur
new file mode 100644
index 0000000..4c08989
--- /dev/null
+++ b/tests/activeEmpty.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml><body>
+  <active code={alert "Howdy, neighbor!"; return <xml/>}/>
+  <hr/>
+  <active code={return <xml>This one <b>ain't</b> empty.</xml>}/>
+</body></xml>
diff --git a/tests/activeFocus.ur b/tests/activeFocus.ur
new file mode 100644
index 0000000..94d465e
--- /dev/null
+++ b/tests/activeFocus.ur
@@ -0,0 +1,18 @@
+fun main () : transaction page =
+    i <- fresh;
+    return <xml><body>
+      <ctextbox/>
+      <ctextbox id={i}/>
+      <active code={giveFocus i; return <xml>Done</xml>}/>
+    </body></xml>
+
+fun dynamic () : transaction page =
+    x <- source <xml/>;
+    return <xml><body>
+      <dyn signal={signal x}/>
+      <button onclick={fn _ => i <- fresh; set x <xml>
+        <ctextbox/>
+        <ctextbox id={i}/>
+        <active code={giveFocus i; return <xml>Done</xml>}/>
+      </xml>}/>
+    </body></xml>
diff --git a/tests/agg.ur b/tests/agg.ur
new file mode 100644
index 0000000..19a8644
--- /dev/null
+++ b/tests/agg.ur
@@ -0,0 +1,14 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int, E : option string}
+
+val q1 : sql_query [] _ _ = (SELECT COUNT( * ) FROM t1)
+val q2 : sql_query [] _ _ = (SELECT AVG(t1.A) FROM t1)
+val q3 : sql_query [] _ _ = (SELECT SUM(t1.C) FROM t1)
+val q4 : sql_query [] _ _ = (SELECT MIN(t1.B), MAX(t1.A) FROM t1)
+val q5 : sql_query [] _ _ = (SELECT SUM(t1.A) FROM t1 GROUP BY t1.B)
+val q6 = (SELECT COUNT(t2.E) FROM t2 GROUP BY t2.D)
+
+fun main () : transaction page =
+    xml <- queryX q6 (fn r => <xml>{[r.1]};</xml>);
+    xml2 <- queryX q4 (fn r => <xml>{[r.1]}, {[r.2]};</xml>);
+    return <xml><body>{xml}<br/>{xml2}</body></xml>
diff --git a/tests/agg.urp b/tests/agg.urp
new file mode 100644
index 0000000..61e6764
--- /dev/null
+++ b/tests/agg.urp
@@ -0,0 +1,4 @@
+database /tmp/test
+sql agg.sql
+
+agg
diff --git a/tests/ahead.ur b/tests/ahead.ur
new file mode 100644
index 0000000..29938d0
--- /dev/null
+++ b/tests/ahead.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page = return <xml>
+  <head>
+    <script code={alert "Hi!"}/>
+  </head>
+  <body>
+    <active code={alert "Bye!"; return <xml/>}/>
+  </body>
+</xml>
diff --git a/tests/alert.ur b/tests/alert.ur
new file mode 100644
index 0000000..3fe68d7
--- /dev/null
+++ b/tests/alert.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+    <a onclick={alert "You clicked it!  That's some fancy shooting!"}>Click Me!</a>
+  </body></xml>
diff --git a/tests/alert.urp b/tests/alert.urp
new file mode 100644
index 0000000..3976e9b
--- /dev/null
+++ b/tests/alert.urp
@@ -0,0 +1,3 @@
+debug
+
+alert
diff --git a/tests/align.ur b/tests/align.ur
new file mode 100644
index 0000000..7d6664d
--- /dev/null
+++ b/tests/align.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <p align="left">Left</p>
+  <p align="right">Right</p>
+</body></xml>
diff --git a/tests/ambig.ur b/tests/ambig.ur
new file mode 100644
index 0000000..f91557c
--- /dev/null
+++ b/tests/ambig.ur
@@ -0,0 +1,4 @@
+type r = {A : int, B : int, C : float}
+type string = int
+
+val x : r = {A = 1, B = "hi", C = 2.3}
diff --git a/tests/appjs.ur b/tests/appjs.ur
new file mode 100644
index 0000000..01e9f34
--- /dev/null
+++ b/tests/appjs.ur
@@ -0,0 +1,5 @@
+fun id n = if n = 0 then 0 else 1 + id (n - 1)
+
+fun main () : transaction page = return <xml><body>
+  <button onclick={alert (show (id 3))}/>
+</body></xml>
diff --git a/tests/arel.ur b/tests/arel.ur
new file mode 100644
index 0000000..5e181de
--- /dev/null
+++ b/tests/arel.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  <a link={main ()} rel="whoKnows">Here</a>
+</body></xml>
diff --git a/tests/ascdesc.ur b/tests/ascdesc.ur
new file mode 100644
index 0000000..59dd016
--- /dev/null
+++ b/tests/ascdesc.ur
@@ -0,0 +1,10 @@
+table t : { A : int }
+
+fun sortEm b =
+    queryX1 (SELECT * FROM t ORDER BY t.A {if b then sql_asc else sql_desc})
+    (fn r => <xml>{[r.A]}; </xml>)
+
+fun main () : transaction page = return <xml><body>
+  <a link={sortEm True}>Ascending</a><br/>
+  <a link={sortEm False}>Descending</a>
+</body></xml>
diff --git a/tests/ascdesc.urp b/tests/ascdesc.urp
new file mode 100644
index 0000000..3e0b075
--- /dev/null
+++ b/tests/ascdesc.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql ascdesc.sql
+
+ascdesc
\ No newline at end of file
diff --git a/tests/attrMangle.ur b/tests/attrMangle.ur
new file mode 100644
index 0000000..6efb051
--- /dev/null
+++ b/tests/attrMangle.ur
@@ -0,0 +1,5 @@
+open Goofy
+
+fun main () : transaction page = return <xml><body>
+  <goofy name="beppo" data-role="excellence"/>
+</body></xml>
diff --git a/tests/attrMangle.urp b/tests/attrMangle.urp
new file mode 100644
index 0000000..5059998
--- /dev/null
+++ b/tests/attrMangle.urp
@@ -0,0 +1,4 @@
+ffi goofy
+rewrite all AttrMangle/*
+
+attrMangle
diff --git a/tests/attrs.ur b/tests/attrs.ur
new file mode 100644
index 0000000..ffc52c6
--- /dev/null
+++ b/tests/attrs.ur
@@ -0,0 +1,3 @@
+val main = fn () => <html><body>
+        <font size=42 face="awesome">Welcome</font>
+</body></html>
diff --git a/tests/attrs_escape.ur b/tests/attrs_escape.ur
new file mode 100644
index 0000000..12de101
--- /dev/null
+++ b/tests/attrs_escape.ur
@@ -0,0 +1,4 @@
+val main = fn () => <html><body>
+        <font face="\"Well hey\"
+Wow">Welcome</font>
+</body></html>
diff --git a/tests/autocomp.ur b/tests/autocomp.ur
new file mode 100644
index 0000000..d4e6a28
--- /dev/null
+++ b/tests/autocomp.ur
@@ -0,0 +1,11 @@
+fun main () : transaction page =
+  a <- source "";
+  b <- source "";
+  return <xml><body>
+    <form>
+      <textbox{#A} source={a}/>
+      <button onclick={x <- get a; set b x}/>
+      <dyn signal={v <- signal a; return <xml>{[v]}</xml>}/>
+      / <dyn signal={v <- signal b; return <xml>{[v]}</xml>}/>
+    </form>
+  </body></xml>
diff --git a/tests/aux/aux.ur b/tests/aux/aux.ur
new file mode 100644
index 0000000..41edf35
--- /dev/null
+++ b/tests/aux/aux.ur
@@ -0,0 +1 @@
+val hello = "Hello!"
diff --git a/tests/babySpawn.ur b/tests/babySpawn.ur
new file mode 100644
index 0000000..d43e739
--- /dev/null
+++ b/tests/babySpawn.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn _ => spawn (alert "Hi")}/>
+</body></xml>
diff --git a/tests/bad.ur b/tests/bad.ur
new file mode 100644
index 0000000..60419db
--- /dev/null
+++ b/tests/bad.ur
@@ -0,0 +1 @@
+fun main $ = 0
diff --git a/tests/bad.urp b/tests/bad.urp
new file mode 100644
index 0000000..3e17f35
--- /dev/null
+++ b/tests/bad.urp
@@ -0,0 +1,2 @@
+
+bad
diff --git a/tests/badCookie.ur b/tests/badCookie.ur
new file mode 100644
index 0000000..bd9c38a
--- /dev/null
+++ b/tests/badCookie.ur
@@ -0,0 +1,2 @@
+cookie x : int
+cookie x : float
diff --git a/tests/badCookie.urp b/tests/badCookie.urp
new file mode 100644
index 0000000..3473be8
--- /dev/null
+++ b/tests/badCookie.urp
@@ -0,0 +1,3 @@
+debug
+
+badCookie
diff --git a/tests/badInline.ur b/tests/badInline.ur
new file mode 100644
index 0000000..bfbdba7
--- /dev/null
+++ b/tests/badInline.ur
@@ -0,0 +1,12 @@
+style s1
+style s2
+style s3
+
+fun ifClass r cls c = if r then classes cls c else c
+
+fun main (n : int) : transaction page = return <xml><body>
+  <p class={ifClass (n = 0) s1
+            (ifClass (n = 1) s2
+             (ifClass (n = 2) s3
+              null))}>Hi</p>
+</body></xml>
diff --git a/tests/badRpc.ur b/tests/badRpc.ur
new file mode 100644
index 0000000..2510413
--- /dev/null
+++ b/tests/badRpc.ur
@@ -0,0 +1,5 @@
+fun zero () = return 0
+
+fun main () : transaction page =
+    z <- rpc (zero ());
+    return <xml>{[z]}</xml>
diff --git a/tests/badTags.ur b/tests/badTags.ur
new file mode 100644
index 0000000..0cc6c06
--- /dev/null
+++ b/tests/badTags.ur
@@ -0,0 +1 @@
+fun main () : transaction page = <xml><body><table></div></body></xml>
diff --git a/tests/badVariant.ur b/tests/badVariant.ur
new file mode 100644
index 0000000..99e346c
--- /dev/null
+++ b/tests/badVariant.ur
@@ -0,0 +1 @@
+val q : variant [X = int, Y = float] = make [#Z] "hi"
diff --git a/tests/badcomment.ur b/tests/badcomment.ur
new file mode 100644
index 0000000..099d449
--- /dev/null
+++ b/tests/badcomment.ur
@@ -0,0 +1 @@
+(* uhoh
diff --git a/tests/baddep.urp b/tests/baddep.urp
new file mode 100644
index 0000000..0e65b25
--- /dev/null
+++ b/tests/baddep.urp
@@ -0,0 +1,2 @@
+baddep1
+baddep2
diff --git a/tests/baddep1.ur b/tests/baddep1.ur
new file mode 100644
index 0000000..1457363
--- /dev/null
+++ b/tests/baddep1.ur
@@ -0,0 +1 @@
+val x : int = "hi"
diff --git a/tests/baddep2.ur b/tests/baddep2.ur
new file mode 100644
index 0000000..22c5e3a
--- /dev/null
+++ b/tests/baddep2.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml/>
diff --git a/tests/bindpat.ur b/tests/bindpat.ur
new file mode 100644
index 0000000..bca4bd4
--- /dev/null
+++ b/tests/bindpat.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+  (a, b) <- return (1, 2);
+  {C = c, ...} <- return {C = "hi", D = False};
+  d <- return 2.34;
+  {1 = e, 2 = f} <- return (8, 9);
+  return <xml>{[a]}, {[b]}, {[c]}, {[d]}, {[e]}, {[f]}</xml>
diff --git a/tests/blob.ur b/tests/blob.ur
new file mode 100644
index 0000000..02f88f0
--- /dev/null
+++ b/tests/blob.ur
@@ -0,0 +1,7 @@
+fun main () =
+  setHeader (blessResponseHeader "X-Test") "Test";
+  return <xml><body>Test</body></xml>
+
+fun bad () =
+   setHeader (blessResponseHeader "X-Test") "Test";
+   returnBlob (textBlob "hello") (blessMime "text/plain")
diff --git a/tests/blob.urp b/tests/blob.urp
new file mode 100644
index 0000000..1cec504
--- /dev/null
+++ b/tests/blob.urp
@@ -0,0 +1,5 @@
+allow responseHeader X-Test
+allow mime text/plain
+rewrite url Blob/*
+
+blob
diff --git a/tests/blob.urs b/tests/blob.urs
new file mode 100644
index 0000000..fa45e01
--- /dev/null
+++ b/tests/blob.urs
@@ -0,0 +1,2 @@
+val main : unit -> transaction page
+val bad : unit -> transaction page
diff --git a/tests/blobOpt.ur b/tests/blobOpt.ur
new file mode 100644
index 0000000..261ce22
--- /dev/null
+++ b/tests/blobOpt.ur
@@ -0,0 +1,38 @@
+sequence s
+table t : { Id : int, Data : option blob, Typ : string }
+
+fun view id =
+    r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]});
+    case r.T.Data of
+        None => return <xml>This one's empty.</xml>
+      | Some data => returnBlob data (blessMime r.T.Typ)
+
+fun save r =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Data, Typ)
+         VALUES ({[id]}, {[Some (fileData r.Data)]}, {[fileMimeType r.Data]}));
+    main ()
+
+and saveEmpty () =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Data, Typ)
+         VALUES ({[id]}, {[None]}, "bogus"));
+    main ()
+
+and main () =
+    ls <- queryX (SELECT t.Id FROM t)
+          (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Id]}</a></li></xml>);
+    return <xml><body>
+      {ls}
+
+      <br/>
+
+      <form>
+        <upload{#Data}/>
+        <submit action={save}/>
+      </form>
+
+      <form>
+        <submit action={saveEmpty}/>
+      </form>
+    </body></xml>
diff --git a/tests/blobOpt.urp b/tests/blobOpt.urp
new file mode 100644
index 0000000..fef3c5d
--- /dev/null
+++ b/tests/blobOpt.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=blobopt
+sql blobOpt.sql
+
+blobOpt
diff --git a/tests/blobOpt.urs b/tests/blobOpt.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/blobOpt.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/blog.ur b/tests/blog.ur
new file mode 100644
index 0000000..a3a06cb
--- /dev/null
+++ b/tests/blog.ur
@@ -0,0 +1,16 @@
+fun main wrap =
+    let
+        fun edit id =
+            let
+                val r = 0
+                fun save () = <xml/>
+            in
+                wrap (save ())
+            end
+    in
+        edit 0
+    end
+
+fun wrap (inside : xbody) = return <xml/>
+
+val main () = main wrap
diff --git a/tests/blog.urp b/tests/blog.urp
new file mode 100644
index 0000000..a3f7bfa
--- /dev/null
+++ b/tests/blog.urp
@@ -0,0 +1,4 @@
+debug
+database dbname=blog
+
+blog
\ No newline at end of file
diff --git a/tests/blog.urs b/tests/blog.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/blog.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/bodyClick.ur b/tests/bodyClick.ur
new file mode 100644
index 0000000..9dcc64c
--- /dev/null
+++ b/tests/bodyClick.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <xml>
+  <body onclick={fn _ => alert "You clicked the body."}
+        onkeyup={fn _ => alert "Key"}>
+    <p>Text</p>
+  </body>
+</xml>
diff --git a/tests/bool.ur b/tests/bool.ur
new file mode 100644
index 0000000..b7e57dc
--- /dev/null
+++ b/tests/bool.ur
@@ -0,0 +1,8 @@
+val page = fn b => <html><body>
+        {cdata (case b of False => "No!" | True => "Yes!")}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page True}>True</a></li>
+        <li><a link={page False}>False</a></li>
+</body></html>
diff --git a/tests/both.ur b/tests/both.ur
new file mode 100644
index 0000000..d1c9f40
--- /dev/null
+++ b/tests/both.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page = return <xml>
+ <body>
+   <form>
+     <textbox{#Text}/><submit action={submit}/>
+   </form>
+ </body>
+</xml>
+
+and submit r = return <xml/>
diff --git a/tests/both.urp b/tests/both.urp
new file mode 100644
index 0000000..a29c8ea
--- /dev/null
+++ b/tests/both.urp
@@ -0,0 +1,2 @@
+
+both
diff --git a/tests/both2.ur b/tests/both2.ur
new file mode 100644
index 0000000..c3f25cc
--- /dev/null
+++ b/tests/both2.ur
@@ -0,0 +1,14 @@
+fun main () : transaction page =
+    let
+        fun submit r = return <xml/>
+    in
+        return <xml>
+          <body>
+            <form>
+              <textbox{#Text}/><submit action={submit}/>
+            </form>
+          </body>
+        </xml>
+    end
+
+
diff --git a/tests/both2.urp b/tests/both2.urp
new file mode 100644
index 0000000..8e85a83
--- /dev/null
+++ b/tests/both2.urp
@@ -0,0 +1,2 @@
+
+both2
diff --git a/tests/broad_unif.ur b/tests/broad_unif.ur
new file mode 100644
index 0000000..bebd910
--- /dev/null
+++ b/tests/broad_unif.ur
@@ -0,0 +1,15 @@
+structure M = struct
+        type t = int
+        val f = fn x => x
+        val y = f 0
+end
+
+signature S = sig
+        type t
+        val f : t -> t
+end
+
+structure M : S = struct
+        type t = int
+        val f = fn x => x
+end
diff --git a/tests/buffer.ur b/tests/buffer.ur
new file mode 100644
index 0000000..27e2b80
--- /dev/null
+++ b/tests/buffer.ur
@@ -0,0 +1,25 @@
+datatype lines = End | Line of string * source lines
+
+type t = { Head : source lines, Tail : source (source lines) }
+
+val create =
+    head <- source End;
+    tail <- source head;
+    return {Head = head, Tail = tail}
+
+fun renderL lines =
+    case lines of
+        End => <xml/>
+      | Line (line, linesS) => <xml>{[line]}<br/><dyn signal={renderS linesS}/></xml>
+
+and renderS linesS =
+    lines <- signal linesS;
+    return (renderL lines)
+
+fun render t = renderS t.Head
+
+fun write t s =
+    oldTail <- get t.Tail;
+    newTail <- source End;
+    set oldTail (Line (s, newTail));
+    set t.Tail newTail
diff --git a/tests/buffer.urs b/tests/buffer.urs
new file mode 100644
index 0000000..58312bb
--- /dev/null
+++ b/tests/buffer.urs
@@ -0,0 +1,5 @@
+type t
+
+val create : transaction t
+val render : t -> signal xbody
+val write : t -> string -> transaction unit
diff --git a/tests/button.ur b/tests/button.ur
new file mode 100644
index 0000000..febcb0c
--- /dev/null
+++ b/tests/button.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn _ => alert "AHOY"}><b>CLICK IT</b></button>
+</body></xml>
+
diff --git a/tests/cancel.ur b/tests/cancel.ur
new file mode 100644
index 0000000..9edb15a
--- /dev/null
+++ b/tests/cancel.ur
@@ -0,0 +1,7 @@
+type t = {A : int, B : float, C : string}
+type u = {A : int, C : string, D : bool}
+
+fun f (x : t) = x
+fun g (x : u) = f x
+
+fun h [ts] [ts ~ [A]] (r : $([A = int] ++ ts)) : $([A = int, B = float] ++ ts) = r
diff --git a/tests/cancel2.ur b/tests/cancel2.ur
new file mode 100644
index 0000000..30bea65
--- /dev/null
+++ b/tests/cancel2.ur
@@ -0,0 +1,5 @@
+fun f [r] [[Id, Foo] ~ r] (x : $(map (fn ts => $ts) r ++ [Id = int, Foo = string]))
+    : $(map (fn ts => $ts) r ++ [Foo = string]) = x
+
+val r = {}
+val x : $(map (fn ts => $ts) _ ++ [Foo = string]) = f r
diff --git a/tests/cantSql.ur b/tests/cantSql.ur
new file mode 100644
index 0000000..026fcaa
--- /dev/null
+++ b/tests/cantSql.ur
@@ -0,0 +1,3 @@
+datatype foo = Bar of int
+
+table bad : { A : foo, B : { X : float } }
diff --git a/tests/cantSql.urp b/tests/cantSql.urp
new file mode 100644
index 0000000..b1809f0
--- /dev/null
+++ b/tests/cantSql.urp
@@ -0,0 +1,3 @@
+database dbname=test
+
+cantSql
diff --git a/tests/capture.ur b/tests/capture.ur
new file mode 100644
index 0000000..0eb3d8b
--- /dev/null
+++ b/tests/capture.ur
@@ -0,0 +1,4 @@
+val y = []
+
+type foo = int
+val z : list {F : foo} = y
diff --git a/tests/cargs.ur b/tests/cargs.ur
new file mode 100644
index 0000000..7aa10d1
--- /dev/null
+++ b/tests/cargs.ur
@@ -0,0 +1,14 @@
+con id = fn t :: Type => t
+con id2 = fn (t :: Type) => id t
+con id3 = fn t => id2 t
+
+con pair = fn (t :: Type) (u :: Type) => (t, u)
+con pair2 = fn t u => pair t u
+con pair3 = fn t (u :: Type) => pair2 t u
+
+con id4 (t :: Type) = t
+con id5 (t :: Type) :: Type = id4 t
+con id6 t :: Type = id5 t
+
+con pair4 t (u :: Type) = pair3 t u
+con pair5 t (u :: Type) :: (Type * Type) = pair4 t u
diff --git a/tests/case.ur b/tests/case.ur
new file mode 100644
index 0000000..b131b27
--- /dev/null
+++ b/tests/case.ur
@@ -0,0 +1,16 @@
+datatype t = A | B
+
+val swap = fn x : t => case x of A => B | B => A
+
+datatype u = C of t | D
+
+val out = fn x : u => case x of C y => y | D => A
+
+datatype nat = O | S of nat
+
+val is_two = fn x : nat =>
+        case x of S (S O) => A | _ => B
+
+val zero_is_two = is_two O
+val one_is_two = is_two (S O)
+val two_is_two = is_two (S (S O))
diff --git a/tests/caseFfi.ur b/tests/caseFfi.ur
new file mode 100644
index 0000000..76232cb
--- /dev/null
+++ b/tests/caseFfi.ur
@@ -0,0 +1,28 @@
+extern structure M : sig
+        datatype t = A | B
+        datatype u = C of t | D
+end
+
+val f = fn x => case x of M.A => M.B | M.B => M.A
+
+val t2s = fn x => case x of M.A => "A" | M.B => "B"
+
+val g = fn x => case x of M.C a => M.C (f a) | M.D => M.C M.A
+
+val u2s = fn x => case x of M.C a => t2s a | M.D => "D"
+
+val page = fn x => <html><body>
+        {cdata (t2s x)}
+</body></html>
+
+val page2 = fn x => <html><body>
+        {cdata (u2s x)}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page M.A}>A</a></li>
+        <li><a link={page M.B}>B</a></li>
+        <li><a link={page2 (M.C M.A)}>C A</a></li>
+        <li><a link={page2 (M.C M.B)}>C B</a></li>
+        <li><a link={page2 M.D}>D</a></li>
+</body></html>
diff --git a/tests/caseMod.ur b/tests/caseMod.ur
new file mode 100644
index 0000000..0a87016
--- /dev/null
+++ b/tests/caseMod.ur
@@ -0,0 +1,38 @@
+structure M = struct
+        datatype t = A | B
+end
+
+val f = fn x : M.t => case x of M.A => M.B | M.B => M.A
+
+datatype t = datatype M.t
+
+val g = fn x : t => case x of M.A => B | B => M.A
+
+structure N = struct
+        datatype u = C of t | D
+end
+
+val h = fn x : N.u => case x of N.C x => x | N.D => M.A
+
+datatype u = datatype N.u
+
+val i = fn x : u => case x of N.C x => x | D => M.A
+
+val toString = fn x =>
+        case x of
+            C A => "C A"
+          | C B => "C B"
+          | D => "D"
+
+val rec page = fn x => <html><body>
+        {cdata (toString x)}<br/>
+        <br/>
+
+        <a link={page x}>Again!</a>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li> <a link={page (C A)}>C A</a></li>
+        <li> <a link={page (C B)}>C B</a></li>
+        <li> <a link={page D}>D</a></li>
+</body></html>
diff --git a/tests/ccheckbox.ur b/tests/ccheckbox.ur
new file mode 100644
index 0000000..09a8ece
--- /dev/null
+++ b/tests/ccheckbox.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page =
+    s <- source True;
+    t <- source 1;
+    return <xml><body><ccheckbox source={s} onclick={set t 3}/>
+      <dyn signal={s <- signal s;
+                   t <- signal t;
+                   return <xml>{[s]} {[t]}</xml>}/>
+    </body></xml>
diff --git a/tests/cdata.ur b/tests/cdata.ur
new file mode 100644
index 0000000..0455665
--- /dev/null
+++ b/tests/cdata.ur
@@ -0,0 +1 @@
+val main : xml[Html] = <html></html>
diff --git a/tests/cdataF.ur b/tests/cdataF.ur
new file mode 100644
index 0000000..3f8da45
--- /dev/null
+++ b/tests/cdataF.ur
@@ -0,0 +1,8 @@
+val snippet = fn s => <body>
+        <h1>{cdata s}</h1>
+</body>
+
+val main = fn () => <html><body>
+        {snippet "<Hi."}
+        {snippet "Bye."}
+</body></html>
diff --git a/tests/cdataL.ur b/tests/cdataL.ur
new file mode 100644
index 0000000..3aa3bef
--- /dev/null
+++ b/tests/cdataL.ur
@@ -0,0 +1,8 @@
+val subpage = fn s => <html><body>
+        <h1>{cdata s}</h1>
+</body></html>
+
+val main = fn () => <html><body>
+        <li> <a link={subpage "<Hi."}>Door #1</a></li>
+        <li> <a link={subpage "Bye."}>Door #2</a></li>
+</body></html>
diff --git a/tests/cdatas.ur b/tests/cdatas.ur
new file mode 100644
index 0000000..bcbf26e
--- /dev/null
+++ b/tests/cdatas.ur
@@ -0,0 +1,4 @@
+val main : xml[Html] = <html>
+        Hi!
+        Bye!
+</html>
diff --git a/tests/cffi.ur b/tests/cffi.ur
new file mode 100644
index 0000000..bcb9944
--- /dev/null
+++ b/tests/cffi.ur
@@ -0,0 +1,29 @@
+fun printer () = Test.foo
+
+fun effect () =
+  Test.print;
+  return <xml><body>
+    <button value="Remote" onclick={printer ()}/>
+    <button value="Local" onclick={Test.bar "Hoho"}/>
+    <button value="Either" onclick={Test.print}/>
+  </body></xml>
+
+fun xact () =
+  Test.transactional;
+  return <xml><body>
+    All good.
+  </body></xml>
+
+fun xact2 () =
+  Test.transactional;
+  error <xml>Failure</xml>;
+  return <xml><body>
+    All gooder.
+  </body></xml>
+
+fun main () = return <xml><body>
+  {[Test.out (Test.frob (Test.create "Hello ") "world!")]}
+  <form><submit action={effect}/></form>
+  <form><submit action={xact}/></form>
+  <form><submit action={xact2}/></form>
+</body></xml>
diff --git a/tests/cffi.urp b/tests/cffi.urp
new file mode 100644
index 0000000..a8f6c2b
--- /dev/null
+++ b/tests/cffi.urp
@@ -0,0 +1,4 @@
+debug
+library clib
+
+cffi
diff --git a/tests/cffi.urs b/tests/cffi.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cffi.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/cfold.ur b/tests/cfold.ur
new file mode 100644
index 0000000..0fcf9d6
--- /dev/null
+++ b/tests/cfold.ur
@@ -0,0 +1,15 @@
+con currier = fold (fn nm => fn t => fn acc => t -> acc) {}
+
+con greenCurryIngredients :: {Type} = []
+con greenCurry = currier greenCurryIngredients
+val greenCurry : greenCurry = {}
+
+con redCurryIngredients = [A = int, B = string]
+con redCurry = currier redCurryIngredients
+val redCurry : redCurry = fn x : int => fn y : string => {}
+
+con yellowCurryIngredients = [A = string, B = int, C = float]
+con yellowCurry = currier yellowCurryIngredients
+val yellowCurry : yellowCurry = fn x => fn y => fn z => {}
+
+val main = yellowCurry
diff --git a/tests/cfold_disj.ur b/tests/cfold_disj.ur
new file mode 100644
index 0000000..e0a1948
--- /dev/null
+++ b/tests/cfold_disj.ur
@@ -0,0 +1,5 @@
+con id = fold (fn nm => fn t :: Type => fn acc => [nm] ~ acc => [nm = t] ++ acc) []
+
+con idT = id [D = int, E = float]
+
+val idV = fn x : $idT => x.E
diff --git a/tests/channel.ur b/tests/channel.ur
new file mode 100644
index 0000000..df50ea2
--- /dev/null
+++ b/tests/channel.ur
@@ -0,0 +1,23 @@
+fun main () : transaction page =
+    ch <- channel;
+    let
+        fun make () =
+            subscribe ch;
+            send ch "Hello world!"
+
+        fun echo () =
+            msg <- recv ch;
+            alert(msg);
+            echo ()
+
+        fun onload () =
+            make ();
+            echo ()
+
+        fun haveAnother () =
+            send ch "Here's another."
+    in
+        return <xml><body onload={onload ()}>
+          <button value="Another?" onclick={haveAnother ()}/>
+        </body></xml>
+    end
diff --git a/tests/channel.urp b/tests/channel.urp
new file mode 100644
index 0000000..167899c
--- /dev/null
+++ b/tests/channel.urp
@@ -0,0 +1,4 @@
+debug
+timeout 10
+
+channel
diff --git a/tests/channelThief.ur b/tests/channelThief.ur
new file mode 100644
index 0000000..1893979
--- /dev/null
+++ b/tests/channelThief.ur
@@ -0,0 +1,32 @@
+table t : { Ch : channel string }
+
+fun go () =
+    let
+        fun overwrite () =
+            dml (DELETE FROM t WHERE TRUE);
+            ch <- channel;
+            dml (INSERT INTO t (Ch) VALUES ({[ch]}));
+            return ch
+
+        fun retrieve () =
+            oneRowE1 (SELECT (t.Ch) FROM t)
+
+        fun transmit () =
+            ch <- retrieve ();
+            send ch "Test"
+
+        fun listenOn ch =
+            s <- recv ch;
+            alert s
+    in
+        ch <- overwrite ();
+        return <xml><body onload={listenOn ch}>
+          <button value="overwrite" onclick={fn _ => ch <- rpc (overwrite ()); listenOn ch}/>
+          <button value="retrieve" onclick={fn _ => ch <- rpc (retrieve ()); listenOn ch}/>
+          <button value="transmit" onclick={fn _ => rpc (transmit ())}/>
+        </body></xml>
+    end
+
+fun main () = return <xml><body>
+  <form><submit action={go}/></form>
+</body></xml>
diff --git a/tests/channelThief.urp b/tests/channelThief.urp
new file mode 100644
index 0000000..dee402d
--- /dev/null
+++ b/tests/channelThief.urp
@@ -0,0 +1,5 @@
+database dbname=test
+sql channelThief.sql
+rewrite url ChannelThief/*
+
+channelThief
diff --git a/tests/channelThief.urs b/tests/channelThief.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/channelThief.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/char.ur b/tests/char.ur
new file mode 100644
index 0000000..08621eb
--- /dev/null
+++ b/tests/char.ur
@@ -0,0 +1,4 @@
+fun main () =
+  case #"A" of
+      #"B" => return <xml/>
+    | _ => return <xml>A!</xml>
diff --git a/tests/char.urp b/tests/char.urp
new file mode 100644
index 0000000..840c447
--- /dev/null
+++ b/tests/char.urp
@@ -0,0 +1,3 @@
+debug
+
+char
diff --git a/tests/char.urs b/tests/char.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/char.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/chat.ur b/tests/chat.ur
new file mode 100644
index 0000000..7f723ba
--- /dev/null
+++ b/tests/chat.ur
@@ -0,0 +1,99 @@
+datatype log = End | Line of string * source log
+
+fun render log =
+    case log of
+        End => <xml/>
+      | Line (line, logS) => <xml>{[line]}<br/><dyn signal={renderS logS}/></xml>
+
+and renderS logS =
+    log <- signal logS;
+    return (render log)
+
+structure Room = Broadcast(struct
+                               type t = string
+                           end)
+
+sequence s
+table t : { Id : int, Title : string, Room : Room.topic }
+
+fun chat id =
+    r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
+    ch <- Room.subscribe r.T.Room;
+
+    newLine <- source "";
+    logHead <- source End;
+    logTail <- source logHead;
+
+    let
+        fun onload () =
+            let
+                fun listener () =
+                    s <- recv ch;
+                    oldTail <- get logTail;
+                    newTail <- source End;
+                    set oldTail (Line (s, newTail));
+                    set logTail newTail;
+                    listener ()
+            in
+                listener ()
+            end
+
+        fun getRoom () =
+            r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
+            return r.T.Room
+
+        fun speak line =
+            room <- getRoom ();
+            Room.send room line
+
+        fun doSpeak () =
+            line <- get newLine;
+            set newLine "";
+            speak line
+    in
+        return <xml><body onload={onload ()}>
+          <h1>{[r.T.Title]}</h1>
+
+          <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
+
+          <h2>Messages</h2>
+
+          <dyn signal={renderS logHead}/>
+          
+        </body></xml>            
+    end
+
+fun list () =
+    queryX (SELECT * FROM t)
+    (fn r => <xml><tr>
+      <td>{[r.T.Id]}</td> <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
+      <td><a link={delete r.T.Id}>[delete]</a></td>
+    </tr></xml>)
+
+and delete id =
+    dml (DELETE FROM t WHERE Id = {[id]});
+    main ()
+
+and main () : transaction page =
+    let
+        fun create r =
+            id <- nextval s;
+            room <- Room.create;
+            dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
+            main ()
+    in
+        ls <- list ();
+        return <xml><body>
+          <table>
+            <tr> <th>ID</th> <th>Title</th> </tr>
+            {ls}
+          </table>
+          
+          <h1>New Channel</h1>
+          
+          <form>
+            Title: <textbox{#Title}/><br/>
+            <submit action={create}/>
+          </form>
+        </body></xml>
+    end
diff --git a/tests/chat.urp b/tests/chat.urp
new file mode 100644
index 0000000..1c42449
--- /dev/null
+++ b/tests/chat.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=chat
+sql chat.sql
+
+chat
diff --git a/tests/checkbox.ur b/tests/checkbox.ur
new file mode 100644
index 0000000..6d7ee34
--- /dev/null
+++ b/tests/checkbox.ur
@@ -0,0 +1,10 @@
+val handler = fn x => <html><body>
+        {if x.A then cdata "Yes" else cdata "No"}
+</body></html>
+
+val main = fn () => <html><body>
+        <lform>
+                <checkbox{#A}/> How about it?<br/>
+                <submit action={handler}/>
+        </lform>
+</body></html>
diff --git a/tests/classFail.ur b/tests/classFail.ur
new file mode 100644
index 0000000..dd7b66e
--- /dev/null
+++ b/tests/classFail.ur
@@ -0,0 +1,3 @@
+val x = show 7
+val y = show (8, 9)
+val z : (show int * show unit) = _
diff --git a/tests/classy_form.ur b/tests/classy_form.ur
new file mode 100644
index 0000000..f9fafb6
--- /dev/null
+++ b/tests/classy_form.ur
@@ -0,0 +1,9 @@
+style form_inline
+
+val main : transaction page = return <xml>
+  <body>
+    <form class="form-inline">
+      Problematic?
+    </form>
+  </body>
+</xml>
diff --git a/tests/clib.urp b/tests/clib.urp
new file mode 100644
index 0000000..de89d03
--- /dev/null
+++ b/tests/clib.urp
@@ -0,0 +1,10 @@
+ffi test
+include test.h
+script http://localhost/test/test.js
+link test.o
+effectful Test.print
+serverOnly Test.foo
+clientOnly Test.bar
+effectful Test.transactional
+jsFunc Test.print=print
+jsFunc Test.bar=bar
diff --git a/tests/cloconv.ur b/tests/cloconv.ur
new file mode 100644
index 0000000..3dd9ad8
--- /dev/null
+++ b/tests/cloconv.ur
@@ -0,0 +1 @@
+val main = fn x : int => x
diff --git a/tests/coalesce.ur b/tests/coalesce.ur
new file mode 100644
index 0000000..5ee8cf1
--- /dev/null
+++ b/tests/coalesce.ur
@@ -0,0 +1,6 @@
+table t : { A : option int }
+
+fun main () : transaction page =
+    queryX (SELECT COALESCE(t.A, 13)
+            FROM t)
+    (fn r => <xml>{[r.1]},</xml>)
diff --git a/tests/coalesce.urp b/tests/coalesce.urp
new file mode 100644
index 0000000..7d7dece
--- /dev/null
+++ b/tests/coalesce.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql coalesce.sql
+
+coalesce
diff --git a/tests/comment.ur b/tests/comment.ur
new file mode 100644
index 0000000..975fc27
--- /dev/null
+++ b/tests/comment.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml>Hi</xml>
diff --git a/tests/comment.urp b/tests/comment.urp
new file mode 100644
index 0000000..4865c8b
--- /dev/null
+++ b/tests/comment.urp
@@ -0,0 +1,4 @@
+#library common
+database dbname=comment
+
+comment
diff --git a/tests/conargs.ur b/tests/conargs.ur
new file mode 100644
index 0000000..310e124
--- /dev/null
+++ b/tests/conargs.ur
@@ -0,0 +1,9 @@
+con func a b = a -> b
+
+signature S = sig
+    con funcy a b = a -> b
+end
+
+structure M : S = struct
+    con funcy = func
+end
diff --git a/tests/concat.ur b/tests/concat.ur
new file mode 100644
index 0000000..1330a21
--- /dev/null
+++ b/tests/concat.ur
@@ -0,0 +1,13 @@
+functor Make(M : sig
+                 con ts :: {(Type * Type)}
+                 val tab : sql_table (map fst ts) []
+                 val cols : $(map (fn p => p.2 -> string) ts)
+             end) = struct
+end
+
+table t : {A : string}
+
+open Make(struct
+              val tab = t
+              val cols = {A = fn p : {B : string, C : string} => p.B ^ p.C}
+          end)
diff --git a/tests/concat.urp b/tests/concat.urp
new file mode 100644
index 0000000..442b05b
--- /dev/null
+++ b/tests/concat.urp
@@ -0,0 +1 @@
+concat
diff --git a/tests/constraint.ur b/tests/constraint.ur
new file mode 100644
index 0000000..e350a4e
--- /dev/null
+++ b/tests/constraint.ur
@@ -0,0 +1,45 @@
+signature S = sig
+        con nm :: Name
+        con r :: {Type}
+
+        constraint [nm] ~ r
+end
+
+structure M : S = struct
+        con nm = #A
+        con r = [B = float, C = string]
+
+        constraint [A] ~ [B]
+        constraint [nm] ~ r
+        constraint [C] ~ [D]
+end
+
+structure M' = struct
+        open M
+
+        con combo = [nm = int] ++ r
+end
+
+structure M' = struct
+        open constraints M
+
+        con nm' = M.nm
+        con r' = M.r
+        con combo = [nm' = int] ++ r'
+end
+
+
+signature S' = sig
+        con r1 :: {Type}
+        con r2 :: {Type}
+
+        constraint r1 ~ r2
+end
+
+functor F (M : S) : S' = struct
+        con r1 = [M.nm = int]
+        con r2 = M.r
+
+        open constraints M
+        constraint r1 ~ r2
+end
diff --git a/tests/consub.ur b/tests/consub.ur
new file mode 100644
index 0000000..4656e33
--- /dev/null
+++ b/tests/consub.ur
@@ -0,0 +1,16 @@
+functor F(M : sig
+              table t : { A : int, B : int }
+                PRIMARY KEY A
+          end) = struct
+    open M
+
+    fun getByA a = oneRow1 (SELECT * FROM t WHERE t.A = {[a]})
+end
+
+table u : { A : int, B : int }
+  PRIMARY KEY A,
+  CONSTRAINT B UNIQUE B
+
+open F(struct
+           val t = u
+       end)
diff --git a/tests/contentDisposition.ur b/tests/contentDisposition.ur
new file mode 100644
index 0000000..8fe2b26
--- /dev/null
+++ b/tests/contentDisposition.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page =
+    setHeader (blessResponseHeader "Content-Disposition")
+              ("attachment; filename=test.txt");
+    returnBlob (textBlob "Hi there!") (blessMime "text/plain")
diff --git a/tests/contentDisposition.urp b/tests/contentDisposition.urp
new file mode 100644
index 0000000..92b0287
--- /dev/null
+++ b/tests/contentDisposition.urp
@@ -0,0 +1,5 @@
+rewrite all ContentDisposition/*
+allow responseHeader Content-Disposition
+allow mime text/plain
+
+contentDisposition
\ No newline at end of file
diff --git a/tests/cookie.ur b/tests/cookie.ur
new file mode 100644
index 0000000..bef45a4
--- /dev/null
+++ b/tests/cookie.ur
@@ -0,0 +1,22 @@
+cookie c : string
+
+fun other () =
+    so <- getCookie c;
+    case so of
+        None => return <xml>No cookie</xml>
+      | Some s => return <xml>Cookie: {[s]}</xml>
+
+structure M = struct
+    fun aux () =
+        setCookie c "Hi";
+        so <- getCookie c;
+        case so of
+            None => return <xml>No cookie</xml>
+          | Some s => return <xml><body>Cookie: {[s]}<br/>
+            <a link={other ()}>Other</a></body></xml>
+end
+
+fun main () : transaction page = return <xml><body>
+  <a link={other ()}>Other</a><br/>
+  <a link={M.aux ()}>Aux</a><br/>
+</body></xml>
diff --git a/tests/cookie.urp b/tests/cookie.urp
new file mode 100644
index 0000000..61a1a1e
--- /dev/null
+++ b/tests/cookie.urp
@@ -0,0 +1,3 @@
+debug
+
+cookie
diff --git a/tests/cookieClear.ur b/tests/cookieClear.ur
new file mode 100644
index 0000000..7082980
--- /dev/null
+++ b/tests/cookieClear.ur
@@ -0,0 +1,19 @@
+cookie c : int
+
+fun setit () =
+    setCookie c {Value = 13,
+                 Expires = None,
+                 Secure = False};
+    return <xml/>
+
+fun doit () =
+    ro <- getCookie c;
+    clearCookie c;
+    case ro of
+      None => return <xml>None</xml>
+    | Some v => return <xml>Some {[v]}</xml>
+
+fun main () = return <xml><body>
+  <form><submit value="Set it!" action={setit}/></form>
+  <form><submit value="Get busy!" action={doit}/></form>
+</body></xml>
diff --git a/tests/cookieClear.urp b/tests/cookieClear.urp
new file mode 100644
index 0000000..c5a1c83
--- /dev/null
+++ b/tests/cookieClear.urp
@@ -0,0 +1 @@
+cookieClear
diff --git a/tests/cookieClear.urs b/tests/cookieClear.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cookieClear.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/cookieJsec.ur b/tests/cookieJsec.ur
new file mode 100644
index 0000000..46668cf
--- /dev/null
+++ b/tests/cookieJsec.ur
@@ -0,0 +1,27 @@
+table t : {Id : int}
+
+cookie c : int
+
+fun setter r =
+    setCookie c (readError r.Id);
+    return <xml>Done</xml>
+
+fun writer () =
+    ido <- getCookie c;
+    case ido of
+        None => error <xml>No cookie</xml>
+      | Some id => dml (INSERT INTO t (Id) VALUES ({[id]}))
+
+fun preWriter () = return <xml><body onload={onConnectFail (alert "RPC error")}>
+  <button onclick={writer ()} value="Write to database"/>
+
+  <a link={main ()}>Back</a>
+</body></xml>
+
+and main () = return <xml><body>
+  <form>
+    <textbox{#Id}/> <submit value="Get cookie" action={setter}/>
+  </form>
+
+  <form><submit action={preWriter} value="Prepare to write to database"/></form>
+</body></xml>
diff --git a/tests/cookieJsec.urp b/tests/cookieJsec.urp
new file mode 100644
index 0000000..fc5044e
--- /dev/null
+++ b/tests/cookieJsec.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=cookiejsec
+sql cookieJsec.sql
+
+cookieJsec
diff --git a/tests/cookieJsec.urs b/tests/cookieJsec.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cookieJsec.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/cookieSec.ur b/tests/cookieSec.ur
new file mode 100644
index 0000000..ea5c911
--- /dev/null
+++ b/tests/cookieSec.ur
@@ -0,0 +1,24 @@
+table t : {Id : int}
+
+cookie c : int
+
+fun setter r =
+    setCookie c (readError r.Id);
+    return <xml>Done</xml>
+
+fun writer () =
+    ido <- getCookie c;
+    case ido of
+        None => error <xml>No cookie</xml>
+      | Some id => dml (INSERT INTO t (Id) VALUES ({[id]}));
+                   return <xml>Done</xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#Id}/> <submit value="Get cookie" action={setter}/>
+  </form>
+
+  <form>
+    <submit value="Write to database" action={writer}/>
+  </form>
+</body></xml>
diff --git a/tests/cookieSec.urp b/tests/cookieSec.urp
new file mode 100644
index 0000000..a2567db
--- /dev/null
+++ b/tests/cookieSec.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=cookiesec
+sql cookieSec.sql
+
+cookieSec
diff --git a/tests/cookieSec.urs b/tests/cookieSec.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cookieSec.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/crud.ur b/tests/crud.ur
new file mode 100644
index 0000000..f085b44
--- /dev/null
+++ b/tests/crud.ur
@@ -0,0 +1,163 @@
+con colMeta = fn t_formT :: (Type * Type) => {
+                 Nam : string,
+                 Show : t_formT.1 -> xbody,
+                 Widget : nm :: Name -> xml form [] [nm = t_formT.2],
+                 WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
+                 Parse : t_formT.2 -> t_formT.1,
+                 Inject : sql_injectable t_formT.1
+                 }
+con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols)
+
+fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+            name : colMeta (t, string) =
+    {Nam = name,
+     Show = txt,
+     Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
+     WidgetPopulated = fn (nm :: Name) n =>
+                          <xml><textbox{nm} value={show n}/></xml>,
+     Parse = readError,
+     Inject = _}
+
+val int = default
+val float = default
+val string = default
+
+fun bool name = {Nam = name,
+                 Show = txt,
+                 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
+                 WidgetPopulated = fn (nm :: Name) b =>
+                                      <xml><checkbox{nm} checked={b}/></xml>,
+                 Parse = fn x => x,
+                 Inject = _}
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 table tab : ([Id = int] ++ mapT2T fstTT cols)
+
+                 val title : string
+
+                 val cols : colsMeta cols
+             end) = struct
+
+    open constraints M
+    val tab = M.tab
+
+    sequence seq
+
+    fun create (inputs : $(mapT2T sndTT M.cols)) =
+        id <- nextval seq;
+        () <- dml (insert tab
+                          (foldT2R2 [sndTT] [colMeta]
+                                    [fn cols => $(mapT2T (fn t :: (Type * Type) =>
+                                                             sql_exp [] [] [] t.1) cols)]
+                                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                     [[nm] ~ rest] =>
+                                     fn input col acc => acc with nm = @sql_inject col.Inject (col.Parse input))
+                                    {} [M.cols] inputs M.cols
+                           with #Id = (SQL {id})));
+        return <xml><body>
+          Inserted with ID {[id]}.
+        </body></xml>
+
+    fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) =
+        () <- dml (update [mapT2T fstTT M.cols]
+                          (foldT2R2 [sndTT] [colMeta]
+                                    [fn cols => $(mapT2T (fn t :: (Type * Type) =>
+                                                             sql_exp [T = [Id = int]
+                                                                              ++ mapT2T fstTT M.cols]
+                                                                     [] [] t.1) cols)]
+                                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                     [[nm] ~ rest] =>
+                                     fn input col acc => acc with nm =
+                                                                  @sql_inject col.Inject (col.Parse input))
+                                    {} [M.cols] inputs M.cols)
+                          tab (WHERE T.Id = {id}));
+        return <xml><body>
+          Saved!
+        </body></xml>
+
+    fun update (id : int) =
+        fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
+        case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
+            None => return <xml><body>Not found!</body></xml>
+          | Some fs => return <xml><body><form>
+            {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
+                      (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                       [[nm] ~ rest] (v : t.1) (col : colMeta t)
+                                       (acc : xml form [] (mapT2T sndTT rest)) =>
+                          <xml>
+                            <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+                            {useMore acc}
+                          </xml>)
+                      <xml/>
+                      [M.cols] fs.Tab M.cols}
+
+            <submit action={save id}/>
+          </form></body></xml>
+
+    fun delete (id : int) =
+        () <- dml (DELETE FROM tab WHERE Id = {id});
+        return <xml><body>
+          The deed is done.
+        </body></xml>
+
+    fun confirm (id : int) = return <xml><body>
+      <p>Are you sure you want to delete ID #{[id]}?</p>
+
+      <p><a link={delete id}>I was born sure!</a></p>
+    </body></xml>
+
+    fun main () =
+        rows <- queryX (SELECT * FROM tab AS T)
+                       (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
+                         <tr>
+                           <td>{[fs.T.Id]}</td>
+                           {foldT2RX2 [fstTT] [colMeta] [tr]
+                                      (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                                       [[nm] ~ rest] v col => <xml>
+                                                         <td>{col.Show v}</td>
+                                                       </xml>)
+                                      [M.cols] (fs.T -- #Id) M.cols}
+                           <td>
+                             <a link={update fs.T.Id}>[Update]</a>
+                             <a link={confirm fs.T.Id}>[Delete]</a>
+                           </td>
+                         </tr>
+                       </xml>);
+        return <xml><head>
+          <title>{cdata M.title}</title>
+        </head><body>
+
+          <h1>{cdata M.title}</h1>
+
+          <table border={1}>
+            <tr>
+              <th>ID</th>
+              {foldT2RX [colMeta] [tr]
+                        (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                         [[nm] ~ rest] col => <xml>
+                                           <th>{cdata col.Nam}</th>
+                                         </xml>)
+                        [M.cols] M.cols}
+            </tr>
+            {rows}
+          </table>
+
+          <br/>
+
+          <form>
+            {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
+                     (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                      [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
+                                        <li> {cdata col.Nam}: {col.Widget [nm]}</li>
+                                        {useMore acc}
+                                      </xml>)
+                     <xml/>
+                     [M.cols] M.cols}
+            
+            <submit action={create}/>
+          </form>
+        </body></xml>
+
+end
diff --git a/tests/crud.urs b/tests/crud.urs
new file mode 100644
index 0000000..ffb1d3f
--- /dev/null
+++ b/tests/crud.urs
@@ -0,0 +1,26 @@
+con colMeta = fn t_formT :: (Type * Type) =>
+                 {Nam : string,
+                  Show : t_formT.1 -> xbody,
+                  Widget : nm :: Name -> xml form [] [nm = t_formT.2],
+                  WidgetPopulated : nm :: Name -> t_formT.1
+                                    -> xml form [] [nm = t_formT.2],
+                  Parse : t_formT.2 -> t_formT.1,
+                  Inject : sql_injectable t_formT.1}
+con colsMeta = fn cols :: {(Type * Type)} => $(mapT2T colMeta cols)
+
+val int : string -> colMeta (int, string)
+val float : string -> colMeta (float, string)
+val string : string -> colMeta (string, string)
+val bool : string -> colMeta (bool, bool)
+
+functor Make(M : sig
+                 con cols :: {(Type * Type)}
+                 constraint [Id] ~ cols
+                 table tab : ([Id = int] ++ mapT2T fstTT cols)
+
+                 val title : string
+
+                 val cols : colsMeta cols
+             end) : sig
+    val main : unit -> transaction page
+end
diff --git a/tests/crud1.html b/tests/crud1.html
new file mode 100644
index 0000000..b1f34b5
--- /dev/null
+++ b/tests/crud1.html
@@ -0,0 +1,35 @@
+<!DOCTYPE html><html><head></head><body>
+<p>Inserted with ID 1.</p>
+
+<table border="1">
+<tr>
+<th>ID</th>
+<th>A</th>
+<th>B</th>
+<th>C</th>
+<th>D</th>
+</tr>
+
+<tr>
+<td>1</td>
+<td>1</td>
+<td>2</td>
+<td>3</td>
+<td>True</td>
+<td>
+<a href="/Demo/Crud1/upd/1">[Update]</a>
+<a href="/Demo/Crud1/confirm/1">[Delete]</a>
+</td>
+</tr>
+
+</table>
+<br /><hr /><br />
+<form method="post" action="/Demo/Crud1/create">
+<li> A: <input type="text" name="A" /></li>
+<li> B: <input type="text" name="B" /></li>
+<li> C: <input type="text" name="C" /></li>
+<li> D: <input type="checkbox" name="D" /></li>
+<input type="submit" />
+</form>
+
+</body></html>
\ No newline at end of file
diff --git a/tests/crud1.ur b/tests/crud1.ur
new file mode 100644
index 0000000..3849e82
--- /dev/null
+++ b/tests/crud1.ur
@@ -0,0 +1,12 @@
+table t1 : {Id : int, A : int, B : string, C : float, D : bool}
+
+open Crud.Make(struct
+                   val tab = t1
+                             
+                   val title = "Crud1"
+                               
+                   val cols = {A = Crud.int "A",
+                               B = Crud.string "B",
+                               C = Crud.float "C",
+                               D = Crud.bool "D"}
+               end)
diff --git a/tests/crud1.urp b/tests/crud1.urp
new file mode 100644
index 0000000..5920f35
--- /dev/null
+++ b/tests/crud1.urp
@@ -0,0 +1,7 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+crud
+crud1
diff --git a/tests/crypt.ur b/tests/crypt.ur
new file mode 100644
index 0000000..e1f48c6
--- /dev/null
+++ b/tests/crypt.ur
@@ -0,0 +1,7 @@
+fun cryptIt r = return <xml><body>
+  {[crypt r.Pass "AB"]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form><textbox{#Pass}/> <submit action={cryptIt}/></form>
+</body></xml>
diff --git a/tests/crypt.urs b/tests/crypt.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/crypt.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/csdebug.ur b/tests/csdebug.ur
new file mode 100644
index 0000000..66ba0ae
--- /dev/null
+++ b/tests/csdebug.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page =
+    n <- source 0;
+    return <xml><body>
+      <button onclick={n' <- get n; set n (n' + 1); debug ("Message: " ^ show n')}/>
+    </body></xml>
diff --git a/tests/cselect.ur b/tests/cselect.ur
new file mode 100644
index 0000000..f2a8355
--- /dev/null
+++ b/tests/cselect.ur
@@ -0,0 +1,11 @@
+fun main () =
+    s <- source "";
+    return <xml><body>
+      <cselect source={s} onchange={v <- get s; alert ("Now it's " ^ v)}>
+        <coption>Wilbur</coption>
+        <coption>Walbur</coption>
+      </cselect>
+
+      Hello, I'm <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/>.
+      I'll be your waiter for this evening.
+    </body></xml>
diff --git a/tests/cselect.urp b/tests/cselect.urp
new file mode 100644
index 0000000..30dfa2c
--- /dev/null
+++ b/tests/cselect.urp
@@ -0,0 +1,3 @@
+debug
+
+cselect
diff --git a/tests/cselect.urs b/tests/cselect.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cselect.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/css.ur b/tests/css.ur
new file mode 100644
index 0000000..6806c84
--- /dev/null
+++ b/tests/css.ur
@@ -0,0 +1,16 @@
+style st1
+style st2
+style st_3
+
+fun main () = return <xml><body>
+  <span title="Whoa" class={classes st1 st2}>Hi!</span>
+  <span class="st-3 st2">Bye!</span>
+  <span class="st1">Appendix!</span>
+  <span class="">Sequel!</span>
+
+  <span style="width: 30%">A</span>
+  <span class="st-3" style="color: blue red">B</span>
+  <span style="background: url(http://www.google.com/image.png)">C</span>
+  <span style="background: url('http://www.google.com/image.png') red 10% 66px">D</span>
+  <span style="color: red; width: 90 green; background: url(http://www.google.com/foo.jpg);">C</span>
+</body></xml>
diff --git a/tests/css.urp b/tests/css.urp
new file mode 100644
index 0000000..38d47f2
--- /dev/null
+++ b/tests/css.urp
@@ -0,0 +1,5 @@
+allow url http://www.google.com/*
+
+# Comment here
+css # Comment at end of line!
+# Comments everywhere!
diff --git a/tests/css.urs b/tests/css.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/css.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/cssNull.ur b/tests/cssNull.ur
new file mode 100644
index 0000000..4939c71
--- /dev/null
+++ b/tests/cssNull.ur
@@ -0,0 +1,6 @@
+style spicy
+
+fun main () : transaction page = return <xml><body>
+  <span class={null}>Boring</span>
+  <span class={classes null spicy}>Spicy!</span>
+</body></xml>
diff --git a/tests/cst.ur b/tests/cst.ur
new file mode 100644
index 0000000..a0ccf53
--- /dev/null
+++ b/tests/cst.ur
@@ -0,0 +1,41 @@
+table u : {C : int, D : int, E : option int, F : string}
+  PRIMARY KEY C,
+  CONSTRAINT U UNIQUE (C, D),
+  CONSTRAINT U2 UNIQUE E,
+
+  CONSTRAINT Pos CHECK D > 0,
+  CONSTRAINT NoNo CHECK C + D <> 2,
+  CONSTRAINT Known CHECK F = "_E = 6"
+
+table t : {A : int, B : int, C : option int}
+  PRIMARY KEY B,
+
+  CONSTRAINT UniA UNIQUE A,
+  CONSTRAINT UniB UNIQUE B,
+  CONSTRAINT UniBoth UNIQUE (A, B),
+
+  CONSTRAINT UniAm UNIQUE {#A},
+  CONSTRAINT UniAm2 {unique [#A] [[]] ! !},
+  {{one_constraint [#UniAm3] (unique [#A] [[]] ! !)}},
+
+  CONSTRAINT UniBothm UNIQUE ({#A}, {#B}),
+  CONSTRAINT UniBothm2 {unique [#A] [[B = _]] ! !},
+  {{one_constraint [#UniBothm3] (unique [#A] [[B = _]] ! !)}},
+
+  CONSTRAINT ForA FOREIGN KEY A REFERENCES u (C),
+  CONSTRAINT ForAB FOREIGN KEY (A, B) REFERENCES u (D, C) ON DELETE CASCADE ON UPDATE RESTRICT,
+  CONSTRAINT ForBA FOREIGN KEY (A, B) REFERENCES u (C, D) ON UPDATE NO ACTION,
+  CONSTRAINT ForB FOREIGN KEY B REFERENCES u (E),
+  CONSTRAINT ForC FOREIGN KEY C REFERENCES u (C),
+
+  CONSTRAINT Self FOREIGN KEY B REFERENCES t (B)
+
+table s : {B : option int}
+  CONSTRAINT UniB UNIQUE B
+
+table s2 : {B : option int}
+  CONSTRAINT ForB FOREIGN KEY B REFERENCES s (B) ON DELETE SET NULL
+
+fun main () : transaction page =
+    queryI (SELECT * FROM t) (fn _ => return ());
+    return <xml/>
diff --git a/tests/cst.urp b/tests/cst.urp
new file mode 100644
index 0000000..b9deaa4
--- /dev/null
+++ b/tests/cst.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=cst
+sql cst.sql
+
+cst
diff --git a/tests/ctextarea.ur b/tests/ctextarea.ur
new file mode 100644
index 0000000..86a8c73
--- /dev/null
+++ b/tests/ctextarea.ur
@@ -0,0 +1,8 @@
+fun main () =
+    s <- source "DEFAULT";
+    return <xml><body>
+      <ctextarea rows={2} source={s}/><br/>
+      <br/>
+
+      <dyn signal={s <- signal s; return (cdata s)}/>
+    </body></xml>
diff --git a/tests/ctextarea.urp b/tests/ctextarea.urp
new file mode 100644
index 0000000..2ed9b69
--- /dev/null
+++ b/tests/ctextarea.urp
@@ -0,0 +1,3 @@
+debug
+
+ctextarea
diff --git a/tests/ctextarea.urs b/tests/ctextarea.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/ctextarea.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/ctextbox.ur b/tests/ctextbox.ur
new file mode 100644
index 0000000..38c6c57
--- /dev/null
+++ b/tests/ctextbox.ur
@@ -0,0 +1,15 @@
+style foo
+
+fun main () : transaction page =
+    s <- source "Initial";
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="http://localhost/static/style.css"/>
+      </head>
+      <body>
+        <ctextbox source={s} size=5/>
+        <ctextbox class={foo} source={s}/>
+
+        <dyn signal={s <- signal s; return (cdata s)}/>
+      </body>
+    </xml>
diff --git a/tests/ctextbox.urp b/tests/ctextbox.urp
new file mode 100644
index 0000000..5c6c5df
--- /dev/null
+++ b/tests/ctextbox.urp
@@ -0,0 +1,5 @@
+debug
+allow url http://localhost/*
+rewrite url Ctextbox/*
+
+ctextbox
diff --git a/tests/ctextboxAttrs.ur b/tests/ctextboxAttrs.ur
new file mode 100644
index 0000000..84cd087
--- /dev/null
+++ b/tests/ctextboxAttrs.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+    s <- source "Initial";
+    return <xml><body>
+      <ctextbox source={s} onclick={fn ev => alert ("Clicky " ^ show ev.ScreenX)}
+                           onkeypress={fn ev => alert ("Code " ^ show ev.KeyCode)}/>
+    </body></xml>
diff --git a/tests/ctuple.ur b/tests/ctuple.ur
new file mode 100644
index 0000000..68c1301
--- /dev/null
+++ b/tests/ctuple.ur
@@ -0,0 +1,9 @@
+val page = fn p :: (Type * Type) => fn f : p.1 -> string => fn x : p.1 => <html><body>
+        {cdata (f x)}
+</body></html>
+
+val page_string = page [(string, int)] (fn x => x)
+
+val main : unit -> page = fn () => <html><body>
+        <a link={page_string "Hi"}>Hi</a>
+</body></html>
diff --git a/tests/curry.ur b/tests/curry.ur
new file mode 100644
index 0000000..4657728
--- /dev/null
+++ b/tests/curry.ur
@@ -0,0 +1 @@
+val main = fn x : int => fn y : int => x
diff --git a/tests/curry3.ur b/tests/curry3.ur
new file mode 100644
index 0000000..fa2804c
--- /dev/null
+++ b/tests/curry3.ur
@@ -0,0 +1 @@
+val main = fn x : int => fn y : int => fn z : int => x
diff --git a/tests/cut.ur b/tests/cut.ur
new file mode 100644
index 0000000..7d0ee77
--- /dev/null
+++ b/tests/cut.ur
@@ -0,0 +1,7 @@
+val r = {A = 1, B = "Hi", C = 0.0}
+val rA = r -- #A
+val rB = r --- [A = _, C = _]
+
+fun main () : transaction page = return <xml>
+        {cdata rA.B}, {cdata rB.B}
+</xml>
diff --git a/tests/cut.urp b/tests/cut.urp
new file mode 100644
index 0000000..5c9c3e8
--- /dev/null
+++ b/tests/cut.urp
@@ -0,0 +1,3 @@
+debug
+
+cut
diff --git a/tests/cyrillic.ur b/tests/cyrillic.ur
new file mode 100644
index 0000000..f125792
--- /dev/null
+++ b/tests/cyrillic.ur
@@ -0,0 +1,2 @@
+fun main () = return <xml><body>одел
+Hi!</body></xml>
diff --git a/tests/cyrillic.urp b/tests/cyrillic.urp
new file mode 100644
index 0000000..279d4af
--- /dev/null
+++ b/tests/cyrillic.urp
@@ -0,0 +1,2 @@
+
+cyrillic
diff --git a/tests/cyrillic.urs b/tests/cyrillic.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/cyrillic.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/data_attr.ur b/tests/data_attr.ur
new file mode 100644
index 0000000..4462dc1
--- /dev/null
+++ b/tests/data_attr.ur
@@ -0,0 +1,26 @@
+fun dynd r = return <xml><body>
+  <div data={data_attr data_kind r.Attr r.Value}>How about that?</div>
+</body></xml>
+
+fun main () : transaction page =
+  s <- source <xml/>;
+  a <- source "";
+  v <- source "";
+  return <xml><body>
+    <div data-foo="hi" aria-something="wow" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
+
+    <hr/>
+
+    <form>
+      <textbox{#Attr}/> = <textbox{#Value}/>
+      <submit action={dynd}/>
+    </form>
+
+    <hr/>
+
+    <ctextbox source={a}/> = <ctextbox source={v}/>
+    <button onclick={fn _ =>
+      a <- get a; v <- get v; set s <xml><div data={data_attr data_kind a v}>OHO!</div></xml>}/>
+    <hr/>
+    <dyn signal={signal s}/>
+  </body></xml>
diff --git a/tests/data_attr.urs b/tests/data_attr.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/data_attr.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/datatype.ur b/tests/datatype.ur
new file mode 100644
index 0000000..302a7da
--- /dev/null
+++ b/tests/datatype.ur
@@ -0,0 +1,16 @@
+datatype t = A | B
+
+val a = A
+val b = B
+
+datatype foo = C of t
+
+val c = C a
+
+datatype list = Nil | Cons of {Head : int, Tail : list}
+
+val nil = Nil
+val l1 = Cons {Head = 0, Tail = nil}
+
+datatype term = App of term * term | Abs of term -> term
+
diff --git a/tests/datatype.urp b/tests/datatype.urp
new file mode 100644
index 0000000..f79cb87
--- /dev/null
+++ b/tests/datatype.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+datatype
diff --git a/tests/datatypeMod.ur b/tests/datatypeMod.ur
new file mode 100644
index 0000000..f82b009
--- /dev/null
+++ b/tests/datatypeMod.ur
@@ -0,0 +1,28 @@
+structure M : sig datatype t = A | B end = struct
+        datatype t = A | B
+end
+
+val ac = M.A
+
+datatype u = datatype M.t
+
+val ac : M.t = A
+val a2 : u = ac
+
+structure M2 = M
+structure M3 : sig datatype t = datatype M.t end = M2
+structure M4 : sig datatype t = datatype M.t end = M
+
+val bc : M3.t = M4.B
+
+structure Ma : sig type t end = M
+
+structure Magain : sig datatype t = A | B end = M
+
+val page : M.t -> page = fn x => <html><body>
+        Hi.
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <a link={page a2}>Link</a>
+</body></html>
diff --git a/tests/datatypeP.ur b/tests/datatypeP.ur
new file mode 100644
index 0000000..171d881
--- /dev/null
+++ b/tests/datatypeP.ur
@@ -0,0 +1,21 @@
+datatype option a = None | Some of a
+
+val none : option int = None
+val some_1 : option int = Some 1
+
+val f = fn t ::: Type => fn x : option t =>
+        case x of None => None | Some x => Some (Some x)
+
+val none_again = f none
+val some_1_again = f some_1
+
+val show = fn t ::: Type => fn x : option t => case x of None => "None" | Some _ => "Some"
+
+val page = fn x => <html><body>
+        {cdata (show x)}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page none_again}>None</a></li>
+        <li><a link={page some_1_again}>Some 1</a></li>
+</body></html>
diff --git a/tests/datatypeP2.ur b/tests/datatypeP2.ur
new file mode 100644
index 0000000..09cc964
--- /dev/null
+++ b/tests/datatypeP2.ur
@@ -0,0 +1,15 @@
+datatype sum a b = Left of a | Right of b
+
+val l : sum int string = Left 5
+val r : sum int string = Right "Hi"
+
+val show = fn x : sum int string => case x of Left _ => "Left _" | Right s => s
+
+val page = fn x => <html><body>
+        {cdata (show x)}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page l}>Left</a></li>
+        <li><a link={page r}>Right</a></li>
+</body></html>
diff --git a/tests/dbupload.ur b/tests/dbupload.ur
new file mode 100644
index 0000000..f088d63
--- /dev/null
+++ b/tests/dbupload.ur
@@ -0,0 +1,25 @@
+table t : { Id : int, Blob : blob, MimeType : string }
+sequence s
+
+fun getImage id : transaction page =
+    r <- oneRow1 (SELECT t.Blob, t.MimeType
+                  FROM t
+                  WHERE t.Id = {[id]});
+    returnBlob r.Blob (blessMime r.MimeType)
+
+fun main () : transaction page =
+    let
+        fun handle r =
+            id <- nextval s;
+            dml (INSERT INTO t (Id, Blob, MimeType)
+                 VALUES ({[id]}, {[fileData r.File]}, {[fileMimeType r.File]}));
+            main ()
+    in
+        x <- queryX1 (SELECT t.Id FROM t)
+                     (fn r => <xml><img src={url (getImage r.Id)}/><br/></xml>);
+        return <xml><body>
+          <form><upload{#File}/> <submit action={handle}/></form>
+          <hr/>
+          {x}
+        </body></xml>
+    end
diff --git a/tests/dbupload.urp b/tests/dbupload.urp
new file mode 100644
index 0000000..dd8417d
--- /dev/null
+++ b/tests/dbupload.urp
@@ -0,0 +1,6 @@
+database dbname=dbupload
+sql dbupload.sql
+allow mime *
+rewrite all Dbupload/*
+
+dbupload
diff --git a/tests/dbupload2.sh b/tests/dbupload2.sh
new file mode 100755
index 0000000..cecf196
--- /dev/null
+++ b/tests/dbupload2.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+set -e
+
+cd `dirname $0`
+
+urweb -dbms sqlite dbupload2
+
+rm -rf dbupload2.db || true
+sqlite3 dbupload2.db < dbupload2.sql
+
+./dbupload2.exe -p 8083 &
+sleep 1
+
+touch /tmp/empty
+curl --verbose -F"operation=upload" -F"filename=@/tmp/empty" http://localhost:8083/Blabla/bla
+
diff --git a/tests/dbupload2.ur b/tests/dbupload2.ur
new file mode 100644
index 0000000..428f246
--- /dev/null
+++ b/tests/dbupload2.ur
@@ -0,0 +1,29 @@
+table t : { Id : int, Blob : blob, MimeType : string }
+sequence s
+
+fun getImage id : transaction page =
+    r <- oneRow1 (SELECT t.Blob, t.MimeType
+                  FROM t
+                  WHERE t.Id = {[id]});
+    returnBlob r.Blob (blessMime r.MimeType)
+
+fun handle (r : {File:file, Param:string}) =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Blob, MimeType)
+         VALUES ({[id]}, {[fileData r.File]}, {[fileMimeType r.File]}));
+    debug ("Text is " ^ r.Param);
+    main ()
+
+and main () : transaction page =
+    x <- queryX1 (SELECT t.Id FROM t)
+                 (fn r => <xml><img src={url (getImage r.Id)}/>
+</xml>);
+    return <xml><body>
+      <form>
+      <upload{#File}/>
+      <textbox{#Param} value="text"/>
+      <submit action={handle}/>
+      </form>
+      <hr/>
+      {x}
+    </body></xml>
diff --git a/tests/dbupload2.urp b/tests/dbupload2.urp
new file mode 100644
index 0000000..bd55058
--- /dev/null
+++ b/tests/dbupload2.urp
@@ -0,0 +1,7 @@
+database dbname=dbupload2.db
+sql dbupload2.sql
+allow mime *
+rewrite all Dbupload2/*
+debug
+
+dbupload2
diff --git a/tests/dbupload2.urs b/tests/dbupload2.urs
new file mode 100644
index 0000000..80240de
--- /dev/null
+++ b/tests/dbupload2.urs
@@ -0,0 +1 @@
+val main: {} -> transaction page
diff --git a/tests/dcol.ur b/tests/dcol.ur
new file mode 100644
index 0000000..b52cf3e
--- /dev/null
+++ b/tests/dcol.ur
@@ -0,0 +1,8 @@
+fun main () =
+  s <- source <xml><td>A</td><td>A'</td></xml>;
+  return <xml><body>
+    <button value="Click me!" onclick={set s <xml><td>B</td><td>B'</td></xml>}/><br/>
+    <table><tr><td>Pre</td><td>Pre'</td></tr>
+      <tr><td>Hehe</td><dyn signal={signal s}/><td>Hoho</td></tr>
+      <tr><td>Post</td><td>Post</td><td>Post'</td></tr></table>
+  </body></xml>
diff --git a/tests/dcol.urp b/tests/dcol.urp
new file mode 100644
index 0000000..1337c66
--- /dev/null
+++ b/tests/dcol.urp
@@ -0,0 +1,3 @@
+debug
+
+dcol
diff --git a/tests/dcol.urs b/tests/dcol.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/dcol.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/delete.ur b/tests/delete.ur
new file mode 100644
index 0000000..fee6381
--- /dev/null
+++ b/tests/delete.ur
@@ -0,0 +1,5 @@
+table t1 : {A : int, B : string, C : float, D : bool}
+
+fun main () : transaction page =
+        () <- dml (DELETE FROM t1 WHERE A = 5);
+        return <html><body>Deleted.</body></html>
diff --git a/tests/delete.urp b/tests/delete.urp
new file mode 100644
index 0000000..61ed022
--- /dev/null
+++ b/tests/delete.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+delete
diff --git a/tests/dep.urp b/tests/dep.urp
new file mode 100644
index 0000000..074f1b0
--- /dev/null
+++ b/tests/dep.urp
@@ -0,0 +1,4 @@
+dep1
+dep2
+dep3
+dep4
diff --git a/tests/dep1.ur b/tests/dep1.ur
new file mode 100644
index 0000000..dd90c56
--- /dev/null
+++ b/tests/dep1.ur
@@ -0,0 +1 @@
+val x = "Hello world"
diff --git a/tests/dep2.ur b/tests/dep2.ur
new file mode 100644
index 0000000..62cf321
--- /dev/null
+++ b/tests/dep2.ur
@@ -0,0 +1 @@
+val y = Dep1.x
diff --git a/tests/dep3.ur b/tests/dep3.ur
new file mode 100644
index 0000000..fab407e
--- /dev/null
+++ b/tests/dep3.ur
@@ -0,0 +1 @@
+val y = Dep1.x ^ "?!"
diff --git a/tests/dep4.ur b/tests/dep4.ur
new file mode 100644
index 0000000..7985829
--- /dev/null
+++ b/tests/dep4.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  {[Dep2.y]}!
+</body></xml>
diff --git a/tests/disallowed.ur b/tests/disallowed.ur
new file mode 100644
index 0000000..a673a2a
--- /dev/null
+++ b/tests/disallowed.ur
@@ -0,0 +1,3 @@
+cookie bad : url
+
+fun worse (x : url) : transaction page = return <xml/>
diff --git a/tests/disjoint.ur b/tests/disjoint.ur
new file mode 100644
index 0000000..2627801
--- /dev/null
+++ b/tests/disjoint.ur
@@ -0,0 +1,35 @@
+con c1 = fn x :: Name => [x] ~ [A] => [x = int, A = string]
+con c2 = fn x :: Name => [x] ~ [A] => [A, x]
+con c3 = fn x :: Name => [A] ~ [x] => [x, A]
+con c4 = fn x :: Name => [A] ~ [x] => [A, x]
+
+con c5 = fn r1 :: {Type} => fn r2 => r1 ~ r2 => r1 ++ r2
+con c6 = fn r1 :: {Type} => fn r2 => r2 ~ r1 => r1 ++ r2
+
+con c7 = fn x :: Name => fn r => [x] ~ r => [x = int] ++ r
+
+val vt1 = fn x : $(c1 #B) => x.B
+val vt2 = fn x : $(c1 #B) => x.A
+val vt3 = fn x : $(c1 #C) => x.A
+val vt4 = fn x : $(c1 #C) => x.A
+(*
+val vtX = fn x : $(c1 #A) => x.A
+val vtX = fn x : $(c1 #A) => x.A
+*)
+
+val v1 = fn x :: Name => fn [x] ~ [A] => fn y : {x : int, A : string} => y.x
+
+val vt5 = v1 [#B] {A = "Hi", B = 0}
+(*
+val vtX = v1 [#A] {A = "Hi", A = 0}
+*)
+
+val v2 = fn x :: Name => fn r :: {Type} => fn y : $(c7 x r) => fn [x] ~ r => y.x
+val vt6 = v2 [#A] [[B = float, C = string]] {A = 8, B = 8.0, C = "8"}
+
+(*
+val vtX = v2 [#A] [[B = float, B = string]] {A = 8, B = 8.0, B = "8"}
+val vtX = v2 [#A] [[A = float, B = string]] {A = 8, A = 8.0, B = "8"}
+*)
+
+val main = vt6
diff --git a/tests/div.ur b/tests/div.ur
new file mode 100644
index 0000000..69a0927
--- /dev/null
+++ b/tests/div.ur
@@ -0,0 +1,43 @@
+functor Make(M : sig
+                 type t
+                 val read_t : read t
+                 val show_t : show t
+                 val num_t : num t
+             end) = struct
+    fun calculate (n1, n2) = return <xml><body>
+      {[readError n1 / readError n2 : M.t]}<br/>
+      {[readError n1 % readError n2 : M.t]}<br/>
+    </body></xml>
+
+    fun main () =
+        s1 <- source "";
+        s2 <- source "";
+        s3 <- source "";
+        s4 <- source "";
+        return <xml><body>
+          <h1>Client-side</h1>
+
+          <ctextbox source={s1}/> / <ctextbox source={s2}/>
+          <button value="=" onclick={n1 <- get s1;
+                                     n2 <- get s2;
+                                     set s3 (show (readError n1 / readError n2 : M.t));
+                                     set s4 (show (readError n1 % readError n2 : M.t))}/>
+          <dyn signal={n <- signal s3; return (txt n)}/>,
+          <dyn signal={n <- signal s4; return (txt n)}/>
+
+          <h1>Server-side</h1>
+
+          <form>
+            <textbox{#1}/> / <textbox{#2}/>
+            <submit value="=" action={calculate}/>
+          </form>
+        </body></xml>
+end
+
+structure Int = Make(struct type t = int end)
+structure Float = Make(struct type t = float end)
+
+fun main () : transaction page = return <xml><body>
+  <li><a link={Int.main ()}>Int</a></li>
+  <li><a link={Float.main ()}>Float</a></li>
+</body></xml>
diff --git a/tests/dlist.ur b/tests/dlist.ur
new file mode 100644
index 0000000..0733a0d
--- /dev/null
+++ b/tests/dlist.ur
@@ -0,0 +1,23 @@
+datatype dlist = Nil | Cons of string * source dlist
+
+fun delist dl =
+    case dl of
+        Nil => <xml>[]</xml>
+      | Cons (x, s) => <xml>{[x]} :: ({delistSource s})</xml>
+
+and delistSource s = <xml><dyn signal={dl <- signal s; return (delist dl)}/></xml>
+
+fun main () : transaction page =
+    ns <- source Nil;
+    s <- source ns;
+    tb <- source "";
+    return <xml><body>
+      <dyn signal={s <- signal s; return (delistSource s)}/><br/>
+      <br/>
+      <ctextbox source={tb}/>
+      <button value="Add" onclick={hd <- get tb;
+                                   tl <- get s;
+                                   s' <- source (Cons (hd, tl));
+                                   set s s'}/>
+      <button value="Reset" onclick={set s ns}/>
+    </body></xml>
diff --git a/tests/dlist.urp b/tests/dlist.urp
new file mode 100644
index 0000000..1603727
--- /dev/null
+++ b/tests/dlist.urp
@@ -0,0 +1,3 @@
+debug
+
+dlist
diff --git a/tests/dlist2.ur b/tests/dlist2.ur
new file mode 100644
index 0000000..3d2c710
--- /dev/null
+++ b/tests/dlist2.ur
@@ -0,0 +1,25 @@
+datatype dlist = Nil | Cons of string * source dlist
+
+fun delist dl =
+    case dl of
+        Nil => <xml>[]</xml>
+      | Cons (x, s) => <xml>{[x]} <ctextbox/> :: {delistSource s}</xml>
+
+and delistSource s = <xml><dyn signal={dl <- signal s; return (delist dl)}/></xml>
+
+fun main () : transaction page =
+    tail0 <- source Nil;
+    tail <- source tail0;
+    tb <- source "";
+    return <xml><body>
+      {delist (Cons ("ROOT", tail0))}
+      <br/>
+      <ctextbox source={tb}/>
+      <button value="Add" onclick={hd <- get tb;
+                                   tl <- source Nil;
+                                   old <- get tail;
+
+                                   set old (Cons (hd, tl));
+                                   set tail tl}/>
+      <button value="Reset" onclick={set tail0 Nil; set tail tail0}/>
+    </body></xml>
diff --git a/tests/dlist2.urp b/tests/dlist2.urp
new file mode 100644
index 0000000..dc43ef1
--- /dev/null
+++ b/tests/dlist2.urp
@@ -0,0 +1,3 @@
+debug
+
+dlist2
diff --git a/tests/docevents.ur b/tests/docevents.ur
new file mode 100644
index 0000000..906afa2
--- /dev/null
+++ b/tests/docevents.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page = return <xml>
+  <body onload={onDblclick (fn _ => alert "Double click");
+                onContextmenu (fn _ => alert "Context menu");
+                onKeypress (fn k => alert ("Keypress: " ^ show k.KeyCode))}>
+    Nothing here.
+    </body>
+</xml>
diff --git a/tests/doubleDyn.ur b/tests/doubleDyn.ur
new file mode 100644
index 0000000..97cf57d
--- /dev/null
+++ b/tests/doubleDyn.ur
@@ -0,0 +1,22 @@
+style linktitle
+style topic
+
+fun main () : transaction page =
+    text <- source "Lorem ipsum dolor sit amet";
+    cls <- source linktitle;
+    return <xml>
+      <head>
+        <title>Dynamic CSS class test</title>
+        <link href="http://adam.chlipala.net/style.css" rel="stylesheet" type="text/css" media="all"/>
+      </head>
+      <body>
+        <dyn signal={t <- signal text;
+                     return <xml><div dynClass={signal cls}>{[t]}</div></xml>}/>
+        <div dynClass={signal cls}>
+          <dyn signal={t <- signal text; return (txt t)}/>
+        </div>
+        <button value="Style1" onclick={set cls linktitle}/>
+        <button value="Style2" onclick={set cls topic}/>
+        <ctextbox source={text}/>
+      </body>
+    </xml>
diff --git a/tests/doubleDyn.urp b/tests/doubleDyn.urp
new file mode 100644
index 0000000..7052290
--- /dev/null
+++ b/tests/doubleDyn.urp
@@ -0,0 +1,4 @@
+allow url http://adam.chlipala.net/style.css
+rewrite all DoubleDyn/*
+
+doubleDyn
diff --git a/tests/dtable.ur b/tests/dtable.ur
new file mode 100644
index 0000000..3a87b7b
--- /dev/null
+++ b/tests/dtable.ur
@@ -0,0 +1,6 @@
+fun main () =
+  s <- source <xml><tr><td>A</td><td>A'</td></tr></xml>;
+  return <xml><body>
+    <button value="Click me!" onclick={set s <xml><tr><td>B</td><td>B'</td></tr><tr><td>C</td><td>C'</td></tr></xml>}/><br/>
+    <table><tr><td>Pre</td><td>Pre'</td></tr><dyn signal={signal s}/><tr><td>Post</td><td>Post</td><td>Post'</td></tr></table>
+  </body></xml>
diff --git a/tests/dtable.urp b/tests/dtable.urp
new file mode 100644
index 0000000..9a35d28
--- /dev/null
+++ b/tests/dtable.urp
@@ -0,0 +1,3 @@
+debug
+
+dtable
diff --git a/tests/dtable.urs b/tests/dtable.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/dtable.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/dtfunctor.ur b/tests/dtfunctor.ur
new file mode 100644
index 0000000..8425747
--- /dev/null
+++ b/tests/dtfunctor.ur
@@ -0,0 +1,9 @@
+functor Make(M : sig end) = struct
+    datatype t = A | B
+end
+
+structure A = Make(struct end)
+structure B = Make(struct end)
+
+fun main (x : A.t) (y : B.t) : transaction page =
+    return <xml/>
diff --git a/tests/dynClass.ur b/tests/dynClass.ur
new file mode 100644
index 0000000..7cb94d2
--- /dev/null
+++ b/tests/dynClass.ur
@@ -0,0 +1,31 @@
+style date
+style topic
+
+fun main () : transaction page =
+    toggle <- source False;
+    return <xml>
+      <head>
+	<link rel="stylesheet" type="text/css" href="http://adam.chlipala.net/style.css"/>
+      </head>
+      <body>
+	<button dynClass={b <- signal toggle;
+                          return (if b then date else topic)}
+                dynStyle={b <- signal toggle;
+                          return (if b then
+                                      STYLE "width: 500px"
+                                  else
+                                      STYLE "width: 200px")}
+                onclick={fn _ => b <- get toggle; set toggle (not b)}/>
+
+        <button dynStyle={b <- signal toggle;
+                          return (if b then
+                                      STYLE "width: 200px"
+                                  else
+                                      STYLE "width: 100px")}/>
+        <button dynClass={b <- signal toggle;
+                          return (if b then
+                                      topic
+                                  else
+                                      date)}/>
+      </body>
+    </xml>
diff --git a/tests/dynClass.urp b/tests/dynClass.urp
new file mode 100644
index 0000000..0818a3b
--- /dev/null
+++ b/tests/dynClass.urp
@@ -0,0 +1,4 @@
+rewrite all DynClass/*
+allow url http://adam.chlipala.net/*
+
+dynClass
diff --git a/tests/dynClassB.ur b/tests/dynClassB.ur
new file mode 100644
index 0000000..fc7aeb4
--- /dev/null
+++ b/tests/dynClassB.ur
@@ -0,0 +1,17 @@
+style style1
+style style2
+
+fun main () : transaction page =
+    toggle <- source False;
+    return <xml>
+      <head>
+	<link rel="stylesheet" type="text/css" href="/style.css"/>
+      </head>
+      <body dynClass={b <- signal toggle;
+                      return (if b then style1 else style2)}
+            dynStyle={b <- signal toggle;
+                      return (if b then STYLE "margin: 100px" else STYLE "")}>
+        Body
+	<button onclick={fn _ => b <- get toggle; set toggle (not b)}>TOGGLE</button>
+      </body>
+    </xml>
diff --git a/tests/dynClassB.urp b/tests/dynClassB.urp
new file mode 100644
index 0000000..e580b03
--- /dev/null
+++ b/tests/dynClassB.urp
@@ -0,0 +1,5 @@
+rewrite all DynClassB/*
+file /style.css style.css
+allow url /style.css
+
+dynClassB
diff --git a/tests/dynList.ur b/tests/dynList.ur
new file mode 100644
index 0000000..09b3ee4
--- /dev/null
+++ b/tests/dynList.ur
@@ -0,0 +1,22 @@
+fun main () =
+    b <- source True;
+    let
+        fun textboxList xs = <xml>
+          <table>
+            {List.mapX (fn src => <xml><tr>
+              <td dynClass={return null} dynStyle={b <- signal b;
+                                                   if b then
+                                                       return (STYLE "width: 500px")
+                                                   else
+                                                       return (STYLE "width: 100px")}>
+                <ctextbox source={src}/>
+            </td></tr></xml>) xs}
+          </table>
+        </xml>
+    in
+        s <- source "foo";
+        return <xml><body>
+          <ccheckbox source={b}/>
+          {textboxList (s :: s :: [])}
+        </body></xml>
+    end
diff --git a/tests/dynList.urp b/tests/dynList.urp
new file mode 100644
index 0000000..dc33cb2
--- /dev/null
+++ b/tests/dynList.urp
@@ -0,0 +1,4 @@
+rewrite all DynList/*
+
+$/list
+dynList
diff --git a/tests/dynList.urs b/tests/dynList.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/dynList.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/dynSpan.ur b/tests/dynSpan.ur
new file mode 100644
index 0000000..123adde
--- /dev/null
+++ b/tests/dynSpan.ur
@@ -0,0 +1,8 @@
+val x = 1
+
+fun main () : transaction page =
+    s <- source "!";
+    return <xml><body>
+      <dyn signal={x <- signal s; return <xml><span>{[x]}</span></xml>}/>
+      <button onclick={x <- get s; set s (x ^ "!")}/>
+    </body></xml>
diff --git a/tests/dynSpan.urp b/tests/dynSpan.urp
new file mode 100644
index 0000000..611dc31
--- /dev/null
+++ b/tests/dynSpan.urp
@@ -0,0 +1,3 @@
+debug
+
+dynSpan
diff --git a/tests/dynTable.ur b/tests/dynTable.ur
new file mode 100644
index 0000000..d73dc52
--- /dev/null
+++ b/tests/dynTable.ur
@@ -0,0 +1,21 @@
+fun main () : transaction page =
+    s <- source <xml/>;
+    s1 <- source <xml/>;
+    n <- source 0;
+    return <xml><body>
+      <table>
+        <dyn signal={signal s}/>
+        <tr> <td>Hi</td> </tr>
+      </table>
+
+      <button onclick={fn _ => v <- get n;
+                          set n (v + 1);
+                          set s <xml><tr> <td>Whoa!({[v]})</td> </tr></xml>}/>
+
+      <table>
+        <tr> <dyn signal={signal s1}/> </tr>
+        <tr> <td>Hi!</td> </tr>
+      </table>
+
+      <button onclick={fn _ => set s1 <xml><td>Whoa!</td></xml>}/>
+    </body></xml>
diff --git a/tests/dynlines.ur b/tests/dynlines.ur
new file mode 100644
index 0000000..92866e6
--- /dev/null
+++ b/tests/dynlines.ur
@@ -0,0 +1,33 @@
+datatype lines = End | Line of source lines
+
+type t = { Head : source lines, Tail : source (source lines) }
+
+val create =
+    head <- source End;
+    tail <- source head;
+    return {Head = head, Tail = tail}
+
+fun renderL lines =
+    case lines of
+        End => <xml/>
+      | Line linesS => <xml>X<br/><dyn signal={renderS linesS}/></xml>
+
+and renderS linesS =
+    lines <- signal linesS;
+    return (renderL lines)
+
+fun render t = renderS t.Head
+
+fun write t =
+    oldTail <- get t.Tail;
+    newTail <- source End;
+    set oldTail (Line newTail);
+    set t.Tail newTail
+
+fun main () : transaction page =
+    b <- create;
+
+    return <xml><body>
+      <button onclick={fn _ => write b}/>
+      <dyn signal={render b}/>
+    </body></xml>
diff --git a/tests/each.ur b/tests/each.ur
new file mode 100644
index 0000000..b3b0b1a
--- /dev/null
+++ b/tests/each.ur
@@ -0,0 +1,16 @@
+sequence s
+table t : { Id : int, S1 : string, S2:string, S3:string, S4:string }
+
+fun each (n : int, (f : unit -> transaction unit)) = if n > 0 then f (); each ((n-1),f) else return ()
+
+fun fill () =
+    dml (DELETE FROM t WHERE 1=1);
+    each (1,( fn () =>
+      (nv <- nextval s;
+      (dml (INSERT INTO t (Id, S1, S2, S3, S4) VALUES ({[nv]}, {["S1"]}, {["S2"]}, {["S3"]}, {["S4"]}))))
+    ));
+    return <xml>done</xml>
+
+fun main () = return <xml><body>
+    <form><submit action={fill} value="fill"/></form>
+</body></xml>
diff --git a/tests/each.urp b/tests/each.urp
new file mode 100644
index 0000000..c25b717
--- /dev/null
+++ b/tests/each.urp
@@ -0,0 +1,3 @@
+database dbname=each
+
+each
diff --git a/tests/each.urs b/tests/each.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/each.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/eargs.ur b/tests/eargs.ur
new file mode 100644
index 0000000..bfac497
--- /dev/null
+++ b/tests/eargs.ur
@@ -0,0 +1,13 @@
+val id1 = fn n : int => n
+val id2 = fn n => id1 n
+
+val pair1 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) => (x1, x2)
+val pair2 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) () => pair1 x1 x2
+
+val id3 n = id2 n
+val id4 n : int = id3 n
+val id5 (n : int) = id4 n
+val id6 (n : int) : int = id5 n
+
+val id1 (t ::: Type) (x : t) = x
+val id2 (t ::: Type) (x : t) : t = id1 x
diff --git a/tests/echoBlob.ur b/tests/echoBlob.ur
new file mode 100644
index 0000000..fc8f860
--- /dev/null
+++ b/tests/echoBlob.ur
@@ -0,0 +1,8 @@
+fun echo r = returnBlob (fileData r.Data) (blessMime (fileMimeType r.Data))
+
+fun main () = return <xml><body>
+  <form>
+    <upload{#Data}/>
+    <submit action={echo}/>
+  </form>
+</body></xml>
diff --git a/tests/echoBlob.urp b/tests/echoBlob.urp
new file mode 100644
index 0000000..4b94b59
--- /dev/null
+++ b/tests/echoBlob.urp
@@ -0,0 +1,3 @@
+debug
+
+echoBlob
diff --git a/tests/echoBlob.urs b/tests/echoBlob.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/echoBlob.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/efold.ur b/tests/efold.ur
new file mode 100644
index 0000000..317d085
--- /dev/null
+++ b/tests/efold.ur
@@ -0,0 +1,8 @@
+val currier : rs :: {Type} -> Cfold.currier rs =
+        fold [Cfold.currier] (fn nm :: Name => fn t :: Type => fn rest :: {Type} => fn acc => fn x : t => acc) {}
+
+val greenCurry : Cfold.greenCurry = currier [Cfold.greenCurryIngredients]
+val redCurry : Cfold.redCurry = currier [Cfold.redCurryIngredients]
+val yellowCurry : Cfold.yellowCurry = currier [Cfold.yellowCurryIngredients]
+
+val main = yellowCurry
diff --git a/tests/empties.ur b/tests/empties.ur
new file mode 100644
index 0000000..6200308
--- /dev/null
+++ b/tests/empties.ur
@@ -0,0 +1,4 @@
+fun main () = return <xml><body>
+  <table> <tr> <th/> <td><p/></td> </tr> </table>
+  <form><textbox{#A}/></form>
+</body></xml>
diff --git a/tests/empties.urp b/tests/empties.urp
new file mode 100644
index 0000000..92ce98f
--- /dev/null
+++ b/tests/empties.urp
@@ -0,0 +1,3 @@
+debug
+
+empties
diff --git a/tests/empties.urs b/tests/empties.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/empties.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/empty.ur b/tests/empty.ur
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/tests/empty.ur
diff --git a/tests/empty.urp b/tests/empty.urp
new file mode 100644
index 0000000..7387128
--- /dev/null
+++ b/tests/empty.urp
@@ -0,0 +1,2 @@
+debug
+
diff --git a/tests/emptyTable.ur b/tests/emptyTable.ur
new file mode 100644
index 0000000..d9469be
--- /dev/null
+++ b/tests/emptyTable.ur
@@ -0,0 +1 @@
+table tricky : {}
diff --git a/tests/emptyTable.urp b/tests/emptyTable.urp
new file mode 100644
index 0000000..c8a7ca2
--- /dev/null
+++ b/tests/emptyTable.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql emptyTable.sql
+
+emptyTable
diff --git a/tests/empty_record.ur b/tests/empty_record.ur
new file mode 100644
index 0000000..45ab6fd
--- /dev/null
+++ b/tests/empty_record.ur
@@ -0,0 +1,3 @@
+val concatX [ctx ::: {Unit}] [use ::: {Type}]
+    : list (xml ctx use []) -> xml ctx use []
+  = List.foldl join <xml/>
diff --git a/tests/empty_record.urp b/tests/empty_record.urp
new file mode 100644
index 0000000..c81175f
--- /dev/null
+++ b/tests/empty_record.urp
@@ -0,0 +1,2 @@
+$/list
+empty_record
diff --git a/tests/ent.ur b/tests/ent.ur
new file mode 100644
index 0000000..fa01e8c
--- /dev/null
+++ b/tests/ent.ur
@@ -0,0 +1,3 @@
+fun main () = return <xml><body>
+  &lt;Whoa-hoa!&gt;  A&#66;CD!
+</body></xml>
diff --git a/tests/ent.urp b/tests/ent.urp
new file mode 100644
index 0000000..f63d115
--- /dev/null
+++ b/tests/ent.urp
@@ -0,0 +1,3 @@
+debug
+
+ent
diff --git a/tests/ent.urs b/tests/ent.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/ent.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/entities.ur b/tests/entities.ur
new file mode 100644
index 0000000..8b78edb
--- /dev/null
+++ b/tests/entities.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml><body>
+  Hello world! &amp; so on, &copy; me today (8 &euro;)<br/>
+  &spades; &clubs; &hearts; &diams;<br/>
+  &dagger; DANGER &dagger;
+</body></xml>
diff --git a/tests/env.ur b/tests/env.ur
new file mode 100644
index 0000000..637ea6b
--- /dev/null
+++ b/tests/env.ur
@@ -0,0 +1,21 @@
+fun handler r =
+  vo <- getenv (blessEnvVar r.Nam);
+  return <xml><body>
+  {case vo of
+       None => <xml>Not set</xml>
+     | Some v => <xml>Set to: {[v]}</xml>}
+</body></xml>
+
+fun main () : transaction page =
+  term <- getenv (blessEnvVar "TERM");
+  return <xml><body>
+    TERM = {case term of
+                None => <xml>Nada</xml>
+              | Some v => txt v}
+                 
+    <form>
+      What would you like to know?
+      <textbox{#Nam}/>
+      <submit action={handler}/>
+    </form>
+  </body></xml>
diff --git a/tests/env.urp b/tests/env.urp
new file mode 100644
index 0000000..0860c8d
--- /dev/null
+++ b/tests/env.urp
@@ -0,0 +1,6 @@
+rewrite url Env/*
+allow env TERM
+allow env DESKTOP_*
+allow env SCRIPT_NAME
+
+env
diff --git a/tests/env.urs b/tests/env.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/env.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/eq.ur b/tests/eq.ur
new file mode 100644
index 0000000..4f758e0
--- /dev/null
+++ b/tests/eq.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page = return <xml><body>
+  {txt _ (1 = 1)}, {txt _ (1 = 2)}<br/>
+  {txt _ (1 <> 1)}, {txt _ (1 <> 2)}<br/>
+  {txt _ (True = True)}, {txt _ (True = False)}<br/>
+  {txt _ (True <> True)}, {txt _ (True <> False)}<br/>
+  {txt _ ("A" = "A")}, {txt _ ("A" = "B")}<br/>
+  {txt _ ("A" <> "A")}, {txt _ ("A" <> "B")}<br/>
+</body></xml>
diff --git a/tests/eq.urp b/tests/eq.urp
new file mode 100644
index 0000000..948e868
--- /dev/null
+++ b/tests/eq.urp
@@ -0,0 +1,3 @@
+debug
+
+eq
diff --git a/tests/equiv.ur b/tests/equiv.ur
new file mode 100644
index 0000000..19ac18d
--- /dev/null
+++ b/tests/equiv.ur
@@ -0,0 +1,3 @@
+type t1 = {A : int, B : float}
+type t2 = {B : float, A : int}
+val e1 : t1 -> t2 = fn x => x
diff --git a/tests/error.ur b/tests/error.ur
new file mode 100644
index 0000000..00c0105
--- /dev/null
+++ b/tests/error.ur
@@ -0,0 +1,2 @@
+fun main () : transaction page =
+  error <xml>I couldn't make up my <b>mind</b>!</xml>
diff --git a/tests/escapes.ur b/tests/escapes.ur
new file mode 100644
index 0000000..7a8eeb1
--- /dev/null
+++ b/tests/escapes.ur
@@ -0,0 +1,3 @@
+fun main () = return <xml>
+  {["H\x65ll\157!"]}
+</xml>
diff --git a/tests/escapes.urp b/tests/escapes.urp
new file mode 100644
index 0000000..f6ba423
--- /dev/null
+++ b/tests/escapes.urp
@@ -0,0 +1,3 @@
+debug
+
+escapes
diff --git a/tests/escapes.urs b/tests/escapes.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/escapes.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/event.ur b/tests/event.ur
new file mode 100644
index 0000000..84d53b6
--- /dev/null
+++ b/tests/event.ur
@@ -0,0 +1,16 @@
+fun main () =
+    s <- source "";
+    return <xml><body onresize={set s "Resize"}>
+      <button onblur={set s "Blur 1"} onfocus={set s "Focus 1"} onclick={set s "Click 1"}/>
+      <button onblur={set s "Blur 2"} onfocus={set s "Focus 2"} onclick={set s "Click 2"}/>
+      <span onclick={set s "Click"} ondblclick={set s "Double-click"}>SPAN</span>
+      <span onmousedown={set s "Mouse down"} onmouseup={set s "Mouse up"}>SPAN</span>
+      <span onmouseout={set s "Mouse out"} onmouseover={set s "Mouse over"}>SPAN</span>
+      <span onmousemove={set s "Mouse move"}>SPAN</span>
+      <button onkeydown={fn k => set s ("Key down: " ^ show k)} onkeyup={fn _ => set s "Key up"}/>
+      <button onkeypress={fn _ => set s "Key press"}/>
+      <br/>
+      <br/>
+
+      <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/>
+    </body></xml>
diff --git a/tests/event.urp b/tests/event.urp
new file mode 100644
index 0000000..01dfcb9
--- /dev/null
+++ b/tests/event.urp
@@ -0,0 +1,3 @@
+debug
+
+event
diff --git a/tests/event.urs b/tests/event.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/event.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/fact.ur b/tests/fact.ur
new file mode 100644
index 0000000..c7989a3
--- /dev/null
+++ b/tests/fact.ur
@@ -0,0 +1,5 @@
+fun fact n = if n <= 1 then 1 else n * fact (n - 1)
+
+fun factTr n acc = if n <= 1 then acc else factTr (n - 1) (n * acc)
+
+fun main () : transaction page = return <xml>{[fact 10]}, {[factTr 10 1]}</xml>
diff --git a/tests/ffi.ur b/tests/ffi.ur
new file mode 100644
index 0000000..79f7ab2
--- /dev/null
+++ b/tests/ffi.ur
@@ -0,0 +1,22 @@
+extern structure Lib : sig
+        type t
+        type u
+        val x : t
+        val y : u
+        val f0 : {} -> u
+        val f1 : t -> t
+        val f2 : t -> u -> t
+end
+
+type t' = Lib.t
+val x' : t' = Lib.x
+val f0' = Lib.f0
+val f1' = Lib.f1
+val f2' = Lib.f2
+
+structure Lib' = Lib
+
+type t'' = Lib'.t
+val x'' : t'' = Lib'.x
+
+val main = f2' (f1' x') (f0' {})
diff --git a/tests/ffi.urs b/tests/ffi.urs
new file mode 100644
index 0000000..f5b719f
--- /dev/null
+++ b/tests/ffi.urs
@@ -0,0 +1 @@
+val setIt : id -> xbody -> transaction unit
diff --git a/tests/ffi_eff.urs b/tests/ffi_eff.urs
new file mode 100644
index 0000000..150c4da
--- /dev/null
+++ b/tests/ffi_eff.urs
@@ -0,0 +1,2 @@
+val shout : string -> transaction {}
+val sneakyShout : string -> int
diff --git a/tests/ffieff.ur b/tests/ffieff.ur
new file mode 100644
index 0000000..a63fa4b
--- /dev/null
+++ b/tests/ffieff.ur
@@ -0,0 +1,6 @@
+open Ffi_eff
+
+fun main () : transaction page = return <xml><body>
+  <button value="shout" onclick={fn _ => shout "Hi!"; shout "Bye!"}/>
+  <button value="sneakyShout" onclick={fn _ => let val x = sneakyShout "Whoa" in return () end}/>
+</body></xml>
diff --git a/tests/ffieff.urp b/tests/ffieff.urp
new file mode 100644
index 0000000..9f89cbc
--- /dev/null
+++ b/tests/ffieff.urp
@@ -0,0 +1,6 @@
+ffi ffi_eff
+jsFunc Ffi_eff.shout=alert
+jsFunc Ffi_eff.sneakyShout=alert
+rewrite all Ffieff/*
+
+ffieff
diff --git a/tests/ffisub.urp b/tests/ffisub.urp
new file mode 100644
index 0000000..b695bad
--- /dev/null
+++ b/tests/ffisub.urp
@@ -0,0 +1,3 @@
+ffi ffisub
+
+empty
diff --git a/tests/ffisub.urs b/tests/ffisub.urs
new file mode 100644
index 0000000..ce24588
--- /dev/null
+++ b/tests/ffisub.urs
@@ -0,0 +1,5 @@
+structure S : sig
+  type t
+end
+
+val x : S.t
diff --git a/tests/ffitag.ur b/tests/ffitag.ur
new file mode 100644
index 0000000..43ec5bf
--- /dev/null
+++ b/tests/ffitag.ur
@@ -0,0 +1,3 @@
+open Tagffi
+
+fun main () : transaction page = return <xml><body><funky>test</funky></body></xml>
diff --git a/tests/ffitag.urp b/tests/ffitag.urp
new file mode 100644
index 0000000..5c7f540
--- /dev/null
+++ b/tests/ffitag.urp
@@ -0,0 +1,4 @@
+ffi tagffi
+rewrite all Ffitag/*
+
+ffitag
diff --git a/tests/fib.ur b/tests/fib.ur
new file mode 100644
index 0000000..9d7fd34
--- /dev/null
+++ b/tests/fib.ur
@@ -0,0 +1,10 @@
+fun fib n =
+    if n = 0 then
+        0
+    else if n = 1 then
+        1
+    else
+        fib (n - 1) + fib (n - 2)
+
+fun main n : transaction page =
+    return <xml>{[fib n]}</xml>
diff --git a/tests/files.ur b/tests/files.ur
new file mode 100644
index 0000000..94cf8eb
--- /dev/null
+++ b/tests/files.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml>Main page</xml>
diff --git a/tests/files.urp b/tests/files.urp
new file mode 100644
index 0000000..3683f1a
--- /dev/null
+++ b/tests/files.urp
@@ -0,0 +1,6 @@
+rewrite all Files/*
+file /hello_world.txt hello.txt
+file /img/web.png web.png
+file /files.urp ./files.urp
+
+files
diff --git a/tests/filter.ur b/tests/filter.ur
new file mode 100644
index 0000000..efd326c
--- /dev/null
+++ b/tests/filter.ur
@@ -0,0 +1,9 @@
+fun filter [fs ::: {Type}] [ks] (t : sql_table fs ks) (p : sql_exp [T = fs] [] [] bool)
+   : sql_query [T = fs] [] =
+   (SELECT * FROM t WHERE {p})
+
+table t : { A : int, B : float }
+
+fun main () =
+    queryX (filter t (WHERE t.A > 3))
+           (fn r => <xml>{[r.T.A]}, {[r.T.B]}</xml>)
diff --git a/tests/filter.urp b/tests/filter.urp
new file mode 100644
index 0000000..102a187
--- /dev/null
+++ b/tests/filter.urp
@@ -0,0 +1,4 @@
+debug
+database dbname=filter
+
+filter
diff --git a/tests/filter.urs b/tests/filter.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/filter.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/firebug.ur b/tests/firebug.ur
new file mode 100644
index 0000000..9a98698
--- /dev/null
+++ b/tests/firebug.ur
@@ -0,0 +1,5 @@
+fun main () =
+  a <- source "some text";
+  return <xml><body>
+    <label>A: <ctextbox source={a}/></label>
+  </body></xml>
diff --git a/tests/firebug.urp b/tests/firebug.urp
new file mode 100644
index 0000000..c87f596
--- /dev/null
+++ b/tests/firebug.urp
@@ -0,0 +1,3 @@
+debug
+
+firebug
diff --git a/tests/firebug.urs b/tests/firebug.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/firebug.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/fitem.ur b/tests/fitem.ur
new file mode 100644
index 0000000..282146c
--- /dev/null
+++ b/tests/fitem.ur
@@ -0,0 +1,6 @@
+table t : { A : int, B : string }
+table u : { A : int, C : float }
+
+val q : sql_query [] [T = [A = int, B = string], U = [C = option float]] [] =
+    (SELECT t.A, t.B, u.C
+     FROM {{sql_left_join (FROM t) (FROM u) (WHERE TRUE)}})
diff --git a/tests/fitem.urp b/tests/fitem.urp
new file mode 100644
index 0000000..61d7a37
--- /dev/null
+++ b/tests/fitem.urp
@@ -0,0 +1 @@
+fitem
diff --git a/tests/float.ur b/tests/float.ur
new file mode 100644
index 0000000..aae6d52
--- /dev/null
+++ b/tests/float.ur
@@ -0,0 +1,6 @@
+fun main () =
+  let
+    val x = 0.001 * 50.0
+  in
+    return <xml><body>{[x]}</body></xml>
+  end
diff --git a/tests/float.urs b/tests/float.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/float.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/focus.ur b/tests/focus.ur
new file mode 100644
index 0000000..9d1f5b8
--- /dev/null
+++ b/tests/focus.ur
@@ -0,0 +1,14 @@
+fun main () : transaction page =
+    id1 <- fresh;
+    id2 <- fresh;
+    s1 <- source "";
+    s2 <- source "";
+    which <- source False;
+
+    return <xml><body>
+      <ctextbox id={id1} source={s1}/>
+      <ctextbox id={id2} source={s2}/>
+      <button onclick={fn _ => w <- get which;
+                          set which (not w);
+                          giveFocus (if w then id1 else id2)}/>
+    </body></xml>
diff --git a/tests/foldm.ur b/tests/foldm.ur
new file mode 100644
index 0000000..64d30ba
--- /dev/null
+++ b/tests/foldm.ur
@@ -0,0 +1,26 @@
+con currier = fold (fn nm => fn t => fn acc => t -> acc) {}
+
+signature S = sig
+        type t
+        val x : t
+
+        con rs :: {Type}
+        val create : currier rs -> t
+end
+
+functor Currier (M : sig con rs :: {Type} end) : S where con rs = M.rs = struct
+        val currier : rs :: {Type} -> currier rs =
+                fold [currier] (fn nm :: Name => fn t :: Type => fn rest :: {Type} => fn acc => fn x : t => acc) {}
+
+        type t = currier M.rs
+        val x = currier [M.rs]
+
+        con rs = M.rs
+        val create : t -> t = fn x => x
+end
+
+structure ChefsSpecial = Currier(struct
+        con rs = [A = int, B = float]
+end)
+
+val main = ChefsSpecial.x
diff --git a/tests/form.ur b/tests/form.ur
new file mode 100644
index 0000000..a046928
--- /dev/null
+++ b/tests/form.ur
@@ -0,0 +1,13 @@
+val handler = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Word: {cdata r.Word}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Word} /><br/>
+
+                <submit action={handler}/>
+        </lform>
+</body></html>
diff --git a/tests/form2.ur b/tests/form2.ur
new file mode 100644
index 0000000..d3ea473
--- /dev/null
+++ b/tests/form2.ur
@@ -0,0 +1,25 @@
+val handler1 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Word: {cdata r.Word}</li>
+</body></html>
+
+val handler2 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Word} /><br/>
+
+                <submit action={handler1}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Ward} /><br/>
+
+                <submit action={handler2}/>
+        </lform>
+</body></html>
diff --git a/tests/form3.ur b/tests/form3.ur
new file mode 100644
index 0000000..3c0915f
--- /dev/null
+++ b/tests/form3.ur
@@ -0,0 +1,39 @@
+val handler1 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Word: {cdata r.Word}</li>
+</body></html>
+
+val handler2 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+</body></html>
+
+val handler3 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+        <li> Words: {cdata r.Words}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Word} /><br/>
+
+                <submit action={handler1}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Ward} /><br/>
+
+                <submit action={handler2}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Ward: <textbox{#Ward} /><br/>
+                Words: <textbox{#Words} /><br/>
+
+                <submit action={handler3}/>
+        </lform>
+</body></html>
diff --git a/tests/formFields.ur b/tests/formFields.ur
new file mode 100644
index 0000000..2dbf2d5
--- /dev/null
+++ b/tests/formFields.ur
@@ -0,0 +1,3 @@
+fun main (pb : postBody) : transaction page = return <xml><body>
+  {List.mapX (fn (n, v) => <xml><li>{[n]} = {[v]}</li></xml>) (postFields pb)}
+</body></xml>
diff --git a/tests/formFields.urp b/tests/formFields.urp
new file mode 100644
index 0000000..82f95f1
--- /dev/null
+++ b/tests/formFields.urp
@@ -0,0 +1,4 @@
+rewrite url FormFields/*
+
+$/list
+formFields
diff --git a/tests/formLimit.ur b/tests/formLimit.ur
new file mode 100644
index 0000000..d591f73
--- /dev/null
+++ b/tests/formLimit.ur
@@ -0,0 +1,11 @@
+fun handler r = return <xml><body>
+  {[r.A]}, {[r.B]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/>
+    <textbox{#B}/>
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/formLimit.urp b/tests/formLimit.urp
new file mode 100644
index 0000000..3fd7e5c
--- /dev/null
+++ b/tests/formLimit.urp
@@ -0,0 +1,4 @@
+rewrite all FormLimit/*
+limit inputs 1
+
+formLimit
diff --git a/tests/formLimit.urs b/tests/formLimit.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/formLimit.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/formid.ur b/tests/formid.ur
new file mode 100644
index 0000000..c9e3317
--- /dev/null
+++ b/tests/formid.ur
@@ -0,0 +1,9 @@
+fun handler () = return <xml></xml>
+
+fun main () : transaction page =
+    id <- fresh;
+    return <xml><body>
+      <form id={id}>
+        <submit action={handler}/>
+      </form>
+    </body></xml>
diff --git a/tests/formid.urs b/tests/formid.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/formid.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/fromString.ur b/tests/fromString.ur
new file mode 100644
index 0000000..dd7fb89
--- /dev/null
+++ b/tests/fromString.ur
@@ -0,0 +1,33 @@
+fun s2i s =
+        case read _ s of
+          None => 0
+        | Some n => n
+
+fun s2f s =
+        case read _ s of
+          None => 0.0
+        | Some n => n
+
+fun s2s s =
+        case read _ s of
+          None => "Error"
+        | Some s => s
+
+fun s2b s =
+        case read _ s of
+          None => False
+        | Some b => b
+
+fun main () : transaction page = return <html><body>
+        Error = {cdata (show _ (s2i "Error"))}<br/>
+        3 = {cdata (show _ (s2i "+3"))}<br/>
+        <br/>
+        Error = {cdata (show _ (s2f "Error"))}<br/>
+        98.76 = {cdata (show _ (s2f "98.76"))}<br/>
+        <br/>
+        Error = {cdata (show _ (s2b "Error"))}<br/>
+        False = {cdata (show _ (s2b "false"))}<br/>
+        True = {cdata (show _ (s2b "trUE"))}<br/>
+        <br/>
+        Hi = {cdata (s2s "Hi")}<br/>
+</body></html>
diff --git a/tests/fromString.urp b/tests/fromString.urp
new file mode 100644
index 0000000..0e6b664
--- /dev/null
+++ b/tests/fromString.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+fromString
diff --git a/tests/fromStringErr.ur b/tests/fromStringErr.ur
new file mode 100644
index 0000000..77fc8a2
--- /dev/null
+++ b/tests/fromStringErr.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <html><body>
+        3 = {cdata (show _ (readError _ "3" : int))}<br/>
+        12.12 = {cdata (show _ (readError _ "12.12" : float))}<br/>
+        Hi = {cdata (show _ (readError _ "Hi" : string))}<br/>
+        True = {cdata (show _ (readError _ "True" : bool))}<br/>
+</body></html>
diff --git a/tests/fromStringErr.urp b/tests/fromStringErr.urp
new file mode 100644
index 0000000..9f6abbe
--- /dev/null
+++ b/tests/fromStringErr.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+fromStringErr
diff --git a/tests/functor.ur b/tests/functor.ur
new file mode 100644
index 0000000..5adfb59
--- /dev/null
+++ b/tests/functor.ur
@@ -0,0 +1,37 @@
+signature S = sig
+        type t
+        val z : t
+        val s : t -> t
+end
+
+signature T = sig
+        type t
+        val three : t
+end
+
+functor F (M : S) : T where type t = M.t = struct
+        type t = M.t
+        val three = M.s (M.s (M.s M.z))
+end
+
+
+structure O = F (struct
+        type t = int
+        val z = 0
+        val s = fn x : t => x
+end)
+val three : int = O.three
+
+structure S = struct
+        type t = int
+        val z = 0
+        val s = fn x : t => x
+end
+structure SO = F (S)
+val three : int = SO.three
+
+structure SS : S = S
+structure SSO = F (SS)
+val three : SS.t = SSO.three
+
+val main = three
diff --git a/tests/functor.urp b/tests/functor.urp
new file mode 100644
index 0000000..eedc7bf
--- /dev/null
+++ b/tests/functor.urp
@@ -0,0 +1,3 @@
+debug
+
+functor
diff --git a/tests/functorMadness.ur b/tests/functorMadness.ur
new file mode 100644
index 0000000..c7ddeac
--- /dev/null
+++ b/tests/functorMadness.ur
@@ -0,0 +1,18 @@
+functor F(M : sig end) = struct
+    fun f () = f ()
+
+    functor G(M : sig end) = struct
+        fun g () = f ()
+    end
+end
+
+structure M1 = F(struct end)
+structure M2 = F(struct end)
+
+structure N1 = M1.G(struct end)
+structure N2 = M2.G(struct end)
+
+fun main () : transaction page =
+    return (N1.g ());
+    return (N2.g ());
+    return <xml/>
diff --git a/tests/functorMania.ur b/tests/functorMania.ur
new file mode 100644
index 0000000..c11ff47
--- /dev/null
+++ b/tests/functorMania.ur
@@ -0,0 +1,36 @@
+functor F1(M : sig type t end) = struct
+    type t = M.t
+    fun g () : M.t = g ()
+    fun f () = g ()
+end
+functor F2(M : sig type t end) = F1(M)
+functor F3(M : sig type t end) = F2(M)
+
+functor F4(M : sig end) = F1(struct type t = int end)
+functor F5(M : sig end) = F2(struct type t = int end)
+functor F6(M : sig end) = F3(struct type t = int end)
+
+functor F7(M : sig end) = F1(struct type t = string end)
+functor F8(M : sig end) = F2(struct type t = string end)
+functor F9(M : sig end) = F3(struct type t = string end)
+
+structure M1 = F1(struct type t = string end)
+structure M2 = F2(struct type t = string end)
+structure M3 = F3(struct type t = string end)
+
+structure M4 = F4(struct  end)
+structure M5 = F5(struct end)
+structure M6 = F6(struct end)
+
+structure M7 = F7(struct end)
+structure M8 = F8(struct end)
+structure M9 = F9(struct end)
+
+fun loop x : unit = loop (M1.f (), M2.f (), M3.f (),
+                          M4.f (), M5.f (), M6.f (),
+                          M7.f (), M8.f (), M9.f ())
+
+fun main () : transaction page =
+    x <- error <xml/>;
+    u <- return (loop x);
+    return <xml/>
diff --git a/tests/funnyStyles.ur b/tests/funnyStyles.ur
new file mode 100644
index 0000000..7945a32
--- /dev/null
+++ b/tests/funnyStyles.ur
@@ -0,0 +1,8 @@
+style booboo
+style hoohoo
+
+fun main () : transaction page = return <xml><body>
+  <p class={booboo}>booboo</p>
+  <p class={hoohoo}>hoohoo</p>
+  <p class={null}>null</p>
+</body></xml>
diff --git a/tests/funnyStyles.urp b/tests/funnyStyles.urp
new file mode 100644
index 0000000..3ab5d63
--- /dev/null
+++ b/tests/funnyStyles.urp
@@ -0,0 +1,4 @@
+rewrite style FunnyStyles/booboo mixed_rule-applied
+rewrite all FunnyStyles/*
+
+funnyStyles
diff --git a/tests/getenv.ur b/tests/getenv.ur
new file mode 100644
index 0000000..a71a282
--- /dev/null
+++ b/tests/getenv.ur
@@ -0,0 +1,5 @@
+task initialize = fn _ =>
+  v <- getenv (blessEnvVar "USER");
+  case v of
+      None => debug "No USER"
+    | Some u => debug u
diff --git a/tests/getenv.urp b/tests/getenv.urp
new file mode 100644
index 0000000..7acc7c7
--- /dev/null
+++ b/tests/getenv.urp
@@ -0,0 +1,3 @@
+allow env USER
+
+getenv
diff --git a/tests/gform.ur b/tests/gform.ur
new file mode 100644
index 0000000..e1b194c
--- /dev/null
+++ b/tests/gform.ur
@@ -0,0 +1,46 @@
+con stringify = fold (fn nm :: Name => fn u :: Unit => fn t :: {Type} => [nm = string] ++ t) []
+
+signature S = sig
+        con rs :: {Unit}
+end
+
+signature S' = sig
+        con rs :: {Unit}
+
+        val handler : $(stringify rs) -> page
+        val page : unit -> page
+end
+
+functor F (M : S) : S' where con rs = M.rs = struct
+        con rs = M.rs
+
+        val handler = fn x : $(stringify M.rs) => <html><body>
+                {fold [fn rs :: {Unit} => $(stringify rs) -> xml body [] []]
+                        (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
+                                fn f : $(stringify rest) -> xml body [] [] =>
+                                fn x : $(stringify ([nm] ++ rest)) =>
+                                        <body><li> {cdata x.nm}</li> {f (x -- nm)}</body>)
+                        (fn x => <body></body>)
+                        [M.rs] x}
+        </body></html>
+
+        val page = fn () => <html><body>
+                <lform>
+                        {fold [fn rs :: {Unit} => xml lform [] (stringify rs)]
+                                (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
+                                        fn frag : xml lform [] (stringify rest) =>
+                                                <lform><li> <textbox{nm}/></li> {useMore frag}</lform>)
+                                <lform></lform>
+                                [rs]}
+
+                        <submit action={handler}/>
+                </lform>
+        </body></html>
+end
+
+structure M = F(struct
+        con rs = [A, B, C]
+end)
+
+open M
+
diff --git a/tests/gformText.ur b/tests/gformText.ur
new file mode 100644
index 0000000..98d0f4e
--- /dev/null
+++ b/tests/gformText.ur
@@ -0,0 +1,50 @@
+con stringify = fold (fn nm :: Name => fn u :: Unit => fn t :: {Type} => [nm = string] ++ t) []
+
+signature S = sig
+        con rs :: {Unit}
+        val names : $(stringify rs)
+end
+
+signature S' = sig
+        con rs :: {Unit}
+
+        val handler : $(stringify rs) -> page
+        val page : unit -> page
+end
+
+functor F (M : S) : S' where con rs = M.rs = struct
+        con rs = M.rs
+
+        val handler = fn x : $(stringify M.rs) => <html><body>
+                {fold [fn rs :: {Unit} => $(stringify rs) -> $(stringify rs) -> xml body [] []]
+                        (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
+                                fn f : $(stringify rest) -> $(stringify rest) -> xml body [] [] =>
+                                fn names : $(stringify ([nm] ++ rest)) =>
+                                fn x : $(stringify ([nm] ++ rest)) =>
+                                        <body><li> {cdata names.nm}: {cdata x.nm}</li> {f (names -- nm) (x -- nm)}</body>)
+                        (fn names => fn x => <body></body>)
+                        [M.rs] M.names x}
+        </body></html>
+
+        val page = fn () => <html><body>
+                <lform>
+                        {fold [fn rs :: {Unit} => xml lform [] (stringify rs)]
+                                (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
+                                        fn frag : xml lform [] (stringify rest) =>
+                                                <lform><li> <textbox{nm}/></li> {useMore frag}</lform>)
+                                <lform></lform>
+                                [rs]}
+
+                        <submit action={handler}/>
+                </lform>
+        </body></html>
+end
+
+structure M = F(struct
+        con rs = [A, B, C]
+
+        val names = {A = "A", B = "B", C = "C"}
+end)
+
+open M
+
diff --git a/tests/globalHandlers.ur b/tests/globalHandlers.ur
new file mode 100644
index 0000000..5ab46de
--- /dev/null
+++ b/tests/globalHandlers.ur
@@ -0,0 +1,10 @@
+fun main () : transaction page = return <xml>
+  <body onload={onDblclick (fn ev => alert ("ScreenX = " ^ show ev.ScreenX ^ "\nShiftKey = " ^ show ev.ShiftKey));
+                onKeypress (fn ev => alert ("KeyCode = " ^ show ev.KeyCode ^ "\nShiftKey = " ^ show ev.ShiftKey))}/>
+</xml>
+
+fun busy () : transaction page = return <xml>
+  <body onload={onMouseout (fn _ => alert "OUT!");
+                onMouseover (fn _ => alert "OVER!");
+                onMousemove (fn _ => alert "MOVE!")}/>
+</xml>
diff --git a/tests/goback.ur b/tests/goback.ur
new file mode 100644
index 0000000..ef61a81
--- /dev/null
+++ b/tests/goback.ur
@@ -0,0 +1,20 @@
+table channels : { Channel : channel {} }
+
+fun get () =
+    ch <- channel;
+    dml (INSERT INTO channels (Channel) VALUES ({[ch]}));
+    return <xml><body onload={recv ch}>
+      Hi.
+    </body></xml>
+
+fun post () =
+    ch <- channel;
+    dml (INSERT INTO channels (Channel) VALUES ({[ch]}));
+    return <xml><body onload={recv ch}>
+      Hi!
+    </body></xml>
+
+fun main () = return <xml><body>
+  <li><a link={get ()}>Get</a></li>
+  <li><form><submit action={post}/></form></li>
+</body></xml>
diff --git a/tests/goback.urp b/tests/goback.urp
new file mode 100644
index 0000000..8db1b3a
--- /dev/null
+++ b/tests/goback.urp
@@ -0,0 +1,6 @@
+database dbname=goback
+sql goback.sql
+rewrite all Goback/*
+safeGet get
+
+goback
diff --git a/tests/goback.urs b/tests/goback.urs
new file mode 100644
index 0000000..901d6bf
--- /dev/null
+++ b/tests/goback.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
diff --git a/tests/goodbye.ur b/tests/goodbye.ur
new file mode 100644
index 0000000..1a46658
--- /dev/null
+++ b/tests/goodbye.ur
@@ -0,0 +1,26 @@
+table boo : { Client : client, Channel : channel unit }
+
+fun doIt () =
+    me <- self;
+    ch <- channel;
+    dml (INSERT INTO boo (Client, Channel) VALUES ({[me]}, {[ch]}));
+    return <xml><body onload={let
+                                  fun loop () =
+                                      v <- recv ch;
+                                      alert "Someone left";
+                                      loop ()
+                              in
+                                  loop ()
+                              end}/></xml>
+
+task clientLeaves = fn cl =>
+                       debug "Client left";
+                       dml (DELETE FROM boo WHERE Client = {[cl]});
+                       queryI (SELECT (boo.Channel)
+                               FROM boo)
+                       (fn r => send r.1 ());
+                       debug "Done processing"
+
+fun main () = return <xml><body>
+  <form> <submit action={doIt}/> </form>
+</body></xml>
diff --git a/tests/goodbye.urp b/tests/goodbye.urp
new file mode 100644
index 0000000..2a46981
--- /dev/null
+++ b/tests/goodbye.urp
@@ -0,0 +1,6 @@
+database dbname=goodbye
+sql goodbye.sql
+rewrite all Goodbye/*
+timeout 5
+
+goodbye
\ No newline at end of file
diff --git a/tests/goodbye.urs b/tests/goodbye.urs
new file mode 100644
index 0000000..901d6bf
--- /dev/null
+++ b/tests/goodbye.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
diff --git a/tests/goofy.urs b/tests/goofy.urs
new file mode 100644
index 0000000..71b55f4
--- /dev/null
+++ b/tests/goofy.urs
@@ -0,0 +1 @@
+val goofy : bodyTag [Nam = string, Data_role = string]
diff --git a/tests/groupBy.ur b/tests/groupBy.ur
new file mode 100644
index 0000000..e91e33c
--- /dev/null
+++ b/tests/groupBy.ur
@@ -0,0 +1,3 @@
+val main : transaction page = return <xml><body>
+  {[List.groupBy eq (1 :: 1 :: 2 :: 2 :: 3 :: 4 :: 4 :: 4 :: 5 :: [])]}
+</body></xml>
diff --git a/tests/groupBy.urp b/tests/groupBy.urp
new file mode 100644
index 0000000..de1db79
--- /dev/null
+++ b/tests/groupBy.urp
@@ -0,0 +1,4 @@
+rewrite all GroupBy/*
+
+$/list
+groupBy
diff --git a/tests/group_by.ur b/tests/group_by.ur
new file mode 100644
index 0000000..dbc7415
--- /dev/null
+++ b/tests/group_by.ur
@@ -0,0 +1,31 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1 GROUP BY t1.B)
+val q2 = (SELECT * FROM t1, t2 GROUP BY t1.B, t2.D, t1.A)
+
+val q3 = (SELECT * FROM t1 WHERE t1.A = 0 GROUP BY t1.B)
+val q4 = (SELECT * FROM t1 WHERE t1.A = 0 GROUP BY t1.B HAVING t1.B <> 'Bad')
+
+val q5 = (SELECT t1.A, t2.D FROM t1, t2 GROUP BY t2.D, t1.A)
+val q6 = (SELECT t1.A, t2.D FROM t1, t2 WHERE t1.C = 0.0 GROUP BY t2.D, t1.A HAVING t1.A = t1.A AND t2.D = 17)
+
+
+datatype list a = Nil | Cons of a * list a
+
+val r1 : transaction (list {B : string}) =
+        query q4
+        (fn fs acc => return (Cons (fs.T1, acc)))
+        Nil
+
+val r2 : transaction string =
+        ls <- r1;
+        return (case ls of
+                    Nil => "Problem"
+                  | Cons ({B = b, ...}, _) => b)
+
+val main : unit -> transaction page = fn () =>
+        s <- r2;
+        return <html><body>
+                {cdata s}
+        </body></html>
diff --git a/tests/has space.ur b/tests/has space.ur
new file mode 100644
index 0000000..4dec8c0
--- /dev/null
+++ b/tests/has space.ur
@@ -0,0 +1,2 @@
+fun main () : transaction page = return <xml>Hehe</xml>
+
diff --git a/tests/headDyn.ur b/tests/headDyn.ur
new file mode 100644
index 0000000..02fb0e0
--- /dev/null
+++ b/tests/headDyn.ur
@@ -0,0 +1,20 @@
+fun main () : transaction page =
+    x <- source <xml/>;
+    return <xml>
+      <head>
+        <title>Test</title>
+      </head>
+      <body onload={set x <xml>boo</xml>}>
+        <dyn signal={signal x}/>
+      </body>
+    </xml>
+
+fun main2 () : transaction page =
+    return <xml>
+      <head>
+        <title>Test</title>
+      </head>
+      <body>
+        <button onclick={alert "Hi"}/>
+      </body>
+    </xml>
diff --git a/tests/headers.ur b/tests/headers.ur
new file mode 100644
index 0000000..afb1565
--- /dev/null
+++ b/tests/headers.ur
@@ -0,0 +1,11 @@
+fun action () =
+  setHeader (blessResponseHeader "Location") "http://www.google.com/";
+  return <xml/>
+
+fun main () =
+  ag <- getHeader (blessRequestHeader "User-Agent");
+  return <xml><body>
+    User agent: {[ag]}
+
+    <form> <submit action={action}/> </form>
+  </body></xml>
diff --git a/tests/headers.urp b/tests/headers.urp
new file mode 100644
index 0000000..c5fdfc9
--- /dev/null
+++ b/tests/headers.urp
@@ -0,0 +1,5 @@
+rewrite url Headers/*
+allow requestHeader User-Agent
+allow responseHeader Location
+
+headers
diff --git a/tests/headers.urs b/tests/headers.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/headers.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/hello.html b/tests/hello.html
new file mode 100644
index 0000000..4fb6f91
--- /dev/null
+++ b/tests/hello.html
@@ -0,0 +1,8 @@
+<!DOCTYPE html><html>
+<head>
+<title>Hello world!</title>
+</head>
+<body>
+<h1>Hello world!</h1>
+</body>
+</html>
\ No newline at end of file
diff --git a/tests/hello.txt b/tests/hello.txt
new file mode 100644
index 0000000..980a0d5
--- /dev/null
+++ b/tests/hello.txt
@@ -0,0 +1 @@
+Hello World!
diff --git a/tests/hog.ur b/tests/hog.ur
new file mode 100644
index 0000000..cd666cb
--- /dev/null
+++ b/tests/hog.ur
@@ -0,0 +1,9 @@
+fun more n =
+    if n <= 0 then
+        "!"
+    else
+        more (n-1) ^ more (n-1)
+
+fun main n =
+    debug "Let's give this a try....";
+    return <xml>{[more n]}</xml>
diff --git a/tests/hog.urp b/tests/hog.urp
new file mode 100644
index 0000000..edfef7f
--- /dev/null
+++ b/tests/hog.urp
@@ -0,0 +1,3 @@
+minHeap 1000000
+
+hog
diff --git a/tests/hog.urs b/tests/hog.urs
new file mode 100644
index 0000000..38b757e
--- /dev/null
+++ b/tests/hog.urs
@@ -0,0 +1 @@
+val main : int -> transaction page
diff --git a/tests/html.ur b/tests/html.ur
new file mode 100644
index 0000000..e6f93ab
--- /dev/null
+++ b/tests/html.ur
@@ -0,0 +1,9 @@
+val main = <html>
+        <head>
+                <title>Hello World!</title>
+        </head>
+
+        <body>
+                <b>Hello</b> <i>World</i>!
+        </body>
+</html>
diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur
new file mode 100644
index 0000000..be07d07
--- /dev/null
+++ b/tests/html5_cforms.ur
@@ -0,0 +1,56 @@
+fun dn [a] (_ : show a) (x : source a) : xbody = <xml>
+  <dyn signal={v <- signal x; return (txt v)}/>
+</xml>
+
+fun main () : transaction page =
+    a <- source "";
+    b <- source True;
+    c <- source "a@b";
+    d <- source "";
+    e <- source "";
+    f <- source "";
+    g <- source 1.0;
+    h <- source 1.0;
+    i <- source "#CCCCCC";
+    j <- source "2014/11/16";
+    k <- source "2014/11/16 12:30:45";
+    l <- source "2014/11/16 12:30:45";
+    m <- source "2014/11";
+    n <- source "2014-W7";
+    o <- source "12:30:45";
+
+    return <xml><body>
+      <ctextbox source={a}/>
+      <ccheckbox source={b}/>
+      <cemail source={c}/>
+      <curl source={d}/>
+      <ctel source={e}/>
+      <csearch source={f}/>
+      <cnumber source={g} min={-10.0} max={10.0} step={0.5}/>
+      <crange source={h} min={-10.0} max={10.0}/>
+      <ccolor source={i}/>
+      <cdate source={j}/>
+      <cdatetime source={k}/>
+      <cdatetime-local source={l}/>
+      <cmonth source={m}/>
+      <cweek source={n}/>
+      <ctime source={o}/>
+
+      <hr/>
+        
+      {dn a};
+      {dn b};
+      {dn c};
+      {dn d};
+      {dn e};
+      {dn f};
+      {dn g};
+      {dn h};
+      {dn i};
+      {dn j};
+      {dn k};
+      {dn l};
+      {dn m};
+      {dn n};
+      {dn o}
+    </body></xml>
diff --git a/tests/html5_forms.ur b/tests/html5_forms.ur
new file mode 100644
index 0000000..507ea3c
--- /dev/null
+++ b/tests/html5_forms.ur
@@ -0,0 +1,45 @@
+fun handler r = return <xml><body>
+  A: {[r.A]}<br/>
+  B: {[r.B]}<br/>
+  C: {[r.C]}<br/>
+  D: {[r.D]}<br/>
+  E: {[r.E]}<br/>
+  F: {[r.F]}<br/>
+  G: {[r.G]}<br/>
+  H: {[r.H]}<br/>
+  I: {[r.I]}<br/>
+  J: {[r.J]}<br/>
+  K: {[r.K]}<br/>
+  L: {[r.L]}<br/>
+  M: {[r.M]}<br/>
+  N: {[r.N]}<br/>
+  O: {[r.O]}<br/>
+  P: {[r.P]}<br/>
+</body></xml>
+
+fun main () =
+    return <xml><body>
+      <form>
+        <textbox{#A} required placeholder="bobby"/>
+        <textbox{#B} placeholder="soggy" autofocus/>
+        <checkbox{#C}/>
+        <email{#D}/>
+        <url{#E}/>
+        <tel{#F}/>
+        <search{#G}/>
+
+        <hr/>
+
+        <color{#H}/>
+        <number{#I} min={17.0} max={32.8} value={20.6} step={2.5}/>
+        <range{#J} min={17.0} max={32.8} value={20.6}/>
+        <date{#K}/>
+        <datetime{#L}/>
+        <datetime-local{#M}/>
+        <month{#N}/>
+        <week{#O}/>
+        <timeInput{#P}/>
+
+        <submit action={handler}/>
+      </form>
+    </body></xml>
diff --git a/tests/html5_forms.urs b/tests/html5_forms.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/html5_forms.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/html_fn.ur b/tests/html_fn.ur
new file mode 100644
index 0000000..fab70cc
--- /dev/null
+++ b/tests/html_fn.ur
@@ -0,0 +1,9 @@
+val main : unit -> page = fn () => <html>
+        <head>
+                <title>Hello World!</title>
+        </head>
+
+        <body>
+                <b>Hello</b> <i>World</i>!
+        </body>
+</html>
diff --git a/tests/hyphenate.ur b/tests/hyphenate.ur
new file mode 100644
index 0000000..48c94f6
--- /dev/null
+++ b/tests/hyphenate.ur
@@ -0,0 +1,7 @@
+style extra_special
+style somewhat_special
+
+fun main () : transaction page = return <xml><body>
+  <span class={extra_special}>Test</span>
+  <span class={somewhat_special}>Test</span>
+</body></xml>
diff --git a/tests/hyphenate.urp b/tests/hyphenate.urp
new file mode 100644
index 0000000..197fd9d
--- /dev/null
+++ b/tests/hyphenate.urp
@@ -0,0 +1,5 @@
+rewrite url Hyphenate/*
+rewrite style Hyphenate/somewhat_special spectactularly_great [-]
+rewrite style Hyphenate/* [-]
+
+hyphenate
\ No newline at end of file
diff --git a/tests/id.ur b/tests/id.ur
new file mode 100644
index 0000000..2178cf4
--- /dev/null
+++ b/tests/id.ur
@@ -0,0 +1,11 @@
+fun main () : transaction page =
+    id1 <- fresh;
+    id2 <- fresh;
+    x <- source <xml/>;
+    return <xml><body>
+      <span id={id1}>Hi!</span>
+      <span id={id2}>Ho!</span>
+      <dyn signal={signal x}/>
+      <button value="Set" onclick={id <- fresh; set x <xml><span id={id}>He!</span></xml>}/>
+      <button value="Show" onclick={x <- get x; alert (show x)}/>
+    </body></xml>
diff --git a/tests/img.ur b/tests/img.ur
new file mode 100644
index 0000000..7089664
--- /dev/null
+++ b/tests/img.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  <img src="http://www.google.com/intl/en_ALL/images/logo.gif"/>
+</body></xml>
diff --git a/tests/img.urp b/tests/img.urp
new file mode 100644
index 0000000..ff71ade
--- /dev/null
+++ b/tests/img.urp
@@ -0,0 +1,3 @@
+debug
+
+img
diff --git a/tests/impl.ur b/tests/impl.ur
new file mode 100644
index 0000000..4a2e7a0
--- /dev/null
+++ b/tests/impl.ur
@@ -0,0 +1,18 @@
+fun id [t :: Type] (x : t) = x
+val id_self = id [t :: Type -> t -> t] id
+
+fun idi [t ::: Type] (x : t) = x
+val idi_self = idi @@idi
+
+fun picker [na :: Name] [a ::: Type] [nb :: Name] [b ::: Type] [fs ::: {Type}] [[na] ~ [nb]] [[na, nb] ~ fs]
+        (r : $([na = a, nb = b] ++ fs)) = {na = r.na, nb = r.nb}
+val getem = picker [#A] [#C] {A = 0, B = 1.0, C = "hi", D = {}}
+val getem2 = picker [#A] [_] {A = 0, B = 1.0, C = "hi", D = {}}
+val getem3 = picker [#A] [_::Name] {A = 0, B = 1.0, C = "hi", D = {}}
+
+fun picker_ohmy [na ::: Name] [a ::: Type] [nb ::: Name] [b ::: Type] [fs ::: {Type}] [[na] ~ [nb]] [[na, nb] ~ fs]
+        (r : $([na = a, nb = b] ++ fs)) = {na = r.na, nb = r.nb}
+val getem_ohmy = picker_ohmy {A = 0, B = 1.0, C = "hi", D = {}}
+
+fun proj [fs] [t] [nm :: Name] [[nm] ~ fs] (r : $([nm = t] ++ fs)) = r.nm
+val one = proj [#A] {A = 1, B = True}
diff --git a/tests/impl.urp b/tests/impl.urp
new file mode 100644
index 0000000..0ca72e1
--- /dev/null
+++ b/tests/impl.urp
@@ -0,0 +1,3 @@
+debug
+
+impl
diff --git a/tests/include.ur b/tests/include.ur
new file mode 100644
index 0000000..6661d0f
--- /dev/null
+++ b/tests/include.ur
@@ -0,0 +1,15 @@
+signature S = sig
+        type t
+        val x : t
+end
+
+signature S' = sig
+        include S
+        val y : t
+end
+
+signature S'' = sig
+        type u
+        include S' where type t = int
+        type v
+end
diff --git a/tests/init.ur b/tests/init.ur
new file mode 100644
index 0000000..8040612
--- /dev/null
+++ b/tests/init.ur
@@ -0,0 +1,6 @@
+sequence seq
+table fred : {A : int, B : int}
+
+task initialize = fn () =>
+    setval seq 1;
+    dml (INSERT INTO fred (A, B) VALUES (0, 1))
diff --git a/tests/init.urp b/tests/init.urp
new file mode 100644
index 0000000..a2166e4
--- /dev/null
+++ b/tests/init.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=init
+sql init.sql
+
+init
diff --git a/tests/initSimple.ur b/tests/initSimple.ur
new file mode 100644
index 0000000..e1c9428
--- /dev/null
+++ b/tests/initSimple.ur
@@ -0,0 +1,3 @@
+task initialize = fn () => debug "I ran!"
+
+fun main () = return <xml>Hi!</xml>
diff --git a/tests/initSimple.urp b/tests/initSimple.urp
new file mode 100644
index 0000000..c237440
--- /dev/null
+++ b/tests/initSimple.urp
@@ -0,0 +1 @@
+initSimple
diff --git a/tests/initSimple.urs b/tests/initSimple.urs
new file mode 100644
index 0000000..901d6bf
--- /dev/null
+++ b/tests/initSimple.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
diff --git a/tests/insert.ur b/tests/insert.ur
new file mode 100644
index 0000000..c718fb7
--- /dev/null
+++ b/tests/insert.ur
@@ -0,0 +1,5 @@
+table t1 : {A : int, B : string, C : float, D : bool}
+
+fun main () : transaction page =
+        () <- dml (INSERT INTO t1 (A, B, C, D) VALUES (5, "6", 7.0, TRUE));
+        return <html><body>Inserted.</body></html>
diff --git a/tests/insert.urp b/tests/insert.urp
new file mode 100644
index 0000000..20d2448
--- /dev/null
+++ b/tests/insert.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+insert
diff --git a/tests/invurl.ur b/tests/invurl.ur
new file mode 100644
index 0000000..aef1ced
--- /dev/null
+++ b/tests/invurl.ur
@@ -0,0 +1,9 @@
+val r = { F = fn () => return <xml/> }
+
+fun main () : transaction page = return <xml><body>
+  <a link={r.F ()}>Go</a>
+</body></xml>
+
+fun main' (r' : {F : unit -> transaction page}) : transaction page = return <xml><body>
+  <a link={r'.F ()}>Go</a>
+</body></xml>
diff --git a/tests/join.ur b/tests/join.ur
new file mode 100644
index 0000000..d664787
--- /dev/null
+++ b/tests/join.ur
@@ -0,0 +1,11 @@
+table t : { A : int, B : string, C : option string }
+
+fun main () =
+    r <- oneRow (SELECT * FROM t);
+    r <- oneRow (SELECT * FROM t AS T1, t AS T2);
+    r <- oneRow (SELECT * FROM t AS T1 CROSS JOIN t AS T2);
+    r <- oneRow (SELECT * FROM t AS T1 JOIN t AS T2 ON T1.A = T2.A);
+    r <- oneRow (SELECT * FROM t AS T1 LEFT JOIN t AS T2 ON T1.A = T2.A);
+    r <- oneRow (SELECT * FROM t AS T1 RIGHT OUTER JOIN t AS T2 ON T1.A = T2.A);
+    r <- oneRow (SELECT * FROM t AS T1 FULL JOIN t AS T2 ON T1.A = T2.A);
+    return <xml/>
diff --git a/tests/join.urp b/tests/join.urp
new file mode 100644
index 0000000..2719ecc
--- /dev/null
+++ b/tests/join.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=join
+sql join.sql
+
+join
diff --git a/tests/join.urs b/tests/join.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/join.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/jscomp.ur b/tests/jscomp.ur
new file mode 100644
index 0000000..e2cf4f9
--- /dev/null
+++ b/tests/jscomp.ur
@@ -0,0 +1,61 @@
+fun fst [a] [b] (x : a) (y : b) = x
+fun snd [a] [b] (x : a) (y : b) = y
+
+fun fact n =
+    case n of
+        0 => 1
+      | _ => n * fact (n - 1)
+
+datatype t =
+         A
+       | B of {C : int, D : float}
+       | E of t * t
+
+fun render x =
+    case x of
+        A => "A"
+      | B {C = n1, D = n2} => "B(" ^ show n1 ^ "," ^ show n2 ^ ")"
+      | E (x, y) => "C(" ^ render x ^ "," ^ render y ^ ")"
+
+fun main () =
+    s <- source "";
+    s' <- source "";
+    f <- source (plus 1);
+    f2 <- source fst;
+    r <- source {A = "x", B = "y"};
+    t <- source (E (A, B {C = 10, D = 1.23}));
+    ht <- source <xml>Nothing here yet.</xml>;
+
+    return <xml><body>
+      <ctextbox source={s}/> <ctextbox source={s'}/><br/><br/>
+
+      Function: <button value="+1" onclick={set f (plus 1)}/>
+      <button value="*3" onclick={set f (times 3)}/><br/><br/>
+
+      Function2: <button value="Fst" onclick={set f2 fst}/>
+      <button value="Snd" onclick={set f2 snd}/><br/><br/>
+
+      Both: <button value="*3,Snd" onclick={set f (times 3); set f2 snd}/><br/><br/>
+
+      <button value="Echo" onclick={s <- get s; alert s}/>
+      <button value="Echo2" onclick={s <- get s; alert s; alert s}/>
+      <button value="-" onclick={s <- get s; alert (show (-(readError s : int)))}/>
+      <button value="+1" onclick={s <- get s; alert (show (readError s + 1))}/>
+      <button value="*3" onclick={s <- get s; alert (show ((readError s) * 3))}/>
+      <button value="!" onclick={s <- get s; alert (show (fact (readError s)))}/>
+      <button value="f" onclick={s <- get s; f <- get f; alert (show (f (readError s)))}/>
+      <button value="+1P" onclick={s <- get s; case read s of
+                                                   None => alert "Nada!"
+                                                 | Some (n : int) => alert (show (n + 1))}/>
+
+      <button value="f2" onclick={s <- get s; s' <- get s'; f2 <- get f2; alert (f2 s s')}/><br/><br/>
+
+      <button value="A" onclick={r <- get r; alert r.A}/>
+      <button value="B" onclick={r <- get r; alert r.B}/><br/><br/>
+
+      <button value="render" onclick={t <- get t; alert (render t)}/><br/><br/>
+
+      <dyn signal={signal ht}/>
+      <button value="Set" onclick={s <- get s;
+                                   set ht <xml><button value="Dynamic!" onclick={alert s}/></xml>}/>
+    </body></xml>
diff --git a/tests/jscomp.urp b/tests/jscomp.urp
new file mode 100644
index 0000000..ac20714
--- /dev/null
+++ b/tests/jscomp.urp
@@ -0,0 +1,3 @@
+debug
+
+jscomp
diff --git a/tests/jscomp.urs b/tests/jscomp.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/jscomp.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/jserror.ur b/tests/jserror.ur
new file mode 100644
index 0000000..eccbe34
--- /dev/null
+++ b/tests/jserror.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml>
+  <body onload={onError (fn s => alert ("There was an error: " ^ show s)); error <xml>Badder</xml>}/>
+</xml>
diff --git a/tests/jserror.urp b/tests/jserror.urp
new file mode 100644
index 0000000..74cceb4
--- /dev/null
+++ b/tests/jserror.urp
@@ -0,0 +1,3 @@
+debug
+
+jserror
diff --git a/tests/jsinj.ur b/tests/jsinj.ur
new file mode 100644
index 0000000..182de33
--- /dev/null
+++ b/tests/jsinj.ur
@@ -0,0 +1,109 @@
+fun getOpt (t ::: Type) (o : option t) (v : t) : t =
+    case o of
+        None => v
+      | Some x => x
+
+datatype color = Red | White | Blue
+
+fun colorToString c =
+    case c of
+        Red => "R"
+      | White => "W"
+      | Blue => "B"
+
+val show_color = mkShow colorToString
+
+datatype list a = Nil | Cons of a * list a
+
+fun delist ls : xbody =
+    case ls of
+        Nil => <xml>Nil</xml>
+      | Cons (h, t) => <xml>{cdata h} :: {delist t}</xml>
+
+datatype weird = Foo | Bar | Baz of string
+
+fun weirdToString w =
+    case w of
+        Foo => "Foo"
+      | Bar => "Bar"
+      | Baz s => s
+
+val show_weird = mkShow weirdToString
+
+cookie int : int
+cookie float : float
+cookie string : string
+cookie bool : bool
+cookie pair : int * float
+cookie option : option int
+cookie color : color
+cookie list : list string
+cookie weird : weird
+
+fun main () : transaction page =
+    n <- getCookie int;
+    n <- return (getOpt n 7);
+    sn <- source 6;
+
+    f <- getCookie float;
+    f <- return (getOpt f 1.23);
+    sf <- source 4.56;
+
+    s <- getCookie string;
+    s <- return (getOpt s "Hi");
+    ss <- source "Bye";
+
+    b <- getCookie bool;
+    b <- return (getOpt b True);
+    sb <- source False;
+
+    p <- getCookie pair;
+    p <- return (getOpt p (1, 2.3));
+    sp <- source (4, 5.6);
+
+    o <- getCookie option;
+    o <- return (getOpt o (Some 1));
+    so <- source None;
+
+    c <- getCookie color;
+    c <- return (getOpt c White);
+    sc <- source Blue;
+
+    l <- getCookie list;
+    l <- return (getOpt l (Cons ("A", Cons ("B", Nil))));
+    sl <- source Nil;
+
+    w <- getCookie weird;
+    w <- return (getOpt w (Baz "TADA!"));
+    sw <- source Foo;
+
+    return <xml><body>
+      <dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
+      <a onclick={set sn n}>CHANGE</a><br/>
+
+      <dyn signal={f <- signal sf; return <xml>{[f]}</xml>}/>
+      <a onclick={set sf f}>CHANGE</a><br/>
+
+      <dyn signal={s <- signal ss; return <xml>{[s]}</xml>}/>
+      <a onclick={set ss s}>CHANGE</a><br/>
+
+      <dyn signal={b <- signal sb; return <xml>{[b]}</xml>}/>
+      <a onclick={set sb b}>CHANGE</a><br/>
+
+      <dyn signal={p <- signal sp; return <xml>{[p.1]}, {[p.2]}</xml>}/>
+      <a onclick={set sp p}>CHANGE</a><br/>
+
+      <dyn signal={o <- signal so; case o of
+                                       None => return <xml>None</xml>
+                                     | Some x => return <xml>{[x]}</xml>}/>
+      <a onclick={set so o}>CHANGE</a><br/>
+
+      <dyn signal={c <- signal sc; return <xml>{[c]}</xml>}/>
+      <a onclick={set sc c}>CHANGE</a><br/>
+
+      <dyn signal={l <- signal sl; return <xml>{delist l}</xml>}/>
+      <a onclick={set sl l}>CHANGE</a><br/>
+
+      <dyn signal={w <- signal sw; return <xml>{[w]}</xml>}/>
+      <a onclick={set sw w}>CHANGE</a><br/>
+    </body></xml>
diff --git a/tests/jsinj.urp b/tests/jsinj.urp
new file mode 100644
index 0000000..dc929b9
--- /dev/null
+++ b/tests/jsinj.urp
@@ -0,0 +1,3 @@
+debug
+
+jsinj
diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur
new file mode 100644
index 0000000..97898de
--- /dev/null
+++ b/tests/jsonTest.ur
@@ -0,0 +1,6 @@
+open Json
+
+fun main () : transaction page = return <xml><body>
+  {[fromJson "[1, 2, 3]" : list int]}<br/>
+  {[toJson ("hi" :: "bye\"" :: "hehe" :: [])]}
+</body></xml>
diff --git a/tests/jsonTest.urp b/tests/jsonTest.urp
new file mode 100644
index 0000000..0b606fa
--- /dev/null
+++ b/tests/jsonTest.urp
@@ -0,0 +1,7 @@
+rewrite all JsonTest/*
+
+$/char
+$/string
+$/list
+$/json
+jsonTest
diff --git a/tests/jsparse.ur b/tests/jsparse.ur
new file mode 100644
index 0000000..de6c9f1
--- /dev/null
+++ b/tests/jsparse.ur
@@ -0,0 +1,8 @@
+fun main () =
+    s <- source "13";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <dyn signal={v <- signal s; return (case read v : option int of
+                                              None => <xml>None</xml>
+                                            | Some n => <xml>Some {[n]}</xml>)}/>
+      </body></xml>
diff --git a/tests/jsparse.urp b/tests/jsparse.urp
new file mode 100644
index 0000000..7f54bfc
--- /dev/null
+++ b/tests/jsparse.urp
@@ -0,0 +1,3 @@
+debug
+
+jsparse
diff --git a/tests/jsparse.urs b/tests/jsparse.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/jsparse.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/jsuni.ur b/tests/jsuni.ur
new file mode 100644
index 0000000..9a1e3e9
--- /dev/null
+++ b/tests/jsuni.ur
@@ -0,0 +1,17 @@
+fun main () =
+    s1 <- source "";
+    s2 <- source "";
+
+    let
+        fun echo s = return s
+
+        fun echoer () =
+            v1 <- get s1;
+            v1' <- rpc (echo v1);
+            set s2 v1'
+    in
+        return <xml><body>
+          <dyn signal={v <- signal s2; return (cdata v)}/><hr/>
+          <ctextbox source={s1}/> <button onclick={echoer ()}/>
+        </body></xml>
+    end
diff --git a/tests/jsuni.urp b/tests/jsuni.urp
new file mode 100644
index 0000000..0eb968e
--- /dev/null
+++ b/tests/jsuni.urp
@@ -0,0 +1,3 @@
+debug
+
+jsuni
diff --git a/tests/jsuni.urs b/tests/jsuni.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/jsuni.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/keyEvent.ur b/tests/keyEvent.ur
new file mode 100644
index 0000000..875e2b6
--- /dev/null
+++ b/tests/keyEvent.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page = return <xml><body>
+  <ctextbox onkeypress={fn ev => alert ("KeyCode = " ^ show ev.KeyCode
+                                        ^ "\nCtrlKey = " ^ show ev.CtrlKey
+                                        ^ "\nShiftKey = " ^ show ev.ShiftKey
+                                        ^ "\nAltKey = " ^ show ev.AltKey
+                                        ^ "\nMetaKey = " ^ show ev.MetaKey)}/>
+</body></xml>
diff --git a/tests/ktuple.ur b/tests/ktuple.ur
new file mode 100644
index 0000000..040578e
--- /dev/null
+++ b/tests/ktuple.ur
@@ -0,0 +1,2 @@
+type q = (fn p => p.1) (int, float)
+type q = (fn p => p.1 * $p.3) (int, float, [])
diff --git a/tests/ktuple.urp b/tests/ktuple.urp
new file mode 100644
index 0000000..c466588
--- /dev/null
+++ b/tests/ktuple.urp
@@ -0,0 +1 @@
+ktuple
diff --git a/tests/label.ur b/tests/label.ur
new file mode 100644
index 0000000..1b482ae
--- /dev/null
+++ b/tests/label.ur
@@ -0,0 +1,4 @@
+fun main () = return <xml><body>
+  <ccheckbox id="A"/> <label for="A">First one</label><br/>
+  <ccheckbox id="B"/> <label for="B">Second one</label><br/>
+</body></xml>
diff --git a/tests/label.urp b/tests/label.urp
new file mode 100644
index 0000000..d79a9b2
--- /dev/null
+++ b/tests/label.urp
@@ -0,0 +1,2 @@
+
+label
diff --git a/tests/label.urs b/tests/label.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/label.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/league.ur b/tests/league.ur
new file mode 100644
index 0000000..5364c97
--- /dev/null
+++ b/tests/league.ur
@@ -0,0 +1,8 @@
+type team = string
+type league = string
+
+table team : { Id : team,
+               League : league }
+
+val foo = queryL(SELECT * FROM team)
+val bar : int = "hi"
diff --git a/tests/lengthGe.ur b/tests/lengthGe.ur
new file mode 100644
index 0000000..2991ad8
--- /dev/null
+++ b/tests/lengthGe.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+    s <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <dyn signal={v <- signal s;
+                   return (txt (strlenGe v 3))}/>
+    </body></xml>
diff --git a/tests/lessSafeFfi.ur b/tests/lessSafeFfi.ur
new file mode 100644
index 0000000..6bf26ba
--- /dev/null
+++ b/tests/lessSafeFfi.ur
@@ -0,0 +1,22 @@
+ffi foo : int -> int
+ffi bar serverOnly benignEffectful : int -> transaction unit
+ffi baz : transaction int
+ffi adder : int -> int -> int
+
+ffi bup jsFunc "alert" : string -> transaction unit
+ffi alert : string -> transaction unit
+
+fun other () : transaction page =
+    (*bar 17;
+    q <- baz;*)
+    return <xml><body>
+      (*{[foo 42]}, {[q]}*)
+      <button value="bup" onclick={fn _ => bup "asdf"}/>
+      <button value="alert" onclick={fn _ => alert "qqqz"}/>
+    </body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <submit action={other}/>
+  </form>
+</body></xml>
diff --git a/tests/lessSafeFfi.urp b/tests/lessSafeFfi.urp
new file mode 100644
index 0000000..729c527
--- /dev/null
+++ b/tests/lessSafeFfi.urp
@@ -0,0 +1,5 @@
+rewrite all LessSafeFfi/*
+debug
+lessSafeFfi
+
+lessSafeFfi
diff --git a/tests/lessSafeFfi.urs b/tests/lessSafeFfi.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/lessSafeFfi.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/let.ur b/tests/let.ur
new file mode 100644
index 0000000..14dc936
--- /dev/null
+++ b/tests/let.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page =
+    let
+        val x = 1
+        val y = "Hello"
+        val z = 3.45
+    in
+        return <xml>{[x]}, {[y]}, {[z]}</xml>
+    end
diff --git a/tests/let.urp b/tests/let.urp
new file mode 100644
index 0000000..4bb17d3
--- /dev/null
+++ b/tests/let.urp
@@ -0,0 +1,3 @@
+debug
+
+let
diff --git a/tests/letwhere.ur b/tests/letwhere.ur
new file mode 100644
index 0000000..8854f2a
--- /dev/null
+++ b/tests/letwhere.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+    let
+        return <xml>Hi {[alice]} and {[bob]}!</xml>
+    where
+        val alice = "Alice"
+        val bob = "Bob"
+    end
diff --git a/tests/lexerr.ur b/tests/lexerr.ur
new file mode 100644
index 0000000..c9d17ad
--- /dev/null
+++ b/tests/lexerr.ur
@@ -0,0 +1,3 @@
+type t = int
+type q = int
+type u = inot
diff --git a/tests/lexerrS.ur b/tests/lexerrS.ur
new file mode 100644
index 0000000..93ab30a
--- /dev/null
+++ b/tests/lexerrS.ur
@@ -0,0 +1,4 @@
+sig
+type t = int
+type q = int
+type u = inot
diff --git a/tests/library.urp b/tests/library.urp
new file mode 100644
index 0000000..1c4d6fb
--- /dev/null
+++ b/tests/library.urp
@@ -0,0 +1 @@
+script /bogus.js
diff --git a/tests/library2.urp b/tests/library2.urp
new file mode 100644
index 0000000..17b1ad5
--- /dev/null
+++ b/tests/library2.urp
@@ -0,0 +1 @@
+library library
diff --git a/tests/limit.ur b/tests/limit.ur
new file mode 100644
index 0000000..2079b47
--- /dev/null
+++ b/tests/limit.ur
@@ -0,0 +1,27 @@
+table t : {A : int, B : string, C : float}
+
+val q1 = (SELECT * FROM t LIMIT 42)
+val q2 = fn n => (SELECT * FROM t LIMIT {n})
+
+val q3 = (SELECT * FROM t OFFSET 3)
+val q4 = fn n => fn m => (SELECT * FROM t LIMIT {n} OFFSET {m})
+
+
+datatype list a = Nil | Cons of a * list a
+
+val r1 : transaction (list {A : int, B : string, C : float}) =
+        query (q4 3 7)
+        (fn fs acc => return (Cons (fs.T, acc)))
+        Nil
+
+val r2 : transaction string =
+        ls <- r1;
+        return (case ls of
+                    Nil => "Problem"
+                  | Cons ({B = b, ...}, _) => b)
+
+val main : unit -> transaction page = fn () =>
+        s <- r2;
+        return <html><body>
+                {cdata s}
+        </body></html>
diff --git a/tests/link.ur b/tests/link.ur
new file mode 100644
index 0000000..aa65b26
--- /dev/null
+++ b/tests/link.ur
@@ -0,0 +1,7 @@
+fun ancillary () = return <xml>
+        Welcome to the ancillary page!
+</xml>
+
+fun main () : transaction page = return <xml><body>
+        <a link={ancillary ()}>Enter the unknown!</a>
+</body></xml>
diff --git a/tests/link.urp b/tests/link.urp
new file mode 100644
index 0000000..988b2e6
--- /dev/null
+++ b/tests/link.urp
@@ -0,0 +1,5 @@
+debug
+exe /tmp/webapp
+
+link
+
diff --git a/tests/linker.ur b/tests/linker.ur
new file mode 100644
index 0000000..22c5e3a
--- /dev/null
+++ b/tests/linker.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml/>
diff --git a/tests/linker.urp b/tests/linker.urp
new file mode 100644
index 0000000..9a0f8f4
--- /dev/null
+++ b/tests/linker.urp
@@ -0,0 +1,4 @@
+debug
+linker ld -g
+
+linker
diff --git a/tests/links.ur b/tests/links.ur
new file mode 100644
index 0000000..7a7b1e9
--- /dev/null
+++ b/tests/links.ur
@@ -0,0 +1,24 @@
+val pC : xhtml = <html><body>
+        <h1>Page C</h1>
+</body></html>
+
+val pB : xhtml = <html><body>
+        <h1>Page B</h1>
+
+        <li> <a link={pC}>C</a></li>
+</body></html>
+
+val pA : xhtml = <html><body>
+        <h1>Page A</h1>
+
+        <li> <a link={pB}>B</a></li>
+        <li> <a link={pC}>C</a></li>
+</body></html>
+
+val main : unit -> xhtml = fn () => <html><body>
+        <h1>Main</h1>
+
+        <li> <a link={pA}>A</a></li>
+        <li> <a link={pB}>B</a></li>
+        <li> <a link={pC}>C</a></li>
+</body></html>
diff --git a/tests/linksF.ur b/tests/linksF.ur
new file mode 100644
index 0000000..0bcfe1d
--- /dev/null
+++ b/tests/linksF.ur
@@ -0,0 +1,24 @@
+val pC : unit -> xhtml = fn () => <html><body>
+        <h1>Page C</h1>
+</body></html>
+
+val pB : unit -> xhtml = fn () => <html><body>
+        <h1>Page B</h1>
+
+        <li> <a link={pC ()}>C</a></li>
+</body></html>
+
+val pA : unit -> xhtml = fn () => <html><body>
+        <h1>Page A</h1>
+
+        <li> <a link={pB ()}>B</a></li>
+        <li> <a link={pC ()}>C</a></li>
+</body></html>
+
+val main : unit -> xhtml = fn () => <html><body>
+        <h1>Main</h1>
+
+        <li> <a link={pA ()}>A</a></li>
+        <li> <a link={pB ()}>B</a></li>
+        <li> <a link={pC ()}>C</a></li>
+</body></html>
diff --git a/tests/list.ur b/tests/list.ur
new file mode 100644
index 0000000..472b9ea
--- /dev/null
+++ b/tests/list.ur
@@ -0,0 +1,22 @@
+fun isNil (t ::: Type) (ls : list t) =
+    case ls of
+        [] => True
+      | _ => False
+
+fun delist (ls : list string) : xbody =
+        case ls of
+            [] => <xml>Nil</xml>
+          | h :: t => <xml>{[h]} :: {delist t}</xml>
+
+fun callback ls = return <xml><body>
+  {delist ls}
+</body></xml>
+
+fun main () = return <xml><body>
+  {[isNil ([] : list bool)]},
+  {[isNil (1 :: [])]},
+  {[isNil ("A" :: "B" :: [])]}
+
+  <p>{delist ("X" :: "Y" :: "Z" :: [])}</p>
+  <a link={callback ("A" :: "B" :: [])}>Go!</a>
+</body></xml>
diff --git a/tests/list.urp b/tests/list.urp
new file mode 100644
index 0000000..d222b71
--- /dev/null
+++ b/tests/list.urp
@@ -0,0 +1,3 @@
+debug
+
+list
diff --git a/tests/list.urs b/tests/list.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/list.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/listinit.ur b/tests/listinit.ur
new file mode 100644
index 0000000..8f9fb57
--- /dev/null
+++ b/tests/listinit.ur
@@ -0,0 +1,43 @@
+fun makeList n =
+    if n = 0 then
+        []
+    else
+        n :: makeList (n-1)
+
+fun sum ls =
+    case ls of
+        [] => 0
+      | n :: ls' => n + sum ls'
+
+val ls = 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: 10
+           :: []
+
+task initialize = fn () =>
+                     debug (show (sum ls + sum ls))
diff --git a/tests/listpair.ur b/tests/listpair.ur
new file mode 100644
index 0000000..641b7a0
--- /dev/null
+++ b/tests/listpair.ur
@@ -0,0 +1,6 @@
+val x = 1 :: 2 :: []
+val y = 3 :: 4 :: []
+
+fun main () : transaction page = return <xml>
+  {[ListPair.mp plus x y]}
+</xml>
diff --git a/tests/listpair.urp b/tests/listpair.urp
new file mode 100644
index 0000000..1b447ed
--- /dev/null
+++ b/tests/listpair.urp
@@ -0,0 +1,5 @@
+rewrite all Listpair/*
+
+$/list
+$/listPair
+listpair
diff --git a/tests/localInstance.ur b/tests/localInstance.ur
new file mode 100644
index 0000000..81a65dd
--- /dev/null
+++ b/tests/localInstance.ur
@@ -0,0 +1,8 @@
+datatype foo = Bar
+
+val x =
+    let
+        val _ = mkShow (fn Bar => "Bar")
+    in
+        show Bar
+    end
diff --git a/tests/localfun.ur b/tests/localfun.ur
new file mode 100644
index 0000000..1539abb
--- /dev/null
+++ b/tests/localfun.ur
@@ -0,0 +1,191 @@
+fun boom s =
+    let
+        val bonk =
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s
+
+        val boonk = fn () =>
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s
+
+        fun booonk () =
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s;
+            debug s
+    in
+        bonk; bonk; boonk (); boonk (); booonk (); booonk ()
+    end
+
+fun main () : transaction page =
+    boom "test";
+    return <xml/>
diff --git a/tests/longConst.ur b/tests/longConst.ur
new file mode 100644
index 0000000..d81e2ad
--- /dev/null
+++ b/tests/longConst.ur
@@ -0,0 +1,12 @@
+val ls = 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: []
+
+fun main () : transaction page = return <xml><body>
+  {List.mapX txt ls}<br/>
+  {List.mapX txt ls}
+</body></xml>
diff --git a/tests/longConst.urp b/tests/longConst.urp
new file mode 100644
index 0000000..0710a6f
--- /dev/null
+++ b/tests/longConst.urp
@@ -0,0 +1,2 @@
+$/list
+longConst
diff --git a/tests/lower.ur b/tests/lower.ur
new file mode 100644
index 0000000..21e1f1f
--- /dev/null
+++ b/tests/lower.ur
@@ -0,0 +1,10 @@
+table lower : { A : string }
+
+fun main () : transaction page =
+    all <- queryX1 (SELECT *
+                    FROM lower
+                    WHERE lower(lower.A) LIKE '%foo')
+                   (fn r => <xml>{[r.A]}<br/></xml>);
+    return <xml><body>
+      {all}
+    </body></xml>
diff --git a/tests/lower.urp b/tests/lower.urp
new file mode 100644
index 0000000..6abf57a
--- /dev/null
+++ b/tests/lower.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql lower.sql
+
+lower
diff --git a/tests/makeUrl.ur b/tests/makeUrl.ur
new file mode 100644
index 0000000..12026da
--- /dev/null
+++ b/tests/makeUrl.ur
@@ -0,0 +1,3 @@
+fun other () = return <xml>Hi!</xml>
+
+fun main () = return <xml>{[Basis.url (main ())]}, {[url (other ())]}</xml>
diff --git a/tests/makeUrl.urp b/tests/makeUrl.urp
new file mode 100644
index 0000000..83451c4
--- /dev/null
+++ b/tests/makeUrl.urp
@@ -0,0 +1,3 @@
+debug
+
+makeUrl
diff --git a/tests/makeUrl.urs b/tests/makeUrl.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/makeUrl.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/malformed.ur b/tests/malformed.ur
new file mode 100644
index 0000000..60e0b9f
--- /dev/null
+++ b/tests/malformed.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  FYI, this file isn't the malformed one.  That's <tt>malformed.urp</tt>.
+</body></xml>
diff --git a/tests/malformed.urp b/tests/malformed.urp
new file mode 100644
index 0000000..d065a03
--- /dev/null
+++ b/tests/malformed.urp
@@ -0,0 +1,5 @@
+rewrite url Malformed/*
+
+rewrite style Malformed/*
+
+malformed
diff --git a/tests/math.ur b/tests/math.ur
new file mode 100644
index 0000000..964b73e
--- /dev/null
+++ b/tests/math.ur
@@ -0,0 +1,26 @@
+fun main () = return <xml><body>
+  <button value="Power 2.0 of 2.0!" onclick={fn _ => alert (show (pow 2.0 2.0))}/>
+  {[(pow 2.0 2.0)]}
+  <button value="Square root of 25!" onclick={fn _ => alert (show (sqrt 25.0))}/>
+  {[(sqrt 25.0)]}
+  <button value="Sin of 0.1!" onclick={fn _ => alert (show (sin 0.1))}/>
+  {[(sin 0.1)]}
+  <button value="Cos of 0.1!" onclick={fn _ => alert (show (cos 0.1))}/>
+  {[(cos 0.1)]}
+  <button value="log of 0.1!" onclick={fn _ => alert (show (log 0.1))}/>
+  {[(log 0.1)]}
+  <button value="Exp of 0.1!" onclick={fn _ => alert (show (exp 0.1))}/>
+  {[(exp 0.1)]}
+  <button value="asin of 0.1!" onclick={fn _ => alert (show (asin 0.1))}/>
+  {[(asin 0.1)]}
+  <button value="acos of 0.1!" onclick={fn _ => alert (show (acos 0.1))}/>
+  {[(acos 0.1)]}
+  <button value="atan of 0.1!" onclick={fn _ => alert (show (atan 0.1))}/>
+  {[(atan 0.1)]}
+  <button value="atan2 of 0.1 and -0.2!" onclick={fn _ => alert (show (atan2 0.1 (-0.2)))}/>
+  {[(atan2 0.1 (-0.2))]}
+  <button value="floor of 34.5!" onclick={fn _ => alert (show (floor 34.5))}/>
+  {[(floor 34.5)]}
+  <button value="abs of -10.0!" onclick={fn _ => alert (show (abs (-10.0)))}/>
+  {[(abs (-10.0))]}
+  </body></xml>
diff --git a/tests/megaform.ur b/tests/megaform.ur
new file mode 100644
index 0000000..2db2f67
--- /dev/null
+++ b/tests/megaform.ur
@@ -0,0 +1,67 @@
+fun handler'' ls =
+    case ls of
+        Nil => <xml/>
+      | Cons (r, ls) => <xml><li>{[r.C]}</li>{handler'' ls}</xml>
+
+fun handler' ls =
+    case ls of
+        Nil => <xml/>
+      | Cons (r, ls) => <xml><li>{[r.Sub.A]} <ul>{handler'' r.Sub.Sub2}</ul></li>{handler' ls}</xml>
+
+fun handler r = return <xml><body>
+  {[r.A]}
+  <ul>{handler' r.Sub}</ul>
+  {[r.C]}<br/>
+  {[r.Sub2.A]}<br/>
+  {handler'' r.Sub2.Nested}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/><br/>
+    <subforms{#Sub}>
+      <entry>
+        <subform{#Sub}>
+          <textbox{#A}/><br/>
+          <subforms{#Sub2}>
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+          </subforms>
+        </subform>
+      </entry>
+
+      <entry>
+        <subform{#Sub}>
+          <textbox{#A}/><br/>
+          <subforms{#Sub2}>
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+          </subforms>
+        </subform>
+      </entry>
+    </subforms>
+    <textbox{#C}/><br/>
+
+    <subform{#Sub2}>
+      <textbox{#A}/><br/>
+
+      <subforms{#Nested}>
+        <entry>
+          <textbox{#C}/>
+        </entry>
+      </subforms>
+    </subform><br/>
+
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/megaform.urp b/tests/megaform.urp
new file mode 100644
index 0000000..714ede1
--- /dev/null
+++ b/tests/megaform.urp
@@ -0,0 +1,3 @@
+debug
+
+megaform
diff --git a/tests/megaform.urs b/tests/megaform.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/megaform.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/meta.ur b/tests/meta.ur
new file mode 100644
index 0000000..f8d1218
--- /dev/null
+++ b/tests/meta.ur
@@ -0,0 +1,48 @@
+fun main () : transaction page =
+    let
+        fun handler r = return <xml>
+          <head>
+            <meta name={blessMeta r.Nam} content={r.Content}/>
+            <title>Testing &lt;meta> tags</title>
+          </head>
+          <body>
+            <p>Did it work?</p>
+          </body>
+        </xml>
+
+        fun handler2 r =
+            case checkMeta r.Nam of
+                None => error <xml>Oh, that name won't do at all.</xml>
+              | Some name =>
+                return <xml>
+                  <head>
+                    <meta name={name} content={r.Content}/>
+                    <title>Testing &lt;meta> tags</title>
+                  </head>
+                  <body>
+                    <p>Did it work?</p>
+                  </body>
+                </xml>
+    in
+        return <xml>
+          <head>
+            <meta name="viewport" content="width=device-width, initial-scale=1.0"/>
+            <title>Testing &lt;meta> tags</title>
+          </head>
+          <body>
+            <p>Did it work?</p>
+
+            <form>
+              Name: <textbox{#Nam}/><br/>
+              Content: <textbox{#Content}/><br/>
+              <submit action={handler}/>
+            </form>
+
+            <form>
+              Name: <textbox{#Nam}/><br/>
+              Content: <textbox{#Content}/><br/>
+              <submit action={handler2}/>
+            </form>
+          </body>
+        </xml>
+    end
diff --git a/tests/meta.urp b/tests/meta.urp
new file mode 100644
index 0000000..95ede78
--- /dev/null
+++ b/tests/meta.urp
@@ -0,0 +1,4 @@
+rewrite all Meta/*
+allow meta viewport
+
+meta
diff --git a/tests/millis.ur b/tests/millis.ur
new file mode 100644
index 0000000..0ba22b9
--- /dev/null
+++ b/tests/millis.ur
@@ -0,0 +1,17 @@
+fun diffThem tm =
+    tm' <- now;
+    return <xml><body>
+      Diff: {[diffInMilliseconds tm tm']}
+    </body></xml>
+
+fun main () : transaction page =
+    tm <- now;
+
+    return <xml><body>
+      Now: {[toMilliseconds tm]}<br/>
+      <a link={diffThem tm}>Diff</a><br/>
+      
+      <button onclick={tm' <- now;
+                       alert ("Now: " ^ show (toMilliseconds tm'));
+                       alert ("Diff: " ^ show (diffInMilliseconds tm tm'))}/>
+    </body></xml>
diff --git a/tests/mismatch.ur b/tests/mismatch.ur
new file mode 100644
index 0000000..e18e373
--- /dev/null
+++ b/tests/mismatch.ur
@@ -0,0 +1,3 @@
+fun main () = return <xml><body>
+  <b>Wowza!</i>
+</body></xml>
diff --git a/tests/mismatch.urp b/tests/mismatch.urp
new file mode 100644
index 0000000..65f340b
--- /dev/null
+++ b/tests/mismatch.urp
@@ -0,0 +1 @@
+mismatch
diff --git a/tests/mismatch.urs b/tests/mismatch.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/mismatch.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/modnested.ur b/tests/modnested.ur
new file mode 100644
index 0000000..d9ff576
--- /dev/null
+++ b/tests/modnested.ur
@@ -0,0 +1,34 @@
+signature S = sig
+        type t
+        val x : t
+
+        structure Q : sig
+                type q
+                val y : q
+
+                structure V : sig
+                        type v
+                end
+        end
+end
+
+structure S = struct
+        type t = int
+        val x = 0
+
+        structure Q = struct
+                type q = float
+                val y = 0.0
+
+                structure V = struct
+                        type v = string
+                        val hi = "Hi"
+                end
+        end
+end
+
+structure S1 = S
+structure S2 : S = S
+structure S3 = S2
+
+val main = S3.Q.y
diff --git a/tests/modproj.ur b/tests/modproj.ur
new file mode 100644
index 0000000..a12e25a
--- /dev/null
+++ b/tests/modproj.ur
@@ -0,0 +1,23 @@
+signature S1 = sig
+        type t
+        val zero : t
+end
+signature S2 = sig
+        type t = int
+        val zero : t
+end
+structure S = struct
+        type t = int
+        val zero = 0
+end
+structure S1 : S1 = S
+structure S2 : S2 = S
+
+type t = S1.t
+val zero : t = S1.zero
+
+type t = S2.t
+val zero : int = S2.zero
+
+structure T = S1
+val main : S1.t = T.zero
diff --git a/tests/modules.ur b/tests/modules.ur
new file mode 100644
index 0000000..5089f17
--- /dev/null
+++ b/tests/modules.ur
@@ -0,0 +1,75 @@
+signature A = sig end
+structure A = struct end
+structure Ao : A = A
+
+
+structure B = struct
+        type t = int
+end
+structure Bo0 : sig end = B
+structure BoA : A = B
+
+signature B1 = sig
+        type t
+end
+structure Bo1 : B1 = B
+(*structure AoB1 : B1 = A*)
+
+signature B2 = sig
+        type t = int
+end
+structure Bo2 : B2 = B
+
+
+structure C = struct
+        type t = float
+end
+structure CoB1 : B1 = C
+(*structure CoB2 : B2 = C*)
+
+
+signature NAT = sig
+        type t
+        val zero : t
+end
+structure Nat : NAT = struct
+        type t = int
+        val zero = 0
+end
+(*structure NotNat : NAT = struct
+        type t = int
+        val zero = 0.0
+end*)
+(*structure NotNat : NAT = struct
+        val zero = 0
+end*)
+
+
+signature WOBBLE = sig
+        type t
+        type s
+end
+structure Wobble1 = struct
+        type t = int
+        type s = float
+end
+structure Wobble2 = struct
+        type s = int
+        type t = float
+end
+
+
+structure N = struct
+        type t = string
+        structure N2 = struct
+                type t = int
+                val zero = 0
+        end
+        val x = "Hi"
+end
+signature N = sig
+        structure N2 : NAT
+        type t
+        val x : t
+end
+structure No : N = N
diff --git a/tests/monad.urp b/tests/monad.urp
new file mode 100644
index 0000000..91523ca
--- /dev/null
+++ b/tests/monad.urp
@@ -0,0 +1,3 @@
+$/monad
+$/list
+monadTest
diff --git a/tests/monadTest.ur b/tests/monadTest.ur
new file mode 100644
index 0000000..16a10f7
--- /dev/null
+++ b/tests/monadTest.ur
@@ -0,0 +1,3 @@
+val x : transaction int = Monad.liftM2 plus (return 1) (return 2)
+
+val x : transaction xbody = List.mapXiM (fn i x => return <xml><li>{[i]} = {[x]}</li></xml>) (1 :: 2 :: [])
diff --git a/tests/mouseEvent.ur b/tests/mouseEvent.ur
new file mode 100644
index 0000000..2192e0b
--- /dev/null
+++ b/tests/mouseEvent.ur
@@ -0,0 +1,16 @@
+val show_mouseButton = mkShow (fn b => case b of
+                                           Left => "Left"
+                                         | Middle => "Middle"
+                                         | Right => "Right")
+
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn ev => alert ("ScreenX = " ^ show ev.ScreenX
+                                   ^ "\nScreenY = " ^ show ev.ScreenY
+                                   ^ "\nClientX = " ^ show ev.ClientX
+                                   ^ "\nClientY = " ^ show ev.ClientY
+                                   ^ "\nCtrlKey = " ^ show ev.CtrlKey
+                                   ^ "\nShiftKey = " ^ show ev.ShiftKey
+                                   ^ "\nAltKey = " ^ show ev.AltKey
+                                   ^ "\nMetaKey = " ^ show ev.MetaKey
+                                   ^ "\nButton = " ^ show ev.Button)}/>
+</body></xml>
diff --git a/tests/mproj.ur b/tests/mproj.ur
new file mode 100644
index 0000000..8e4317c
--- /dev/null
+++ b/tests/mproj.ur
@@ -0,0 +1,21 @@
+structure M : sig
+    type t
+    val x : t
+
+    structure S : sig
+        type u = t
+
+        val eq : eq u
+    end
+end = struct
+    type t = int
+    val x = 0
+
+    structure S = struct
+        type u = t
+
+        val eq = _
+    end
+end
+
+val y = M.x = M.x
diff --git a/tests/mproj.urp b/tests/mproj.urp
new file mode 100644
index 0000000..d222e3d
--- /dev/null
+++ b/tests/mproj.urp
@@ -0,0 +1,3 @@
+debug
+
+mproj
diff --git a/tests/ms.ur b/tests/ms.ur
new file mode 100644
index 0000000..3dcc48c
--- /dev/null
+++ b/tests/ms.ur
@@ -0,0 +1,35 @@
+table ms : {Client : client, Channel : channel xbody}
+
+val hitMe =
+    me <- self;
+    ch <- oneRowE1 (SELECT (ms.Channel)
+                    FROM ms
+                    WHERE ms.Client = {[me]});
+
+    s <- source 0;
+    send ch <xml>
+      <dyn signal={n <- signal s; return <xml>{[n]}</xml>}/>
+      <button value="Inc" onclick={n <- get s; set s (n + 1)}/>
+    </xml>
+
+fun main' () =
+    me <- self;
+    ch <- channel;
+    dml (INSERT INTO ms (Client, Channel) VALUES ({[me]}, {[ch]}));
+
+    s <- source <xml/>;
+
+    return <xml><body onload={let
+                                  fun loop () =
+                                      x <- recv ch;
+                                      set s x;
+                                      loop ()
+                              in
+                                  loop ()
+                              end}>
+      <button value="Another" onclick={rpc hitMe}/>
+      <dyn signal={signal s}/>
+    </body></xml>
+
+fun main () =
+    return <xml><body><form><submit action={main'}/></form></body></xml>
diff --git a/tests/ms.urp b/tests/ms.urp
new file mode 100644
index 0000000..83ae584
--- /dev/null
+++ b/tests/ms.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql ms.sql
+
+ms
diff --git a/tests/ms.urs b/tests/ms.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/ms.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/multilib.ur b/tests/multilib.ur
new file mode 100644
index 0000000..52c8cb3
--- /dev/null
+++ b/tests/multilib.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn _ => alert "AHA!"}>CLICK ME</button>
+</body></xml>
diff --git a/tests/multilib.urp b/tests/multilib.urp
new file mode 100644
index 0000000..b33d66e
--- /dev/null
+++ b/tests/multilib.urp
@@ -0,0 +1,5 @@
+library library
+library library2
+rewrite all Multilib/*
+
+multilib
diff --git a/tests/mutual.ur b/tests/mutual.ur
new file mode 100644
index 0000000..c3d80c8
--- /dev/null
+++ b/tests/mutual.ur
@@ -0,0 +1,10 @@
+datatype foo = A | B of bar
+and bar = C | D of foo
+
+val q = B (D A)
+
+fun main () = return <xml>
+  {case q of
+       B (D A) => <xml>Good</xml>
+     | _ => <xml>Bad</xml>}
+</xml>
diff --git a/tests/mutual.urp b/tests/mutual.urp
new file mode 100644
index 0000000..90e2a57
--- /dev/null
+++ b/tests/mutual.urp
@@ -0,0 +1,3 @@
+debug
+
+mutual
diff --git a/tests/mutual.urs b/tests/mutual.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/mutual.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/name.ur b/tests/name.ur
new file mode 100644
index 0000000..49e02c2
--- /dev/null
+++ b/tests/name.ur
@@ -0,0 +1 @@
+fun hello name = return <xml>{[name]}</xml>
diff --git a/tests/name.urp b/tests/name.urp
new file mode 100644
index 0000000..f121bdb
--- /dev/null
+++ b/tests/name.urp
@@ -0,0 +1 @@
+name
diff --git a/tests/name.urs b/tests/name.urs
new file mode 100644
index 0000000..9ef3626
--- /dev/null
+++ b/tests/name.urs
@@ -0,0 +1 @@
+val hello : string -> transaction page
diff --git a/tests/namejs.ur b/tests/namejs.ur
new file mode 100644
index 0000000..50f6f52
--- /dev/null
+++ b/tests/namejs.ur
@@ -0,0 +1,3 @@
+fun main (n : int) (s : string) : transaction page = return <xml><body>
+  <button onclick={fn _ => alert ("n = " ^ show n ^ "; s = " ^ s)}/>
+</body></xml>
diff --git a/tests/naughty.ur b/tests/naughty.ur
new file mode 100644
index 0000000..14919f8
--- /dev/null
+++ b/tests/naughty.ur
@@ -0,0 +1,12 @@
+fun main () : transaction page =
+    if naughtyDebug "hello" = 0 then
+        return <xml><body></body></xml>
+    else
+        error <xml>Uhoh!</xml>
+
+(*fun main () : transaction page =
+    let
+        val a = naughtyDebug ""
+    in
+        return <xml><body></body></xml>
+    end*)
diff --git a/tests/nest.ur b/tests/nest.ur
new file mode 100644
index 0000000..96bfdff
--- /dev/null
+++ b/tests/nest.ur
@@ -0,0 +1,79 @@
+fun add x =
+    let
+        fun add' y = x + y
+    in
+        add' 1 + add' 2
+    end
+
+fun f (x : int) =
+    let
+        fun page () = return <xml><body>
+          <a link={page ()}>{[x]}</a>
+        </body></xml>
+    in
+        page
+    end
+
+fun f (x : int) =
+    let
+        fun page1 () = return <xml><body>
+          <a link={page2 ()}>{[x]}</a>
+        </body></xml>
+
+        and page2 () =
+            case Some True of
+                Some r => return <xml><body><a link={page1 ()}>{[r]}</a></body></xml>
+              | _ => return <xml>Error</xml>
+    in
+        page2
+    end
+
+fun f (x : int) =
+    let
+        fun page1 () = return <xml><body>
+          <a link={page2 ()}>{[x]}</a>
+        </body></xml>
+
+        and page2 () =
+            case Some True of
+                Some r => return <xml><body><a link={page1 ()}>{[r]}</a></body></xml>
+              | _ => return <xml><body><a link={page3 ()}>!!</a></body></xml>
+
+        and page3 () = return <xml><body><a link={page2 ()}>!</a><a link={page1 ()}>!</a>
+          <a link={page3 ()}>!</a></body></xml>
+    in
+        page3
+    end
+
+fun add2 (x : int) (y : int) =
+    let
+        fun add3 () = x + y
+    in
+        add3
+    end
+
+fun add3 (x : int) =
+    let
+        fun add2 (y : int) =
+            let
+                fun add1 (z : int) = x + y + z
+            in
+                add1
+            end
+    in
+        add2
+    end
+
+(*datatype list t = Nil | Cons of t * list t
+
+fun length (t ::: Type) (ls : list t) =
+    let
+        fun length' ls acc =
+            case ls of
+                Nil => acc
+              | Cons (_, ls') => length' ls' (acc + 1)
+    in
+        length' ls 0
+    end
+
+*)
diff --git a/tests/nest.urp b/tests/nest.urp
new file mode 100644
index 0000000..7f8a473
--- /dev/null
+++ b/tests/nest.urp
@@ -0,0 +1,3 @@
+debug
+
+nest
diff --git a/tests/nest2.ur b/tests/nest2.ur
new file mode 100644
index 0000000..9a1d271
--- /dev/null
+++ b/tests/nest2.ur
@@ -0,0 +1,15 @@
+fun wooho (wrap : xbody -> transaction page) =
+    let
+        fun subPage n =
+            let
+                fun subberPage () = wrap <xml>{[n]}</xml>
+            in
+                wrap <xml><a link={subberPage ()}>Go</a></xml>
+            end
+    in
+        subPage 0
+    end
+
+fun wrap x = return <xml><body>{x}</body></xml>
+
+fun main () = wooho wrap
diff --git a/tests/nest2.urp b/tests/nest2.urp
new file mode 100644
index 0000000..2668c65
--- /dev/null
+++ b/tests/nest2.urp
@@ -0,0 +1,3 @@
+debug
+
+nest2
diff --git a/tests/nested.ur b/tests/nested.ur
new file mode 100644
index 0000000..a23ae2a
--- /dev/null
+++ b/tests/nested.ur
@@ -0,0 +1,29 @@
+table t : {A : int, B : int}
+
+fun init () =
+    dml (DELETE FROM t WHERE TRUE);
+    dml (INSERT INTO t (A, B) VALUES (1, 2));
+    dml (INSERT INTO t (A, B) VALUES (2, 3))
+
+fun easy () =
+    queryX' (SELECT MAX(t.A) AS M FROM t)
+    (fn r =>
+        queryX (SELECT * FROM t WHERE t.A = {[r.M]})
+        (fn r => <xml>({[r.T.A]}, {[r.T.B]})</xml>))
+
+fun hard id =
+    queryX' (SELECT t.B AS N FROM t WHERE t.A = {[id]})
+    (fn r =>
+        b <- hard r.N;
+        return <xml>({[id]}, {[r.N]}); {b}</xml>)
+
+fun doit () =
+    init ();
+    b1 <- easy ();
+    b2 <- hard 1;
+    return <xml><body>
+      {b1}<br/>
+      {b2}
+    </body></xml>
+
+fun main () = return <xml><body><form><submit action={doit}/></form></body></xml>
diff --git a/tests/nested.urp b/tests/nested.urp
new file mode 100644
index 0000000..67cb7e1
--- /dev/null
+++ b/tests/nested.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=nested
+sql nested.sql
+
+nested
diff --git a/tests/nested.urs b/tests/nested.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/nested.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/nestedInput.ur b/tests/nestedInput.ur
new file mode 100644
index 0000000..19a73e1
--- /dev/null
+++ b/tests/nestedInput.ur
@@ -0,0 +1,10 @@
+fun main () : transaction page =
+    let
+        fun handler _ = return <xml/>
+    in
+        return <xml><body>
+          <form>
+            <submit action={handler}>Uh oh!</submit>
+          </form>
+        </body></xml>
+    end
diff --git a/tests/newMessage.ur b/tests/newMessage.ur
new file mode 100644
index 0000000..e6ae3b4
--- /dev/null
+++ b/tests/newMessage.ur
@@ -0,0 +1,15 @@
+datatype message =  NewQuestion of { Id : string}
+                  | Something of {Blah : int}
+
+fun showMessage (message : message) =
+    case message of
+        NewQuestion {Id = a} => a
+      | Something {Blah = x} => "blah"
+
+val show_mes = mkShow showMessage
+
+fun showTwoTuple [a] [b] (_ : show a) (_: show b) = mkShow (fn (two_tuple : {1:a, 2:b}) =>
+                              "(" ^ show two_tuple.1 ^ ", " ^ show two_tuple.2 ^ ")"
+
+                          )
+val om = show  (Something {Blah = 1}, Something {Blah = 2}) 
diff --git a/tests/nextid.ur b/tests/nextid.ur
new file mode 100644
index 0000000..8120ef0
--- /dev/null
+++ b/tests/nextid.ur
@@ -0,0 +1,11 @@
+fun main () : transaction page =
+    id1 <- fresh;
+    id2 <- fresh;
+    id3 <- fresh;
+    idS <- source id3;
+    return <xml><body>
+      <span id={id1}>Hi</span> <span id={id2}>there!</span><br/><br/>
+      <dyn signal={idS <- signal idS; return <xml><span id={idS}>Whoa-hoa!</span></xml>}/>
+      <button onclick={id <- fresh; set idS id}/>
+      Source: <dyn signal={idS <- signal idS; return (txt (<xml><span id={idS}>Whoa-hoa!</span></xml> : xbody))}/>
+    </body></xml>
diff --git a/tests/nomangle.ur b/tests/nomangle.ur
new file mode 100644
index 0000000..b853a69
--- /dev/null
+++ b/tests/nomangle.ur
@@ -0,0 +1,7 @@
+table foo : { Bar : int, Baz : string }
+  PRIMARY KEY Baz
+
+fun main () : transaction page =
+    rs <- queryX1 (SELECT foo.Bar FROM foo WHERE foo.Baz = 'Hi')
+          (fn r => <xml>{[r.Bar]}</xml>);
+    return <xml><body>{rs}</body></xml>
diff --git a/tests/nomangle.urp b/tests/nomangle.urp
new file mode 100644
index 0000000..7fab4b0
--- /dev/null
+++ b/tests/nomangle.urp
@@ -0,0 +1,5 @@
+database dbname=test
+noMangleSql
+sql nomangle.sql
+
+nomangle
diff --git a/tests/nopoly.ur b/tests/nopoly.ur
new file mode 100644
index 0000000..687403a
--- /dev/null
+++ b/tests/nopoly.ur
@@ -0,0 +1,2 @@
+fun x y = y.Hellodsad
+val bar = x {Hello = 1, RightO = 2}
diff --git a/tests/normalizeTable.ur b/tests/normalizeTable.ur
new file mode 100644
index 0000000..be16d93
--- /dev/null
+++ b/tests/normalizeTable.ur
@@ -0,0 +1,50 @@
+fun main () =
+visible <- source True;
+return
+    <xml>
+      <body>
+	<section>
+	  <h1>Static table</h1>
+	  <table border=1>
+	    <thead>
+	      <tr>
+		<th>Column 0</th>
+		<th>Column 1</th>
+	      </tr>
+	    </thead>
+	    <tbody>
+	      <tr>
+		<td>A</td>
+		<td>B</td>
+	      </tr>
+	    </tbody>
+	  </table>
+	</section>
+
+	<section>
+	  <h1>Dynamic table</h1>
+	  <table border=1>
+	    <thead>
+	      <tr>
+		<th>Column 0</th>
+		<th>Column 1</th>
+	      </tr>
+	    </thead>
+	    <tbody>
+	      <dyn signal={
+		 visible <- signal visible;
+		 return (if visible then
+			     <xml>
+			       <tr>
+			       <td>A</td>
+			       <td>B</td>
+			       </tr>			       
+			     </xml>
+			 else
+			     <xml></xml>)
+	      }/>
+	    </tbody>
+	  </table>
+	</section>
+      </body>
+    </xml>
diff --git a/tests/normalizeTable.urp b/tests/normalizeTable.urp
new file mode 100644
index 0000000..e22cda3
--- /dev/null
+++ b/tests/normalizeTable.urp
@@ -0,0 +1 @@
+normalizeTable
diff --git a/tests/normalizeTable.urs b/tests/normalizeTable.urs
new file mode 100644
index 0000000..9e80cf4
--- /dev/null
+++ b/tests/normalizeTable.urs
@@ -0,0 +1 @@
+val main: unit -> transaction page
diff --git a/tests/ntags.ur b/tests/ntags.ur
new file mode 100644
index 0000000..74a78d8
--- /dev/null
+++ b/tests/ntags.ur
@@ -0,0 +1,4 @@
+fun main () = return <xml><body>
+ <div></div>
+ <div><div></div></div>
+</body></xml>
diff --git a/tests/ntags.urp b/tests/ntags.urp
new file mode 100644
index 0000000..786f0bd
--- /dev/null
+++ b/tests/ntags.urp
@@ -0,0 +1,2 @@
+
+ntags
diff --git a/tests/ntags.urs b/tests/ntags.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/ntags.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/num.ur b/tests/num.ur
new file mode 100644
index 0000000..0fa2ffd
--- /dev/null
+++ b/tests/num.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml><body>
+  {[ -1 ]}, {[ 1 + 1 ]}, {[ 9 - 3 ]}, {[ 9 * 3 ]}, {[ 9 / 3 ]}, {[ 9 % 3 ]}<br/>
+  {[ -1.1 ]}, {[ 1.0 + 1.1 ]}, {[ 9.1 - 3.0 ]}, {[ 9.1 * 3.0 ]},
+  {[ 9.1 / 3.0 ]}, {[ 9.1 % 3.0 ]}<br/>
+</body></xml>
diff --git a/tests/num.urp b/tests/num.urp
new file mode 100644
index 0000000..50b5ed8
--- /dev/null
+++ b/tests/num.urp
@@ -0,0 +1,3 @@
+debug
+
+num
diff --git a/tests/onerror.ur b/tests/onerror.ur
new file mode 100644
index 0000000..9877d8d
--- /dev/null
+++ b/tests/onerror.ur
@@ -0,0 +1,4 @@
+fun main n =
+  case n of
+      0 => error <xml>Zero is bad!</xml>
+    | _ => return <xml/>
diff --git a/tests/onerror.urp b/tests/onerror.urp
new file mode 100644
index 0000000..39d7ac7
--- /dev/null
+++ b/tests/onerror.urp
@@ -0,0 +1,4 @@
+onError OnerrorE.err
+
+onerrorE
+onerror
diff --git a/tests/onerror.urs b/tests/onerror.urs
new file mode 100644
index 0000000..38b757e
--- /dev/null
+++ b/tests/onerror.urs
@@ -0,0 +1 @@
+val main : int -> transaction page
diff --git a/tests/onerrorE.ur b/tests/onerrorE.ur
new file mode 100644
index 0000000..b2948c7
--- /dev/null
+++ b/tests/onerrorE.ur
@@ -0,0 +1,5 @@
+fun err x = return <xml><body>
+  <h1>Bad thing!</h1>
+
+  {x}
+</body></xml>
diff --git a/tests/onerrorJs.ur b/tests/onerrorJs.ur
new file mode 100644
index 0000000..b53f883
--- /dev/null
+++ b/tests/onerrorJs.ur
@@ -0,0 +1,4 @@
+fun main n =
+  case n of
+      0 => error <xml>Zero is bad! <button value="Capische?" onclick={alert "GOOD!"}/></xml>
+    | _ => return <xml/>
diff --git a/tests/onerrorJs.urp b/tests/onerrorJs.urp
new file mode 100644
index 0000000..2ce197e
--- /dev/null
+++ b/tests/onerrorJs.urp
@@ -0,0 +1,4 @@
+onError OnerrorE.err
+
+onerrorE
+onerrorJs
diff --git a/tests/onerrorJs.urs b/tests/onerrorJs.urs
new file mode 100644
index 0000000..38b757e
--- /dev/null
+++ b/tests/onerrorJs.urs
@@ -0,0 +1 @@
+val main : int -> transaction page
diff --git a/tests/ooo.ur b/tests/ooo.ur
new file mode 100644
index 0000000..5401fa7
--- /dev/null
+++ b/tests/ooo.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page =
+    s <- source "Hi";
+    return <xml><body>
+      <form>
+        <textbox{#A} source={s}/>
+        Change it up!
+      </form>
+    </body></xml>
diff --git a/tests/ooo.urp b/tests/ooo.urp
new file mode 100644
index 0000000..5a51010
--- /dev/null
+++ b/tests/ooo.urp
@@ -0,0 +1,3 @@
+debug
+
+ooo
diff --git a/tests/open.ur b/tests/open.ur
new file mode 100644
index 0000000..47f8121
--- /dev/null
+++ b/tests/open.ur
@@ -0,0 +1,20 @@
+structure S = struct
+        type t = int
+        val x = 0
+
+        structure S' : sig type u val y : t end = struct
+                type u = t
+                val y = x
+        end
+
+        signature Sig = sig
+                type t
+                val x : t
+        end
+end
+
+open S.S'
+open S
+open S'
+
+structure S' : Sig = S
diff --git a/tests/openRedef.ur b/tests/openRedef.ur
new file mode 100644
index 0000000..2d8161c
--- /dev/null
+++ b/tests/openRedef.ur
@@ -0,0 +1,16 @@
+structure M = struct
+    con num = int
+    val zero = 0
+end
+
+structure N = struct
+    open M
+    con num = num * num
+    val zero = zero + 1
+end
+
+structure O = struct
+    open N
+
+    val one : num = (zero + 1, zero)
+end
diff --git a/tests/open_functor.ur b/tests/open_functor.ur
new file mode 100644
index 0000000..36525a0
--- /dev/null
+++ b/tests/open_functor.ur
@@ -0,0 +1,16 @@
+signature S = sig
+        type t
+        val x : t
+end
+
+functor F (M : S) : S where type t = M.t = struct
+        type t = M.t
+        val x = M.x
+end
+
+structure M = F(struct
+        type t = int
+        val x = 0
+end)
+
+open M
diff --git a/tests/option.ur b/tests/option.ur
new file mode 100644
index 0000000..d9e901b
--- /dev/null
+++ b/tests/option.ur
@@ -0,0 +1,25 @@
+datatype option a = None | Some of a
+
+val none_Hi : option string = None
+val some_Hi = Some "Hi"
+val none_some_Hi : option (option string) = None
+val some_some_Hi = Some some_Hi
+
+val show = fn x => case x of None => "None" | Some x => x
+
+val show2 = fn x => case x of None => "None'" | Some x => show x
+
+val page = fn x => return <html><body>
+        {cdata (show x)}
+</body></html>
+
+val page2 = fn x => return <html><body>
+        {cdata (show2 x)}
+</body></html>
+
+val main : unit -> transaction page = fn () => return <html><body>
+        <li><a link={page none_Hi}>None1</a></li>
+        <li><a link={page some_Hi}>Some1</a></li>
+        <li><a link={page2 none_some_Hi}>None2</a></li>
+        <li><a link={page2 some_some_Hi}>Some2</a></li>
+</body></html>
diff --git a/tests/option.urp b/tests/option.urp
new file mode 100644
index 0000000..865e089
--- /dev/null
+++ b/tests/option.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+option
diff --git a/tests/optionM.ur b/tests/optionM.ur
new file mode 100644
index 0000000..4af6a46
--- /dev/null
+++ b/tests/optionM.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml>{[x <- Some 1;
+                                               y <- Some 2;
+                                               return (x + y)]}</xml>
diff --git a/tests/optionM.urp b/tests/optionM.urp
new file mode 100644
index 0000000..b043dfe
--- /dev/null
+++ b/tests/optionM.urp
@@ -0,0 +1,2 @@
+$/option
+optionM
diff --git a/tests/ord.ur b/tests/ord.ur
new file mode 100644
index 0000000..fe2dbe8
--- /dev/null
+++ b/tests/ord.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <xml><body>
+  {[ 1 < 1 ]}, {[ 1 < 2 ]}, {[ 1 <= 1 ]}, {[ 2 <= 1 ]}, {[ 1 > 1 ]}, {[ 2 > 1 ]}, {[ 0 >= 1 ]}, {[ 2 >= 1 ]}<br/>
+  {[ 1.0 < 1.0 ]}, {[ 1.0 < 2.0 ]}, {[ 1.0 <= 1.0 ]}, {[ 2.0 <= 1.0 ]}, {[ 1.0 > 1.0 ]}, {[ 2.0 > 1.0 ]}, {[ 0.0 >= 1.0 ]}, {[ 2.0 >= 1.0 ]}<br/>
+  {[ True < False ]}, {[ False < True ]}, {[ False <= True ]}, {[ False > True ]}<br/>
+  {[ "A" < "B" ]}, {[ "C" < "B" ]}
+</body></xml>
diff --git a/tests/ord.urp b/tests/ord.urp
new file mode 100644
index 0000000..b44219b
--- /dev/null
+++ b/tests/ord.urp
@@ -0,0 +1,3 @@
+debug
+
+ord
diff --git a/tests/order_by.ur b/tests/order_by.ur
new file mode 100644
index 0000000..de584fd
--- /dev/null
+++ b/tests/order_by.ur
@@ -0,0 +1,35 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1 ORDER BY t1.A, t1.B)
+val q2 = (SELECT * FROM t1 GROUP BY t1.A ORDER BY t1.A, t1.B)
+val q3 = (SELECT t1.B FROM t1
+        UNION SELECT t1.B FROM t1
+        ORDER BY t1.B)
+
+val q4 = (SELECT t1.A, t2.D, t1.A < t2.D AS Lt
+        FROM t1, t2
+        ORDER BY Lt)
+val q5 = (SELECT t1.A, t1.B, t2.D, t1.A < t2.D AS Lt
+        FROM t1, t2
+        ORDER BY t1.A DESC, Lt ASC, t2.D DESC)
+
+
+datatype list a = Nil | Cons of a * list a
+
+val r1 : transaction (list string) =
+        query q5
+        (fn fs acc => return (Cons (fs.T1.B, acc)))
+        Nil
+
+val r2 : transaction string =
+        ls <- r1;
+        return (case ls of
+                    Nil => "Problem"
+                  | Cons (b, _) => b)
+
+val main : unit -> transaction page = fn () =>
+        s <- r2;
+        return <html><body>
+                {cdata s}
+        </body></html>
diff --git a/tests/overflow.ur b/tests/overflow.ur
new file mode 100644
index 0000000..09edc5a
--- /dev/null
+++ b/tests/overflow.ur
@@ -0,0 +1,8 @@
+fun makeList n = if n = 0 then [] else 1 :: makeList (n - 1)
+
+fun doit {N = n} = return <xml><body>{[List.length (makeList (readError n))]}</body></xml>
+
+fun main () =
+    return <xml><body>
+      <form> <textbox{#N}/> <submit action={doit}/> </form>
+    </body></xml>
diff --git a/tests/overflow.urp b/tests/overflow.urp
new file mode 100644
index 0000000..d091387
--- /dev/null
+++ b/tests/overflow.urp
@@ -0,0 +1,4 @@
+rewrite all Overflow/*
+
+$/list
+overflow
diff --git a/tests/overflow.urs b/tests/overflow.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/overflow.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/parseInt.ur b/tests/parseInt.ur
new file mode 100644
index 0000000..2d906fc
--- /dev/null
+++ b/tests/parseInt.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page =
+    s <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <button onclick={n <- get s;
+                       case read n of
+                           None => alert "Invalid"
+                         | Some n => alert (show (n + 1))}/>
+    </body></xml>
diff --git a/tests/pass.ur b/tests/pass.ur
new file mode 100644
index 0000000..2260267
--- /dev/null
+++ b/tests/pass.ur
@@ -0,0 +1,13 @@
+val handler = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Password: {cdata r.Word}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Password: <password{#Word} /><br/>
+
+                <submit action={handler}/>
+        </lform>
+</body></html>
diff --git a/tests/pathcheck.ur b/tests/pathcheck.ur
new file mode 100644
index 0000000..6d2359c
--- /dev/null
+++ b/tests/pathcheck.ur
@@ -0,0 +1,9 @@
+fun ancillary () : transaction page = return <xml/>
+
+fun ancillary () = return <xml>
+        Welcome to the ancillary page!
+</xml>
+
+fun main () : transaction page = return <xml><body>
+        <a link={ancillary ()}>Enter the unknown!</a>
+</body></xml>
diff --git a/tests/pathcheck.urp b/tests/pathcheck.urp
new file mode 100644
index 0000000..42f9af1
--- /dev/null
+++ b/tests/pathcheck.urp
@@ -0,0 +1,5 @@
+debug
+exe /tmp/webapp
+
+pathcheck
+
diff --git a/tests/pathmap.ur b/tests/pathmap.ur
new file mode 100644
index 0000000..98eaad7
--- /dev/null
+++ b/tests/pathmap.ur
@@ -0,0 +1,9 @@
+val x = List.rev (List.Cons (1, List.Cons (0, List.Nil)))
+val y = List.mp (plus 2) x
+
+fun main () : transaction page = return <xml><body>
+  {[x]}<br/>
+  {[y]}<br/>
+  {[Aux.hello]}<br/>
+  {List.mapX (fn n => <xml>{[n]}!</xml>) x}
+</body></xml>
diff --git a/tests/pathmap.urp b/tests/pathmap.urp
new file mode 100644
index 0000000..70373e6
--- /dev/null
+++ b/tests/pathmap.urp
@@ -0,0 +1,5 @@
+path extra=aux
+
+$/list
+$extra/aux
+pathmap
diff --git a/tests/paths.urp b/tests/paths.urp
new file mode 100644
index 0000000..7f3f6f0
--- /dev/null
+++ b/tests/paths.urp
@@ -0,0 +1,4 @@
+debug
+
+$TESTS/paths1
+paths2
diff --git a/tests/paths1.ur b/tests/paths1.ur
new file mode 100644
index 0000000..cf06999
--- /dev/null
+++ b/tests/paths1.ur
@@ -0,0 +1 @@
+val it = 1
diff --git a/tests/paths2.ur b/tests/paths2.ur
new file mode 100644
index 0000000..cdff114
--- /dev/null
+++ b/tests/paths2.ur
@@ -0,0 +1 @@
+val main = return <xml>{[Tests.Paths1.it]}</xml>
diff --git a/tests/paths2.urs b/tests/paths2.urs
new file mode 100644
index 0000000..61778b8
--- /dev/null
+++ b/tests/paths2.urs
@@ -0,0 +1 @@
+val main : transaction page
diff --git a/tests/pb.ur b/tests/pb.ur
new file mode 100644
index 0000000..e6e5bd5
--- /dev/null
+++ b/tests/pb.ur
@@ -0,0 +1,7 @@
+fun api_1 (pb:postBody) (nm:string) : transaction page =
+  return <xml>Processing the request</xml>
+
+fun api (pb:postBody) (v:int) (nm:string) : transaction page =
+  case v of
+      1 => api_1 pb nm
+    | _ => error <xml>Version {[v]} is not supported</xml>
diff --git a/tests/pb.urs b/tests/pb.urs
new file mode 100644
index 0000000..9def087
--- /dev/null
+++ b/tests/pb.urs
@@ -0,0 +1 @@
+val api : postBody -> int -> string -> transaction page
diff --git a/tests/pcase.ur b/tests/pcase.ur
new file mode 100644
index 0000000..581d94c
--- /dev/null
+++ b/tests/pcase.ur
@@ -0,0 +1,9 @@
+val flip = fn x : int => case x of 0 => 1 | _ => 0
+
+val zero = flip 1
+val one = flip 0
+
+val flipS = fn x : string => case x of "" => "Hello world!" | _ => ""
+
+val s1 = flipS ""
+val s2 = flipS "Boop"
diff --git a/tests/periodic.ur b/tests/periodic.ur
new file mode 100644
index 0000000..baf49b3
--- /dev/null
+++ b/tests/periodic.ur
@@ -0,0 +1,4 @@
+task periodic 5 = fn () => debug "Every 5 seconds"
+task periodic 13 = fn () => debug "Every 13 seconds"
+
+fun main () : transaction page = return <xml/>
diff --git a/tests/pkey.ur b/tests/pkey.ur
new file mode 100644
index 0000000..4efbd03
--- /dev/null
+++ b/tests/pkey.ur
@@ -0,0 +1,6 @@
+table t : {A : int, B : int}
+  PRIMARY KEY (A, B)
+
+fun main () : transaction page =
+    queryI (SELECT * FROM t) (fn _ => return ());
+    return <xml/>
diff --git a/tests/pkey.urp b/tests/pkey.urp
new file mode 100644
index 0000000..40ff258
--- /dev/null
+++ b/tests/pkey.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=pkey
+sql pkey.sql
+
+pkey
diff --git a/tests/pkeyEscape.ur b/tests/pkeyEscape.ur
new file mode 100644
index 0000000..c432b1e
--- /dev/null
+++ b/tests/pkeyEscape.ur
@@ -0,0 +1,6 @@
+table t : {A : int, B : int}
+  PRIMARY KEY {{primary_key [#A] [[B = _]]}}
+
+fun main () : transaction page =
+    queryI (SELECT * FROM t) (fn _ => return ());
+    return <xml/>
diff --git a/tests/pkeyEscape.urp b/tests/pkeyEscape.urp
new file mode 100644
index 0000000..f041ed1
--- /dev/null
+++ b/tests/pkeyEscape.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=pkeyEscape
+sql pkeyEscape.sql
+
+pkeyEscape
diff --git a/tests/plink.ur b/tests/plink.ur
new file mode 100644
index 0000000..eda255f
--- /dev/null
+++ b/tests/plink.ur
@@ -0,0 +1,8 @@
+val pA = fn size => <html><body>
+        <font size={size}>Hello World!</font>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li> <a link={pA 5}>Size 5</a></li>
+        <li> <a link={pA 10}>Size 10</a></li>
+</body></html>
diff --git a/tests/plink2.ur b/tests/plink2.ur
new file mode 100644
index 0000000..e446515
--- /dev/null
+++ b/tests/plink2.ur
@@ -0,0 +1,8 @@
+val pA : int -> int -> page = fn size1 => fn size2 => <html><body>
+        <font size={size1}>Hello</font> <font size={size2}>World!</font>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li> <a link={pA 5 10}>Size 5</a></li>
+        <li> <a link={pA 10 5}>Size 10</a></li>
+</body></html>
diff --git a/tests/plink3.ur b/tests/plink3.ur
new file mode 100644
index 0000000..0ecd3ac
--- /dev/null
+++ b/tests/plink3.ur
@@ -0,0 +1,10 @@
+val pA = fn size1 => fn size2 => fn size3 => <html><body>
+        <p><font size={size1}>Hello</font> <font size={size2}>World!</font></p>
+
+        <p><font size={size3}>Epilogue</font></p>
+</body></html>
+
+val main = fn () => <html><body>
+        <li> <a link={pA 5 10 1}>Size 5</a></li>
+        <li> <a link={pA 10 5 10}>Size 10</a></li>
+</body></html>
diff --git a/tests/policy.ur b/tests/policy.ur
new file mode 100644
index 0000000..fedc3fc
--- /dev/null
+++ b/tests/policy.ur
@@ -0,0 +1,70 @@
+type fruit = int
+table fruit : { Id : fruit, Nam : string, Weight : float, Secret : string }
+  PRIMARY KEY Id,
+  CONSTRAINT Nam UNIQUE Nam
+
+type order = int
+table order : { Id : order, Fruit : fruit, Qty : int, Code : int }
+  PRIMARY KEY Id,
+  CONSTRAINT Fruit FOREIGN KEY Fruit REFERENCES fruit(Id)
+
+(* Everyone may knows IDs and names. *)
+policy sendClient (SELECT fruit.Id, fruit.Nam
+                   FROM fruit)
+
+(* The weight is sensitive information; you must know the secret. *)
+policy sendClient (SELECT fruit.Weight, fruit.Secret
+                   FROM fruit
+                   WHERE known(fruit.Secret))
+
+policy sendClient (SELECT order.Id, order.Fruit, order.Qty
+                   FROM order, fruit
+                   WHERE order.Fruit = fruit.Id
+                     AND order.Qty = 13)
+
+fun fname r =
+    x <- queryX (SELECT fruit.Weight
+                 FROM fruit
+                 WHERE fruit.Nam = {[r.Nam]}
+                   AND fruit.Secret = {[r.Secret]}
+                   AND fruit.Weight <> 3.14
+                   AND fruit.Weight < 100.0
+                   AND fruit.Weight <= 200.1
+                   AND fruit.Weight > 1.23
+                   AND fruit.Weight >= 1.24)
+         (fn r => <xml>Weight is {[r.Fruit.Weight]}</xml>);
+
+    return <xml><body>
+      {x}
+    </body></xml>
+
+fun main () =
+    x1 <- queryX (SELECT fruit.Id, fruit.Nam
+                  FROM fruit
+                  WHERE fruit.Nam = "apple")
+                 (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>);
+
+    x2 <- queryX (SELECT fruit.Nam, order.Qty
+                  FROM fruit, order
+                  WHERE fruit.Id = order.Fruit
+                    AND order.Qty = 13)
+                 (fn x => <xml><li>{[x.Fruit.Nam]}: {[x.Order.Qty]}</li></xml>);
+
+    ro <- oneOrNoRows (SELECT fruit.Id, fruit.Nam
+                       FROM fruit);
+
+    return <xml><body>
+      <ul>{x1}</ul>
+
+      <ul>{x2}</ul>
+
+      {case ro of
+           None => <xml>None</xml>
+         | Some _ => <xml>Some</xml>}
+
+      <form>
+        Fruit name: <textbox{#Nam}/><br/>
+        Secret: <textbox{#Secret}/><br/>
+        <submit action={fname}/>
+      </form>
+    </body></xml>
diff --git a/tests/policy.urp b/tests/policy.urp
new file mode 100644
index 0000000..b26ebd4
--- /dev/null
+++ b/tests/policy.urp
@@ -0,0 +1 @@
+policy
diff --git a/tests/policy.urs b/tests/policy.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/policy.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/policy2.ur b/tests/policy2.ur
new file mode 100644
index 0000000..b8480c0
--- /dev/null
+++ b/tests/policy2.ur
@@ -0,0 +1,22 @@
+type fruit = int
+table fruit : { Id : fruit, Nam : string, Weight : float, Secret : string }
+  PRIMARY KEY Id,
+  CONSTRAINT Nam UNIQUE Nam
+
+(* Everyone may knows IDs and names. *)
+policy sendClient (SELECT fruit.Id, fruit.Nam
+                   FROM fruit)
+
+(* The weight is sensitive information; you must know the secret. *)
+policy sendClient (SELECT fruit.Weight, fruit.Secret
+                   FROM fruit
+                   WHERE known(fruit.Secret))
+
+fun main () =
+    x1 <- queryX (SELECT fruit.Id, fruit.Nam
+                  FROM fruit
+                  WHERE fruit.Nam = "apple")
+                 (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>);
+    return <xml><body>
+      <ul>{x1}</ul>
+    </body></xml>
diff --git a/tests/policy2.urp b/tests/policy2.urp
new file mode 100644
index 0000000..4650975
--- /dev/null
+++ b/tests/policy2.urp
@@ -0,0 +1 @@
+policy2
diff --git a/tests/policy2.urs b/tests/policy2.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/policy2.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/polyjs.ur b/tests/polyjs.ur
new file mode 100644
index 0000000..fe10080
--- /dev/null
+++ b/tests/polyjs.ur
@@ -0,0 +1,5 @@
+open PolyjsFfi
+
+fun main () : transaction page = return <xml><body>
+  <button onclick={fn _ => alert (one "hi" ^ two "bye")}/>
+</body></xml>
diff --git a/tests/polyjs.urp b/tests/polyjs.urp
new file mode 100644
index 0000000..489bd68
--- /dev/null
+++ b/tests/polyjs.urp
@@ -0,0 +1,5 @@
+ffi polyjsFfi
+jsFunc PolyjsFfi.one=one
+jsFunc PolyjsFfi.two=two
+
+polyjs
diff --git a/tests/polyjsFfi.urs b/tests/polyjsFfi.urs
new file mode 100644
index 0000000..a2be890
--- /dev/null
+++ b/tests/polyjsFfi.urs
@@ -0,0 +1,2 @@
+val one : a ::: Type -> a -> a
+val two : a ::: Type -> b ::: Type -> a -> b
diff --git a/tests/post.ur b/tests/post.ur
new file mode 100644
index 0000000..4cee7a4
--- /dev/null
+++ b/tests/post.ur
@@ -0,0 +1,5 @@
+fun callMe n s pb = return <xml><body>
+  n = {[n]}<br/>
+  s = {[s]}<br/>
+  pb : {[postType pb]} = {[postData pb]}
+</body></xml>
diff --git a/tests/post.urp b/tests/post.urp
new file mode 100644
index 0000000..8b1e502
--- /dev/null
+++ b/tests/post.urp
@@ -0,0 +1 @@
+post
diff --git a/tests/post.urs b/tests/post.urs
new file mode 100644
index 0000000..5d6e646
--- /dev/null
+++ b/tests/post.urs
@@ -0,0 +1 @@
+val callMe : int -> string -> postBody -> transaction page
diff --git a/tests/pow.ur b/tests/pow.ur
new file mode 100644
index 0000000..f03fe47
--- /dev/null
+++ b/tests/pow.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <li>2^4 = {[pow 2 4]}</li>
+  <li>3.4^5.6 = {[pow 3.4 5.6]}</li>
+</body></xml>
diff --git a/tests/pprint.ur b/tests/pprint.ur
new file mode 100644
index 0000000..5d4f7f0
--- /dev/null
+++ b/tests/pprint.ur
@@ -0,0 +1,4 @@
+fun isNone [a] (x : option a) =
+    case x of
+        None => True
+      | Some _ => False
diff --git a/tests/pquery.ur b/tests/pquery.ur
new file mode 100644
index 0000000..4c0e4e4
--- /dev/null
+++ b/tests/pquery.ur
@@ -0,0 +1,51 @@
+table t1 : {A : int, B : string, C : float, D : bool}
+
+fun display (q : sql_query [T1 = [A = int, B = string, C = float, D = bool]] []) =
+        s <- query q
+                (fn fs _ => return (Some fs.T1))
+                None;
+        return <html><body>
+                {case s of
+                  None => cdata "Row not found."
+                | Some s =>
+                        <body>
+                                A: {cdata (show _ s.A)}<br/>
+                                B: {cdata (show _ s.B)}<br/>
+                                C: {cdata (show _ s.C)}<br/>
+                                D: {cdata (show _ s.D)}<br/>
+                        </body>}
+        </body></html>
+
+fun lookupA (inp : {A : string}) =
+        display (SELECT * FROM t1 WHERE t1.A = {readError _ inp.A})
+
+fun lookupB (inp : {B : string}) =
+        display (SELECT * FROM t1 WHERE t1.B = {inp.B})
+
+fun lookupC (inp : {C : string}) =
+        display (SELECT * FROM t1 WHERE t1.C = {readError _ inp.C})
+
+fun lookupD (inp : {D : string}) =
+        display (SELECT * FROM t1 WHERE t1.D = {readError _ inp.D})
+
+fun main () : transaction page = return <html><body>
+        <lform>
+                A: <textbox{#A}/>
+                <submit action={lookupA}/>
+        </lform>
+
+        <lform>
+                B: <textbox{#B}/>
+                <submit action={lookupB}/>
+        </lform>
+
+        <lform>
+                C: <textbox{#C}/>
+                <submit action={lookupC}/>
+        </lform>
+
+        <lform>
+                D: <textbox{#D}/>
+                <submit action={lookupD}/>
+        </lform>
+</body></html>
diff --git a/tests/pquery.urp b/tests/pquery.urp
new file mode 100644
index 0000000..802281c
--- /dev/null
+++ b/tests/pquery.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+pquery
diff --git a/tests/pquery.urs b/tests/pquery.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/pquery.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/prefix.ur b/tests/prefix.ur
new file mode 100644
index 0000000..22c5e3a
--- /dev/null
+++ b/tests/prefix.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml/>
diff --git a/tests/prefix1.urp b/tests/prefix1.urp
new file mode 100644
index 0000000..9293f85
--- /dev/null
+++ b/tests/prefix1.urp
@@ -0,0 +1,3 @@
+prefix /Prefix1
+
+prefix
diff --git a/tests/prefix2.urp b/tests/prefix2.urp
new file mode 100644
index 0000000..6fa7b5e
--- /dev/null
+++ b/tests/prefix2.urp
@@ -0,0 +1,3 @@
+prefix /Prefix2
+
+prefix
diff --git a/tests/prim.ur b/tests/prim.ur
new file mode 100644
index 0000000..c1a76b3
--- /dev/null
+++ b/tests/prim.ur
@@ -0,0 +1,3 @@
+val zero = 0
+val pi = 3.14159
+val welcome = "Hello world!"
diff --git a/tests/pvar.ur b/tests/pvar.ur
new file mode 100644
index 0000000..6b90e2c
--- /dev/null
+++ b/tests/pvar.ur
@@ -0,0 +1,5 @@
+val v1 : variant [A = int, B = float] = make [#A] 1
+val v2 : variant [A = int, B = float] = make [#B] 2.3
+
+fun main () = return (match v1 {A = fn n => <xml>A: {[n]}</xml>,
+                                B = fn n => <xml>B: {[n]}</xml>})
diff --git a/tests/pvar.urp b/tests/pvar.urp
new file mode 100644
index 0000000..f86c4a2
--- /dev/null
+++ b/tests/pvar.urp
@@ -0,0 +1 @@
+pvar
diff --git a/tests/pvar.urs b/tests/pvar.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/pvar.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/qualrecord.ur b/tests/qualrecord.ur
new file mode 100644
index 0000000..4db64e5
--- /dev/null
+++ b/tests/qualrecord.ur
@@ -0,0 +1,7 @@
+structure M = struct
+    con the_best_name = #Wiggles
+    con the_runner_up = #Beppo
+end
+
+val x : {M.the_best_name : int, A : int, M.the_runner_up : int} =
+  {M.the_best_name = 8, A = 9, M.the_runner_up = 10}
diff --git a/tests/query.ur b/tests/query.ur
new file mode 100644
index 0000000..5d6264c
--- /dev/null
+++ b/tests/query.ur
@@ -0,0 +1,23 @@
+table t1 : {A : int, B : string, C : float, D : bool}
+table t2 : {A : float, D : int}
+
+datatype list a = Nil | Cons of a * list a
+
+val q1 = (SELECT * FROM t1)
+
+val r1 : transaction (list {A : int, B : string, C : float, D : bool}) =
+    query q1
+          (fn fs acc => return (Cons (fs.T1, acc)))
+          Nil
+
+val r2 : transaction string =
+    ls <- r1;
+    return (case ls of
+                Nil => "Problem"
+              | Cons ({B = b, ...}, _) => b)
+
+fun main () : transaction page =
+    s <- r2;
+    return <xml><body>
+      {cdata s}
+    </body></xml>
diff --git a/tests/query.urp b/tests/query.urp
new file mode 100644
index 0000000..ac7cb6e
--- /dev/null
+++ b/tests/query.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+query
diff --git a/tests/radio.ur b/tests/radio.ur
new file mode 100644
index 0000000..e44eb0b
--- /dev/null
+++ b/tests/radio.ur
@@ -0,0 +1,15 @@
+fun handler x = return <xml><body>
+  You entered: {[case x.A of
+                     None => "nothing at all"
+                   | Some v => v]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <radio{#A}>
+      <li><radioOption value="A"/>A</li>
+      <li><radioOption value="B"/>B</li>
+    </radio>
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/radio.urs b/tests/radio.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/radio.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/random.ur b/tests/random.ur
new file mode 100644
index 0000000..b200630
--- /dev/null
+++ b/tests/random.ur
@@ -0,0 +1,8 @@
+table t : { A : int }
+
+fun main () : transaction page =
+    x <- queryX (SELECT *
+                 FROM t
+                 ORDER BY RANDOM)
+         (fn r => <xml>{[r.T.A]}<br/></xml>);
+    return <xml><body>{x}</body></xml>
diff --git a/tests/random.urp b/tests/random.urp
new file mode 100644
index 0000000..5cc06fe
--- /dev/null
+++ b/tests/random.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql random.sql
+
+random
diff --git a/tests/rcapture.ur b/tests/rcapture.ur
new file mode 100644
index 0000000..782efcd
--- /dev/null
+++ b/tests/rcapture.ur
@@ -0,0 +1,3 @@
+fun frob x = x
+
+fun foo [a] (x : a) = frob x
diff --git a/tests/reactive.ur b/tests/reactive.ur
new file mode 100644
index 0000000..95839c7
--- /dev/null
+++ b/tests/reactive.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page =
+  x <- source <xml>TEST</xml>;
+  return <xml><body>
+    <dyn signal={signal x}/>
+  </body></xml>
diff --git a/tests/reactive.urp b/tests/reactive.urp
new file mode 100644
index 0000000..88dd4cb
--- /dev/null
+++ b/tests/reactive.urp
@@ -0,0 +1,3 @@
+debug
+
+reactive
diff --git a/tests/reactive2.ur b/tests/reactive2.ur
new file mode 100644
index 0000000..7164468
--- /dev/null
+++ b/tests/reactive2.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+  x <- source <xml>TEST</xml>;
+  set x <xml>HI</xml>;
+  return <xml><body>
+    <dyn signal={signal x}/>
+  </body></xml>
diff --git a/tests/reactive2.urp b/tests/reactive2.urp
new file mode 100644
index 0000000..bdc0d1b
--- /dev/null
+++ b/tests/reactive2.urp
@@ -0,0 +1,3 @@
+debug
+
+reactive2
diff --git a/tests/reactive3.ur b/tests/reactive3.ur
new file mode 100644
index 0000000..c12455c
--- /dev/null
+++ b/tests/reactive3.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+  x <- source <xml>TEST</xml>;
+  return <xml><body>
+    <dyn signal={signal x}/>
+    <br/>
+    <a onclick={alert "Changing...."; set x <xml>CHANGEUP</xml>}>Oh My</a>
+  </body></xml>
diff --git a/tests/reactive3.urp b/tests/reactive3.urp
new file mode 100644
index 0000000..8a95bc8
--- /dev/null
+++ b/tests/reactive3.urp
@@ -0,0 +1,3 @@
+debug
+
+reactive3
diff --git a/tests/reactive4.ur b/tests/reactive4.ur
new file mode 100644
index 0000000..b5278a6
--- /dev/null
+++ b/tests/reactive4.ur
@@ -0,0 +1,7 @@
+fun main () : transaction page =
+  x <- source <xml>TEST</xml>;
+  return <xml><body>
+    <dyn signal={y <- signal x; return <xml>!{y}?</xml>}/>
+    <br/>
+    <a onclick={set x <xml>CHANGEUP</xml>}>Oh My</a>
+  </body></xml>
diff --git a/tests/reactive4.urp b/tests/reactive4.urp
new file mode 100644
index 0000000..e32cf7a
--- /dev/null
+++ b/tests/reactive4.urp
@@ -0,0 +1,3 @@
+debug
+
+reactive4
diff --git a/tests/reactive5.ur b/tests/reactive5.ur
new file mode 100644
index 0000000..01c63ea
--- /dev/null
+++ b/tests/reactive5.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page =
+  x <- source <xml>A</xml>;
+  y <- source <xml>B</xml>;
+  return <xml><body>
+    <dyn signal={x <- signal x; y <- signal y; return <xml>{x}, {y}</xml>}/>
+    <br/>
+    <a onclick={set x <xml>C</xml>}>Change x</a><br/>
+    <a onclick={set y <xml>D</xml>}>Change y</a><br/>
+  </body></xml>
diff --git a/tests/reactive5.urp b/tests/reactive5.urp
new file mode 100644
index 0000000..27231d3
--- /dev/null
+++ b/tests/reactive5.urp
@@ -0,0 +1,3 @@
+debug
+
+reactive5
diff --git a/tests/rec.ur b/tests/rec.ur
new file mode 100644
index 0000000..0a0c744
--- /dev/null
+++ b/tests/rec.ur
@@ -0,0 +1,4 @@
+
+fun main () : transaction page = return <html><body>
+        <a link={main ()}>Ride again!</a>
+</body></html>
diff --git a/tests/rec.urp b/tests/rec.urp
new file mode 100644
index 0000000..8c3adc2
--- /dev/null
+++ b/tests/rec.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+rec
diff --git a/tests/rec2.ur b/tests/rec2.ur
new file mode 100644
index 0000000..e5f208c
--- /dev/null
+++ b/tests/rec2.ur
@@ -0,0 +1,7 @@
+val rec main = fn () => <html><body>
+        <a link={aux ()}>See another page</a>
+</body></html>
+
+and aux = fn () => <html><body>
+        <a link={main ()}>Back to square one</a>
+</body></html>
diff --git a/tests/rec3.ur b/tests/rec3.ur
new file mode 100644
index 0000000..eaa07fe
--- /dev/null
+++ b/tests/rec3.ur
@@ -0,0 +1,13 @@
+val rec main = fn () => <html><body>
+        <a link={aux ()}>See another page</a>
+</body></html>
+
+and aux = fn () => <html><body>
+        <h1>The Main Event</h1>
+
+        {auxer ()}
+</body></html>
+
+and auxer = fn () => <body>
+        <a link={main ()}>Back to square one</a>
+</body>
diff --git a/tests/recBad.ur b/tests/recBad.ur
new file mode 100644
index 0000000..11934ec
--- /dev/null
+++ b/tests/recBad.ur
@@ -0,0 +1,9 @@
+datatype list a = Nil | Cons of a * list a
+
+fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
+        case ls1 of
+            Nil => ls2
+          | Cons (h, t) => Cons (h, append t ls2)
+
+(*val rec ones : list int = Cons (1, ones)*)
+val rec ones = fn () => Cons (1, ones ())
diff --git a/tests/recReal.ur b/tests/recReal.ur
new file mode 100644
index 0000000..e3d46e8
--- /dev/null
+++ b/tests/recReal.ur
@@ -0,0 +1,8 @@
+val rec endlessList = fn () => <body>
+        <li> Buy eggs.</li>
+        {endlessList ()}
+</body>
+
+val main = fn () => <html><body>
+        {endlessList ()}
+</body></html>
diff --git a/tests/recReal2.ur b/tests/recReal2.ur
new file mode 100644
index 0000000..efe2400
--- /dev/null
+++ b/tests/recReal2.ur
@@ -0,0 +1,13 @@
+val rec endlessList1 = fn () => <body>
+        <li> Buy eggs.</li>
+        {endlessList2 ()}
+</body>
+
+and endlessList2 = fn () => <body>
+        <li> Buy milk.</li>
+        {endlessList1 ()}
+</body>
+
+val main = fn () => <html><body>
+        {endlessList1 ()}
+</body></html>
diff --git a/tests/recReal3.ur b/tests/recReal3.ur
new file mode 100644
index 0000000..0ebc489
--- /dev/null
+++ b/tests/recReal3.ur
@@ -0,0 +1,18 @@
+val rec endlessList1 = fn () => <body>
+        <li> Buy eggs.</li>
+        {endlessList2 ()}
+</body>
+
+and endlessList2 = fn () => <body>
+        <li> Buy milk.</li>
+        {endlessList1 ()}
+        {endlessList3 ()}
+</body>
+
+and endlessList3 = fn () => <body>
+        <li> Buy goat.</li>
+</body>
+
+val main = fn () => <html><body>
+        {endlessList1 ()}
+</body></html>
diff --git a/tests/record_page.ur b/tests/record_page.ur
new file mode 100644
index 0000000..a54a913
--- /dev/null
+++ b/tests/record_page.ur
@@ -0,0 +1,10 @@
+type t = {A : string, B : {C : string, D : string}}
+
+val page = fn x : t => <html><body>
+        {cdata x.A},{cdata x.B.C},{cdata x.B.D}
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <li><a link={page {A = "A", B = {C = "B", D = "C"}}}>First</a></li>
+        <li><a link={page {A = "D", B = {C = "E", D = "F"}}}>Second</a></li>
+</body></html>
\ No newline at end of file
diff --git a/tests/redirect.ur b/tests/redirect.ur
new file mode 100644
index 0000000..da5114c
--- /dev/null
+++ b/tests/redirect.ur
@@ -0,0 +1,15 @@
+fun other () = redirect (bless "http://www.google.com/")
+
+fun further () = case checkUrl "http://www.google.com/" of
+                     None => return <xml>Darn.</xml>
+                   | Some url => redirect url
+
+fun failing () = case checkUrl "http://www.yahoo.com/" of
+                     None => return <xml>Darn.</xml>
+                   | Some url => redirect url
+
+fun main () = return <xml><body>
+  <a link={other ()}>Go there</a><br/>
+  <a link={further ()}>Go also there</a><br/>
+  <a link={failing ()}>Fail there</a>
+</body></xml>
diff --git a/tests/redirect.urp b/tests/redirect.urp
new file mode 100644
index 0000000..670d321
--- /dev/null
+++ b/tests/redirect.urp
@@ -0,0 +1,4 @@
+debug
+allow url http://www.google.com/
+
+redirect
diff --git a/tests/redirect.urs b/tests/redirect.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/redirect.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/reduce.ur b/tests/reduce.ur
new file mode 100644
index 0000000..f292a29
--- /dev/null
+++ b/tests/reduce.ur
@@ -0,0 +1,27 @@
+con c1 = int
+con c2 = (fn t :: Type => t) int
+
+con id = fn t :: Type => t
+con c3 = id int
+
+con fst = fn t1 :: Type => fn t2 :: Type => t1
+con c4 = fst int string
+
+con snd = fn t1 :: Type => fn t2 :: Type => t2
+con c5 = snd int string
+
+con apply = fn f :: Type -> Type => fn t :: Type => f t
+con c6 = apply id int
+con c7 = apply (fst int) string
+
+val tickle = fn n :: Name => fn t :: Type => fn fs :: {Type} =>
+        fn x : $([n = t] ++ fs) => x
+val tickleA = tickle[#A][int][[B = string]]
+val test_tickleA = tickleA {A = 6, B = "13"}
+
+val grab = fn n :: Name => fn t ::: Type => fn fs ::: {Type} =>
+        fn x : $([n = t] ++ fs) => x.n
+val test_grab1 = grab[#A] {A = 6, B = "13"}
+val test_grab2 = grab[#B] {A = 6, B = "13"}
+
+val main = {A = test_grab1, B = test_grab2}
diff --git a/tests/relops.ur b/tests/relops.ur
new file mode 100644
index 0000000..77a352d
--- /dev/null
+++ b/tests/relops.ur
@@ -0,0 +1,30 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1
+        UNION SELECT * FROM t1)
+val q2 = (SELECT t1.A, t1.B FROM t1 WHERE t1.A = 0
+        INTERSECT SELECT t1.B, t1.A FROM t1 WHERE t1.B = t1.B)
+val q3 = (SELECT t1.A, t1.B, t1.C FROM t1 WHERE t1.A = 0
+        INTERSECT SELECT * FROM t1 WHERE t1.B = 'Hello world!'
+        EXCEPT SELECT * FROM t1 WHERE t1.A < t1.A
+        UNION SELECT * FROM t1 WHERE t1.A > t1.A)
+
+datatype list a = Nil | Cons of a * list a
+
+val r1 : transaction (list {A : int, B : string, C : float}) =
+        query q3
+        (fn fs acc => return (Cons (fs.T1, acc)))
+        Nil
+
+val r2 : transaction string =
+        ls <- r1;
+        return (case ls of
+                    Nil => "Problem"
+                  | Cons ({B = b, ...}, _) => b)
+
+val main : unit -> transaction page = fn () =>
+        s <- r2;
+        return <xml><body>
+                {cdata s}
+        </body></xml>
diff --git a/tests/relops.urp b/tests/relops.urp
new file mode 100644
index 0000000..5d0cae7
--- /dev/null
+++ b/tests/relops.urp
@@ -0,0 +1,4 @@
+debug
+database dbname=test
+
+relops
diff --git a/tests/reqheader.ur b/tests/reqheader.ur
new file mode 100644
index 0000000..d659935
--- /dev/null
+++ b/tests/reqheader.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page =
+    ua <- requestHeader "User-Agent";
+    case ua of
+        None => return <xml>Not found</xml>
+      | Some s => return <xml>User-Agent: {[s]}</xml>
diff --git a/tests/reqheader.urp b/tests/reqheader.urp
new file mode 100644
index 0000000..4541390
--- /dev/null
+++ b/tests/reqheader.urp
@@ -0,0 +1,3 @@
+debug
+
+reqheader
diff --git a/tests/rewrite.ur b/tests/rewrite.ur
new file mode 100644
index 0000000..8b9f5bb
--- /dev/null
+++ b/tests/rewrite.ur
@@ -0,0 +1,9 @@
+table t : { A : int }
+
+fun other () = return <xml><body>
+  Other
+</body></xml>
+
+fun main () = return <xml><body>
+  <a link={other ()}>Hi!</a>
+</body></xml>
diff --git a/tests/rewrite.urp b/tests/rewrite.urp
new file mode 100644
index 0000000..43f141b
--- /dev/null
+++ b/tests/rewrite.urp
@@ -0,0 +1,8 @@
+debug
+database dbname=rewrite
+sql rewrite.sql
+rewrite url Rewrite/other Schrewrite/brother
+rewrite url Rewrite/* 
+rewrite relation Rewrite/t mytab
+
+rewrite
diff --git a/tests/rewrite.urs b/tests/rewrite.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/rewrite.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/rform.ur b/tests/rform.ur
new file mode 100644
index 0000000..17e9a0c
--- /dev/null
+++ b/tests/rform.ur
@@ -0,0 +1,10 @@
+fun main () : transaction page =
+    s <- source "Hi";
+    return <xml><body>
+      <form>
+        <textbox{#A} source={s}/>
+      </form>
+      <a onclick={set s "NEW AND DIFFERENT"}>Change it up!</a><br/>
+      <br/>
+      Latest: <dyn signal={s <- signal s; return (cdata s)}/>
+    </body></xml>
diff --git a/tests/rform.urp b/tests/rform.urp
new file mode 100644
index 0000000..b8cfc36
--- /dev/null
+++ b/tests/rform.urp
@@ -0,0 +1,3 @@
+debug
+
+rform
diff --git a/tests/roundTrip.ur b/tests/roundTrip.ur
new file mode 100644
index 0000000..0ee3f8f
--- /dev/null
+++ b/tests/roundTrip.ur
@@ -0,0 +1,47 @@
+table channels : { Client : client, Channel : channel (string * int * float) }
+  PRIMARY KEY Client
+
+table dearlyDeparted : { Client : option client, When : time }
+
+task clientLeaves = fn cli : client =>
+                       dml (INSERT INTO dearlyDeparted (Client, When) VALUES ({[Some cli]}, CURRENT_TIMESTAMP));
+                       debug "Our favorite client has LEFT!"
+
+fun writeBack v =
+    me <- self;
+    r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]});
+    send r.Channels.Channel v
+
+fun main' () =
+    me <- self;
+    ch <- channel;
+    dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]}));
+    
+    buf <- Buffer.create;
+
+    let
+        fun receiverA () =
+            v <- recv ch;
+            Buffer.write buf ("A:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
+            receiverA ()
+
+        fun receiverB () =
+            v <- recv ch;
+            Buffer.write buf ("B:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
+            error <xml>Bail out!</xml>;
+            receiverB ()
+
+        fun sender s n f =
+            sleep 2000;
+            rpc (writeBack (s, n, f));
+            sender (s ^ "!") (n + 1) (f + 1.23)
+    in
+        return <xml><body onload={onDisconnect (alert "Server booted me");
+                                  onConnectFail (alert "Connection failed");
+                                  onServerError (fn s => alert ("Server error: " ^ s));
+                                  spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}>
+          <dyn signal={Buffer.render buf}/>
+        </body></xml>
+    end
+
+fun main () = return <xml><body><form><submit action={main'}/></form></body></xml>
diff --git a/tests/roundTrip.urp b/tests/roundTrip.urp
new file mode 100644
index 0000000..e8f27f2
--- /dev/null
+++ b/tests/roundTrip.urp
@@ -0,0 +1,5 @@
+database dbname=roundtrip
+sql roundTrip.sql
+
+buffer
+roundTrip
diff --git a/tests/roundTrip.urs b/tests/roundTrip.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/roundTrip.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/rpat.ur b/tests/rpat.ur
new file mode 100644
index 0000000..6c4f9c5
--- /dev/null
+++ b/tests/rpat.ur
@@ -0,0 +1,13 @@
+val f = fn x : {A : int} => case x of {A = _} => 0
+val f = fn x : {A : int} => case x of {A = _, ...} => 0
+val f = fn x : {A : int, B : int} => case x of {A = _, ...} => 0
+val f = fn x : {A : int, B : int} => case x of {A = 1, B = 2} => 0 | {A = _, ...} => 1
+
+datatype t = A | B
+
+val f = fn x => case x of {A = A, B = 2} => 0 | {A = A, ...} => 0 | {A = B, ...} => 0
+
+val f = fn x => case x of {A = {A = A, ...}, B = B} => 0
+        | {B = A, ...} => 1
+        | {A = {A = B, B = A}, B = B} => 2
+        | {A = {A = B, B = B}, B = B} => 3
diff --git a/tests/rpc.ur b/tests/rpc.ur
new file mode 100644
index 0000000..b2e9722
--- /dev/null
+++ b/tests/rpc.ur
@@ -0,0 +1,15 @@
+sequence s
+
+fun main () : transaction page =
+    let
+        fun getNext () = nextval s
+    in
+        s <- source 0;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={n <- getNext ();
+                           set s n}/><br/>
+          <br/>
+          Current: <dyn signal={n <- signal s; return <xml>{[n]}</xml>}/>
+        </body></xml>
+    end
diff --git a/tests/rpc.urp b/tests/rpc.urp
new file mode 100644
index 0000000..02fd0f2
--- /dev/null
+++ b/tests/rpc.urp
@@ -0,0 +1,5 @@
+debug
+sql rpc.sql
+database dbname=rpc
+
+rpc
diff --git a/tests/rpc2.ur b/tests/rpc2.ur
new file mode 100644
index 0000000..47548e7
--- /dev/null
+++ b/tests/rpc2.ur
@@ -0,0 +1,25 @@
+sequence s
+sequence s2
+
+fun dint src = n <- signal src; return <xml>{[n]}</xml>
+
+fun main () : transaction page =
+    let
+        fun getNext () =
+            n <- nextval s;
+            n2 <- nextval s2;
+            return (n, n2)
+    in
+        src1 <- source 0;
+        src2 <- source 0;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={p <- getNext ();
+                           case p of
+                               (n1, n2) => set src1 n1;
+                                           set src2 n2}/>
+          <br/>
+          Current1: <dyn signal={dint src1}/>
+          Current2: <dyn signal={dint src2}/>
+        </body></xml>
+    end
diff --git a/tests/rpc2.urp b/tests/rpc2.urp
new file mode 100644
index 0000000..74f46f9
--- /dev/null
+++ b/tests/rpc2.urp
@@ -0,0 +1,5 @@
+debug
+sql rpc2.sql
+database dbname=rpc2
+
+rpc2
diff --git a/tests/rpcDD.ur b/tests/rpcDD.ur
new file mode 100644
index 0000000..13293b8
--- /dev/null
+++ b/tests/rpcDD.ur
@@ -0,0 +1,26 @@
+datatype list t = Nil | OtherNil | Cons of t * list t
+
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun rows () =
+            query (SELECT * FROM t)
+            (fn r ls => return (Cons (r.T.A, ls)))
+            Nil
+
+        fun show ls =
+            case ls of
+                Nil => <xml/>
+              | OtherNil => <xml>That's impossible!</xml>
+              | Cons (x, ls') => <xml>{[x]}<br/>{show ls'}</xml>
+    in
+        s <- source Nil;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={ls <- rows ();
+                           set s ls}/><br/>
+          <br/>
+          Current: <dyn signal={ls <- signal s; return (show ls)}/>
+        </body></xml>
+    end
diff --git a/tests/rpcDD.urp b/tests/rpcDD.urp
new file mode 100644
index 0000000..118ea72
--- /dev/null
+++ b/tests/rpcDD.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDD.sql
+database dbname=rpcdd
+
+rpcDD
diff --git a/tests/rpcDE.ur b/tests/rpcDE.ur
new file mode 100644
index 0000000..64e190f
--- /dev/null
+++ b/tests/rpcDE.ur
@@ -0,0 +1,30 @@
+datatype result = Neg | Zero | Pos
+
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun check () =
+            r <- oneRow (SELECT SUM(t.A) AS X FROM t);
+            return (if r.X < 0 then
+                        Neg
+                    else if r.X = 0 then
+                        Zero
+                    else
+                        Pos)
+
+        fun show r =
+            case r of
+                Neg => <xml>-</xml>
+              | Zero => <xml>0</xml>
+              | Pos => <xml>+</xml>
+    in
+        s <- source Zero;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={r <- check ();
+                           set s r}/><br/>
+          <br/>
+          Current: <dyn signal={r <- signal s; return (show r)}/>
+        </body></xml>
+    end
diff --git a/tests/rpcDE.urp b/tests/rpcDE.urp
new file mode 100644
index 0000000..2027ff8
--- /dev/null
+++ b/tests/rpcDE.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDE.sql
+database dbname=rpcde
+
+rpcDE
diff --git a/tests/rpcDO.ur b/tests/rpcDO.ur
new file mode 100644
index 0000000..4ba6015
--- /dev/null
+++ b/tests/rpcDO.ur
@@ -0,0 +1,25 @@
+datatype list t = Nil | Cons of t * list t
+
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun rows () =
+            query (SELECT * FROM t)
+            (fn r ls => return (Cons (r.T.A, ls)))
+            Nil
+
+        fun show ls =
+            case ls of
+                Nil => <xml/>
+              | Cons (x, ls') => <xml>{[x]}<br/>{show ls'}</xml>
+    in
+        s <- source Nil;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={ls <- rows ();
+                           set s ls}/><br/>
+          <br/>
+          Current: <dyn signal={ls <- signal s; return (show ls)}/>
+        </body></xml>
+    end
diff --git a/tests/rpcDO.urp b/tests/rpcDO.urp
new file mode 100644
index 0000000..7d9bb6a
--- /dev/null
+++ b/tests/rpcDO.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDO.sql
+database dbname=rpcdo
+
+rpcDO
diff --git a/tests/rpcList2.ur b/tests/rpcList2.ur
new file mode 100644
index 0000000..e3ebb45
--- /dev/null
+++ b/tests/rpcList2.ur
@@ -0,0 +1,13 @@
+fun showList l = case l of
+    [] => "[]"
+  | h :: t => strcat (strcat (show h) " :: ") (showList t)
+
+fun rpcFunc l : transaction string =
+  case l of h :: _ => return (showList h) | [] => return "[]"
+
+fun main () : transaction page = return <xml><body>
+  <button onclick={
+    s <- rpc (rpcFunc  (("foo" :: []) :: []));
+    alert s
+  }/>
+  </body></xml>
diff --git a/tests/rpcM.ur b/tests/rpcM.ur
new file mode 100644
index 0000000..4cd4b86
--- /dev/null
+++ b/tests/rpcM.ur
@@ -0,0 +1,33 @@
+datatype list t = Nil | Cons of t * list t
+
+sequence s
+
+fun main () : transaction page =
+    let
+        fun getIndices srcs =
+            case srcs of
+                Nil => return Nil
+              | Cons (src, srcs') =>
+                i <- nextval s;
+                set src i;
+                ls <- getIndices srcs';
+                return (Cons (i, ls))
+
+        fun show ls =
+            case ls of
+                Nil => <xml/>
+              | Cons (x, ls') => <xml>{[x]}<br/>{show ls'}</xml>
+    in
+        src1 <- source 0;
+        src2 <- source 1;
+        s <- source Nil;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={ns <- getIndices (Cons (src1, Cons (src2, Nil)));
+                           set s ns}/><br/>
+          <br/>
+          #1: <dyn signal={n <- signal src1; return <xml>{[n]}</xml>}/><br/>
+          #2: <dyn signal={n <- signal src2; return <xml>{[n]}</xml>}/><br/>
+          Current: <dyn signal={ns <- signal s; return (show ns)}/>
+        </body></xml>
+    end
diff --git a/tests/rpcM.urp b/tests/rpcM.urp
new file mode 100644
index 0000000..a1eec77
--- /dev/null
+++ b/tests/rpcM.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcM.sql
+database dbname=rpcm
+
+rpcM
diff --git a/tests/rpcN.ur b/tests/rpcN.ur
new file mode 100644
index 0000000..857b5ed
--- /dev/null
+++ b/tests/rpcN.ur
@@ -0,0 +1,16 @@
+table t : { A : int }
+
+fun main () : transaction page =
+    let
+        fun count a = r <- oneRow (SELECT COUNT( * ) AS N FROM t WHERE t.A = {[a]});
+                      return r.N
+    in
+        s <- source 0;
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={n <- count 3;
+                           set s n}/><br/>
+          <br/>
+          Current: <dyn signal={n <- signal s; return <xml>{[n]}</xml>}/>
+        </body></xml>
+    end
diff --git a/tests/rpcN.urp b/tests/rpcN.urp
new file mode 100644
index 0000000..6181d8b
--- /dev/null
+++ b/tests/rpcN.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcN.sql
+database dbname=rpcN
+
+rpcN
diff --git a/tests/rpcNested.ur b/tests/rpcNested.ur
new file mode 100644
index 0000000..4d8923b
--- /dev/null
+++ b/tests/rpcNested.ur
@@ -0,0 +1,16 @@
+datatype node
+  = Node of
+    { Label     : string
+    , SubForest : list node
+    }
+
+fun getNode () : transaction node =
+    return (Node { Label = "foo", SubForest = [] })
+
+fun main () : transaction page = return <xml><body>
+  <button onclick={
+    n <- rpc (getNode ());
+    case n of
+        Node {Label = l, ...} => alert ("l = " ^ l)
+  }/>
+  </body></xml>
diff --git a/tests/rpcO.ur b/tests/rpcO.ur
new file mode 100644
index 0000000..bc4b430
--- /dev/null
+++ b/tests/rpcO.ur
@@ -0,0 +1,25 @@
+table t : {A : int}
+
+fun main () : transaction page =
+    let
+        fun check () =
+            r <- oneRow (SELECT SUM(t.A) AS X FROM t);
+            return (if r.X < 0 then
+                        (Some 3, None)
+                    else
+                        (None, Some "Hi"))
+
+        fun show (t ::: Type) (_ : show t) (opt : option t) =
+            case opt of
+                None => <xml>None</xml>
+              | Some v => <xml>{[v]}</xml>
+    in
+        s <- source (None, None);
+        return <xml><body>
+          <button value="Get It On!"
+                  onclick={r <- check ();
+                           set s r}/><br/>
+          <br/>
+          Current: <dyn signal={p <- signal s; return <xml>{show p.1}, {show p.2}</xml>}/>
+        </body></xml>
+    end
diff --git a/tests/rpcO.urp b/tests/rpcO.urp
new file mode 100644
index 0000000..3a51158
--- /dev/null
+++ b/tests/rpcO.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcO.sql
+database dbname=rpco
+
+rpcO
diff --git a/tests/rpcSource.ur b/tests/rpcSource.ur
new file mode 100644
index 0000000..ad144cd
--- /dev/null
+++ b/tests/rpcSource.ur
@@ -0,0 +1,13 @@
+fun remote () =
+    s <- source <xml/>;
+    return (s, <xml><dyn signal={signal s}/></xml>)
+
+fun main () : transaction page =
+    x <- source <xml/>;
+    return <xml><body>
+      <dyn signal={signal x}/>
+      <hr/>
+      <button onclick={p <- rpc (remote ());
+                       set x p.2;
+                       set p.1 <xml>Hi!</xml>}/>
+    </body></xml>
diff --git a/tests/rpchan.ur b/tests/rpchan.ur
new file mode 100644
index 0000000..08308d9
--- /dev/null
+++ b/tests/rpchan.ur
@@ -0,0 +1,18 @@
+fun remote () =
+    ch <- channel;
+    send ch "Hello World!";
+    return ch
+
+fun remoter () =
+    ch <- channel;
+    send ch "Hello World!";
+    return <xml><active code={spawn (s <- recv ch; alert s); return <xml/>}/></xml>
+
+fun main () =
+    x <- source <xml/>;
+    return <xml><body>
+      <button onclick={fn _ => ch <- rpc (remote ()); s <- recv ch; alert s}>TEST</button>
+      <button onclick={fn _ => y <- rpc (remoter ()); set x y}>TESTER</button>
+      <hr/>
+      <dyn signal={signal x}/>
+    </body></xml>
diff --git a/tests/rpchan.urs b/tests/rpchan.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/rpchan.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/rs.ur b/tests/rs.ur
new file mode 100644
index 0000000..ae5ff85
--- /dev/null
+++ b/tests/rs.ur
@@ -0,0 +1,15 @@
+fun bobo () =
+    n1 <- source 0;
+    n2 <- source 1;
+    return <xml>
+      <dyn signal={n1 <- signal n1; n2 <- signal n2; return <xml>{[n1 + n2]}</xml>}/>
+      <button value="Increment1" onclick={v <- get n1; set n1 (v + 1)}/>
+      <button value="Increment2" onclick={v <- get n2; set n2 (v + 1)}/>
+    </xml>
+
+fun main () =
+    x <- source <xml/>;
+    return <xml><body>
+      <dyn signal={signal x}/>
+      <button value="Grab" onclick={y <- rpc (bobo ()); set x y}/>
+    </body></xml>
diff --git a/tests/rs.urs b/tests/rs.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/rs.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/saveEnv.ur b/tests/saveEnv.ur
new file mode 100644
index 0000000..b53f219
--- /dev/null
+++ b/tests/saveEnv.ur
@@ -0,0 +1 @@
+con c :: (K --> L --> (K * L) -> K) = K ==> L ==> fn p => p.2
diff --git a/tests/sbind.ur b/tests/sbind.ur
new file mode 100644
index 0000000..6e3ca78
--- /dev/null
+++ b/tests/sbind.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml><body>
+  <p>Before</p>
+  <p><dyn signal={s <- return "Bye"; return <xml>{[s]}</xml>}/></p>
+  <p>After</p>
+</body></xml>
diff --git a/tests/sbind.urp b/tests/sbind.urp
new file mode 100644
index 0000000..d8735c7
--- /dev/null
+++ b/tests/sbind.urp
@@ -0,0 +1,3 @@
+debug
+
+sbind
diff --git a/tests/selclause.ur b/tests/selclause.ur
new file mode 100644
index 0000000..484c1eb
--- /dev/null
+++ b/tests/selclause.ur
@@ -0,0 +1,6 @@
+table t : { A : int, B : string, C : float }
+table u : { D : int, E : string, F : float }
+
+val q : transaction (list {T : { A : int, B : string, C : float}, U : { D : int }, X : string }) =
+    queryL (SELECT t.*, u.D, 'hi' AS X
+            FROM t, u)
diff --git a/tests/selclause.urp b/tests/selclause.urp
new file mode 100644
index 0000000..ccd6262
--- /dev/null
+++ b/tests/selclause.urp
@@ -0,0 +1,4 @@
+database dbname=test
+sql selclause.sql
+
+selclause
diff --git a/tests/select.ur b/tests/select.ur
new file mode 100644
index 0000000..ff3908e
--- /dev/null
+++ b/tests/select.ur
@@ -0,0 +1,13 @@
+val handler = fn x => <xml><body>
+        You entered: {cdata x.A}
+</body></xml>
+
+val main = fn () => <xml><body>
+        <form>
+                <select{#A}>
+                        <option value="A">A</option>
+                        <option value="B">B</option>
+                </select>
+                <submit action={handler}/>
+        </form>
+</body></xml>
diff --git a/tests/selexp.ur b/tests/selexp.ur
new file mode 100644
index 0000000..11bb796
--- /dev/null
+++ b/tests/selexp.ur
@@ -0,0 +1,6 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT 0 AS Zero FROM t1)
+val q2 = (SELECT t1.A < t2.D AS Lt FROM t1, t2)
+val q3 = (SELECT t1.A < t2.D AS Lt, t1.A, t2.D, t1.C = t2.A AS Eq FROM t1, t2)
diff --git a/tests/selfRpc.ur b/tests/selfRpc.ur
new file mode 100644
index 0000000..a851008
--- /dev/null
+++ b/tests/selfRpc.ur
@@ -0,0 +1,7 @@
+fun test () =
+    k <- source <xml/>;
+    return <xml><button onclick={r <- rpc (test ()); set k r}/></xml>
+
+fun main () : transaction page =
+    h <- test ();
+    return <xml><body>{h}</body></xml>
diff --git a/tests/sendurl.ur b/tests/sendurl.ur
new file mode 100644
index 0000000..8264305
--- /dev/null
+++ b/tests/sendurl.ur
@@ -0,0 +1,11 @@
+fun main () =
+    let
+        fun getIt () = return (bless "http://www.yahoo.com/")
+    in
+        s <- source <xml/>;
+        return <xml><body>
+          <dyn signal={signal s}/>
+
+          <button onclick={v <- rpc (getIt ()); set s <xml><a href={v}>Go!</a></xml>}/>
+        </body></xml>
+    end
diff --git a/tests/sendurl.urp b/tests/sendurl.urp
new file mode 100644
index 0000000..4bb6273
--- /dev/null
+++ b/tests/sendurl.urp
@@ -0,0 +1,4 @@
+debug
+allow url http://www.yahoo.com/
+
+sendurl
diff --git a/tests/sendurl.urs b/tests/sendurl.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/sendurl.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sequence.ur b/tests/sequence.ur
new file mode 100644
index 0000000..4d37d05
--- /dev/null
+++ b/tests/sequence.ur
@@ -0,0 +1,7 @@
+sequence seq
+
+fun main () : transaction page =
+        n <- nextval seq;
+        return <html><body>
+                {txt _ n}
+        </body></html>
diff --git a/tests/sequence.urp b/tests/sequence.urp
new file mode 100644
index 0000000..5edfb18
--- /dev/null
+++ b/tests/sequence.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+sequence
diff --git a/tests/setActive.ur b/tests/setActive.ur
new file mode 100644
index 0000000..e937c1d
--- /dev/null
+++ b/tests/setActive.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page =
+    i <- fresh;
+    x <- source <xml/>;
+    return <xml>
+      <body>
+        <dyn signal={signal x} />
+        <active code={set x <xml><ctextbox/><ctextbox id={i}/><ctextbox/><active code={giveFocus i; return <xml/>}/></xml>; return <xml/>}/>
+      </body>
+    </xml>
diff --git a/tests/setInner.js b/tests/setInner.js
new file mode 100644
index 0000000..4f71ac2
--- /dev/null
+++ b/tests/setInner.js
@@ -0,0 +1,3 @@
+function setIt(id, html) {
+    setInnerHTML(document.getElementById(id), html);
+}
diff --git a/tests/setInner.ur b/tests/setInner.ur
new file mode 100644
index 0000000..3032f8a
--- /dev/null
+++ b/tests/setInner.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page =
+    x <- fresh;
+    s <- source 0;
+    q <- source "";
+    return <xml><body>
+      <span id={x}/>
+      <button onclick={v <- get q; set q (v ^ "!"); Ffi.setIt x <xml><dyn signal={n <- signal s; return <xml>n = {[n]}</xml>}/>{[v]}</xml>}/>
+      <button onclick={n <- get s; set s (n + 1)}/>
+    </body></xml>
diff --git a/tests/setInner.urp b/tests/setInner.urp
new file mode 100644
index 0000000..cfbc6a5
--- /dev/null
+++ b/tests/setInner.urp
@@ -0,0 +1,7 @@
+rewrite all SetInner/*
+script http://localhost/setInner.js
+jsFunc Ffi.setIt=setIt
+benignEffectful Ffi.setIt
+ffi ffi
+
+setInner
diff --git a/tests/showClass.ur b/tests/showClass.ur
new file mode 100644
index 0000000..c8a4fb3
--- /dev/null
+++ b/tests/showClass.ur
@@ -0,0 +1,3 @@
+style test
+
+fun main () : transaction page = return <xml>{[test]}</xml>
diff --git a/tests/showSql.ur b/tests/showSql.ur
new file mode 100644
index 0000000..c373b21
--- /dev/null
+++ b/tests/showSql.ur
@@ -0,0 +1,5 @@
+table t : { A : int }
+
+fun main () : transaction page = return <xml><body>
+  {[(SELECT t.A FROM t ORDER BY t.A DESC) : sql_query [] [] _ _]}
+</body></xml>
diff --git a/tests/showSql.urp b/tests/showSql.urp
new file mode 100644
index 0000000..415248c
--- /dev/null
+++ b/tests/showSql.urp
@@ -0,0 +1,3 @@
+database dbname=test
+
+showSql
diff --git a/tests/showTime.ur b/tests/showTime.ur
new file mode 100644
index 0000000..e439d6a
--- /dev/null
+++ b/tests/showTime.ur
@@ -0,0 +1,8 @@
+fun main () : transaction page =
+    tm <- now;
+    s <- source tm;
+    return <xml><body>
+      <b>Server:</b> {[tm]}<br/>
+      <b>Client:</b> <dyn signal={v <- signal s; return (txt v)}/>
+      <button value="Recalculate" onclick={tm <- now; set s tm}/>
+    </body></xml>
diff --git a/tests/showTime.urp b/tests/showTime.urp
new file mode 100644
index 0000000..7ef7e20
--- /dev/null
+++ b/tests/showTime.urp
@@ -0,0 +1,4 @@
+timeFormat %H:%M %Y
+rewrite url ShowTime/*
+
+showTime
diff --git a/tests/sidecheck.ur b/tests/sidecheck.ur
new file mode 100644
index 0000000..e21a004
--- /dev/null
+++ b/tests/sidecheck.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+    s <- source 0;
+    n <- get s;
+    set s (n + 1);
+    n' <- get s;
+    return <xml>{[n']}</xml>
diff --git a/tests/sidecheckGood.ur b/tests/sidecheckGood.ur
new file mode 100644
index 0000000..01a8c3d
--- /dev/null
+++ b/tests/sidecheckGood.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+    s <- source 0;
+    set s 42;
+    return <xml><body>
+      <dyn signal={n <- signal s; return (txt n)}/>
+    </body></xml>
diff --git a/tests/sigInModule.ur b/tests/sigInModule.ur
new file mode 100644
index 0000000..efb7b0f
--- /dev/null
+++ b/tests/sigInModule.ur
@@ -0,0 +1,8 @@
+structure A = struct
+    signature S = sig
+        val x : int
+    end 
+end
+structure B : A.S = struct
+    val x = 42
+end
diff --git a/tests/sig_impl.ur b/tests/sig_impl.ur
new file mode 100644
index 0000000..cdcd4ef
--- /dev/null
+++ b/tests/sig_impl.ur
@@ -0,0 +1,58 @@
+signature S = sig
+        type t
+        val x : t
+end
+
+structure M : S = struct
+        val x = 0
+end
+
+signature S = sig
+        con r :: {Type}
+        val x : $r
+end
+
+structure M : S = struct
+        val x = {A = 0, B = "Hi"}
+end
+
+signature S = sig
+        type t
+        con r :: {Type}
+        val x : t -> $r
+end
+
+structure M : S = struct
+        val x = fn v : int => {A = 0, B = "Hi"}
+end
+
+signature S = sig
+        con nm :: Name
+        con t :: Type
+        con r :: {Type}
+        val x : $([nm = t] ++ r)
+end
+
+structure M : S = struct
+        val x = {A = 0, B = "Hi"}
+end
+
+signature S = sig
+        con nm :: Name
+        con r :: {Type}
+        val x : $([nm = int] ++ r)
+end
+
+structure M : S = struct
+        val x = {A = 0, B = "Hi"}
+end
+
+signature S = sig
+        con nm :: Name
+        con r :: {Type}
+        val x : $([nm = string] ++ r)
+end
+
+structure M : S = struct
+        val x = {A = 0, B = "Hi"}
+end
diff --git a/tests/sig_wild.ur b/tests/sig_wild.ur
new file mode 100644
index 0000000..3f71477
--- /dev/null
+++ b/tests/sig_wild.ur
@@ -0,0 +1,9 @@
+signature S = sig
+        type t
+        val x : t
+end
+
+structure M : S = struct
+        type t = _
+        val x = 0
+end
diff --git a/tests/sigbug.ur b/tests/sigbug.ur
new file mode 100644
index 0000000..ec00343
--- /dev/null
+++ b/tests/sigbug.ur
@@ -0,0 +1,3 @@
+val z = 3
+val x = 1
+val y = 2
diff --git a/tests/sigbug.urs b/tests/sigbug.urs
new file mode 100644
index 0000000..8169393
--- /dev/null
+++ b/tests/sigbug.urs
@@ -0,0 +1,3 @@
+val x : inta
+val y : into
+val z : introx
diff --git a/tests/sigdupe.ur b/tests/sigdupe.ur
new file mode 100644
index 0000000..50bed79
--- /dev/null
+++ b/tests/sigdupe.ur
@@ -0,0 +1,4 @@
+signature S = sig
+        type t
+        type t
+end
diff --git a/tests/simplify.ur b/tests/simplify.ur
new file mode 100644
index 0000000..11e002e
--- /dev/null
+++ b/tests/simplify.ur
@@ -0,0 +1 @@
+fun main [r] (r : $([A = int] ++ ([B = float] ++ r))) : $([A = float] ++ ([B = int] ++ r)) = r
diff --git a/tests/sleep.ur b/tests/sleep.ur
new file mode 100644
index 0000000..132479e
--- /dev/null
+++ b/tests/sleep.ur
@@ -0,0 +1,7 @@
+fun annoyer () =
+    alert "Hi!";
+    sleep 5000;
+    annoyer ()
+
+fun main () : transaction page = return <xml><body onload={annoyer ()}/></xml>
+
diff --git a/tests/sleep.urp b/tests/sleep.urp
new file mode 100644
index 0000000..f6eaf9f
--- /dev/null
+++ b/tests/sleep.urp
@@ -0,0 +1,3 @@
+debug
+
+sleep
diff --git a/tests/snest.ur b/tests/snest.ur
new file mode 100644
index 0000000..c7daae3
--- /dev/null
+++ b/tests/snest.ur
@@ -0,0 +1,15 @@
+fun main () =
+    s1 <- source False;
+    s2 <- source False;
+
+    return <xml><body>
+      <dyn signal={s1 <- signal s1;
+                   return (if s1 then
+                               <xml><dyn signal={s2 <- signal s2;
+                                                 return <xml>{[s2]}</xml>}/></xml>
+                           else
+                               <xml>Not yet</xml>)}/>
+      <hr/>
+      <button value="s1" onclick={set s1 True}/>
+      <button value="s2" onclick={set s2 True}/>
+   </body></xml>
diff --git a/tests/snest.urp b/tests/snest.urp
new file mode 100644
index 0000000..3e68a59
--- /dev/null
+++ b/tests/snest.urp
@@ -0,0 +1,3 @@
+debug
+
+snest
diff --git a/tests/snest.urs b/tests/snest.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/snest.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/solo.ur b/tests/solo.ur
new file mode 100644
index 0000000..c3d5cb7
--- /dev/null
+++ b/tests/solo.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml>Gnarly!</xml>
diff --git a/tests/spacey.ur b/tests/spacey.ur
new file mode 100644
index 0000000..22c5e3a
--- /dev/null
+++ b/tests/spacey.ur
@@ -0,0 +1 @@
+fun main () : transaction page = return <xml/>
diff --git a/tests/spacey.urp b/tests/spacey.urp
new file mode 100644
index 0000000..47ba25c
--- /dev/null
+++ b/tests/spacey.urp
@@ -0,0 +1,3 @@
+exe has space.exe
+
+spacey
diff --git a/tests/spawn.ur b/tests/spawn.ur
new file mode 100644
index 0000000..263b52b
--- /dev/null
+++ b/tests/spawn.ur
@@ -0,0 +1,24 @@
+table t : {A : int, Ch : channel string}
+
+fun listener n ch =
+    s <- recv ch;
+    alert (show n ^ ": " ^ s);
+    listener n ch
+
+fun speak id msg =
+    r <- oneRow (SELECT t.Ch FROM t WHERE t.A = {[id]});
+    send r.T.Ch msg
+
+fun main () : transaction page =
+    ch1 <- channel;
+    dml (INSERT INTO t (A, Ch) VALUES (1, {[ch1]}));
+    ch2 <- channel;
+    dml (INSERT INTO t (A, Ch) VALUES (2, {[ch2]}));
+
+    s1 <- source "";
+    s2 <- source "";
+
+    return <xml><body onload={spawn (listener 1 ch1); spawn (listener 2 ch2)}>
+      1: <ctextbox source={s1}/><button onclick={msg <- get s1; speak 1 msg}/><br/>
+      2: <ctextbox source={s2}/><button onclick={msg <- get s2; speak 2 msg}/>
+    </body></xml>
diff --git a/tests/spawn.urp b/tests/spawn.urp
new file mode 100644
index 0000000..d24ba14
--- /dev/null
+++ b/tests/spawn.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=spawn
+sql spawn.sql
+
+spawn
diff --git a/tests/specialize.ur b/tests/specialize.ur
new file mode 100644
index 0000000..4032b49
--- /dev/null
+++ b/tests/specialize.ur
@@ -0,0 +1,40 @@
+datatype list a = Nil | Cons of a * list a
+
+fun isNil (t ::: Type) (ls : list t) : bool =
+        case ls of
+          Nil => True
+        | Cons _ => False
+
+fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, append ls1' ls2)
+
+fun pairAppend (t1 ::: Type) (t2 ::: Type) (ls1 : list (t1 * t2)) (ls2 : list (t1 * t2)) : list (t1 * t2) =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, pairAppend ls1' ls2)
+
+fun delist (ls : list string) : xml body [] [] =
+        case ls of
+          Nil => <body>Nil</body>
+        | Cons (h, t) => <body>{cdata h} :: {delist t}</body>
+
+fun pairDelist (ls : list (string * int)) : xml body [] [] =
+        case ls of
+          Nil => <body>Nil</body>
+        | Cons ((s, n), t) => <body>({cdata s}, {cdata (show _ n)}) :: {pairDelist t}</body>
+
+val ls = Cons ("X", Cons ("Y", Cons ("Z", Nil)))
+val ls' = Cons ("A", Cons ("B", Nil))
+
+val pls = Cons (("X", 1), Cons (("Y", 2), Cons (("Z", 3), Nil)))
+val pls' = Cons (("A", 1), Cons (("B", 2), Nil))
+
+fun main () : transaction page = return <html><body>
+        {if isNil ls then <body>It's Nil.</body> else <body>It's not Nil.</body>}
+
+        <p>{delist (append ls' ls)}</p>
+
+        <p>{pairDelist (pairAppend pls' pls)}</p>
+</body></html>
diff --git a/tests/specialize.urp b/tests/specialize.urp
new file mode 100644
index 0000000..a3f67c2
--- /dev/null
+++ b/tests/specialize.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+specialize
+
diff --git a/tests/split.ur b/tests/split.ur
new file mode 100644
index 0000000..0a855c5
--- /dev/null
+++ b/tests/split.ur
@@ -0,0 +1,2 @@
+type t = int
+val x = 0
diff --git a/tests/split.urs b/tests/split.urs
new file mode 100644
index 0000000..d095f7c
--- /dev/null
+++ b/tests/split.urs
@@ -0,0 +1,2 @@
+type t
+val x : t
diff --git a/tests/split2.ur b/tests/split2.ur
new file mode 100644
index 0000000..fb66e52
--- /dev/null
+++ b/tests/split2.ur
@@ -0,0 +1 @@
+val main = Split.x
diff --git a/tests/sql_if.ur b/tests/sql_if.ur
new file mode 100644
index 0000000..4413e76
--- /dev/null
+++ b/tests/sql_if.ur
@@ -0,0 +1,6 @@
+table t : { A : int, B : int }
+
+fun main () =
+    x <- queryX (SELECT * FROM t WHERE IF t.A = 6 THEN t.B < 2 ELSE t.B > 5)
+                (fn r => <xml><li>{[r.T.A]}, {[r.T.B]}</li></xml>);
+    return <xml><body>{x}</body></xml>
diff --git a/tests/sql_if.urp b/tests/sql_if.urp
new file mode 100644
index 0000000..49e846f
--- /dev/null
+++ b/tests/sql_if.urp
@@ -0,0 +1,4 @@
+database dbname=sql_if
+sql sql_if.sql
+
+sql_if
diff --git a/tests/sql_if.urs b/tests/sql_if.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/sql_if.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sql_indent.ur b/tests/sql_indent.ur
new file mode 100644
index 0000000..958fb07
--- /dev/null
+++ b/tests/sql_indent.ur
@@ -0,0 +1,26 @@
+table t1 : {A : int, B : string, C : float}
+
+val q1 = (SELECT *
+          FROM t1
+          WHERE A = 0)
+
+val a1 = (INSERT INTO t1
+          VALUES (0, "1", 2.0))
+
+val a2 = (UPDATE t1
+          SET A = 3, B = "4", C = 5.0)
+         
+val a3 = (DELETE FROM t1
+          WHERE B <> "good")
+
+
+val q2 = (SELECT *
+          FROM t1
+          WHERE A = 0
+            OR B = "hi"
+            AND (C <> 10.01
+              OR A = 8)
+            AND (B = B
+              OR B = B
+              AND C = C OR (D =
+                6 AND 8 = 8)))
diff --git a/tests/sql_ops.ur b/tests/sql_ops.ur
new file mode 100644
index 0000000..34e7877
--- /dev/null
+++ b/tests/sql_ops.ur
@@ -0,0 +1,8 @@
+table t : { A : int, B : float }
+
+val q = (SELECT t.A + t.A AS X, t.B * t.B AS Y FROM t)
+
+fun main () : transaction page =
+    xml <- queryX q (fn r => <xml>{[r.X]}, {[r.Y]}<br/></xml>);
+    return <xml><body>{xml}</body></xml>
+
diff --git a/tests/sql_ops.urp b/tests/sql_ops.urp
new file mode 100644
index 0000000..90e47b7
--- /dev/null
+++ b/tests/sql_ops.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=sql_ops
+sql sql_ops.sql
+exe /tmp/webapp
+
+sql_ops
diff --git a/tests/sql_option.ur b/tests/sql_option.ur
new file mode 100644
index 0000000..0676c90
--- /dev/null
+++ b/tests/sql_option.ur
@@ -0,0 +1,28 @@
+table t : { O : option int }
+
+fun addNull () =
+    dml (INSERT INTO t (O) VALUES (NULL));
+    return <xml>Done</xml>
+
+fun add3 () =
+    dml (INSERT INTO t (O) VALUES ({Some 3}));
+    return <xml>Done</xml>
+
+fun addN r =
+    dml (INSERT INTO t (O) VALUES ({Some (readError r.N)}));
+    return <xml>Done</xml>
+
+fun main () : transaction page =
+    xml <- queryX (SELECT * FROM t)
+                  (fn r => case r.T.O of
+                               None => <xml>Nada<br/></xml>
+                             | Some n => <xml>Num: {[n]}<br/></xml>);
+    return <xml><body>
+      {xml}
+
+      <a link={addNull ()}>Add a null</a><br/>
+      <a link={add3 ()}>Add a 3</a><br/>
+      <form>
+        Add <textbox{#N}/> <submit action={addN}/>
+      </form>
+    </body></xml>
diff --git a/tests/sql_option.urp b/tests/sql_option.urp
new file mode 100644
index 0000000..543c32a
--- /dev/null
+++ b/tests/sql_option.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=option
+sql option.sql
+
+sql_option
diff --git a/tests/sql_option.urs b/tests/sql_option.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/sql_option.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sqliteTime.ur b/tests/sqliteTime.ur
new file mode 100644
index 0000000..427b5e0
--- /dev/null
+++ b/tests/sqliteTime.ur
@@ -0,0 +1,14 @@
+table dates : { Date : time }
+
+fun aform () =
+    let
+        val a : time = readError "01/02/03 04:06:07"
+    in
+        dml(INSERT INTO dates (Date) VALUES ({[a]}));
+        ds <- queryX (SELECT * FROM dates)
+                     (fn r => <xml>{[r.Dates.Date]}<br/></xml>);
+        return <xml><body>{ds}</body></xml>
+    end
+
+fun main () =
+  return <xml><body><form><submit action={aform}/></form></body></xml>
diff --git a/tests/sqliteTime.urp b/tests/sqliteTime.urp
new file mode 100644
index 0000000..9275bf4
--- /dev/null
+++ b/tests/sqliteTime.urp
@@ -0,0 +1,5 @@
+dbms sqlite
+database /tmp/test
+sql sqliteTime.sql
+
+sqliteTime
diff --git a/tests/sqliteTime.urs b/tests/sqliteTime.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/sqliteTime.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sqlprecision.ur b/tests/sqlprecision.ur
new file mode 100644
index 0000000..0391ea0
--- /dev/null
+++ b/tests/sqlprecision.ur
@@ -0,0 +1,12 @@
+table t : { N : float }
+
+fun insert r =
+    dml (INSERT INTO t (N) VALUES ({[readError r.N]}));
+    return <xml/>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#N}/>
+    <submit action={insert}/>
+  </form>
+</body></xml>
diff --git a/tests/sqlprecision.urp b/tests/sqlprecision.urp
new file mode 100644
index 0000000..7a396b5
--- /dev/null
+++ b/tests/sqlprecision.urp
@@ -0,0 +1,5 @@
+database dbname=test
+rewrite url Sqlprecision/*
+sql sqlprecision.sql
+
+sqlprecision
diff --git a/tests/sqlprecision.urs b/tests/sqlprecision.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/sqlprecision.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/sqlurl.ur b/tests/sqlurl.ur
new file mode 100644
index 0000000..cdd51ca
--- /dev/null
+++ b/tests/sqlurl.ur
@@ -0,0 +1,4 @@
+table t : { Url : url }
+
+task initialize = fn () =>
+     dml (INSERT INTO t (Url) VALUES ({[bless "http://www.google.com/"]}))
diff --git a/tests/sqlurl.urp b/tests/sqlurl.urp
new file mode 100644
index 0000000..bb5544d
--- /dev/null
+++ b/tests/sqlurl.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql sqlurl.sql
+rewrite url Sqlurl/*
+allow url http://www.google.com/
+
+sqlurl
diff --git a/tests/sreturn.ur b/tests/sreturn.ur
new file mode 100644
index 0000000..62db377
--- /dev/null
+++ b/tests/sreturn.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml><body>
+  <p>Before</p>
+  <p><dyn signal={return <xml>Hi!</xml>}/></p>
+  <p>After</p>
+</body></xml>
diff --git a/tests/sreturn.urp b/tests/sreturn.urp
new file mode 100644
index 0000000..5591aa5
--- /dev/null
+++ b/tests/sreturn.urp
@@ -0,0 +1,3 @@
+debug
+
+sreturn
diff --git a/tests/strcspn.ur b/tests/strcspn.ur
new file mode 100644
index 0000000..8066010
--- /dev/null
+++ b/tests/strcspn.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+    s <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <button onclick={fn _ => v <- get s; alert (show (strcspn v "0123456789"))}/>
+    </body></xml>
diff --git a/tests/strdupe.ur b/tests/strdupe.ur
new file mode 100644
index 0000000..2a11aa5
--- /dev/null
+++ b/tests/strdupe.ur
@@ -0,0 +1,11 @@
+val x = 0
+val x = x
+
+type t = int
+type t = { A : t }
+
+signature S = sig end
+signature S = sig type t structure M : S end
+
+structure S = struct end
+structure S : S = struct type t = int structure M = S end
diff --git a/tests/stringToTime.ur b/tests/stringToTime.ur
new file mode 100644
index 0000000..df7b7ee
--- /dev/null
+++ b/tests/stringToTime.ur
@@ -0,0 +1,9 @@
+fun main () : transaction page =
+    s <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <button onclick={v <- get s; alert (show (readError v : time))}/>
+      <button onclick={v <- get s; case read v : option time of
+                                       None => alert "Invalid"
+                                     | Some tm => alert (show tm)}/>
+    </body></xml>
diff --git a/tests/stuff.ur b/tests/stuff.ur
new file mode 100644
index 0000000..806e4df
--- /dev/null
+++ b/tests/stuff.ur
@@ -0,0 +1,38 @@
+type c1 = t :: Type -> t
+con c2 :: Type = t :: Type -> t
+con c3 = fn t :: Type => c1
+con c4 = c3 c1
+con c5 = (fn t :: Type => c1) c1
+
+con name = #MyName
+
+con c6 = {A : c1, name : c2}
+con c7 = [A = c1, name = c2]
+
+con c8 = fn t :: Type => t
+
+con c9 = {}
+con c10 = ([]) :: {Type}
+
+val v1 = fn t :: Type => fn x : t => x
+val v2 = v1 [t :: Type -> t -> t] v1
+
+val r = {X = v1, Y = v2}
+val v1_again = r.X
+val v2_again = r.Y
+
+val r2 = {X = {}, Y = v2, Z = {}}
+val r2_X = r2.X
+val r2_Y = r2.Y
+val r2_Z = r2.Z
+
+val f = fn fs :: {Type} => fn x : $([X = {}] ++ fs) => x.X
+val f2 = fn fs :: {Type} => fn x : $(fs ++ [X = {}]) => x.X
+val f3 = fn fs :: {Type} => fn x : $([X = {}, Y = {Z : {}}] ++ fs) => x.X
+val f4 = fn fs :: {Type} => fn x : $([X = {}, Y = {Z : {}}] ++ fs) => x.Y
+val f5 = fn fs1 :: {Type} => fn fs2 :: {Type} => fn x : $(fs1 ++ [X = {}] ++ fs2) => x.X
+val f6 = fn fs1 :: {Type} => fn fs2 :: {Type} => fn x : $(fs1 ++ [X = {}] ++ fs2 ++ [Y = {Z : {}}]) => x.X
+val f7 = fn fs1 :: {Type} => fn fs2 :: {Type} => fn x : $(fs1 ++ [X = {}] ++ fs2 ++ [Y = {Z : {}}]) => x.Y
+
+val test = f [[Y = t :: Type -> t -> t, Z = {}]] r2
+val test = f7 [[Y = t :: Type -> t -> t]] [[Z = {}]] r2
diff --git a/tests/style.css b/tests/style.css
new file mode 100644
index 0000000..78b33fc
--- /dev/null
+++ b/tests/style.css
@@ -0,0 +1,7 @@
+body.style1 {
+    background-color: blue;
+}
+
+body.style2 {
+     background-color: green;
+}
diff --git a/tests/style.ur b/tests/style.ur
new file mode 100644
index 0000000..8a5c114
--- /dev/null
+++ b/tests/style.ur
@@ -0,0 +1,11 @@
+style q
+style r
+
+fun main () : transaction page = return <xml>
+  <head>
+    <link rel="stylesheet" type="text/css" href="http://www.schizomaniac.net/style.css" media="screen"/>
+  </head>
+  <body>
+    Hi.  <span class={q}>And hi <span class={r}>again</span>!</span>
+  </body>
+</xml>
diff --git a/tests/style.urp b/tests/style.urp
new file mode 100644
index 0000000..fdb25a8
--- /dev/null
+++ b/tests/style.urp
@@ -0,0 +1,3 @@
+debug
+
+style
diff --git a/tests/styleRt.ur b/tests/styleRt.ur
new file mode 100644
index 0000000..583649a
--- /dev/null
+++ b/tests/styleRt.ur
@@ -0,0 +1,38 @@
+fun handler r =
+    return <xml><body>
+      <span style={oneProperty
+                       (oneProperty noStyle (value (property r.Prop) (atom r.Valu)))
+                       (value (property "background") (css_url (bless r.Url)))}>
+        Teeeest
+      </span>
+    </body></xml>
+
+fun main () =
+    prop <- source "";
+    valu <- source "";
+    url <- source "";
+    xm <- source <xml/>;
+    return <xml><body>
+      Property: <ctextbox source={prop}/><br/>
+      Value: <ctextbox source={valu}/><br/>
+      URL: <ctextbox source={url}/><br/>
+      <button value="Go!" onclick={prop <- get prop;
+                                   valu <- get valu;
+                                   url <- get url;
+                                   set xm <xml><span style={oneProperty
+                                                                (oneProperty noStyle (value (property prop) (atom valu)))
+                                                                (value (property "background") (css_url (bless url)))}>
+                                     Teeeest
+                                   </span></xml>}/>
+      <hr/>
+      <dyn signal={signal xm}/>
+      <hr/>
+      <h2>Or the old fashioned way...</h2>
+
+      <form>
+        Property: <textbox{#Prop}/><br/>
+        Value: <textbox{#Valu}/><br/>
+        URL: <textbox{#Url}/><br/>
+        <submit action={handler}/>
+      </form>
+    </body></xml>
diff --git a/tests/styleRt.urp b/tests/styleRt.urp
new file mode 100644
index 0000000..42e5f02
--- /dev/null
+++ b/tests/styleRt.urp
@@ -0,0 +1,4 @@
+rewrite all StyleRt/*
+allow url http://www.google.com/*
+
+styleRt
diff --git a/tests/styleRt.urs b/tests/styleRt.urs
new file mode 100644
index 0000000..901d6bf
--- /dev/null
+++ b/tests/styleRt.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
diff --git a/tests/stypes.ur b/tests/stypes.ur
new file mode 100644
index 0000000..142925e
--- /dev/null
+++ b/tests/stypes.ur
@@ -0,0 +1,62 @@
+datatype color = Red | White | Blue
+
+fun c2s c =
+    case c of
+        Red => "Red"
+      | White => "White"
+      | Blue => "Blue"
+
+val show_color = mkShow c2s
+
+datatype list a = Nil | Cons of a * list a
+
+fun isNil (t ::: Type) (ls : list t) =
+    case ls of
+        Nil => True
+      | _ => False
+
+fun delist (ls : list string) : xml body [] [] =
+    case ls of
+        Nil => <xml>Nil</xml>
+      | Cons (h, t) => <xml>{[h]} :: {delist t}</xml>
+
+fun main () : transaction page =
+    sInt <- source 0;
+    sFloat <- source 1.23;
+    sBoth <- source (7, 42.1);
+
+    sOpt <- source None;
+    sBool <- source True;
+
+    sColor <- source White;
+    sList <- source Nil;
+
+    return <xml><body>
+      <dyn signal={n <- signal sInt; return <xml>{[n + 3]}</xml>}/> <a onclick={set sInt 1}>Change</a><br/>
+
+      <dyn signal={n <- signal sFloat; return <xml>{[n + 1.0]}</xml>}/> <a onclick={set sFloat 4.56}>Change</a><br/>
+
+      <dyn signal={p <- signal sBoth; return <xml>{[p.1]}, {[p.2]}</xml>}/>;
+      <dyn signal={p <- signal sBoth; case p of
+                                          (7, _) => return <xml>Initial</xml>
+                                        | (fst, snd) => return <xml>{[fst]}, {[snd]}</xml>}/>
+      <a onclick={set sBoth (8, 100.001)}>Change</a><br/>
+
+      <dyn signal={o <- signal sOpt; case o of
+                                         None => return <xml>None</xml>
+                                       | Some n => return <xml>{[n]}</xml>}/>
+        <a onclick={set sOpt (Some 7)}>Change</a><br/>
+
+      <dyn signal={b <- signal sBool; return <xml>{[b]}</xml>}/>
+      <dyn signal={b <- signal sBool; if b then return <xml>Yes</xml> else return <xml>No</xml>}/>
+      <a onclick={set sBool False}>Change</a><br/>
+
+      <dyn signal={c <- signal sColor; return <xml>{[c]}</xml>}/>
+      <a onclick={set sColor Red}>Red</a>
+      <a onclick={set sColor White}>White</a>
+      <a onclick={set sColor Blue}>Blue</a><br/>
+
+      <dyn signal={ls <- signal sList; return <xml>{[isNil ls]}</xml>}/>;
+      <dyn signal={ls <- signal sList; return <xml>{delist ls}</xml>}/>
+      <a onclick={set sList (Cons ("A", Cons ("B", Nil)))}>Change</a><br/>
+    </body></xml>
diff --git a/tests/stypes.urp b/tests/stypes.urp
new file mode 100644
index 0000000..353ea9e
--- /dev/null
+++ b/tests/stypes.urp
@@ -0,0 +1,3 @@
+debug
+
+stypes
diff --git a/tests/subform.ur b/tests/subform.ur
new file mode 100644
index 0000000..2ab1f1a
--- /dev/null
+++ b/tests/subform.ur
@@ -0,0 +1,16 @@
+fun handler r = return <xml><body>
+  {[r.A]}, {[r.Sub.A]}, {[r.Sub.B]}, {[r.Sub.Sub]}, {[r.C]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/><br/>
+    <subform{#Sub}>
+      <textbox{#A}/><br/>
+      <textbox{#B}/><br/>
+      <textbox{#Sub}/><br/>
+    </subform>
+    <textbox{#C}/><br/>
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/subform.urp b/tests/subform.urp
new file mode 100644
index 0000000..52f6a75
--- /dev/null
+++ b/tests/subform.urp
@@ -0,0 +1,3 @@
+debug
+
+subform
diff --git a/tests/subform.urs b/tests/subform.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/subform.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/subforms.ur b/tests/subforms.ur
new file mode 100644
index 0000000..f6876bd
--- /dev/null
+++ b/tests/subforms.ur
@@ -0,0 +1,33 @@
+fun handler' ls =
+    case ls of
+        Nil => <xml/>
+      | Cons (r, ls) => <xml><li>{[r.Nam]}, {[r.A]}, {[r.B]}, {[r.Sub]}</li>{handler' ls}</xml>
+
+fun handler r = return <xml><body>
+  {[r.A]}<br/>
+  {handler' r.Sub}
+  {[r.C]}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/><br/>
+    <subforms{#Sub}>
+      <entry>
+        <hidden{#Nam} value="Sparky"/>
+        <textbox{#A}/><br/>
+        <textbox{#B}/><br/>
+        <textbox{#Sub}/><br/>
+      </entry>
+
+      <entry>
+        <hidden{#Nam} value="Snarky"/>
+        <textbox{#A}/><br/>
+        <textbox{#B}/><br/>
+        <textbox{#Sub}/><br/>
+      </entry>
+    </subforms>
+    <textbox{#C}/><br/>
+    <submit action={handler}/>
+  </form>
+</body></xml>
diff --git a/tests/subforms.urp b/tests/subforms.urp
new file mode 100644
index 0000000..f0d5c23
--- /dev/null
+++ b/tests/subforms.urp
@@ -0,0 +1,3 @@
+debug
+
+subforms
diff --git a/tests/subforms.urs b/tests/subforms.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/subforms.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/subfunctor.ur b/tests/subfunctor.ur
new file mode 100644
index 0000000..3c2aa83
--- /dev/null
+++ b/tests/subfunctor.ur
@@ -0,0 +1,6 @@
+functor F(M : sig con fs :: {Type} end) = struct
+    open M
+
+    functor G(M : sig val x : $(map sql_injectable_prim fs) end) = struct
+    end
+end
diff --git a/tests/subfunctor.urs b/tests/subfunctor.urs
new file mode 100644
index 0000000..db393d2
--- /dev/null
+++ b/tests/subfunctor.urs
@@ -0,0 +1,3 @@
+functor F(M : sig con fs :: {Type} end) : sig
+    functor G(M : sig val x : $(map sql_injectable_prim M.fs) end) : sig end
+end
diff --git a/tests/subquery.ur b/tests/subquery.ur
new file mode 100644
index 0000000..b788181
--- /dev/null
+++ b/tests/subquery.ur
@@ -0,0 +1,19 @@
+table t : { A : int, B : int, C : int }
+
+fun main () =
+    v <- queryX1 (SELECT t.A, t.C
+                  FROM t
+                  WHERE t.B = (SELECT MAX(U.B) AS M
+                               FROM t AS U
+                               WHERE U.A = t.A))
+                 (fn r => <xml>{[r.A]},{[r.C]};</xml>);
+    v' <- queryX1 (SELECT t.A, t.C
+                   FROM (SELECT t.A AS A, MAX(t.B) AS B
+                         FROM t
+                         GROUP BY t.A) AS Maxes
+                   JOIN t ON t.A = Maxes.A AND t.B = Maxes.B)
+                  (fn r => <xml>{[r.A]},{[r.C]};</xml>);
+    return <xml><body>
+      {v}<br/>
+      {v'}
+    </body></xml>
diff --git a/tests/subquery.urp b/tests/subquery.urp
new file mode 100644
index 0000000..3397f04
--- /dev/null
+++ b/tests/subquery.urp
@@ -0,0 +1,4 @@
+database /tmp/test
+sql subquery.sql
+
+subquery
diff --git a/tests/subquery.urs b/tests/subquery.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/subquery.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/subs_sig.ur b/tests/subs_sig.ur
new file mode 100644
index 0000000..934f604
--- /dev/null
+++ b/tests/subs_sig.ur
@@ -0,0 +1,7 @@
+signature S = sig
+        type t
+end
+
+structure S : S = struct
+        type t = int
+end
diff --git a/tests/subs_sig.urs b/tests/subs_sig.urs
new file mode 100644
index 0000000..7a6ab8f
--- /dev/null
+++ b/tests/subs_sig.urs
@@ -0,0 +1,5 @@
+signature S = sig
+        type t
+end
+
+structure S : S
diff --git a/tests/subs_str.ur b/tests/subs_str.ur
new file mode 100644
index 0000000..fcdc699
--- /dev/null
+++ b/tests/subs_str.ur
@@ -0,0 +1,5 @@
+structure M = struct
+        type t = int
+end
+
+val x = 0
diff --git a/tests/subs_str.urs b/tests/subs_str.urs
new file mode 100644
index 0000000..11ab2e2
--- /dev/null
+++ b/tests/subs_str.urs
@@ -0,0 +1,5 @@
+structure M : sig
+        type t
+end
+
+val x : M.t
diff --git a/tests/subsig.ur b/tests/subsig.ur
new file mode 100644
index 0000000..c10fb3b
--- /dev/null
+++ b/tests/subsig.ur
@@ -0,0 +1,43 @@
+structure M = struct
+        signature S = sig
+                type t
+        end
+end
+
+structure N : M.S = struct
+        type t = int
+end
+
+structure M' = struct
+        type t = int
+        val y = 42
+
+        signature S = sig
+                val x : t
+        end
+end
+
+structure N' : M'.S = struct
+        val x = 0
+end
+
+signature S = sig
+        type t
+        val y : t
+
+        signature S = sig
+                val x : t
+        end
+end
+
+structure M'S : S = M'
+
+structure V : M'S.S = struct
+        val x = M'S.y
+end
+
+structure M'S' = M'S
+
+structure V : M'S'.S = struct
+        val x = M'S.y
+end
diff --git a/tests/substring.ur b/tests/substring.ur
new file mode 100644
index 0000000..bc7b506
--- /dev/null
+++ b/tests/substring.ur
@@ -0,0 +1,5 @@
+fun main () : transaction page = return <xml>
+  {[case String.split "abc{" #"{" of
+        None => "!"
+      | Some (pre, post) => pre ^ post]}
+</xml>
diff --git a/tests/substring.urp b/tests/substring.urp
new file mode 100644
index 0000000..acc6288
--- /dev/null
+++ b/tests/substring.urp
@@ -0,0 +1,4 @@
+debug
+
+$/string
+substring
diff --git a/tests/t_t.ur b/tests/t_t.ur
new file mode 100644
index 0000000..a20e45f
--- /dev/null
+++ b/tests/t_t.ur
@@ -0,0 +1,4 @@
+table t : {A : int, B : string}
+
+task initialize = fn () => dml (UPDATE t SET A = A + 1 WHERE TRUE);
+                     dml (UPDATE t SET B = 'q' WHERE TRUE)
diff --git a/tests/t_t.urp b/tests/t_t.urp
new file mode 100644
index 0000000..12e96e3
--- /dev/null
+++ b/tests/t_t.urp
@@ -0,0 +1,5 @@
+dbms sqlite
+database /tmp/test
+sql t_t.sql
+
+t_t
diff --git a/tests/table.ur b/tests/table.ur
new file mode 100644
index 0000000..b27874c
--- /dev/null
+++ b/tests/table.ur
@@ -0,0 +1,16 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1)
+
+val q2 = (SELECT * FROM t1, t2)
+
+(*val q3 = (SELECT * FROM t1, t1)*)
+val q3 = (SELECT * FROM t1, t1 AS T2)
+
+val q4 = (SELECT * FROM {{t1}} AS T, t1 AS T2)
+
+val q5 = (SELECT t1.A FROM t1)
+val q6 = (SELECT t1.B, t1.C, t1.A FROM t1)
+
+val q7 = (SELECT t1.A, t2.A FROM t1, t2)
diff --git a/tests/table_sig.ur b/tests/table_sig.ur
new file mode 100644
index 0000000..0603d75
--- /dev/null
+++ b/tests/table_sig.ur
@@ -0,0 +1,2 @@
+table t : { A : int }
+
diff --git a/tests/table_sig.urp b/tests/table_sig.urp
new file mode 100644
index 0000000..6a161ed
--- /dev/null
+++ b/tests/table_sig.urp
@@ -0,0 +1,3 @@
+debug
+
+table_sig
diff --git a/tests/table_sig.urs b/tests/table_sig.urs
new file mode 100644
index 0000000..40dde3c
--- /dev/null
+++ b/tests/table_sig.urs
@@ -0,0 +1 @@
+table t : { A : int }
diff --git a/tests/tagffi.urs b/tests/tagffi.urs
new file mode 100644
index 0000000..87ee01c
--- /dev/null
+++ b/tests/tagffi.urs
@@ -0,0 +1 @@
+val funky : bodyTag boxAttrs
diff --git a/tests/tags.ur b/tests/tags.ur
new file mode 100644
index 0000000..059e869
--- /dev/null
+++ b/tests/tags.ur
@@ -0,0 +1,26 @@
+table images : { Id : int, Content : blob }
+table tags : { Id : int, Tag : string }
+
+datatype mode = Present | Absent
+type condition = { Tag : string, Mode : mode }
+
+type tag_query = sql_query [] [] [] [Id = int]
+
+fun addCondition (c : condition) (q : tag_query) : tag_query =
+    case c.Mode of
+        Present => (SELECT I.Id AS Id
+                    FROM ({{q}}) AS I
+                      JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
+      | Absent => (SELECT I.Id AS Id
+                   FROM ({{q}}) AS I
+                     LEFT JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]}
+                   WHERE tags.Tag IS NULL)
+
+fun withConditions (cs : list condition) : tag_query =
+    List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
+
+fun main (cs : list condition) : transaction page =
+    x <- queryX (withConditions cs) (fn r => <xml><li>{[r.Id]}</li></xml>);
+    return <xml><body>
+      {x}
+    </body></xml>
diff --git a/tests/tags.urp b/tests/tags.urp
new file mode 100644
index 0000000..b2f21c5
--- /dev/null
+++ b/tests/tags.urp
@@ -0,0 +1,6 @@
+database dbname=test
+sql tags.sql
+rewrite url Tags/*
+
+$/list
+tags
diff --git a/tests/tail.ur b/tests/tail.ur
new file mode 100644
index 0000000..84e0b7e
--- /dev/null
+++ b/tests/tail.ur
@@ -0,0 +1,24 @@
+fun one () = return 1
+
+fun addEm n =
+    if n = 0 then
+        return 0
+    else
+        n1 <- rpc (one ());
+        n2 <- addEm (n - 1);
+        return (n1 + n2)
+
+fun addEm' n acc =
+    if n = 0 then
+        return acc
+    else
+        n1 <- rpc (one ());
+        addEm' (n - 1) (n1 + acc)
+
+fun main () =
+    s <- source 0;
+    s' <- source 0;
+    return <xml><body onload={n <- addEm 3; set s n; n <- addEm' 4 0; set s' n; alert "Welcome!"}>
+      <dyn signal={n <- signal s; return (txt n)}/>
+      <dyn signal={n <- signal s'; return (txt n)}/>
+    </body></xml>
diff --git a/tests/tail.urp b/tests/tail.urp
new file mode 100644
index 0000000..5063c0b
--- /dev/null
+++ b/tests/tail.urp
@@ -0,0 +1,3 @@
+debug
+
+tail
diff --git a/tests/tail.urs b/tests/tail.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/tail.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/tbody.ur b/tests/tbody.ur
new file mode 100644
index 0000000..53bc029
--- /dev/null
+++ b/tests/tbody.ur
@@ -0,0 +1,13 @@
+fun main () : transaction page =
+    s <- source [];
+    entry <- source "";
+    return <xml><body>
+      <table>
+        <dyn signal={s <- signal s;
+                     return (List.mapX (fn s => <xml><tr><td>{[s]}</td></tr></xml>) s)}/>
+      </table>
+
+      Add one: <ctextbox source={entry}/> <button onclick={e <- get entry;
+                                                           v <- get s;
+                                                           set s (e :: v)}/>
+    </body></xml>
diff --git a/tests/tbody.urp b/tests/tbody.urp
new file mode 100644
index 0000000..4a264fb
--- /dev/null
+++ b/tests/tbody.urp
@@ -0,0 +1,4 @@
+debug
+
+$/list
+tbody
diff --git a/tests/tcrec.ur b/tests/tcrec.ur
new file mode 100644
index 0000000..3d3e6e6
--- /dev/null
+++ b/tests/tcrec.ur
@@ -0,0 +1,5 @@
+type r1 = {A : string, B : string}
+type r2 = {B : string, A : string}
+
+val show_r1 : show r1 = mkShow (fn r => r.A ^ "+" ^ r.B)
+val show_r2 : show r2 = _
diff --git a/tests/tcsimp.ur b/tests/tcsimp.ur
new file mode 100644
index 0000000..5e471e6
--- /dev/null
+++ b/tests/tcsimp.ur
@@ -0,0 +1,3 @@
+val x : $(mapU string [A, B]) = {A = "hi", B = "bye"}
+
+val y = show x
diff --git a/tests/termination.ur b/tests/termination.ur
new file mode 100644
index 0000000..64acd99
--- /dev/null
+++ b/tests/termination.ur
@@ -0,0 +1,28 @@
+datatype list a = Nil | Cons of a * list a
+
+fun isNil (t ::: Type) (ls : list t) : bool =
+        case ls of
+          Nil => True
+        | Cons _ => False
+
+fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, append ls1' ls2)
+
+fun appendR (t ::: Type) (ls2 : list t) (ls1 : list t) : list t =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, appendR ls2 ls1')
+
+(*fun naughty (t ::: Type) (ls : list t) : list t = naughty ls*)
+
+fun append1 (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, append2 ls2 ls1')
+
+and append2 (t ::: Type) (ls2 : list t) (ls1 : list t) : list t =
+        case ls1 of
+          Nil => ls2
+        | Cons (x, ls1') => Cons (x, append1 ls1' ls2)
diff --git a/tests/termination.urp b/tests/termination.urp
new file mode 100644
index 0000000..24df484
--- /dev/null
+++ b/tests/termination.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+termination
diff --git a/tests/test.c b/tests/test.c
new file mode 100644
index 0000000..ef8558d
--- /dev/null
+++ b/tests/test.c
@@ -0,0 +1,42 @@
+#include <stdio.h>
+
+#include "../include/urweb.h"
+
+typedef uw_Basis_string uw_Test_t;
+
+uw_Test_t uw_Test_create(uw_context ctx, uw_Basis_string s) {
+  return s;
+}
+
+uw_Basis_string uw_Test_out(uw_context ctx, uw_Test_t s) {
+  return s;
+}
+
+uw_Test_t uw_Test_frob(uw_context ctx, uw_Test_t s1, uw_Basis_string s2) {
+  return uw_Basis_strcat(ctx, s1, s2);
+}
+
+uw_Basis_unit uw_Test_print(uw_context ctx) {
+  printf("Hi there!\n");
+  return uw_unit_v;
+}
+
+uw_Basis_unit uw_Test_foo(uw_context ctx) {
+  printf("FOO!\n");
+  return uw_unit_v;
+}
+
+static void commit(void *data) {
+  printf("Commit: %s\n", data);
+}
+static void rollback(void *data) {
+  printf("Rollback: %s\n", data);
+}
+static void free(void *data) {
+  printf("Free: %s\n", data);
+}
+
+uw_Basis_unit uw_Test_transactional(uw_context ctx) {
+  uw_register_transactional(ctx, "Beppo", commit, rollback, free);
+  return uw_unit_v;
+}
diff --git a/tests/test.h b/tests/test.h
new file mode 100644
index 0000000..c0dec37
--- /dev/null
+++ b/tests/test.h
@@ -0,0 +1,12 @@
+#include "../include/urweb.h"
+
+typedef uw_Basis_string uw_Test_t;
+
+uw_Test_t uw_Test_create(uw_context, uw_Basis_string);
+uw_Basis_string uw_Test_out(uw_context, uw_Test_t);
+uw_Test_t uw_Test_frob(uw_context, uw_Test_t, uw_Basis_string);
+
+uw_Basis_unit uw_Test_print(uw_context);
+uw_Basis_unit uw_Test_foo(uw_context);
+
+uw_Basis_unit uw_Test_transactional(uw_context);
diff --git a/tests/test.js b/tests/test.js
new file mode 100644
index 0000000..4f29ca8
--- /dev/null
+++ b/tests/test.js
@@ -0,0 +1,7 @@
+function print() {
+  alert("Hi there!");
+}
+
+function bar(s) {
+  alert("<<" + s + ">>");
+}
diff --git a/tests/test.urs b/tests/test.urs
new file mode 100644
index 0000000..b4ca6fb
--- /dev/null
+++ b/tests/test.urs
@@ -0,0 +1,11 @@
+type t
+
+val create : string -> t
+val out : t -> string
+val frob : t -> string -> t
+val print : transaction unit
+
+val foo : transaction unit
+val bar : string -> transaction unit
+
+val transactional : transaction unit
diff --git a/tests/textarea.ur b/tests/textarea.ur
new file mode 100644
index 0000000..708c9b0
--- /dev/null
+++ b/tests/textarea.ur
@@ -0,0 +1,10 @@
+val handler = fn x => <html><body>
+        You entered: {cdata x.A}
+</body></html>
+
+val main = fn () => <html><body>
+        <lform>
+                <ltextarea{#A}/>
+                <submit action={handler}/>
+        </lform>
+</body></html>
diff --git a/tests/textarea_placeholder.ur b/tests/textarea_placeholder.ur
new file mode 100644
index 0000000..b328f83
--- /dev/null
+++ b/tests/textarea_placeholder.ur
@@ -0,0 +1,12 @@
+fun lame _ = return <xml/>
+
+fun main () =
+    s <- source "";
+    return <xml><body>
+      <form>
+        <textarea{#Text} placeholder="Type something here."/>
+        <submit action={lame}/>
+      </form>
+
+      <ctextarea source={s} placeholder="Absolutely don't type something here."/>
+    </body></xml>
diff --git a/tests/textarea_placeholder.urs b/tests/textarea_placeholder.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/textarea_placeholder.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/thead.ur b/tests/thead.ur
new file mode 100644
index 0000000..a977434
--- /dev/null
+++ b/tests/thead.ur
@@ -0,0 +1,16 @@
+fun main () : transaction page = return <xml><body>
+  <table>
+    <thead>
+      <tr> <th>A</th> <th>B</th> </tr>
+    </thead>
+
+    <tbody>
+      <tr> <td>1</td> <td>2</td> </tr>
+      <tr> <td>3</td> <td>4</td> </tr>
+    </tbody>
+
+    <tfoot>
+      <tr> <th>C</th> <th>D</th> </tr>
+    </tfoot>
+  </table>
+</body></xml>
diff --git a/tests/thog.ur b/tests/thog.ur
new file mode 100644
index 0000000..29e335f
--- /dev/null
+++ b/tests/thog.ur
@@ -0,0 +1,9 @@
+fun ack (m, n) =
+    if m = 0 then
+        n + 1
+    else if n = 0 then
+        ack (m - 1, 1)
+    else
+        ack (m - 1, ack (m, n - 1))
+
+fun main n = return <xml>{[ack (n, 4)]}</xml>
diff --git a/tests/thog.urp b/tests/thog.urp
new file mode 100644
index 0000000..e9e7e46
--- /dev/null
+++ b/tests/thog.urp
@@ -0,0 +1,2 @@
+$/list
+thog
diff --git a/tests/thog.urs b/tests/thog.urs
new file mode 100644
index 0000000..38b757e
--- /dev/null
+++ b/tests/thog.urs
@@ -0,0 +1 @@
+val main : int -> transaction page
diff --git a/tests/threads.ur b/tests/threads.ur
new file mode 100644
index 0000000..447b7a7
--- /dev/null
+++ b/tests/threads.ur
@@ -0,0 +1,18 @@
+fun main () =
+    buf <- Buffer.create;
+    let
+        fun loop1 () =
+            Buffer.write buf "A";
+            sleep 9;
+            loop1 ()
+
+        fun loop2 () =
+            Buffer.write buf "B";
+            sleep 9;
+            error <xml>Darn</xml>
+            loop2 ()
+    in
+        return <xml><body onload={spawn (loop1 ()); loop2 ()}>
+          <dyn signal={Buffer.render buf}/>
+        </body></xml>
+    end
diff --git a/tests/threads.urp b/tests/threads.urp
new file mode 100644
index 0000000..153e09a
--- /dev/null
+++ b/tests/threads.urp
@@ -0,0 +1,3 @@
+
+buffer
+threads
diff --git a/tests/threads.urs b/tests/threads.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/threads.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/time.ur b/tests/time.ur
new file mode 100644
index 0000000..8676c48
--- /dev/null
+++ b/tests/time.ur
@@ -0,0 +1,15 @@
+table t : { Id : int, Time : time }
+
+val now : time = readError "10/30/08 14:35:42"
+val later : time = readError "10/30/08 14:37:42"
+
+fun main () =
+    dml (INSERT INTO t (Id, Time) VALUES (42, {now}));
+    xml <- queryX (SELECT * FROM t)
+           (fn r => <xml>{[r.T.Id]}: {[r.T.Time]}<br/></xml>);
+    minMax <- oneRow (SELECT CURRENT_TIMESTAMP AS Cur, MIN(t.Time) AS Min, MAX(t.Time) AS Max FROM t);
+    return <xml><body>
+      {xml}
+      {[now]}, {[now = now]}, {[now = later]}, {[later < now]}, {[now < later]}<br/>
+      {[minMax.Cur]}, {[minMax.Min]}, {[minMax.Max]}
+    </body></xml>
diff --git a/tests/time.urp b/tests/time.urp
new file mode 100644
index 0000000..bfa87a0
--- /dev/null
+++ b/tests/time.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=time
+sql time.sql
+
+time
diff --git a/tests/time.urs b/tests/time.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/time.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/timeRoundTrip.ur b/tests/timeRoundTrip.ur
new file mode 100644
index 0000000..d20e61e
--- /dev/null
+++ b/tests/timeRoundTrip.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page =
+    t <- now;
+    return <xml>{[readError (show t) : time]}</xml>
diff --git a/tests/timef.ur b/tests/timef.ur
new file mode 100644
index 0000000..6ba6ccf
--- /dev/null
+++ b/tests/timef.ur
@@ -0,0 +1,12 @@
+fun main () : transaction page =
+    date <- source "2011/11/26 10:08:42";
+    format <- source "";
+    return <xml><body>
+      <ctextbox source={date}/>
+      <ctextbox source={format}/>
+      <dyn signal={d <- signal date;
+                   f <- signal format;
+                   return (case read d of
+                               None => <xml/>
+                             | Some d => <xml>{[timef f d]}</xml>)}/>
+    </body></xml>
diff --git a/tests/timeout.ur b/tests/timeout.ur
new file mode 100644
index 0000000..d96b42b
--- /dev/null
+++ b/tests/timeout.ur
@@ -0,0 +1,22 @@
+table listeners : { Ch : channel unit }
+
+fun ping () =
+    queryI1 (SELECT * FROM listeners)
+    (fn r => send r.Ch ())
+
+fun main () =
+    ch <- channel;
+    dml (INSERT INTO listeners(Ch) VALUES ({[ch]}));
+    count <- source 0;
+    return <xml><body onload={let
+                                  fun loop () =
+                                      _ <- recv ch;
+                                      c <- get count;
+                                      set count (c + 1);
+                                      loop ()
+                              in
+                                  loop ()
+                              end}>
+      <dyn signal={n <- signal count; return (txt n)}/>
+      <button onclick={fn _ => rpc (ping ())}>Ping</button>
+    </body></xml>
diff --git a/tests/timeout.urp b/tests/timeout.urp
new file mode 100644
index 0000000..6d3ca87
--- /dev/null
+++ b/tests/timeout.urp
@@ -0,0 +1,7 @@
+timeout 2
+rewrite url Timeout/*
+database dbname=test
+sql timeout.sql
+safeGet main
+
+timeout
diff --git a/tests/timeout.urs b/tests/timeout.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/timeout.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/timestamp.ur b/tests/timestamp.ur
new file mode 100644
index 0000000..56f030e
--- /dev/null
+++ b/tests/timestamp.ur
@@ -0,0 +1,11 @@
+table t : { A : time }
+
+fun many ls =
+    case ls of
+        [] => (WHERE TRUE)
+      | tm :: ls' => (WHERE t.A = {[tm]} AND {many ls'})
+
+task initialize = fn () =>
+                     tm <- now;
+                     dml (DELETE FROM t WHERE {many (tm :: [])})
+
diff --git a/tests/timestamp.urp b/tests/timestamp.urp
new file mode 100644
index 0000000..d07aa30
--- /dev/null
+++ b/tests/timestamp.urp
@@ -0,0 +1,5 @@
+database dbname=test
+dbms mysql
+sql timestamp.sql
+
+timestamp
diff --git a/tests/toString.ur b/tests/toString.ur
new file mode 100644
index 0000000..6a22fe6
--- /dev/null
+++ b/tests/toString.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <html><body>
+        6 = {cdata (show _ 6)}<br/>
+        12.34 = {cdata (show _ 12.34)}<br/>
+        Hi = {cdata (show _ "Hi")}<br/>
+        False = {cdata (show _ False)}<br/>
+</body></html>
diff --git a/tests/toString.urp b/tests/toString.urp
new file mode 100644
index 0000000..e29d34c
--- /dev/null
+++ b/tests/toString.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+toString
diff --git a/tests/topLevelPattern.ur b/tests/topLevelPattern.ur
new file mode 100644
index 0000000..e272c30
--- /dev/null
+++ b/tests/topLevelPattern.ur
@@ -0,0 +1,5 @@
+val (x, y) = (1, 2)
+
+fun main () : transaction page = return <xml>
+  {[x]} + {[y]} = {[x + y]}
+</xml>
diff --git a/tests/transact.ur b/tests/transact.ur
new file mode 100644
index 0000000..baf8ab9
--- /dev/null
+++ b/tests/transact.ur
@@ -0,0 +1,13 @@
+fun listHell n =
+    if n <= 0 then
+        []
+    else
+        n :: List.append (listHell (n-1)) (listHell (n-1))
+
+fun doit r =
+    Transactional.foo;
+    return <xml>{[listHell (readError r.N)]}</xml>
+
+fun main () = return <xml><body>
+  <form> <textbox{#N}/> <submit action={doit}/> </form>
+</body></xml>
diff --git a/tests/transact.urp b/tests/transact.urp
new file mode 100644
index 0000000..dcd8485
--- /dev/null
+++ b/tests/transact.urp
@@ -0,0 +1,5 @@
+library transactional
+rewrite all Transact/*
+
+$/list
+transact
diff --git a/tests/transact.urs b/tests/transact.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/transact.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/transactional.c b/tests/transactional.c
new file mode 100644
index 0000000..54e2687
--- /dev/null
+++ b/tests/transactional.c
@@ -0,0 +1,12 @@
+#include <stdio.h>
+
+#include "/usr/local/include/urweb/urweb.h"
+
+static void do_free(void *data, int will_retry) {
+  printf("will_retry = %d\n", will_retry);
+}
+
+uw_unit uw_Transactional_foo(uw_context ctx) {
+  printf("Registering....\n");
+  uw_register_transactional(ctx, NULL, NULL, NULL, do_free);
+}
diff --git a/tests/transactional.h b/tests/transactional.h
new file mode 100644
index 0000000..afb1532
--- /dev/null
+++ b/tests/transactional.h
@@ -0,0 +1,3 @@
+#include "/usr/local/include/urweb/types.h"
+
+uw_unit uw_Transactional_foo(uw_context);
diff --git a/tests/transactional.urp b/tests/transactional.urp
new file mode 100644
index 0000000..4ff1fea
--- /dev/null
+++ b/tests/transactional.urp
@@ -0,0 +1,4 @@
+ffi transactional
+include transactional.h
+link transactional.o
+effectful Transactional.foo
diff --git a/tests/transactional.urs b/tests/transactional.urs
new file mode 100644
index 0000000..8dea9bc
--- /dev/null
+++ b/tests/transactional.urs
@@ -0,0 +1 @@
+val foo : transaction {}
diff --git a/tests/treeDyn.ur b/tests/treeDyn.ur
new file mode 100644
index 0000000..1d58cca
--- /dev/null
+++ b/tests/treeDyn.ur
@@ -0,0 +1,18 @@
+table t : {Id : int, Parent : option int}
+
+fun recurse (root : option int) =
+    queryX' (SELECT * FROM t WHERE {eqNullable' (SQL t.Parent) root})
+            (fn r =>
+                children <- recurse (Some r.T.Id);
+                (*s <- source False;*)
+                return <xml>
+                  <dyn signal={(*v <- signal s;
+                               if v then*)
+                                   return <xml><b>HI</b>{children}<b>BYE</b></xml>
+                               (*else
+                                   return <xml/>*)}/>
+                </xml>)
+
+fun main () =
+    x <- recurse None;
+    return <xml><body>{x}</body></xml>
diff --git a/tests/treeDyn.urp b/tests/treeDyn.urp
new file mode 100644
index 0000000..231bad2
--- /dev/null
+++ b/tests/treeDyn.urp
@@ -0,0 +1,4 @@
+database dbname=treeDyn
+sql treeDyn.sql
+
+treeDyn
diff --git a/tests/treeDyn.urs b/tests/treeDyn.urs
new file mode 100644
index 0000000..901d6bf
--- /dev/null
+++ b/tests/treeDyn.urs
@@ -0,0 +1 @@
+val main : {} -> transaction page
diff --git a/tests/tryDml.ur b/tests/tryDml.ur
new file mode 100644
index 0000000..942cc1c
--- /dev/null
+++ b/tests/tryDml.ur
@@ -0,0 +1,15 @@
+table t : {Id : int}
+  PRIMARY KEY Id
+
+fun doStuff () =
+    dml (INSERT INTO t (Id) VALUES (0));
+    o1 <- tryDml (INSERT INTO t (Id) VALUES (0));
+    dml (INSERT INTO t (Id) VALUES (1));
+    o2 <- tryDml (INSERT INTO t (Id) VALUES (2));
+    dml (INSERT INTO t (Id) VALUES (3));
+    o3 <- tryDml (INSERT INTO t (Id) VALUES (3));
+    return <xml>{[o1]}; {[o2]}; {[o3]}</xml>
+
+fun main () = return <xml><body>
+  <form> <submit action={doStuff}/> </form>
+</body></xml>
diff --git a/tests/tryDml.urp b/tests/tryDml.urp
new file mode 100644
index 0000000..cf42105
--- /dev/null
+++ b/tests/tryDml.urp
@@ -0,0 +1,4 @@
+database dbname=trydml
+sql trydml.sql
+
+tryDml
diff --git a/tests/tryDml.urs b/tests/tryDml.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/tryDml.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/tryRpc.ur b/tests/tryRpc.ur
new file mode 100644
index 0000000..7a8d3a8
--- /dev/null
+++ b/tests/tryRpc.ur
@@ -0,0 +1,46 @@
+fun isBeppo (s : string) : transaction string =
+    case s of
+        "Beppo" => return "Yup, that's him!"
+      | "Mephisto" => error <xml>Great googely moogely!</xml>
+      | _ => return "Who's that?"
+
+fun listOf (n : int) =
+    if n < 0 then
+        error <xml>Negative!</xml>
+    else if n = 0 then
+        return []
+    else
+        ls <- listOf (n - 1);
+        return (n :: ls)
+
+fun length ls =
+    case ls of
+        [] => 0
+      | _ :: ls' => 1 + length ls'
+
+fun main () : transaction page =
+    s <- source "";
+    ns <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <button value="rpc" onclick={fn _ => v <- get s;
+                                      r <- rpc (isBeppo v);
+                                      alert r}/>
+      <button value="tryRpc" onclick={fn _ => v <- get s;
+                                         r <- tryRpc (isBeppo v);
+                                         case r of
+                                             None => alert "Faaaaaailure."
+                                           | Some r => alert ("Success: " ^ r)}/>
+
+      <hr/>
+
+      <ctextbox source={ns}/>
+      <button value="rpc" onclick={fn _ => v <- get ns;
+                                      r <- rpc (listOf (readError v));
+                                      alert (show (length r))}/>
+      <button value="tryRpc" onclick={fn _ => v <- get ns;
+                                         r <- tryRpc (listOf (readError v));
+                                         case r of
+                                             None => alert "Faaaaaailure."
+                                           | Some r => alert ("Success: " ^ show (length r))}/>
+    </body></xml>
diff --git a/tests/tsource.ur b/tests/tsource.ur
new file mode 100644
index 0000000..20cb486
--- /dev/null
+++ b/tests/tsource.ur
@@ -0,0 +1,28 @@
+fun doSubmit r =
+  return <xml>Done {[readError r.Amount1 * readError r.Amount2 * 2.0]}</xml>
+
+fun main () =
+  amount1S <- source "1";
+  amount2S <- source "1";
+  return <xml>  <body>
+   <form>
+      <table>
+        <tr><td>Amount1:</td><td><textbox{#Amount1}
+source={amount1S}/></td></tr>
+        <tr><td>Amount2:</td><td><textbox{#Amount2}
+source={amount2S}/></td></tr>
+        <tr><td>Total:</td><td><dyn signal={showTotal amount1S
+amount2S}/></td></tr>
+      </table>
+      <submit value="Buy" action={doSubmit}/>
+    </form>
+  </body>
+</xml>
+
+and showTotal amount1S amount2S =
+  a1 <- signal amount1S;
+  a2 <- signal amount2S;
+  return (case ((read a1), (read a2)) of
+           (None, _) => <xml></xml>
+         | (_, None) => <xml></xml>
+         | (Some a, Some b) => <xml>{[a * b * 2.0]}</xml>)
diff --git a/tests/tsource.urs b/tests/tsource.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/tsource.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/tuple.ur b/tests/tuple.ur
new file mode 100644
index 0000000..555cfd0
--- /dev/null
+++ b/tests/tuple.ur
@@ -0,0 +1,13 @@
+val x = (1, 2.0, "Hi")
+
+val x1 = x.1
+val x2 = x.2
+val x3 = x.3
+
+val y : int * float * string = x
+
+val bizarro_x = case x of (a, b, c) => (c, a, b)
+
+val main : unit -> page = fn () => <html><body>
+        {cdata bizarro_x.1}
+</body></html>
diff --git a/tests/tupleError.ur b/tests/tupleError.ur
new file mode 100644
index 0000000..d9b21ff
--- /dev/null
+++ b/tests/tupleError.ur
@@ -0,0 +1,3 @@
+fun f (x : int * float) : string = x
+fun g (x : int * float * bool) : string = x
+fun h (x : {A : int, B : float, C : bool}) : string = x
diff --git a/tests/twoArg.ur b/tests/twoArg.ur
new file mode 100644
index 0000000..bc2c81d
--- /dev/null
+++ b/tests/twoArg.ur
@@ -0,0 +1,3 @@
+fun main n s = return <xml>{[n]}, {[s]}</xml>
+
+val shadow = return <xml>You found me!</xml>
diff --git a/tests/twoArg.urp b/tests/twoArg.urp
new file mode 100644
index 0000000..88fb254
--- /dev/null
+++ b/tests/twoArg.urp
@@ -0,0 +1,3 @@
+debug
+
+twoArg
diff --git a/tests/twoArg.urs b/tests/twoArg.urs
new file mode 100644
index 0000000..9eb22be
--- /dev/null
+++ b/tests/twoArg.urs
@@ -0,0 +1,3 @@
+val main : int -> string -> transaction page
+
+val shadow : transaction page
diff --git a/tests/type_class.ur b/tests/type_class.ur
new file mode 100644
index 0000000..8c77bba
--- /dev/null
+++ b/tests/type_class.ur
@@ -0,0 +1,73 @@
+datatype pair a b = Pair of a * b
+
+structure M : sig
+    class default
+    val get : t ::: Type -> default t -> t
+
+    val string_default : default string
+    val int_default : default int
+
+    val option_default : t ::: Type -> default t -> default (option t)
+    val pair_default : a ::: Type -> b ::: Type -> default a -> default b -> default (pair a b)
+
+    (*val uh_oh : t ::: Type -> default t -> default t*)
+
+    class awesome
+    val awesome_default : t ::: Type -> awesome t -> default t
+
+    val float_awesome : awesome float
+
+    val oh_my : t ::: Type -> awesome (option t) -> awesome (option t)
+
+    val awesome : t ::: Type -> awesome t -> t
+end = struct
+    class default t = t
+    fun get (t ::: Type) (x : t) = x
+
+    val string_default = "Hi"
+    val int_default = 0
+
+    fun option_default (t ::: Type) (x : t) = Some x
+    fun pair_default (a ::: Type) (b ::: Type) (x : a) (y : b) = Pair (x, y)
+
+    (*fun uh_oh (t ::: Type) (x : t) = x*)
+
+    class awesome t = t
+    fun awesome_default (t ::: Type) (x : t) = x
+
+    val float_awesome = 1.23
+
+    fun oh_my (t ::: Type) (x : option t) = x
+
+    fun awesome (t ::: Type) (x : t) = x
+end
+
+open M
+
+fun default (t ::: Type) (_ : default t) : t = get
+val hi : string = default
+val zero : int = default
+val some_zero : option int = default
+val hi_zero : pair string int = default
+val ott : float = default
+
+fun frob (t ::: Type) (_ : default t) : t = default
+val hi_again : string = frob
+val zero_again : int = frob
+
+fun show_option (t ::: Type) (_ : show t) : show (option t) =
+    mkShow (fn x =>
+               case x of
+                   None => "None"
+                 | Some y => show y)
+
+(*val x : option float = awesome*)
+
+fun show_pair (a ::: Type) (b ::: Type) (_ : show a) (_ : show b) : show (pair a b) =
+    mkShow (fn x =>
+               case x of
+                   Pair (y, z) => "(" ^ show y ^ "," ^ show z ^ ")")
+
+fun main () : transaction page = return <xml><body>
+  {[hi_again]}, {[zero_again]}, {[some_zero]}, {[hi_zero]}, {[ott]}
+</body></xml>
diff --git a/tests/type_class.urp b/tests/type_class.urp
new file mode 100644
index 0000000..1a34662
--- /dev/null
+++ b/tests/type_class.urp
@@ -0,0 +1,3 @@
+debug
+
+type_class
diff --git a/tests/type_classMod.ur b/tests/type_classMod.ur
new file mode 100644
index 0000000..bcf03d1
--- /dev/null
+++ b/tests/type_classMod.ur
@@ -0,0 +1,18 @@
+structure M = struct
+        structure N = struct
+                class c t = t
+                val string_c : c string = "Hi"
+        end
+end
+
+val c : t :: Type -> M.N.c t -> t =
+        fn t :: Type => fn pf : M.N.c t => pf
+val hi = c [string] _
+
+val bool_c : M.N.c bool = True
+val true = c [bool] _
+val hi = c [string] _
+
+con c = M.N.c
+val int_c : c int = 0
+val zero = c [int] _
diff --git a/tests/type_classMod2.ur b/tests/type_classMod2.ur
new file mode 100644
index 0000000..ba700c2
--- /dev/null
+++ b/tests/type_classMod2.ur
@@ -0,0 +1,18 @@
+signature S = sig
+        class c
+        val default : t :: Type -> c t -> t
+
+        val string_c : c string
+        val int_c : c int
+end
+
+structure M : S = struct
+        class c t = t
+        val default = fn t :: Type => fn v : c t => v
+
+        val int_c : c int = 0
+        val string_c : c string = "Hi"
+end
+
+val hi = M.default [string] _
+val zero = M.default [int] _
diff --git a/tests/ubn.ur b/tests/ubn.ur
new file mode 100644
index 0000000..0bb50ba
--- /dev/null
+++ b/tests/ubn.ur
@@ -0,0 +1,8 @@
+con e = []
+structure B : sig
+end = struct
+end
+open B
+
+fun main () =
+ return <xml></xml>
diff --git a/tests/ubn.urs b/tests/ubn.urs
new file mode 100644
index 0000000..5ae8bfc
--- /dev/null
+++ b/tests/ubn.urs
@@ -0,0 +1,3 @@
+val main : unit -> transaction page
+con a = []
+con e = a
diff --git a/tests/unbound.ur b/tests/unbound.ur
new file mode 100644
index 0000000..3f508e5
--- /dev/null
+++ b/tests/unbound.ur
@@ -0,0 +1,3 @@
+structure M = struct end
+
+fun f (x : $M.r) : $([A = int] ++ M.r) = x
diff --git a/tests/undet.ur b/tests/undet.ur
new file mode 100644
index 0000000..7dba0ee
--- /dev/null
+++ b/tests/undet.ur
@@ -0,0 +1 @@
+fun main () : transaction _ = return <xml/>
diff --git a/tests/unif1.ur b/tests/unif1.ur
new file mode 100644
index 0000000..9dac9b3
--- /dev/null
+++ b/tests/unif1.ur
@@ -0,0 +1,3 @@
+fun g n = n + 1
+
+fun f x = x
diff --git a/tests/unpoly.ur b/tests/unpoly.ur
new file mode 100644
index 0000000..706f365
--- /dev/null
+++ b/tests/unpoly.ur
@@ -0,0 +1,28 @@
+val current = return (Some "1")
+fun resolve (_ : string) = return (Some "2")
+
+fun checkDeps deps =
+    u <- current;
+    List.foldlM (fn s (good, errs) =>
+                    v' <- resolve s;
+                    case v' of
+                        None =>
+                        return (False, <xml>
+                          {errs}
+                          Unknown library path <tt>{[s]}</tt>.<br/>
+                        </xml>)
+                      | Some v' =>
+                        b <- return True;
+                        if b then
+                            return (good, errs)
+                        else
+                            return (False, <xml>
+                              {errs}
+                              Access denied to <tt>{[s]}</tt>.<br/>
+                            </xml>)) (True, <xml/>) deps
+
+fun main () =
+    p <- checkDeps ("a" :: "b" :: []);
+    return <xml><body>
+      {p.2}
+    </body></xml>
diff --git a/tests/unpoly.urp b/tests/unpoly.urp
new file mode 100644
index 0000000..106bd20
--- /dev/null
+++ b/tests/unpoly.urp
@@ -0,0 +1,2 @@
+$/list
+unpoly
diff --git a/tests/unpoly.urs b/tests/unpoly.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/unpoly.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/unurlify.ur b/tests/unurlify.ur
new file mode 100644
index 0000000..bb3b1e0
--- /dev/null
+++ b/tests/unurlify.ur
@@ -0,0 +1,20 @@
+datatype list t = Nil | Cons of t * list t
+
+fun handler (ls : list bool) = return <xml/>
+
+datatype wlist = WNil | Empty | WCons of bool * wlist
+
+fun whandler' (ls : wlist) =
+    case ls of
+        WNil => <xml>Nil</xml>
+      | Empty => <xml>Empty</xml>
+      | WCons (x, ls') => <xml>{[x]} :: {whandler' ls'}</xml>
+
+fun whandler ls = return (whandler' ls)
+
+fun main () : transaction page = return <xml><body>
+  <a link={handler Nil}>!</a><br/>
+  <a link={whandler WNil}>Nil</a><br/>
+  <a link={whandler Empty}>Empty</a><br/>
+  <a link={whandler (WCons (True, WCons (False, Empty)))}>True :: False :: Empty</a><br/>
+</body></xml>
diff --git a/tests/unurlify.urp b/tests/unurlify.urp
new file mode 100644
index 0000000..d1e2b8e
--- /dev/null
+++ b/tests/unurlify.urp
@@ -0,0 +1,3 @@
+debug
+
+unurlify
diff --git a/tests/update.ur b/tests/update.ur
new file mode 100644
index 0000000..6d8060d
--- /dev/null
+++ b/tests/update.ur
@@ -0,0 +1,5 @@
+table t1 : {A : int, B : string, C : float, D : bool}
+
+fun main () : transaction page =
+        () <- dml (UPDATE t1 SET B = 'Hi', C = 12.34 WHERE A = 5);
+        return <html><body>Updated.</body></html>
diff --git a/tests/update.urp b/tests/update.urp
new file mode 100644
index 0000000..7a249b8
--- /dev/null
+++ b/tests/update.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+update
diff --git a/tests/updateErr.ur b/tests/updateErr.ur
new file mode 100644
index 0000000..d15f27a
--- /dev/null
+++ b/tests/updateErr.ur
@@ -0,0 +1,18 @@
+fun main () : transaction page =
+    s <- source "";
+    b <- Buffer.create;
+    txt <- source "";
+
+    return <xml><body onload={onError (fn xml => Buffer.write b (show xml));
+                              onFail (fn s => alert ("FAIL! " ^ s))}>
+      <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/><br/>
+      <dyn signal={s <- signal s; if s = "" then return <xml>Init</xml> else error <xml>Crapky</xml>}/><br/>
+      <dyn signal={s <- signal s; return <xml>"{[s]}"</xml>}/><br/>
+      <button onclick={fn _ => debug "88"}/><br/>
+
+      <ctextbox source={txt}/> <button onclick={fn _ => s' <- get txt; set s s'; set txt ""}/>
+
+      <hr/>
+
+      <dyn signal={Buffer.render b}/>
+    </body></xml>
diff --git a/tests/updateErr.urp b/tests/updateErr.urp
new file mode 100644
index 0000000..80d8200
--- /dev/null
+++ b/tests/updateErr.urp
@@ -0,0 +1,4 @@
+debug
+
+buffer
+updateErr
diff --git a/tests/urblog.ur b/tests/urblog.ur
new file mode 100644
index 0000000..9e3cc27
--- /dev/null
+++ b/tests/urblog.ur
@@ -0,0 +1,35 @@
+table entry : { Id : int, Title : string, Created : time, Author : string,
+Body : string }
+  PRIMARY KEY Id
+
+fun list () =
+    rows <- queryX (SELECT * FROM entry)
+            (fn row => 
+				<xml>
+					<div>
+						<h1>{[row.Entry.Title]}</h1><br />
+							<h2>By {[row.Entry.Author]} at {[row.Entry.Created]}</h2>
+						<p>{[row.Entry.Body]}</p>
+					</div>
+				</xml>
+            );
+    return 
+	 	<xml>
+		  <head>
+				<title>All Entries</title>
+		  </head>
+		  <body>
+			<h1>All Entries</h1>
+        {rows}
+		  </body>
+    	</xml>
+
+fun main () = return <xml>
+  <head>
+    <title>UrBlog</title>
+  </head>
+
+  <body>
+    <h1>UrBlog</h1>
+  </body>
+</xml>
diff --git a/tests/urblog.urp b/tests/urblog.urp
new file mode 100644
index 0000000..08f0d65
--- /dev/null
+++ b/tests/urblog.urp
@@ -0,0 +1,4 @@
+database dbname=urblog
+sql urblog.sql
+
+urblog
diff --git a/tests/urblog.urs b/tests/urblog.urs
new file mode 100644
index 0000000..febad7b
--- /dev/null
+++ b/tests/urblog.urs
@@ -0,0 +1,2 @@
+val list : unit -> transaction page
+val main : unit -> transaction page
diff --git a/tests/url.ur b/tests/url.ur
new file mode 100644
index 0000000..ea23650
--- /dev/null
+++ b/tests/url.ur
@@ -0,0 +1,12 @@
+fun readersChoice r = return <xml><body>
+  {case checkUrl r.Url of
+       None => <xml>I can't do that, Dave.</xml>
+     | Some url => <xml><a href={url}>Your pick, boss</a></xml>}
+</body></xml>
+
+fun main () : transaction page = return <xml><body>
+  <a href="http://en.wikipedia.org/wiki/Wikipedia:About">Learn</a>
+  <br/>
+
+  <form><textbox{#Url}/> <submit action={readersChoice}/></form>
+</body></xml>
diff --git a/tests/url.urp b/tests/url.urp
new file mode 100644
index 0000000..aaa8490
--- /dev/null
+++ b/tests/url.urp
@@ -0,0 +1,5 @@
+debug
+deny url http://en.wikipedia.org/wiki/Perl
+allow url http://en.wikipedia.org/*
+
+url
diff --git a/tests/url.urs b/tests/url.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/url.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/urlifyVariant.ur b/tests/urlifyVariant.ur
new file mode 100644
index 0000000..aba162d
--- /dev/null
+++ b/tests/urlifyVariant.ur
@@ -0,0 +1,5 @@
+datatype t = T of variant [A = t]
+
+fun main (x : t) : transaction page = return <xml><body>
+  <a link={main x}>Go</a>
+</body></xml>
diff --git a/tests/user.ur b/tests/user.ur
new file mode 100644
index 0000000..c36fe40
--- /dev/null
+++ b/tests/user.ur
@@ -0,0 +1,5 @@
+table user : {A : int}
+
+fun main () =
+    r <- oneRow (SELECT COUNT( * ) AS N FROM user);
+    return <xml>{[r.N]}</xml>
diff --git a/tests/user.urp b/tests/user.urp
new file mode 100644
index 0000000..bbbc435
--- /dev/null
+++ b/tests/user.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=udb
+sql user.sql
+
+user
diff --git a/tests/user.urs b/tests/user.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/user.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/view.ur b/tests/view.ur
new file mode 100644
index 0000000..36d77de
--- /dev/null
+++ b/tests/view.ur
@@ -0,0 +1,10 @@
+table t : { A : int, B : string }
+
+view v = SELECT t.A AS X FROM t
+
+fun main () =
+    rows <- queryX (SELECT * FROM v)
+            (fn r => <xml><li>{[r.V.X]}</li></xml>);
+    return <xml><body>
+      {rows}
+    </body></xml>
diff --git a/tests/view.urp b/tests/view.urp
new file mode 100644
index 0000000..3528ec9
--- /dev/null
+++ b/tests/view.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=view
+sql view.sql
+
+view
diff --git a/tests/view.urs b/tests/view.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/view.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/vlad1.ur b/tests/vlad1.ur
new file mode 100644
index 0000000..4576f48
--- /dev/null
+++ b/tests/vlad1.ur
@@ -0,0 +1,5 @@
+fun row (label : string) : xbody = <xml>
+ {[label]}
+</xml>
+fun main () = return (row "asdf")
+
diff --git a/tests/vlad1.urp b/tests/vlad1.urp
new file mode 100644
index 0000000..f06af95
--- /dev/null
+++ b/tests/vlad1.urp
@@ -0,0 +1,2 @@
+
+vlad1
diff --git a/tests/vlad1.urs b/tests/vlad1.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/vlad1.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/vlad2.ur b/tests/vlad2.ur
new file mode 100644
index 0000000..b4f573d
--- /dev/null
+++ b/tests/vlad2.ur
@@ -0,0 +1,3 @@
+fun main () = return <xml><body><table>
+ <tr> <td align="right">#</td> <td>123</td> </tr>
+</table></body></xml>
diff --git a/tests/vlad2.urp b/tests/vlad2.urp
new file mode 100644
index 0000000..c18469d
--- /dev/null
+++ b/tests/vlad2.urp
@@ -0,0 +1,2 @@
+
+vlad2
diff --git a/tests/vlad2.urs b/tests/vlad2.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/vlad2.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/vlad3.ur b/tests/vlad3.ur
new file mode 100644
index 0000000..3d1e812
--- /dev/null
+++ b/tests/vlad3.ur
@@ -0,0 +1,27 @@
+cookie user : {EMail : string}
+
+fun main () =
+    ro <- getCookie user;
+    case ro of
+        Some u => welcome u
+      | _ => login ()
+
+and welcome u = return <xml><body>
+  Welcome {[u.EMail]}. <a link={logout ()}>Logout</a>
+</body></xml>
+
+and logout () =
+    clearCookie user;
+    main ()
+
+and login () = return <xml><body>
+  <form>E-mail:<textbox{#EMail}/><submit action={signin}/></form>
+</body></xml>
+   
+and signin r =
+    setCookie user {Value = {EMail = r.EMail},
+                    Expires = None, (* Some (readError "2012-11-6
+00:00:00"), *)
+                    Secure = False
+                   };
+    main ()
diff --git a/tests/vlad3.urp b/tests/vlad3.urp
new file mode 100644
index 0000000..3a0fa1f
--- /dev/null
+++ b/tests/vlad3.urp
@@ -0,0 +1,2 @@
+
+vlad3
diff --git a/tests/vlad3.urs b/tests/vlad3.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/vlad3.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/tests/vlad4.ur b/tests/vlad4.ur
new file mode 100644
index 0000000..d2bd14e
--- /dev/null
+++ b/tests/vlad4.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+    s <- source "";
+    return <xml><body>
+      <ctextbox source={s} value="123" onchange={s <- get s; alert (s ^ "!")}/>
+      <dyn signal={s <- signal s; return (txt s)}/>
+    </body></xml>
diff --git a/tests/wackyunif.ur b/tests/wackyunif.ur
new file mode 100644
index 0000000..2a215e6
--- /dev/null
+++ b/tests/wackyunif.ur
@@ -0,0 +1,2 @@
+val concatX [ctx] [use] : _ -> _ ctx use _ =
+    List.foldl join <xml/>
diff --git a/tests/wackyunif.urp b/tests/wackyunif.urp
new file mode 100644
index 0000000..35791ac
--- /dev/null
+++ b/tests/wackyunif.urp
@@ -0,0 +1,2 @@
+$/list
+wackyunif
diff --git a/tests/web.png b/tests/web.png
new file mode 100644
index 0000000..1754806
--- /dev/null
+++ b/tests/web.png
diff --git a/tests/where.ur b/tests/where.ur
new file mode 100644
index 0000000..55381ca
--- /dev/null
+++ b/tests/where.ur
@@ -0,0 +1,30 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1)
+val q2 = (SELECT * FROM t1 WHERE TRUE)
+val q3 = (SELECT * FROM t1 WHERE FALSE)
+val q4 = (SELECT * FROM t1 WHERE {True})
+val q5 = (SELECT * FROM t1 WHERE {1} = {1})
+val q6 = (SELECT * FROM t1 WHERE {"Hi"} < {"Bye"})
+val q7 = (SELECT * FROM t1 WHERE {1} = {1} AND NOT ({"Hi"} <= {"Bye"}))
+val q8 = (SELECT * FROM t1 WHERE t1.A = 1 OR t1.C < 3.0)
+
+datatype list a = Nil | Cons of a * list a
+
+val r1 : transaction (list {A : int, B : string, C : float}) =
+        query q7
+        (fn fs acc => return (Cons (fs.T1, acc)))
+        Nil
+
+val r2 : transaction string =
+        ls <- r1;
+        return (case ls of
+                    Nil => "Problem"
+                  | Cons ({B = b, ...}, _) => b)
+
+val main : unit -> transaction page = fn () =>
+        s <- r2;
+        return <html><body>
+                {cdata s}
+        </body></html>
diff --git a/tests/where.urp b/tests/where.urp
new file mode 100644
index 0000000..aa496f4
--- /dev/null
+++ b/tests/where.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+exe /tmp/webapp
+sql /tmp/urweb.sql
+
+where
diff --git a/tests/whiteout.ur b/tests/whiteout.ur
new file mode 100644
index 0000000..5fb9d57
--- /dev/null
+++ b/tests/whiteout.ur
@@ -0,0 +1,6 @@
+table t : { Chan : option (channel unit) }
+
+fun main () : transaction page =
+    ch <- channel;
+    dml (INSERT INTO t (Chan) VALUES ({[Some ch]}));
+    return <xml><body>Did it.</body></xml>
diff --git a/tests/whiteout.urp b/tests/whiteout.urp
new file mode 100644
index 0000000..a8c3d0a
--- /dev/null
+++ b/tests/whiteout.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=whiteout
+sql whiteout.sql
+timeout 5
+
+whiteout
diff --git a/tests/wildify.ur b/tests/wildify.ur
new file mode 100644
index 0000000..8f64e1f
--- /dev/null
+++ b/tests/wildify.ur
@@ -0,0 +1,25 @@
+signature S = sig
+    type t
+    val x : t
+end
+
+signature T = sig
+    structure M : S
+
+    type u
+    val y : u
+
+    structure N : S
+end
+
+structure M : T = struct
+    structure M = struct
+        val x = True
+    end
+
+    val y = 0
+
+    structure N = struct
+        val x = "hi"
+    end
+end
diff --git a/tests/wildify.urp b/tests/wildify.urp
new file mode 100644
index 0000000..0969334
--- /dev/null
+++ b/tests/wildify.urp
@@ -0,0 +1 @@
+wildify
diff --git a/tests/window.ur b/tests/window.ur
new file mode 100644
index 0000000..c0eaf6e
--- /dev/null
+++ b/tests/window.ur
@@ -0,0 +1,13 @@
+table empsalary : { Depname : string,
+                    Empno : int,
+                    Salary : int }
+
+fun main () : transaction page =
+    x <- queryX (SELECT empsalary.Depname, empsalary.Empno, empsalary.Salary,
+                   RANK() OVER (PARTITION BY empsalary.Depname ORDER BY empsalary.Salary DESC) AS R,
+                   AVG(empsalary.Salary) OVER (PARTITION BY empsalary.Depname) AS A
+                 FROM empsalary)
+                (fn r => <xml>{[r.Empsalary.Depname]}, {[r.Empsalary.Empno]}, {[r.Empsalary.Salary]}, {[r.R]}, {[r.A]}<br/></xml>);
+    return <xml><body>
+      {x}
+    </body></xml>
diff --git a/tests/window.urp b/tests/window.urp
new file mode 100644
index 0000000..d1fb21a
--- /dev/null
+++ b/tests/window.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+sql window.sql
+rewrite url Window/*
+
+window
diff --git a/tests/with.ur b/tests/with.ur
new file mode 100644
index 0000000..458153b
--- /dev/null
+++ b/tests/with.ur
@@ -0,0 +1,5 @@
+val r = ({A = 1, B = 2} with #C = "Hi") with #D = "Bye"
+
+fun main () : transaction page = return <html><body>
+        {cdata r.C}, {cdata r.D}
+</body></html>
diff --git a/tests/with.urp b/tests/with.urp
new file mode 100644
index 0000000..9e1e7fb
--- /dev/null
+++ b/tests/with.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+with
diff --git a/tests/xcomments.ur b/tests/xcomments.ur
new file mode 100644
index 0000000..83608ff
--- /dev/null
+++ b/tests/xcomments.ur
@@ -0,0 +1,10 @@
+fun foo () = <xml>Hi!</xml>
+
+(* fun bar () = return (* No *)<xml>Yes!</xml> *)
+
+fun main () = return <xml><body>
+  A (* B *) C (* D (* E *) F *) D<br/>
+  <b>A</b> <i>(* B *) C <b>D (* E <!-- 7 --> *) F {foo ()}</b></i>
+  A <!-- B --> C <!-- D (* E *) F --> D<br/>
+  <b>A</b> <i><!-- B --> C <b>D <!-- E --> F {foo ()}</b></i>
+</body></xml>
diff --git a/tests/xcomments.urp b/tests/xcomments.urp
new file mode 100644
index 0000000..1a0c34f
--- /dev/null
+++ b/tests/xcomments.urp
@@ -0,0 +1 @@
+xcomments
diff --git a/tests/xcomments.urs b/tests/xcomments.urs
new file mode 100644
index 0000000..6ac44e0
--- /dev/null
+++ b/tests/xcomments.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/urweb.ebuild b/urweb.ebuild
new file mode 100644
index 0000000..750e0db
--- /dev/null
+++ b/urweb.ebuild
@@ -0,0 +1,39 @@
+# Distributed under the terms of the BSD3 license
+
+# This file needs to be renamed to something like "urweb-20110917.ebuild", to reflect the Ur/Web version to use.
+
+inherit eutils
+
+EAPI=3
+
+DESCRIPTION="A domain-specific functional programming language for modern web applications"
+HOMEPAGE="http://www.impredicative.com/ur/"
+SRC_URI="http://www.impredicative.com/ur/${P}.tgz"
+
+LICENSE="BSD"
+SLOT="0"
+KEYWORDS="~amd64 ~x86"
+IUSE=""
+
+DEPEND="dev-lang/mlton
+	dev-libs/openssl"
+RDEPEND="${DEPEND}"
+
+S="${WORKDIR}/urweb"
+
+src_unpack() {
+	unpack ${A}
+}
+
+src_configure() {
+	econf || die
+}
+
+src_compile() {
+	emake || die
+}
+
+src_install() {
+	emake DESTDIR=${D} install || die
+	dodoc CHANGELOG || die
+}
diff --git a/xml/parse.sml b/xml/parse.sml
new file mode 100644
index 0000000..2125601
--- /dev/null
+++ b/xml/parse.sml
@@ -0,0 +1,75 @@
+(* Copyright (c) 2011, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Building SML code from XML entity tables *)
+
+fun main () =
+    let
+        fun doFile fname =
+            let
+                val inf = TextIO.openIn fname
+
+                fun loop () =
+                    case TextIO.inputLine inf of
+                        NONE => TextIO.closeIn inf
+                      | SOME line =>
+                        if String.isPrefix "<!ENTITY " line then
+                            case String.tokens (fn ch => Char.isSpace ch orelse ch = #">") line of
+                                "<!ENTITY" :: ent :: exp :: _ =>
+                                let
+                                    val exp = if String.isPrefix "\"&#" exp andalso String.isSuffix ";\"" exp then
+                                                  let
+                                                      val middle = String.substring (exp, 3, size exp - 5)
+                                                  in
+                                                      if CharVector.all Char.isDigit middle then
+                                                          middle
+                                                      else if String.isPrefix "38;#" middle then
+                                                          String.extract (middle, 4, NONE)
+                                                      else
+                                                          raise Fail "Bad entity expression [1]"
+                                                  end
+                                              else
+                                                  raise Fail "Bad entity expansion [2]"
+                                in
+                                    print ("\t\t(\"" ^ ent ^ "\", " ^ exp ^ ") ::\n");
+                                    loop ()
+                                end
+                              | _ => raise Fail "Bad ENTITY line"
+                        else
+                            loop ()
+            in
+                loop ()
+            end
+    in
+        print "structure Entities = struct\n";
+        print "\tval all =\n";
+        app doFile (CommandLine.arguments ());
+        print "\t[]\n";
+        print "end\n"
+    end
+
+val () = main ()
diff --git a/xml/xhtml-lat1.ent b/xml/xhtml-lat1.ent
new file mode 100644
index 0000000..ffee223
--- /dev/null
+++ b/xml/xhtml-lat1.ent
@@ -0,0 +1,196 @@
+<!-- Portions (C) International Organization for Standardization 1986
+     Permission to copy in any form is granted for use with
+     conforming SGML systems and applications as defined in
+     ISO 8879, provided this notice is included in all copies.
+-->
+<!-- Character entity set. Typical invocation:
+    <!ENTITY % HTMLlat1 PUBLIC
+       "-//W3C//ENTITIES Latin 1 for XHTML//EN"
+       "http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent">
+    %HTMLlat1;
+-->
+
+<!ENTITY nbsp   "&#160;"> <!-- no-break space = non-breaking space,
+                                  U+00A0 ISOnum -->
+<!ENTITY iexcl  "&#161;"> <!-- inverted exclamation mark, U+00A1 ISOnum -->
+<!ENTITY cent   "&#162;"> <!-- cent sign, U+00A2 ISOnum -->
+<!ENTITY pound  "&#163;"> <!-- pound sign, U+00A3 ISOnum -->
+<!ENTITY curren "&#164;"> <!-- currency sign, U+00A4 ISOnum -->
+<!ENTITY yen    "&#165;"> <!-- yen sign = yuan sign, U+00A5 ISOnum -->
+<!ENTITY brvbar "&#166;"> <!-- broken bar = broken vertical bar,
+                                  U+00A6 ISOnum -->
+<!ENTITY sect   "&#167;"> <!-- section sign, U+00A7 ISOnum -->
+<!ENTITY uml    "&#168;"> <!-- diaeresis = spacing diaeresis,
+                                  U+00A8 ISOdia -->
+<!ENTITY copy   "&#169;"> <!-- copyright sign, U+00A9 ISOnum -->
+<!ENTITY ordf   "&#170;"> <!-- feminine ordinal indicator, U+00AA ISOnum -->
+<!ENTITY laquo  "&#171;"> <!-- left-pointing double angle quotation mark
+                                  = left pointing guillemet, U+00AB ISOnum -->
+<!ENTITY not    "&#172;"> <!-- not sign = angled dash,
+                                  U+00AC ISOnum -->
+<!ENTITY shy    "&#173;"> <!-- soft hyphen = discretionary hyphen,
+                                  U+00AD ISOnum -->
+<!ENTITY reg    "&#174;"> <!-- registered sign = registered trade mark sign,
+                                  U+00AE ISOnum -->
+<!ENTITY macr   "&#175;"> <!-- macron = spacing macron = overline
+                                  = APL overbar, U+00AF ISOdia -->
+<!ENTITY deg    "&#176;"> <!-- degree sign, U+00B0 ISOnum -->
+<!ENTITY plusmn "&#177;"> <!-- plus-minus sign = plus-or-minus sign,
+                                  U+00B1 ISOnum -->
+<!ENTITY sup2   "&#178;"> <!-- superscript two = superscript digit two
+                                  = squared, U+00B2 ISOnum -->
+<!ENTITY sup3   "&#179;"> <!-- superscript three = superscript digit three
+                                  = cubed, U+00B3 ISOnum -->
+<!ENTITY acute  "&#180;"> <!-- acute accent = spacing acute,
+                                  U+00B4 ISOdia -->
+<!ENTITY micro  "&#181;"> <!-- micro sign, U+00B5 ISOnum -->
+<!ENTITY para   "&#182;"> <!-- pilcrow sign = paragraph sign,
+                                  U+00B6 ISOnum -->
+<!ENTITY middot "&#183;"> <!-- middle dot = Georgian comma
+                                  = Greek middle dot, U+00B7 ISOnum -->
+<!ENTITY cedil  "&#184;"> <!-- cedilla = spacing cedilla, U+00B8 ISOdia -->
+<!ENTITY sup1   "&#185;"> <!-- superscript one = superscript digit one,
+                                  U+00B9 ISOnum -->
+<!ENTITY ordm   "&#186;"> <!-- masculine ordinal indicator,
+                                  U+00BA ISOnum -->
+<!ENTITY raquo  "&#187;"> <!-- right-pointing double angle quotation mark
+                                  = right pointing guillemet, U+00BB ISOnum -->
+<!ENTITY frac14 "&#188;"> <!-- vulgar fraction one quarter
+                                  = fraction one quarter, U+00BC ISOnum -->
+<!ENTITY frac12 "&#189;"> <!-- vulgar fraction one half
+                                  = fraction one half, U+00BD ISOnum -->
+<!ENTITY frac34 "&#190;"> <!-- vulgar fraction three quarters
+                                  = fraction three quarters, U+00BE ISOnum -->
+<!ENTITY iquest "&#191;"> <!-- inverted question mark
+                                  = turned question mark, U+00BF ISOnum -->
+<!ENTITY Agrave "&#192;"> <!-- latin capital letter A with grave
+                                  = latin capital letter A grave,
+                                  U+00C0 ISOlat1 -->
+<!ENTITY Aacute "&#193;"> <!-- latin capital letter A with acute,
+                                  U+00C1 ISOlat1 -->
+<!ENTITY Acirc  "&#194;"> <!-- latin capital letter A with circumflex,
+                                  U+00C2 ISOlat1 -->
+<!ENTITY Atilde "&#195;"> <!-- latin capital letter A with tilde,
+                                  U+00C3 ISOlat1 -->
+<!ENTITY Auml   "&#196;"> <!-- latin capital letter A with diaeresis,
+                                  U+00C4 ISOlat1 -->
+<!ENTITY Aring  "&#197;"> <!-- latin capital letter A with ring above
+                                  = latin capital letter A ring,
+                                  U+00C5 ISOlat1 -->
+<!ENTITY AElig  "&#198;"> <!-- latin capital letter AE
+                                  = latin capital ligature AE,
+                                  U+00C6 ISOlat1 -->
+<!ENTITY Ccedil "&#199;"> <!-- latin capital letter C with cedilla,
+                                  U+00C7 ISOlat1 -->
+<!ENTITY Egrave "&#200;"> <!-- latin capital letter E with grave,
+                                  U+00C8 ISOlat1 -->
+<!ENTITY Eacute "&#201;"> <!-- latin capital letter E with acute,
+                                  U+00C9 ISOlat1 -->
+<!ENTITY Ecirc  "&#202;"> <!-- latin capital letter E with circumflex,
+                                  U+00CA ISOlat1 -->
+<!ENTITY Euml   "&#203;"> <!-- latin capital letter E with diaeresis,
+                                  U+00CB ISOlat1 -->
+<!ENTITY Igrave "&#204;"> <!-- latin capital letter I with grave,
+                                  U+00CC ISOlat1 -->
+<!ENTITY Iacute "&#205;"> <!-- latin capital letter I with acute,
+                                  U+00CD ISOlat1 -->
+<!ENTITY Icirc  "&#206;"> <!-- latin capital letter I with circumflex,
+                                  U+00CE ISOlat1 -->
+<!ENTITY Iuml   "&#207;"> <!-- latin capital letter I with diaeresis,
+                                  U+00CF ISOlat1 -->
+<!ENTITY ETH    "&#208;"> <!-- latin capital letter ETH, U+00D0 ISOlat1 -->
+<!ENTITY Ntilde "&#209;"> <!-- latin capital letter N with tilde,
+                                  U+00D1 ISOlat1 -->
+<!ENTITY Ograve "&#210;"> <!-- latin capital letter O with grave,
+                                  U+00D2 ISOlat1 -->
+<!ENTITY Oacute "&#211;"> <!-- latin capital letter O with acute,
+                                  U+00D3 ISOlat1 -->
+<!ENTITY Ocirc  "&#212;"> <!-- latin capital letter O with circumflex,
+                                  U+00D4 ISOlat1 -->
+<!ENTITY Otilde "&#213;"> <!-- latin capital letter O with tilde,
+                                  U+00D5 ISOlat1 -->
+<!ENTITY Ouml   "&#214;"> <!-- latin capital letter O with diaeresis,
+                                  U+00D6 ISOlat1 -->
+<!ENTITY times  "&#215;"> <!-- multiplication sign, U+00D7 ISOnum -->
+<!ENTITY Oslash "&#216;"> <!-- latin capital letter O with stroke
+                                  = latin capital letter O slash,
+                                  U+00D8 ISOlat1 -->
+<!ENTITY Ugrave "&#217;"> <!-- latin capital letter U with grave,
+                                  U+00D9 ISOlat1 -->
+<!ENTITY Uacute "&#218;"> <!-- latin capital letter U with acute,
+                                  U+00DA ISOlat1 -->
+<!ENTITY Ucirc  "&#219;"> <!-- latin capital letter U with circumflex,
+                                  U+00DB ISOlat1 -->
+<!ENTITY Uuml   "&#220;"> <!-- latin capital letter U with diaeresis,
+                                  U+00DC ISOlat1 -->
+<!ENTITY Yacute "&#221;"> <!-- latin capital letter Y with acute,
+                                  U+00DD ISOlat1 -->
+<!ENTITY THORN  "&#222;"> <!-- latin capital letter THORN,
+                                  U+00DE ISOlat1 -->
+<!ENTITY szlig  "&#223;"> <!-- latin small letter sharp s = ess-zed,
+                                  U+00DF ISOlat1 -->
+<!ENTITY agrave "&#224;"> <!-- latin small letter a with grave
+                                  = latin small letter a grave,
+                                  U+00E0 ISOlat1 -->
+<!ENTITY aacute "&#225;"> <!-- latin small letter a with acute,
+                                  U+00E1 ISOlat1 -->
+<!ENTITY acirc  "&#226;"> <!-- latin small letter a with circumflex,
+                                  U+00E2 ISOlat1 -->
+<!ENTITY atilde "&#227;"> <!-- latin small letter a with tilde,
+                                  U+00E3 ISOlat1 -->
+<!ENTITY auml   "&#228;"> <!-- latin small letter a with diaeresis,
+                                  U+00E4 ISOlat1 -->
+<!ENTITY aring  "&#229;"> <!-- latin small letter a with ring above
+                                  = latin small letter a ring,
+                                  U+00E5 ISOlat1 -->
+<!ENTITY aelig  "&#230;"> <!-- latin small letter ae
+                                  = latin small ligature ae, U+00E6 ISOlat1 -->
+<!ENTITY ccedil "&#231;"> <!-- latin small letter c with cedilla,
+                                  U+00E7 ISOlat1 -->
+<!ENTITY egrave "&#232;"> <!-- latin small letter e with grave,
+                                  U+00E8 ISOlat1 -->
+<!ENTITY eacute "&#233;"> <!-- latin small letter e with acute,
+                                  U+00E9 ISOlat1 -->
+<!ENTITY ecirc  "&#234;"> <!-- latin small letter e with circumflex,
+                                  U+00EA ISOlat1 -->
+<!ENTITY euml   "&#235;"> <!-- latin small letter e with diaeresis,
+                                  U+00EB ISOlat1 -->
+<!ENTITY igrave "&#236;"> <!-- latin small letter i with grave,
+                                  U+00EC ISOlat1 -->
+<!ENTITY iacute "&#237;"> <!-- latin small letter i with acute,
+                                  U+00ED ISOlat1 -->
+<!ENTITY icirc  "&#238;"> <!-- latin small letter i with circumflex,
+                                  U+00EE ISOlat1 -->
+<!ENTITY iuml   "&#239;"> <!-- latin small letter i with diaeresis,
+                                  U+00EF ISOlat1 -->
+<!ENTITY eth    "&#240;"> <!-- latin small letter eth, U+00F0 ISOlat1 -->
+<!ENTITY ntilde "&#241;"> <!-- latin small letter n with tilde,
+                                  U+00F1 ISOlat1 -->
+<!ENTITY ograve "&#242;"> <!-- latin small letter o with grave,
+                                  U+00F2 ISOlat1 -->
+<!ENTITY oacute "&#243;"> <!-- latin small letter o with acute,
+                                  U+00F3 ISOlat1 -->
+<!ENTITY ocirc  "&#244;"> <!-- latin small letter o with circumflex,
+                                  U+00F4 ISOlat1 -->
+<!ENTITY otilde "&#245;"> <!-- latin small letter o with tilde,
+                                  U+00F5 ISOlat1 -->
+<!ENTITY ouml   "&#246;"> <!-- latin small letter o with diaeresis,
+                                  U+00F6 ISOlat1 -->
+<!ENTITY divide "&#247;"> <!-- division sign, U+00F7 ISOnum -->
+<!ENTITY oslash "&#248;"> <!-- latin small letter o with stroke,
+                                  = latin small letter o slash,
+                                  U+00F8 ISOlat1 -->
+<!ENTITY ugrave "&#249;"> <!-- latin small letter u with grave,
+                                  U+00F9 ISOlat1 -->
+<!ENTITY uacute "&#250;"> <!-- latin small letter u with acute,
+                                  U+00FA ISOlat1 -->
+<!ENTITY ucirc  "&#251;"> <!-- latin small letter u with circumflex,
+                                  U+00FB ISOlat1 -->
+<!ENTITY uuml   "&#252;"> <!-- latin small letter u with diaeresis,
+                                  U+00FC ISOlat1 -->
+<!ENTITY yacute "&#253;"> <!-- latin small letter y with acute,
+                                  U+00FD ISOlat1 -->
+<!ENTITY thorn  "&#254;"> <!-- latin small letter thorn,
+                                  U+00FE ISOlat1 -->
+<!ENTITY yuml   "&#255;"> <!-- latin small letter y with diaeresis,
+                                  U+00FF ISOlat1 -->
diff --git a/xml/xhtml-special.ent b/xml/xhtml-special.ent
new file mode 100644
index 0000000..ca358b2
--- /dev/null
+++ b/xml/xhtml-special.ent
@@ -0,0 +1,80 @@
+<!-- Special characters for XHTML -->
+
+<!-- Character entity set. Typical invocation:
+     <!ENTITY % HTMLspecial PUBLIC
+        "-//W3C//ENTITIES Special for XHTML//EN"
+        "http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent">
+     %HTMLspecial;
+-->
+
+<!-- Portions (C) International Organization for Standardization 1986:
+     Permission to copy in any form is granted for use with
+     conforming SGML systems and applications as defined in
+     ISO 8879, provided this notice is included in all copies.
+-->
+
+<!-- Relevant ISO entity set is given unless names are newly introduced.
+     New names (i.e., not in ISO 8879 list) do not clash with any
+     existing ISO 8879 entity names. ISO 10646 character numbers
+     are given for each character, in hex. values are decimal
+     conversions of the ISO 10646 values and refer to the document
+     character set. Names are Unicode names. 
+-->
+
+<!-- C0 Controls and Basic Latin -->
+<!ENTITY quot    "&#34;"> <!--  quotation mark, U+0022 ISOnum -->
+<!ENTITY amp     "&#38;#38;"> <!--  ampersand, U+0026 ISOnum -->
+<!ENTITY lt      "&#38;#60;"> <!--  less-than sign, U+003C ISOnum -->
+<!ENTITY gt      "&#62;"> <!--  greater-than sign, U+003E ISOnum -->
+<!ENTITY apos	 "&#39;"> <!--  apostrophe = APL quote, U+0027 ISOnum -->
+
+<!-- Latin Extended-A -->
+<!ENTITY OElig   "&#338;"> <!--  latin capital ligature OE,
+                                    U+0152 ISOlat2 -->
+<!ENTITY oelig   "&#339;"> <!--  latin small ligature oe, U+0153 ISOlat2 -->
+<!-- ligature is a misnomer, this is a separate character in some languages -->
+<!ENTITY Scaron  "&#352;"> <!--  latin capital letter S with caron,
+                                    U+0160 ISOlat2 -->
+<!ENTITY scaron  "&#353;"> <!--  latin small letter s with caron,
+                                    U+0161 ISOlat2 -->
+<!ENTITY Yuml    "&#376;"> <!--  latin capital letter Y with diaeresis,
+                                    U+0178 ISOlat2 -->
+
+<!-- Spacing Modifier Letters -->
+<!ENTITY circ    "&#710;"> <!--  modifier letter circumflex accent,
+                                    U+02C6 ISOpub -->
+<!ENTITY tilde   "&#732;"> <!--  small tilde, U+02DC ISOdia -->
+
+<!-- General Punctuation -->
+<!ENTITY ensp    "&#8194;"> <!-- en space, U+2002 ISOpub -->
+<!ENTITY emsp    "&#8195;"> <!-- em space, U+2003 ISOpub -->
+<!ENTITY thinsp  "&#8201;"> <!-- thin space, U+2009 ISOpub -->
+<!ENTITY zwnj    "&#8204;"> <!-- zero width non-joiner,
+                                    U+200C NEW RFC 2070 -->
+<!ENTITY zwj     "&#8205;"> <!-- zero width joiner, U+200D NEW RFC 2070 -->
+<!ENTITY lrm     "&#8206;"> <!-- left-to-right mark, U+200E NEW RFC 2070 -->
+<!ENTITY rlm     "&#8207;"> <!-- right-to-left mark, U+200F NEW RFC 2070 -->
+<!ENTITY ndash   "&#8211;"> <!-- en dash, U+2013 ISOpub -->
+<!ENTITY mdash   "&#8212;"> <!-- em dash, U+2014 ISOpub -->
+<!ENTITY lsquo   "&#8216;"> <!-- left single quotation mark,
+                                    U+2018 ISOnum -->
+<!ENTITY rsquo   "&#8217;"> <!-- right single quotation mark,
+                                    U+2019 ISOnum -->
+<!ENTITY sbquo   "&#8218;"> <!-- single low-9 quotation mark, U+201A NEW -->
+<!ENTITY ldquo   "&#8220;"> <!-- left double quotation mark,
+                                    U+201C ISOnum -->
+<!ENTITY rdquo   "&#8221;"> <!-- right double quotation mark,
+                                    U+201D ISOnum -->
+<!ENTITY bdquo   "&#8222;"> <!-- double low-9 quotation mark, U+201E NEW -->
+<!ENTITY dagger  "&#8224;"> <!-- dagger, U+2020 ISOpub -->
+<!ENTITY Dagger  "&#8225;"> <!-- double dagger, U+2021 ISOpub -->
+<!ENTITY permil  "&#8240;"> <!-- per mille sign, U+2030 ISOtech -->
+<!ENTITY lsaquo  "&#8249;"> <!-- single left-pointing angle quotation mark,
+                                    U+2039 ISO proposed -->
+<!-- lsaquo is proposed but not yet ISO standardized -->
+<!ENTITY rsaquo  "&#8250;"> <!-- single right-pointing angle quotation mark,
+                                    U+203A ISO proposed -->
+<!-- rsaquo is proposed but not yet ISO standardized -->
+
+<!-- Currency Symbols -->
+<!ENTITY euro   "&#8364;"> <!--  euro sign, U+20AC NEW -->
diff --git a/xml/xhtml-symbol.ent b/xml/xhtml-symbol.ent
new file mode 100644
index 0000000..63c2abf
--- /dev/null
+++ b/xml/xhtml-symbol.ent
@@ -0,0 +1,237 @@
+<!-- Mathematical, Greek and Symbolic characters for XHTML -->
+
+<!-- Character entity set. Typical invocation:
+     <!ENTITY % HTMLsymbol PUBLIC
+        "-//W3C//ENTITIES Symbols for XHTML//EN"
+        "http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent">
+     %HTMLsymbol;
+-->
+
+<!-- Portions (C) International Organization for Standardization 1986:
+     Permission to copy in any form is granted for use with
+     conforming SGML systems and applications as defined in
+     ISO 8879, provided this notice is included in all copies.
+-->
+
+<!-- Relevant ISO entity set is given unless names are newly introduced.
+     New names (i.e., not in ISO 8879 list) do not clash with any
+     existing ISO 8879 entity names. ISO 10646 character numbers
+     are given for each character, in hex. values are decimal
+     conversions of the ISO 10646 values and refer to the document
+     character set. Names are Unicode names. 
+-->
+
+<!-- Latin Extended-B -->
+<!ENTITY fnof     "&#402;"> <!-- latin small letter f with hook = function
+                                    = florin, U+0192 ISOtech -->
+
+<!-- Greek -->
+<!ENTITY Alpha    "&#913;"> <!-- greek capital letter alpha, U+0391 -->
+<!ENTITY Beta     "&#914;"> <!-- greek capital letter beta, U+0392 -->
+<!ENTITY Gamma    "&#915;"> <!-- greek capital letter gamma,
+                                    U+0393 ISOgrk3 -->
+<!ENTITY Delta    "&#916;"> <!-- greek capital letter delta,
+                                    U+0394 ISOgrk3 -->
+<!ENTITY Epsilon  "&#917;"> <!-- greek capital letter epsilon, U+0395 -->
+<!ENTITY Zeta     "&#918;"> <!-- greek capital letter zeta, U+0396 -->
+<!ENTITY Eta      "&#919;"> <!-- greek capital letter eta, U+0397 -->
+<!ENTITY Theta    "&#920;"> <!-- greek capital letter theta,
+                                    U+0398 ISOgrk3 -->
+<!ENTITY Iota     "&#921;"> <!-- greek capital letter iota, U+0399 -->
+<!ENTITY Kappa    "&#922;"> <!-- greek capital letter kappa, U+039A -->
+<!ENTITY Lambda   "&#923;"> <!-- greek capital letter lamda,
+                                    U+039B ISOgrk3 -->
+<!ENTITY Mu       "&#924;"> <!-- greek capital letter mu, U+039C -->
+<!ENTITY Nu       "&#925;"> <!-- greek capital letter nu, U+039D -->
+<!ENTITY Xi       "&#926;"> <!-- greek capital letter xi, U+039E ISOgrk3 -->
+<!ENTITY Omicron  "&#927;"> <!-- greek capital letter omicron, U+039F -->
+<!ENTITY Pi       "&#928;"> <!-- greek capital letter pi, U+03A0 ISOgrk3 -->
+<!ENTITY Rho      "&#929;"> <!-- greek capital letter rho, U+03A1 -->
+<!-- there is no Sigmaf, and no U+03A2 character either -->
+<!ENTITY Sigma    "&#931;"> <!-- greek capital letter sigma,
+                                    U+03A3 ISOgrk3 -->
+<!ENTITY Tau      "&#932;"> <!-- greek capital letter tau, U+03A4 -->
+<!ENTITY Upsilon  "&#933;"> <!-- greek capital letter upsilon,
+                                    U+03A5 ISOgrk3 -->
+<!ENTITY Phi      "&#934;"> <!-- greek capital letter phi,
+                                    U+03A6 ISOgrk3 -->
+<!ENTITY Chi      "&#935;"> <!-- greek capital letter chi, U+03A7 -->
+<!ENTITY Psi      "&#936;"> <!-- greek capital letter psi,
+                                    U+03A8 ISOgrk3 -->
+<!ENTITY Omega    "&#937;"> <!-- greek capital letter omega,
+                                    U+03A9 ISOgrk3 -->
+
+<!ENTITY alpha    "&#945;"> <!-- greek small letter alpha,
+                                    U+03B1 ISOgrk3 -->
+<!ENTITY beta     "&#946;"> <!-- greek small letter beta, U+03B2 ISOgrk3 -->
+<!ENTITY gamma    "&#947;"> <!-- greek small letter gamma,
+                                    U+03B3 ISOgrk3 -->
+<!ENTITY delta    "&#948;"> <!-- greek small letter delta,
+                                    U+03B4 ISOgrk3 -->
+<!ENTITY epsilon  "&#949;"> <!-- greek small letter epsilon,
+                                    U+03B5 ISOgrk3 -->
+<!ENTITY zeta     "&#950;"> <!-- greek small letter zeta, U+03B6 ISOgrk3 -->
+<!ENTITY eta      "&#951;"> <!-- greek small letter eta, U+03B7 ISOgrk3 -->
+<!ENTITY theta    "&#952;"> <!-- greek small letter theta,
+                                    U+03B8 ISOgrk3 -->
+<!ENTITY iota     "&#953;"> <!-- greek small letter iota, U+03B9 ISOgrk3 -->
+<!ENTITY kappa    "&#954;"> <!-- greek small letter kappa,
+                                    U+03BA ISOgrk3 -->
+<!ENTITY lambda   "&#955;"> <!-- greek small letter lamda,
+                                    U+03BB ISOgrk3 -->
+<!ENTITY mu       "&#956;"> <!-- greek small letter mu, U+03BC ISOgrk3 -->
+<!ENTITY nu       "&#957;"> <!-- greek small letter nu, U+03BD ISOgrk3 -->
+<!ENTITY xi       "&#958;"> <!-- greek small letter xi, U+03BE ISOgrk3 -->
+<!ENTITY omicron  "&#959;"> <!-- greek small letter omicron, U+03BF NEW -->
+<!ENTITY pi       "&#960;"> <!-- greek small letter pi, U+03C0 ISOgrk3 -->
+<!ENTITY rho      "&#961;"> <!-- greek small letter rho, U+03C1 ISOgrk3 -->
+<!ENTITY sigmaf   "&#962;"> <!-- greek small letter final sigma,
+                                    U+03C2 ISOgrk3 -->
+<!ENTITY sigma    "&#963;"> <!-- greek small letter sigma,
+                                    U+03C3 ISOgrk3 -->
+<!ENTITY tau      "&#964;"> <!-- greek small letter tau, U+03C4 ISOgrk3 -->
+<!ENTITY upsilon  "&#965;"> <!-- greek small letter upsilon,
+                                    U+03C5 ISOgrk3 -->
+<!ENTITY phi      "&#966;"> <!-- greek small letter phi, U+03C6 ISOgrk3 -->
+<!ENTITY chi      "&#967;"> <!-- greek small letter chi, U+03C7 ISOgrk3 -->
+<!ENTITY psi      "&#968;"> <!-- greek small letter psi, U+03C8 ISOgrk3 -->
+<!ENTITY omega    "&#969;"> <!-- greek small letter omega,
+                                    U+03C9 ISOgrk3 -->
+<!ENTITY thetasym "&#977;"> <!-- greek theta symbol,
+                                    U+03D1 NEW -->
+<!ENTITY upsih    "&#978;"> <!-- greek upsilon with hook symbol,
+                                    U+03D2 NEW -->
+<!ENTITY piv      "&#982;"> <!-- greek pi symbol, U+03D6 ISOgrk3 -->
+
+<!-- General Punctuation -->
+<!ENTITY bull     "&#8226;"> <!-- bullet = black small circle,
+                                     U+2022 ISOpub  -->
+<!-- bullet is NOT the same as bullet operator, U+2219 -->
+<!ENTITY hellip   "&#8230;"> <!-- horizontal ellipsis = three dot leader,
+                                     U+2026 ISOpub  -->
+<!ENTITY prime    "&#8242;"> <!-- prime = minutes = feet, U+2032 ISOtech -->
+<!ENTITY Prime    "&#8243;"> <!-- double prime = seconds = inches,
+                                     U+2033 ISOtech -->
+<!ENTITY oline    "&#8254;"> <!-- overline = spacing overscore,
+                                     U+203E NEW -->
+<!ENTITY frasl    "&#8260;"> <!-- fraction slash, U+2044 NEW -->
+
+<!-- Letterlike Symbols -->
+<!ENTITY weierp   "&#8472;"> <!-- script capital P = power set
+                                     = Weierstrass p, U+2118 ISOamso -->
+<!ENTITY image    "&#8465;"> <!-- black-letter capital I = imaginary part,
+                                     U+2111 ISOamso -->
+<!ENTITY real     "&#8476;"> <!-- black-letter capital R = real part symbol,
+                                     U+211C ISOamso -->
+<!ENTITY trade    "&#8482;"> <!-- trade mark sign, U+2122 ISOnum -->
+<!ENTITY alefsym  "&#8501;"> <!-- alef symbol = first transfinite cardinal,
+                                     U+2135 NEW -->
+<!-- alef symbol is NOT the same as hebrew letter alef,
+     U+05D0 although the same glyph could be used to depict both characters -->
+
+<!-- Arrows -->
+<!ENTITY larr     "&#8592;"> <!-- leftwards arrow, U+2190 ISOnum -->
+<!ENTITY uarr     "&#8593;"> <!-- upwards arrow, U+2191 ISOnum-->
+<!ENTITY rarr     "&#8594;"> <!-- rightwards arrow, U+2192 ISOnum -->
+<!ENTITY darr     "&#8595;"> <!-- downwards arrow, U+2193 ISOnum -->
+<!ENTITY harr     "&#8596;"> <!-- left right arrow, U+2194 ISOamsa -->
+<!ENTITY crarr    "&#8629;"> <!-- downwards arrow with corner leftwards
+                                     = carriage return, U+21B5 NEW -->
+<!ENTITY lArr     "&#8656;"> <!-- leftwards double arrow, U+21D0 ISOtech -->
+<!-- Unicode does not say that lArr is the same as the 'is implied by' arrow
+    but also does not have any other character for that function. So lArr can
+    be used for 'is implied by' as ISOtech suggests -->
+<!ENTITY uArr     "&#8657;"> <!-- upwards double arrow, U+21D1 ISOamsa -->
+<!ENTITY rArr     "&#8658;"> <!-- rightwards double arrow,
+                                     U+21D2 ISOtech -->
+<!-- Unicode does not say this is the 'implies' character but does not have 
+     another character with this function so rArr can be used for 'implies'
+     as ISOtech suggests -->
+<!ENTITY dArr     "&#8659;"> <!-- downwards double arrow, U+21D3 ISOamsa -->
+<!ENTITY hArr     "&#8660;"> <!-- left right double arrow,
+                                     U+21D4 ISOamsa -->
+
+<!-- Mathematical Operators -->
+<!ENTITY forall   "&#8704;"> <!-- for all, U+2200 ISOtech -->
+<!ENTITY part     "&#8706;"> <!-- partial differential, U+2202 ISOtech  -->
+<!ENTITY exist    "&#8707;"> <!-- there exists, U+2203 ISOtech -->
+<!ENTITY empty    "&#8709;"> <!-- empty set = null set, U+2205 ISOamso -->
+<!ENTITY nabla    "&#8711;"> <!-- nabla = backward difference,
+                                     U+2207 ISOtech -->
+<!ENTITY isin     "&#8712;"> <!-- element of, U+2208 ISOtech -->
+<!ENTITY notin    "&#8713;"> <!-- not an element of, U+2209 ISOtech -->
+<!ENTITY ni       "&#8715;"> <!-- contains as member, U+220B ISOtech -->
+<!ENTITY prod     "&#8719;"> <!-- n-ary product = product sign,
+                                     U+220F ISOamsb -->
+<!-- prod is NOT the same character as U+03A0 'greek capital letter pi' though
+     the same glyph might be used for both -->
+<!ENTITY sum      "&#8721;"> <!-- n-ary summation, U+2211 ISOamsb -->
+<!-- sum is NOT the same character as U+03A3 'greek capital letter sigma'
+     though the same glyph might be used for both -->
+<!ENTITY minus    "&#8722;"> <!-- minus sign, U+2212 ISOtech -->
+<!ENTITY lowast   "&#8727;"> <!-- asterisk operator, U+2217 ISOtech -->
+<!ENTITY radic    "&#8730;"> <!-- square root = radical sign,
+                                     U+221A ISOtech -->
+<!ENTITY prop     "&#8733;"> <!-- proportional to, U+221D ISOtech -->
+<!ENTITY infin    "&#8734;"> <!-- infinity, U+221E ISOtech -->
+<!ENTITY ang      "&#8736;"> <!-- angle, U+2220 ISOamso -->
+<!ENTITY and      "&#8743;"> <!-- logical and = wedge, U+2227 ISOtech -->
+<!ENTITY or       "&#8744;"> <!-- logical or = vee, U+2228 ISOtech -->
+<!ENTITY cap      "&#8745;"> <!-- intersection = cap, U+2229 ISOtech -->
+<!ENTITY cup      "&#8746;"> <!-- union = cup, U+222A ISOtech -->
+<!ENTITY int      "&#8747;"> <!-- integral, U+222B ISOtech -->
+<!ENTITY there4   "&#8756;"> <!-- therefore, U+2234 ISOtech -->
+<!ENTITY sim      "&#8764;"> <!-- tilde operator = varies with = similar to,
+                                     U+223C ISOtech -->
+<!-- tilde operator is NOT the same character as the tilde, U+007E,
+     although the same glyph might be used to represent both  -->
+<!ENTITY cong     "&#8773;"> <!-- approximately equal to, U+2245 ISOtech -->
+<!ENTITY asymp    "&#8776;"> <!-- almost equal to = asymptotic to,
+                                     U+2248 ISOamsr -->
+<!ENTITY ne       "&#8800;"> <!-- not equal to, U+2260 ISOtech -->
+<!ENTITY equiv    "&#8801;"> <!-- identical to, U+2261 ISOtech -->
+<!ENTITY le       "&#8804;"> <!-- less-than or equal to, U+2264 ISOtech -->
+<!ENTITY ge       "&#8805;"> <!-- greater-than or equal to,
+                                     U+2265 ISOtech -->
+<!ENTITY sub      "&#8834;"> <!-- subset of, U+2282 ISOtech -->
+<!ENTITY sup      "&#8835;"> <!-- superset of, U+2283 ISOtech -->
+<!ENTITY nsub     "&#8836;"> <!-- not a subset of, U+2284 ISOamsn -->
+<!ENTITY sube     "&#8838;"> <!-- subset of or equal to, U+2286 ISOtech -->
+<!ENTITY supe     "&#8839;"> <!-- superset of or equal to,
+                                     U+2287 ISOtech -->
+<!ENTITY oplus    "&#8853;"> <!-- circled plus = direct sum,
+                                     U+2295 ISOamsb -->
+<!ENTITY otimes   "&#8855;"> <!-- circled times = vector product,
+                                     U+2297 ISOamsb -->
+<!ENTITY perp     "&#8869;"> <!-- up tack = orthogonal to = perpendicular,
+                                     U+22A5 ISOtech -->
+<!ENTITY sdot     "&#8901;"> <!-- dot operator, U+22C5 ISOamsb -->
+<!-- dot operator is NOT the same character as U+00B7 middle dot -->
+
+<!-- Miscellaneous Technical -->
+<!ENTITY lceil    "&#8968;"> <!-- left ceiling = APL upstile,
+                                     U+2308 ISOamsc  -->
+<!ENTITY rceil    "&#8969;"> <!-- right ceiling, U+2309 ISOamsc  -->
+<!ENTITY lfloor   "&#8970;"> <!-- left floor = APL downstile,
+                                     U+230A ISOamsc  -->
+<!ENTITY rfloor   "&#8971;"> <!-- right floor, U+230B ISOamsc  -->
+<!ENTITY lang     "&#9001;"> <!-- left-pointing angle bracket = bra,
+                                     U+2329 ISOtech -->
+<!-- lang is NOT the same character as U+003C 'less than sign' 
+     or U+2039 'single left-pointing angle quotation mark' -->
+<!ENTITY rang     "&#9002;"> <!-- right-pointing angle bracket = ket,
+                                     U+232A ISOtech -->
+<!-- rang is NOT the same character as U+003E 'greater than sign' 
+     or U+203A 'single right-pointing angle quotation mark' -->
+
+<!-- Geometric Shapes -->
+<!ENTITY loz      "&#9674;"> <!-- lozenge, U+25CA ISOpub -->
+
+<!-- Miscellaneous Symbols -->
+<!ENTITY spades   "&#9824;"> <!-- black spade suit, U+2660 ISOpub -->
+<!-- black here seems to mean filled as opposed to hollow -->
+<!ENTITY clubs    "&#9827;"> <!-- black club suit = shamrock,
+                                     U+2663 ISOpub -->
+<!ENTITY hearts   "&#9829;"> <!-- black heart suit = valentine,
+                                     U+2665 ISOpub -->
+<!ENTITY diams    "&#9830;"> <!-- black diamond suit, U+2666 ISOpub -->