summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-02-26 16:16:54 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-02-26 16:16:54 -0500
commite4e1bf5221bd0cf68df2ba444425e5a0b9d50af1 (patch)
tree986072376068c16f878d6702faa48b50dbd85f92
parent40e3a4a698ed666280de68373d3ed09f43985bef (diff)
Kind-polymorphic [fst] and friends
-rw-r--r--demo/crud.ur30
-rw-r--r--demo/crud.urs2
-rw-r--r--lib/ur/top.ur10
-rw-r--r--lib/ur/top.urs10
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)