aboutsummaryrefslogtreecommitdiffhomepage
path: root/lib/ur/top.ur
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-08-25 13:57:56 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-08-25 13:57:56 -0400
commit7c866487f8ab0dd9b9c73bee013c18805a0c4489 (patch)
treeeccb7d719d3ca507893680773971963313bd56c2 /lib/ur/top.ur
parentdadc173e9a2d4f130a573f59adce2e386901c18d (diff)
grid1 compiles but gets stuck in JS
Diffstat (limited to 'lib/ur/top.ur')
-rw-r--r--lib/ur/top.ur21
1 files changed, 21 insertions, 0 deletions
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index ce110b27..7073884f 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -155,6 +155,17 @@ fun foldR2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: {K} -> Type]
f [nm] [t] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
(fn _ _ => i)
+fun foldR3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
+ (f : nm :: Name -> t :: K -> rest :: {K}
+ -> [[nm] ~ rest] =>
+ tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
+ (i : tr []) [r :: {K}] (fl : folder r) =
+ fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r]
+ (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+ (acc : _ -> _ -> _ -> tr rest) r1 r2 r3 =>
+ f [nm] [t] [rest] ! r1.nm r2.nm r3.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm)))
+ (fn _ _ _ => i)
+
fun foldRX [K] [tf :: K -> Type] [ctx :: {Unit}]
(f : nm :: Name -> t :: K -> rest :: {K}
-> [[nm] ~ rest] =>
@@ -174,6 +185,16 @@ fun foldRX2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [ctx :: {Unit}]
<xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>)
<xml/>
+fun foldRX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx :: {Unit}]
+ (f : nm :: Name -> t :: K -> rest :: {K}
+ -> [[nm] ~ rest] =>
+ tf1 t -> tf2 t -> tf3 t -> xml ctx [] []) =
+ foldR3 [tf1] [tf2] [tf3] [fn _ => xml ctx [] []]
+ (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
+ r1 r2 r3 acc =>
+ <xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
+ <xml/>
+
fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
[tables ~ exps] (q : sql_query tables exps)
(f : $(exps ++ map (fn fields :: {Type} => $fields) tables)