Mercurial > urweb
changeset 1313:0bf73c3e4563
Monad.appR3
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Tue, 19 Oct 2010 15:26:12 -0400 |
| parents | 726f0caeea3f |
| children | 6c2e565adca6 |
| files | lib/ur/monad.ur lib/ur/monad.urs |
| diffstat | 2 files changed, 15 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/monad.ur Tue Oct 19 11:51:53 2010 -0400 +++ b/lib/ur/monad.ur Tue Oct 19 15:26:12 2010 -0400 @@ -112,3 +112,13 @@ f [nm] [t] r1.nm r2.nm) (fn _ _ => return ()) fl + +fun appR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] + (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m unit) + [r ::: {K}] (fl : folder r) = + @Top.fold [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m unit] + (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] acc r1 r2 r3 => + acc (r1 -- nm) (r2 -- nm) (r3 -- nm); + f [nm] [t] r1.nm r2.nm r3.nm) + (fn _ _ _ => return ()) + fl
--- a/lib/ur/monad.urs Tue Oct 19 11:51:53 2010 -0400 +++ b/lib/ur/monad.urs Tue Oct 19 15:26:12 2010 -0400 @@ -70,3 +70,8 @@ -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> m unit) -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m unit + +val appR3 : K --> m ::: (Type -> Type) -> monad m + -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) + -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m unit) + -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m unit