# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1337441532 14400
# Node ID a613cae954ca293d0de5a7f0257837ecac0f1c83
# Parent  92cfc69419bd343fdbda9bb00d0f29b5213929c0
Some standard library additions from Edward Z. Yang

diff -r 92cfc69419bd -r a613cae954ca lib/ur/list.ur
--- a/lib/ur/list.ur	Thu May 17 10:20:24 2012 -0400
+++ b/lib/ur/list.ur	Sat May 19 11:32:12 2012 -0400
@@ -424,3 +424,16 @@
 
 fun splitAt [a] (n : int) (xs : list a) : list a * list a =
     (take n xs, drop n xs)
+
+fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
+    let
+        fun mapXiM' i ls =
+            case ls of
+                [] => return <xml/>
+              | x :: ls =>
+                this <- f i x;
+                rest <- mapXiM' (i+1) ls;
+                return <xml>{this}{rest}</xml>
+    in
+        mapXiM' 0
+    end
diff -r 92cfc69419bd -r a613cae954ca lib/ur/list.urs
--- a/lib/ur/list.urs	Thu May 17 10:20:24 2012 -0400
+++ b/lib/ur/list.urs	Sat May 19 11:32:12 2012 -0400
@@ -36,6 +36,8 @@
 val mapXM : m ::: (Type -> Type) -> monad m -> a ::: Type -> ctx ::: {Unit}
             -> (a -> m (xml ctx [] [])) -> t a -> m (xml ctx [] [])
 
+val mapXiM : m ::: (Type -> Type) -> monad m -> a ::: Type -> ctx ::: {Unit} -> (int -> a -> m (xml ctx [] [])) -> t a -> m (xml ctx [] [])
+
 val filter : a ::: Type -> (a -> bool) -> t a -> t a
 
 val exists : a ::: Type -> (a -> bool) -> t a -> bool
diff -r 92cfc69419bd -r a613cae954ca lib/ur/monad.ur
--- a/lib/ur/monad.ur	Thu May 17 10:20:24 2012 -0400
+++ b/lib/ur/monad.ur	Sat May 19 11:32:12 2012 -0400
@@ -12,6 +12,8 @@
     v <- m;
     return (f v)
 
+val liftM = @@mp
+
 fun foldR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: {K} -> Type]
           (f : nm :: Name -> t :: K -> rest :: {K}
                -> [[nm] ~ rest] =>
@@ -122,3 +124,8 @@
          f [nm] [t] r1.nm r2.nm r3.nm)
      (fn _ _ _ => return ())
      fl
+
+fun liftM2 [m ::: Type -> Type] (_ : monad m) [a] [b] [c] (f : a -> b -> c) (mx : m a) (my : m b) : m c =
+    x <- mx;
+    y <- my;
+    return (f x y)
diff -r 92cfc69419bd -r a613cae954ca lib/ur/monad.urs
--- a/lib/ur/monad.urs	Thu May 17 10:20:24 2012 -0400
+++ b/lib/ur/monad.urs	Sat May 19 11:32:12 2012 -0400
@@ -7,6 +7,13 @@
 val mp : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
          -> (a -> b) -> m a -> m b
 
+val liftM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+            -> (a -> b) -> m a -> m b
+(* Haskell-style synonym for [mp] *)
+
+val liftM2 : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> c ::: Type
+             -> (a -> b -> c) -> m a -> m b -> m c
+
 val foldR : K --> m ::: (Type -> Type) -> monad m
             -> tf :: (K -> Type)
             -> tr :: ({K} -> Type)
diff -r 92cfc69419bd -r a613cae954ca tests/monad.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/monad.urp	Sat May 19 11:32:12 2012 -0400
@@ -0,0 +1,3 @@
+$/monad
+$/list
+monadTest
diff -r 92cfc69419bd -r a613cae954ca tests/monadTest.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/monadTest.ur	Sat May 19 11:32:12 2012 -0400
@@ -0,0 +1,3 @@
+val x : transaction int = Monad.liftM2 plus (return 1) (return 2)
+
+val x : transaction xbody = List.mapXiM (fn i x => return <xml><li>{[i]} = {[x]}</li></xml>) (1 :: 2 :: [])