From 7325b2f19498583eb190a70cb789dfd3e305273b Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 24 Feb 2009 13:50:39 -0500
Subject: Top.Fold.mp

---
 lib/ur/top.ur  | 11 +++++++++++
 lib/ur/top.urs |  2 ++
 2 files changed, 13 insertions(+)

diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 0fca0a5b..5ce6ea9a 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -29,6 +29,17 @@ structure Folder = struct
                             [[nm] ~ r1'] [[nm = v] ++ r1' ~ r2] =>
                f [nm] [v] [r1' ++ r2] acc !)
            (fn [[] ~ r2] => f2 [tf] f i) !
+
+    fun mp K1 K2 (f ::: K1 -> K2) (r ::: {K1})
+        (fold : folder r)
+        (tf :: {K2} -> Type)
+        (f : nm :: Name -> v :: K2 -> r :: {K2} -> tf r
+             -> [[nm] ~ r] => tf ([nm = v] ++ r))
+        (i : tf []) =
+        fold [fn r => tf (map f r)]
+        (fn (nm :: Name) (v :: K1) (rest :: {K1}) (acc : tf (map f rest)) [[nm] ~ rest] =>
+            f [nm] [f v] [map f rest] acc !)
+        i
 end
 
 
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index a32a87a3..29b34b10 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -12,6 +12,8 @@ structure Folder : sig
                -> [[nm] ~ r] => folder r -> folder ([nm = v] ++ r)
     val concat : K --> r1 ::: {K} -> r2 ::: {K}
                  -> [r1 ~ r2] => folder r1 -> folder r2 -> folder (r1 ++ r2)
+    val mp : K1 --> K2 --> f ::: (K1 -> K2) -> r ::: {K1}
+             -> folder r -> folder (map f r)
 end
 
 
-- 
cgit v1.2.3