Metaform demos, minus prose

2 files changed, 32 insertions, 0 deletions

diff --git a/lib/top.ur b/lib/top.ur
index ab506c80..91cab991 100644
--- a/lib/top.ur
+++ b/lib/top.ur
@@ -36,6 +36,26 @@ fun foldUR (tf :: Type) (tr :: {Unit} -> Type)
                  f [nm] [rest] r.nm (acc (r -- nm)))
              (fn _ => i)
 
+fun foldUR2 (tf1 :: Type) (tf2 :: Type) (tr :: {Unit} -> Type)
+           (f : nm :: Name -> rest :: {Unit}
+                -> fn [[nm] ~ rest] =>
+                      tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
+           (i : tr []) =
+    fold [fn r :: {Unit} => $(mapUT tf1 r) -> $(mapUT tf2 r) -> tr r]
+             (fn (nm :: Name) (t :: Unit) (rest :: {Unit}) acc
+                              [[nm] ~ rest] r1 r2 =>
+                 f [nm] [rest] r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
+             (fn _ _ => i)
+
+fun foldURX2 (tf1 :: Type) (tf2 :: Type) (ctx :: {Unit})
+           (f : nm :: Name -> rest :: {Unit}
+                -> fn [[nm] ~ rest] =>
+                      tf1 -> tf2 -> xml ctx [] []) =
+    foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []]
+            (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] v1 v2 acc =>
+                <xml>{f [nm] [rest] v1 v2}{acc}</xml>)
+            <xml/>
+
 fun foldTR (tf :: Type -> Type) (tr :: {Type} -> Type)
            (f : nm :: Name -> t :: Type -> rest :: {Type}
                 -> fn [[nm] ~ rest] =>
diff --git a/lib/top.urs b/lib/top.urs
index abdb7477..29a1acf1 100644
--- a/lib/top.urs
+++ b/lib/top.urs
@@ -29,6 +29,18 @@ val foldUR : tf :: Type -> tr :: ({Unit} -> Type)
                        tf -> tr rest -> tr ([nm] ++ rest))
              -> tr [] -> r :: {Unit} -> $(mapUT tf r) -> tr r
 
+val foldUR2 : tf1 :: Type -> tf2 :: Type -> tr :: ({Unit} -> Type)
+             -> (nm :: Name -> rest :: {Unit}
+                 -> fn [[nm] ~ rest] =>
+                       tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
+             -> tr [] -> r :: {Unit} -> $(mapUT tf1 r) -> $(mapUT tf2 r) -> tr r
+
+val foldURX2: tf1 :: Type -> tf2 :: Type -> ctx :: {Unit}
+              -> (nm :: Name -> rest :: {Unit}
+                  -> fn [[nm] ~ rest] =>
+                        tf1 -> tf2 -> xml ctx [] [])
+              -> r :: {Unit} -> $(mapUT tf1 r) -> $(mapUT tf2 r) -> xml ctx [] []
+
 val foldTR : tf :: (Type -> Type) -> tr :: ({Type} -> Type)
              -> (nm :: Name -> t :: Type -> rest :: {Type}
                  -> fn [[nm] ~ rest] =>