diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-02-26 16:16:54 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-02-26 16:16:54 -0500 |
| commit | e4e1bf5221bd0cf68df2ba444425e5a0b9d50af1 (patch) | |
| tree | 986072376068c16f878d6702faa48b50dbd85f92 | |
| parent | 40e3a4a698ed666280de68373d3ed09f43985bef (diff) | |
Kind-polymorphic [fst] and friends
| -rw-r--r-- | demo/crud.ur | 30 | ||||
| -rw-r--r-- | demo/crud.urs | 2 | ||||
| -rw-r--r-- | lib/ur/top.ur | 10 | ||||
| -rw-r--r-- | lib/ur/top.urs | 10 |
4 files changed, 26 insertions, 26 deletions
diff --git a/demo/crud.ur b/demo/crud.ur index a6a65bb3..dc9a5b7c 100644 --- a/demo/crud.ur +++ b/demo/crud.ur @@ -35,7 +35,7 @@ functor Make(M : sig 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig <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 @@ functor Make(M : sig </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 @@ functor Make(M : sig 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 @@ functor Make(M : sig {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 --git a/demo/crud.urs b/demo/crud.urs index b240b7c1..57ab3808 100644 --- a/demo/crud.urs +++ b/demo/crud.urs @@ -18,7 +18,7 @@ functor Make(M : sig 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 --git a/lib/ur/top.ur b/lib/ur/top.ur index 48ee4dd0..053075bd 100644 --- a/lib/ur/top.ur +++ b/lib/ur/top.ur @@ -49,11 +49,11 @@ fun not b = if b then False else True 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 --git a/lib/ur/top.urs b/lib/ur/top.urs index 65da4a07..583b025f 100644 --- a/lib/ur/top.urs +++ b/lib/ur/top.urs @@ -23,11 +23,11 @@ val not : bool -> bool 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) |