# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1243521325 14400
# Node ID 669ac5e9a69ec3f5092555a3cf550f881835e055
# Parent  d4e811beb8eb1e928a41509b16717862ac295075
Demo compiles with pattern-matching-fu

diff -r d4e811beb8eb -r 669ac5e9a69e demo/batchFun.ur
--- a/demo/batchFun.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/batchFun.ur	Thu May 28 10:35:25 2009 -0400
@@ -8,7 +8,7 @@
                   ReadState : t_state.2 -> transaction t_state.1}
 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
 
-fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
             name : colMeta (t, source string) =
     {Nam = name,
      Show = txt,
@@ -49,7 +49,7 @@
                     (foldR2 [fst] [colMeta]
                             [fn cols => $(map (fn t :: (Type * Type) =>
                                                   sql_exp [] [] [] t.1) cols)]
-                            (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                            (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                              [[nm] ~ rest] input col acc =>
                                 acc ++ {nm = @sql_inject col.Inject input})
                             {} [M.cols] M.fl (r -- #Id) M.cols
@@ -74,7 +74,7 @@
                     <tr>
                       <td>{[r.Id]}</td>
                       {foldRX2 [colMeta] [fst] [_]
-                               (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+                               (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
                                                 [[nm] ~ rest] m v =>
                                    <xml><td>{m.Show v}</td></xml>)
                                [M.cols] M.fl M.cols (r -- #Id)}
@@ -90,7 +90,7 @@
               <tr>
                 <th>Id</th>
                 {foldRX [colMeta] [_]
-                        (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+                        (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
                                          [[nm] ~ rest] m =>
                             <xml><th>{[m.Nam]}</th></xml>)
                         [M.cols] M.fl M.cols}
@@ -105,7 +105,7 @@
 
         id <- source "";
         inps <- foldR [colMeta] [fn r => transaction ($(map snd r))]
-                (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) [[nm] ~ rest] m acc =>
+                (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc =>
                     s <- m.NewState;
                     r <- acc;
                     return ({nm = s} ++ r))
@@ -116,7 +116,7 @@
             fun add () =
                 id <- get id;
                 vs <- foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
-                             (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+                             (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
                                               [[nm] ~ rest] m s acc =>
                                  v <- m.ReadState s;
                                  r <- acc;
@@ -146,7 +146,7 @@
               <table>
                 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
                 {foldRX2 [colMeta] [snd] [_]
-                 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+                 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
                                   [[nm] ~ rest] m s =>
                      <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
                  [M.cols] M.fl M.cols inps}
diff -r d4e811beb8eb -r 669ac5e9a69e demo/crud.ur
--- a/demo/crud.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/crud.ur	Thu May 28 10:35:25 2009 -0400
@@ -8,12 +8,12 @@
                  }
 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
 
-fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+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 =>
+     Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
+     WidgetPopulated = fn [nm :: Name] n =>
                           <xml><textbox{nm} value={show n}/></xml>,
      Parse = readError,
      Inject = _}
@@ -24,8 +24,8 @@
 
 fun bool name = {Nam = name,
                  Show = txt,
-                 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
-                 WidgetPopulated = fn (nm :: Name) b =>
+                 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
+                 WidgetPopulated = fn [nm :: Name] b =>
                                       <xml><checkbox{nm} checked={b}/></xml>,
                  Parse = fn x => x,
                  Inject = _}
@@ -53,7 +53,7 @@
                          <tr>
                            <td>{[fs.T.Id]}</td>
                            {foldRX2 [fst] [colMeta] [tr]
-                                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                    (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                                      [[nm] ~ rest] v col => <xml>
                                                        <td>{col.Show v}</td>
                                                      </xml>)
@@ -69,7 +69,7 @@
             <tr>
               <th>ID</th>
               {foldRX [colMeta] [tr]
-                        (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                        (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                          [[nm] ~ rest] col => <xml>
                                            <th>{cdata col.Nam}</th>
                                          </xml>)
@@ -82,7 +82,7 @@
 
           <form>
             {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
-                   (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                   (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                     [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
                                       <li> {cdata col.Nam}: {col.Widget [nm]}</li>
                                       {useMore acc}
@@ -100,7 +100,7 @@
                     (foldR2 [snd] [colMeta]
                             [fn cols => $(map (fn t :: (Type * Type) =>
                                                   sql_exp [] [] [] t.1) cols)]
-                            (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                            (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                              [[nm] ~ rest] =>
                              fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
                             {} [M.cols] M.fl inputs M.cols
@@ -121,7 +121,7 @@
                                                           sql_exp [T = [Id = int]
                                                                            ++ map fst M.cols]
                                                                   [] [] t.1) cols)]
-                                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                                    (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                                      [[nm] ~ rest] =>
                                      fn input col acc => acc ++ {nm =
                                                                  @sql_inject col.Inject (col.Parse input)})
@@ -139,7 +139,7 @@
                 None => return <xml><body>Not found!</body></xml>
               | Some fs => return <xml><body><form>
                 {foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
-                        (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+                        (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
                                          [[nm] ~ rest] (v : t.1) (col : colMeta t)
                                          (acc : xml form [] (map snd rest)) =>
                             <xml>
diff -r d4e811beb8eb -r 669ac5e9a69e demo/crud2.ur
--- a/demo/crud2.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/crud2.ur	Thu May 28 10:35:25 2009 -0400
@@ -12,13 +12,13 @@
                                                             <xml>Ready!</xml>
                                                         else
                                                             <xml>Not ready</xml>),
-                                        Widget = (fn (nm :: Name) => <xml>
+                                        Widget = (fn [nm :: Name] => <xml>
                                           <select{nm}>
                                             <option>Ready</option>
                                             <option>Not ready</option>
                                           </select>
                                         </xml>),
-                                        WidgetPopulated = (fn (nm :: Name) b => <xml>
+                                        WidgetPopulated = (fn [nm :: Name] b => <xml>
                                           <select{nm}>
                                             <option selected={b}>Ready</option>
                                             <option selected={not b}>Not ready</option>
diff -r d4e811beb8eb -r 669ac5e9a69e demo/crud3.ur
--- a/demo/crud3.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/crud3.ur	Thu May 28 10:35:25 2009 -0400
@@ -8,13 +8,13 @@
 
                    val cols = {Text = {Nam = "Text",
                                        Show = txt,
-                                       Widget = (fn (nm :: Name) => <xml>
+                                       Widget = (fn [nm :: Name] => <xml>
                                          <subform{nm}>
                                            <textbox{#A}/>
                                            <textbox{#B}/>
                                          </subform>
                                        </xml>),
-                                       WidgetPopulated = (fn (nm :: Name) s => <xml>
+                                       WidgetPopulated = (fn [nm :: Name] s => <xml>
                                          <subform{nm}>
                                            <textbox{#A} value={s}/>
                                            <textbox{#B}/>
diff -r d4e811beb8eb -r 669ac5e9a69e demo/list.ur
--- a/demo/list.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/list.ur	Thu May 28 10:35:25 2009 -0400
@@ -1,6 +1,6 @@
 datatype list t = Nil | Cons of t * list t
 
-fun length (t ::: Type) (ls : list t) =
+fun length [t] (ls : list t) =
     let
         fun length' (ls : list t) (acc : int) =
             case ls of
@@ -10,7 +10,7 @@
         length' ls 0
     end
 
-fun rev (t ::: Type) (ls : list t) = 
+fun rev [t] (ls : list t) = 
     let
         fun rev' (ls : list t) (acc : list t) =
             case ls of
diff -r d4e811beb8eb -r 669ac5e9a69e demo/metaform.ur
--- a/demo/metaform.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/metaform.ur	Thu May 28 10:35:25 2009 -0400
@@ -6,7 +6,7 @@
 
     fun handler values = return <xml><body>
       {foldURX2 [string] [string] [body]
-       (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] name value => <xml>
+       (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name value => <xml>
          <li> {[name]} = {[value]}</li>
        </xml>)
        [M.fs] M.fl M.names values}
@@ -15,7 +15,7 @@
     fun main () = return <xml><body>
       <form>
         {foldUR [string] [fn cols :: {Unit} => xml form [] (mapU string cols)]
-                (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] name
+                (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name
                                  (acc : xml form [] (mapU string rest)) => <xml>
                                    <li> {[name]}: <textbox{nm}/></li>
                                    {useMore acc}
diff -r d4e811beb8eb -r 669ac5e9a69e demo/sum.ur
--- a/demo/sum.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/sum.ur	Thu May 28 10:35:25 2009 -0400
@@ -1,6 +1,6 @@
-fun sum (fs ::: {Unit}) (fl : folder fs) (x : $(mapU int fs)) =
+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)
+    (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
     0 [fs] fl x
 
 fun main () = return <xml><body>
diff -r d4e811beb8eb -r 669ac5e9a69e demo/tcSum.ur
--- a/demo/tcSum.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/tcSum.ur	Thu May 28 10:35:25 2009 -0400
@@ -1,6 +1,6 @@
-fun sum (t ::: Type) (_ : num t) (fs ::: {Unit}) (fl : folder fs) (x : $(mapU t fs)) =
+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)
+    (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
     zero [fs] fl x
 
 fun main () = return <xml><body>
diff -r d4e811beb8eb -r 669ac5e9a69e demo/view.ur
--- a/demo/view.ur	Thu May 28 10:16:50 2009 -0400
+++ b/demo/view.ur	Thu May 28 10:35:25 2009 -0400
@@ -1,7 +1,7 @@
 table t : { A : int }
 view v = SELECT t.A AS A FROM t WHERE t.A > 7
 
-fun list (u ::: Type) (_ : fieldsOf u [A = int]) (title : string) (x : u) =
+fun list [u] (_ : fieldsOf u [A = int]) (title : string) (x : u) =
     xml <- queryX (SELECT * FROM x)
            (fn r : {X : {A : int}} => <xml><li>{[r.X.A]}</li></xml>);
     return <xml>
diff -r d4e811beb8eb -r 669ac5e9a69e src/monoize.sml
--- a/src/monoize.sml	Thu May 28 10:16:50 2009 -0400
+++ b/src/monoize.sml	Thu May 28 10:35:25 2009 -0400
@@ -148,6 +148,8 @@
                     (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.CFfi ("Basis", "sql_query"), _), _), _), _) =>
diff -r d4e811beb8eb -r 669ac5e9a69e src/reduce.sml
--- a/src/reduce.sml	Thu May 28 10:16:50 2009 -0400
+++ b/src/reduce.sml	Thu May 28 10:35:25 2009 -0400
@@ -390,6 +390,9 @@
                       | _ => default ()
                 end
 
+              | ECase (_, [((PRecord [], _), e)], _) => exp env e
+              | ECase (_, [((PWild, _), e)], _) => exp env e
+
               | ECase (e, pes, {disc, result}) =>
                 let
                     fun patBinds (p, _) =
diff -r d4e811beb8eb -r 669ac5e9a69e src/urweb.grm
--- a/src/urweb.grm	Thu May 28 10:16:50 2009 -0400
+++ b/src/urweb.grm	Thu May 28 10:35:25 2009 -0400
@@ -985,6 +985,7 @@
 
                                                 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),
@@ -1001,6 +1002,7 @@
 
                                                 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),