From 44eb43907a88455c0cf223a411860a27d59c78b6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 15 Sep 2009 10:18:56 -0400
Subject: Summary row with aggregates

---
 lib/ur/monad.ur  | 9 +++++++++
 lib/ur/monad.urs | 6 ++++++
 lib/ur/top.ur    | 7 +++++++
 lib/ur/top.urs   | 9 ++++++---
 4 files changed, 28 insertions(+), 3 deletions(-)

(limited to 'lib/ur')

diff --git a/lib/ur/monad.ur b/lib/ur/monad.ur
index 96c46311..efba7546 100644
--- a/lib/ur/monad.ur
+++ b/lib/ur/monad.ur
@@ -59,3 +59,12 @@ fun mapR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: K -> Type]
         v' <- f [nm] [t] v;
         return (acc ++ {nm = v'}))
     {}
+
+fun mapR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: K -> Type]
+         (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> m (tr t)) =
+    @@foldR2 [m] _ [tf1] [tf2] [fn r => $(map tr r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (v1 : tf1 t) (v2 : tf2 t)
+                     (acc : $(map tr rest)) =>
+        v' <- f [nm] [t] v1 v2;
+        return (acc ++ {nm = v'}))
+    {}
diff --git a/lib/ur/monad.urs b/lib/ur/monad.urs
index 27fe255f..9ad9262d 100644
--- a/lib/ur/monad.urs
+++ b/lib/ur/monad.urs
@@ -39,3 +39,9 @@ val mapR : K --> m ::: (Type -> Type) -> monad m
            -> tr :: (K -> Type)
            -> (nm :: Name -> t :: K -> tf t -> m (tr t))
            -> r :: {K} -> folder r -> $(map tf r) -> m ($(map tr r))
+
+val mapR2 : K --> m ::: (Type -> Type) -> monad m
+            -> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
+            -> tr :: (K -> Type)
+            -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> m (tr t))
+            -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m ($(map tr r))
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 7073884f..67e75573 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -105,6 +105,13 @@ fun map2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type]
         acc (r1 -- nm) (r2 -- nm) ++ {nm = f r1.nm r2.nm})
     (fn _ _ => {})
 
+fun map3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tf :: K -> Type]
+         (f : t ::: K -> tf1 t -> tf2 t -> tf3 t -> tf t) [r :: {K}] (fl : folder r) =
+    fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> $(map tf r)]
+    (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 r3 =>
+        acc (r1 -- nm) (r2 -- nm) (r3 -- nm) ++ {nm = f r1.nm r2.nm r3.nm})
+    (fn _ _ _ => {})
+
 fun foldUR [tf :: Type] [tr :: {Unit} -> Type]
            (f : nm :: Name -> rest :: {Unit}
                 -> [[nm] ~ rest] =>
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index a19961f4..637c4e5d 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -48,9 +48,12 @@ val txt : t ::: Type -> ctx ::: {Unit} -> use ::: {Type} -> show t -> t
 val mp : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type)
          -> (t ::: K -> tf1 t -> tf2 t)
          -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r)
-val map2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type)
-           -> (t ::: K -> tf1 t -> tf2 t -> tf3 t)
-           -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r)
+val map2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf :: (K -> Type)
+           -> (t ::: K -> tf1 t -> tf2 t -> tf t)
+           -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf r)
+val map3 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) -> tf :: (K -> Type)
+           -> (t ::: K -> tf1 t -> tf2 t -> tf3 t -> tf t)
+           -> r :: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> $(map tf r)
 
 val foldUR : tf :: Type -> tr :: ({Unit} -> Type)
              -> (nm :: Name -> rest :: {Unit}
-- 
cgit v1.2.3