# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1235683014 18000
# Node ID 24fd1edfcaa36b14b608cdebace5fc7169ffc7c0
# Parent  de8333ef1a0c241f37df2968f88e2a3b11cd1dc0
Kind-polymorphic [fst] and friends

diff -r de8333ef1a0c -r 24fd1edfcaa3 demo/crud.ur
--- a/demo/crud.ur	Thu Feb 26 13:56:54 2009 -0500
+++ b/demo/crud.ur	Thu Feb 26 16:16:54 2009 -0500
@@ -35,7 +35,7 @@
                  constraint [Id] ~ cols
                  val fl : folder cols
 
-                 val tab : sql_table ([Id = int] ++ map fstTT cols)
+                 val tab : sql_table ([Id = int] ++ map fst cols)
 
                  val title : string
 
@@ -49,10 +49,10 @@
 
     fun list () =
         rows <- queryX (SELECT * FROM tab AS T)
-                       (fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml>
+                       (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
                          <tr>
                            <td>{[fs.T.Id]}</td>
-                           {foldRX2 [fstTT] [colMeta] [tr]
+                           {foldRX2 [fst] [colMeta] [tr]
                                     (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                                                      [[nm] ~ rest] v col => <xml>
                                                        <td>{col.Show v}</td>
@@ -81,9 +81,9 @@
           <br/><hr/><br/>
 
           <form>
-            {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
+            {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
                    (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
-                                    [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml>
+                                    [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
                                       <li> {cdata col.Nam}: {col.Widget [nm]}</li>
                                       {useMore acc}
                                     </xml>)
@@ -94,10 +94,10 @@
           </form>
         </xml>
 
-    and create (inputs : $(map sndTT M.cols)) =
+    and create (inputs : $(map snd M.cols)) =
         id <- nextval seq;
         dml (insert tab
-                    (foldR2 [sndTT] [colMeta]
+                    (foldR2 [snd] [colMeta]
                             [fn cols => $(map (fn t :: (Type * Type) =>
                                                   sql_exp [] [] [] t.1) cols)]
                             (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
@@ -114,12 +114,12 @@
 
     and upd (id : int) =
         let
-            fun save (inputs : $(map sndTT M.cols)) =
-                dml (update [map fstTT M.cols] !
-                            (foldR2 [sndTT] [colMeta]
+            fun save (inputs : $(map snd M.cols)) =
+                dml (update [map fst M.cols] !
+                            (foldR2 [snd] [colMeta]
                                     [fn cols => $(map (fn t :: (Type * Type) =>
                                                           sql_exp [T = [Id = int]
-                                                                           ++ map fstTT M.cols]
+                                                                           ++ map fst M.cols]
                                                                   [] [] t.1) cols)]
                                     (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                                                      [[nm] ~ rest] =>
@@ -134,14 +134,14 @@
                   {ls}
                 </body></xml>
         in
-            fso <- oneOrNoRows (SELECT tab.{{map fstTT M.cols}} FROM tab WHERE tab.Id = {[id]});
-            case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of
+            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 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
+                {foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
                         (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
                                          [[nm] ~ rest] (v : t.1) (col : colMeta t)
-                                         (acc : xml form [] (map sndTT rest)) =>
+                                         (acc : xml form [] (map snd rest)) =>
                             <xml>
                               <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
                               {useMore acc}
diff -r de8333ef1a0c -r 24fd1edfcaa3 demo/crud.urs
--- a/demo/crud.urs	Thu Feb 26 13:56:54 2009 -0500
+++ b/demo/crud.urs	Thu Feb 26 16:16:54 2009 -0500
@@ -18,7 +18,7 @@
                  constraint [Id] ~ cols
                  val fl : folder cols
 
-                 val tab : sql_table ([Id = int] ++ map fstTT cols)
+                 val tab : sql_table ([Id = int] ++ map fst cols)
 
                  val title : string
 
diff -r de8333ef1a0c -r 24fd1edfcaa3 lib/ur/top.ur
--- a/lib/ur/top.ur	Thu Feb 26 13:56:54 2009 -0500
+++ b/lib/ur/top.ur	Thu Feb 26 16:16:54 2009 -0500
@@ -49,11 +49,11 @@
 
 con idT (t :: Type) = t
 con record (t :: {Type}) = $t
-con fstTT (t :: (Type * Type)) = t.1
-con sndTT (t :: (Type * Type)) = t.2
-con fstTTT (t :: (Type * Type * Type)) = t.1
-con sndTTT (t :: (Type * Type * Type)) = t.2
-con thdTTT (t :: (Type * Type * Type)) = t.3
+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 mapUT = fn f :: Type => map (fn _ :: Unit => f)
 
diff -r de8333ef1a0c -r 24fd1edfcaa3 lib/ur/top.urs
--- a/lib/ur/top.urs	Thu Feb 26 13:56:54 2009 -0500
+++ b/lib/ur/top.urs	Thu Feb 26 16:16:54 2009 -0500
@@ -23,11 +23,11 @@
 
 con idT = fn t :: Type => t
 con record = fn t :: {Type} => $t
-con fstTT = fn t :: (Type * Type) => t.1
-con sndTT = fn t :: (Type * Type) => t.2
-con fstTTT = fn t :: (Type * Type * Type) => t.1
-con sndTTT = fn t :: (Type * Type * Type) => t.2
-con thdTTT = fn t :: (Type * Type * Type) => t.3
+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 mapUT = fn f :: Type => map (fn _ :: Unit => f)