Merge branch 'master' of ssh://hnf.impredicative.com:/home/adamc/git-root/urweb

16 files changed, 158 insertions, 36 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 89fee4f2..94d3b0a4 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,16 @@
 ========
+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
 ========
 
diff --git a/Makefile.am b/Makefile.am
index 33bf4e7c..f0392de0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -123,7 +123,7 @@ test:
 	bin/urweb -boot -noEmacs -dbms sqlite -db $(TESTDB) -demo /Demo demo
 	rm -f $(TESTDB)
 	sqlite3 $(TESTDB) < demo/demo.sql
-	demo/demo.exe -a 127.0.0.1 & echo $$! > $(TESTPID)
+	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)
@@ -133,7 +133,7 @@ test:
 		echo "Running IPv6 tests."; \
 		rm -f $(TESTDB); \
 		sqlite3 $(TESTDB) < demo/demo.sql; \
-		demo/demo.exe -A ::1 & echo $$! > $(TESTPID); \
+		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); \
diff --git a/configure.ac b/configure.ac
index 5d0cd40f..5786c582 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,5 +1,5 @@
-AC_INIT([urweb], [20170105])
-WORKING_VERSION=1
+AC_INIT([urweb], [20170720])
+WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
 # automake 1.12 requires this, but automake 1.11 doesn't recognize it
diff --git a/doc/manual.tex b/doc/manual.tex
index f6d67f07..eaf7aab5 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -155,6 +155,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
 \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}
@@ -554,7 +555,7 @@ $$\begin{array}{rrcll}
   &&& \_ & \textrm{wildcard} \\
   &&& (e) & \textrm{explicit precedence} \\
   \\
-  \textrm{Local declarations} & ed &::=& \cd{val} \; x : \tau = e & \textrm{non-recursive value} \\
+  \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}$$
 
@@ -565,7 +566,7 @@ $$\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} \; x : \tau = e & \textrm{value} \\
+  &&& \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} \\
diff --git a/src/c/http.c b/src/c/http.c
index b39520cc..21ad809f 100644
--- a/src/c/http.c
+++ b/src/c/http.c
@@ -359,7 +359,7 @@ int main(int argc, char *argv[]) {
   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:")) != -1) {
+  while ((opt = getopt(argc, argv, "hp:a:A:t:kqT:m:")) != -1) {
     switch (opt) {
     case '?':
       fprintf(stderr, "Unknown command-line option\n");
diff --git a/src/c/static.c b/src/c/static.c
index 7f63d393..d70881e2 100644
--- a/src/c/static.c
+++ b/src/c/static.c
@@ -38,6 +38,7 @@ int main(int argc, char *argv[]) {
     fk = uw_begin(ctx, argv[1]);
 
     if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
+      uw_commit(ctx);
       uw_print(ctx, 1);
       puts("");
       return 0;
diff --git a/src/compiler.sig b/src/compiler.sig
index a4b3e562..952c7070 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -48,6 +48,7 @@ signature COMPILER = sig
          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,
diff --git a/src/compiler.sml b/src/compiler.sml
index 3e08fcc6..c13de304 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -52,6 +52,7 @@ type job = {
      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,
@@ -273,7 +274,7 @@ val parseUr = {
 
 fun p_job ({prefix, database, exe, sql, sources, debug, profile,
             timeout, ffi, link, headers, scripts,
-            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
+            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsModule, jsFuncs, ...} : job) =
     let
         open Print.PD
         open Print
@@ -312,6 +313,9 @@ fun p_job ({prefix, database, exe, sql, sources, debug, profile,
              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,
@@ -368,6 +372,7 @@ fun institutionalizeJob (job : 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);
@@ -445,6 +450,7 @@ fun parseUrp' accLibs fname =
                         benignEffectful = [],
                         clientOnly = [],
                         serverOnly = [],
+                        jsModule = NONE,
                         jsFuncs = [],
                         rewrites = [{pkind = Settings.Any,
                                      kind = Settings.Prefix,
@@ -579,6 +585,7 @@ fun parseUrp' accLibs fname =
                      val benignEffectful = ref []
                      val clientOnly = ref []
                      val serverOnly = ref []
+                     val jsModule = ref NONE
                      val jsFuncs = ref []
                      val rewrites = ref []
                      val url = ref []
@@ -616,6 +623,7 @@ fun parseUrp' accLibs fname =
                                  benignEffectful = rev (!benignEffectful),
                                  clientOnly = rev (!clientOnly),
                                  serverOnly = rev (!serverOnly),
+                                 jsModule = !jsModule,
                                  jsFuncs = rev (!jsFuncs),
                                  rewrites = rev (!rewrites),
                                  filterUrl = rev (!url),
@@ -674,6 +682,7 @@ fun parseUrp' accLibs fname =
                                  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,
@@ -809,6 +818,10 @@ fun parseUrp' accLibs fname =
                                    | "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
diff --git a/src/demo.sml b/src/demo.sml
index 47d22395..62b9037a 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -16,7 +16,7 @@
  * 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 
+ * 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
@@ -111,6 +111,7 @@ fun make' {prefix, dirname, guided} =
             benignEffectful = [],
             clientOnly = [],
             serverOnly = [],
+            jsModule = NONE,
             jsFuncs = [],
             rewrites = #rewrites combined @ #rewrites urp,
             filterUrl = #filterUrl combined @ #filterUrl urp,
@@ -280,7 +281,7 @@ fun make' {prefix, dirname, guided} =
                             val (urpData, out) = startUrp urp
                         in
                             finished ();
-                            
+
                             SOME (readUrp (urpData,
                                            out))
                         end
@@ -399,7 +400,7 @@ fun make' {prefix, dirname, guided} =
                              case #kind rule of
                                  Settings.Exact => ()
                                | Settings.Prefix => TextIO.output (outf, "*");
-                             TextIO.output (outf, "\n")))                  
+                             TextIO.output (outf, "\n")))
             in
                 Option.app (fn db => (TextIO.output (outf, "database ");
                                       TextIO.output (outf, db);
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 6965adfd..4a04d4bf 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2489,6 +2489,15 @@ 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));
@@ -3807,7 +3816,8 @@ and wildifyStr env (str, sgn) =
                      foldl (fn ((d, _), nd) =>
                                case d of
                                    L.DCon (x, _, _) => ndelCon (nd, x)
-                                 | L.DVal (x, _, _) => ndelVal (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
@@ -3855,7 +3865,7 @@ and wildifyStr env (str, sgn) =
                                | xs =>
                                  let
                                      val ewild = (L.EWild, #2 str)
-                                     val ds'' = map (fn x => (L.DVal (x, NONE, ewild), #2 str)) xs
+                                     val ds'' = map (fn x => (L.DVal ((L.PVar x, #2 str), ewild), #2 str)) xs
                                  in
                                      ds'' @ ds'
                                  end
@@ -4022,22 +4032,55 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                                    ([], (env, denv, [])))
                      end)
 
-              | L.DVal (x, co, e) =>
+              | L.DVal (p, e) =>
                 let
-                    val (c', _, gs1) = case co of
-                                           NONE => (cunif env (loc, ktype), ktype, [])
-                                         | SOME c => elabCon (env, denv) c
+                    val ((p', pt), (env', bound)) = elabPat (p, (env, SS.empty))
 
-                    val (e', et, gs2) = elabExp (env, denv) e
+                    val (e', et, gs1) = elabExp (env, denv) e
 
-                    val () = checkCon env e' et c'
+                    val c' = normClassConstraint env et
 
-                    val c' = normClassConstraint env c'
-                    val (env', n) = E.pushENamed env x c'
+                    fun singleVar (p : L.pat) =
+                        case #1 p of
+                            L.PVar x => SOME x
+                          | L.PAnnot (p', _) => singleVar p'
+                          | _ => NONE
                 in
-                    (*prefaces "DVal" [("x", Print.PD.string x),
-                                     ("c'", p_con env c')];*)
-                    ([(L'.DVal (x, n, c', e'), loc)], (env', denv, enD gs1 @ gs2 @ gs))
+                    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
diff --git a/src/settings.sig b/src/settings.sig
index 0ae81b13..256a12b5 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -96,6 +96,7 @@ signature SETTINGS = sig
     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
diff --git a/src/settings.sml b/src/settings.sml
index 9fdc2232..a3263c06 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -346,7 +346,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("asin", "asin"),
                           ("acos", "acos"),
                           ("atan", "atan"),
-                          ("atan2", "atan2"),                           
+                          ("atan2", "atan2"),
                           ("abs", "abs"),
 
                           ("now", "now"),
@@ -395,9 +395,15 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("htmlifySpecialChar", "htmlifySpecialChar"),
                           ("chr", "chr")]
 val jsFuncs = ref jsFuncsBase
-fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
+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, v)
+fun addJsFunc (k, v) = jsFuncs := M.insert (!jsFuncs, k, jsFuncName v)
 fun allJsFuncs () = M.listItemsi (!jsFuncs)
 
 datatype pattern_kind = Exact | Prefix
diff --git a/src/source.sml b/src/source.sml
index 9971ca93..2d8c1ed3 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -157,7 +157,7 @@ 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 string * con option * exp
+       | 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? *)
diff --git a/src/source_print.sml b/src/source_print.sml
index 7b657422..e18a82f9 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -560,9 +560,13 @@ fun p_decl ((d, _) : decl) =
              string "datatype",
              space,
              p_list_sep (string ".") string (ms @ [x'])]
-      | DVal vi => box [string "val",
-                        space,
-                        p_vali vi]
+      | DVal (p, e) => box [string "val",
+                            space,
+                            p_pat p,
+                            space,
+                            string "=",
+                            space,
+                            p_exp e]
       | DValRec vis => box [string "val",
                             space,
                             string "rec",
diff --git a/src/urweb.grm b/src/urweb.grm
index db5473a6..afebff0a 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -490,7 +490,7 @@ fun patternOut (e : exp) =
  | earga of exp * con -> exp * con
  | eargs of exp * con -> exp * con
  | eargl of exp * con -> exp * con
- | eargl2 of exp * con -> exp * con
+ | eargl2 of bool * (exp * con -> exp * con)
 
  | branch of pat * exp
  | branchs of (pat * exp) list
@@ -622,7 +622,41 @@ decl   : CON SYMBOL cargl2 kopt EQ cexp (let
                 (case dargs of
                      [] => [(DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))]
                    | _ => raise Fail "Arguments specified for imported datatype")
-       | VAL vali                       ([(DVal vali, s (VALleft, valiright))])
+       | 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))])
 
@@ -695,7 +729,7 @@ vali   : SYMBOL eargl2 copt EQ eexp     (let
                                              val loc = s (SYMBOLleft, eexpright)
                                              val t = Option.getOpt (copt, (CWild (KType, loc), loc))
 
-                                             val (e, t) = eargl2 (eexp, t)
+                                             val (e, t) = #2 eargl2 (eexp, t)
                                          in
                                              (SYMBOL, SOME t, e)
                                          end)
@@ -1279,8 +1313,8 @@ eargs  : earg                           (earg)
 eargl  : eargp eargp                    (eargp1 o eargp2)
        | eargp eargl                    (eargp o eargl)
 
-eargl2 :                                (fn x => x)
-       | eargp eargl2                   (eargp o eargl2)
+eargl2 :                                (false, fn x => x)
+       | eargp eargl2                   (true, eargp o #2 eargl2)
 
 earg   : patS                           (fn (e, t) =>
                                             let
diff --git a/tests/topLevelPattern.ur b/tests/topLevelPattern.ur
new file mode 100644
index 00000000..e272c30c
--- /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>