Mercurial > urweb

changeset 845:6725d73c3c31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Mark current as effectful; add List functions
author Adam Chlipala <adamc@hcoop.net>
date Tue, 09 Jun 2009 11:12:34 -0400
parents 74a1e3bdf430
children 0d30e6338c65
files lib/ur/list.ur lib/ur/list.urs src/settings.sml
diffstat 3 files changed, 39 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/list.ur	Sun Jun 07 16:45:00 2009 -0400
+++ b/lib/ur/list.ur	Tue Jun 09 11:12:34 2009 -0400
@@ -10,6 +10,16 @@
                   mkShow show'
               end
 
+fun foldl [a] [b] f =
+    let
+        fun foldl' acc ls =
+            case ls of
+                [] => acc
+              | x :: ls => foldl' (f x acc) ls
+    in
+        foldl'
+    end
+
 val rev = fn [a] =>
              let
                  fun rev' acc (ls : list a) =
@@ -123,20 +133,6 @@
         fold []
     end
 
-fun assoc [a] [b] (_ : eq a) (x : a) =
-    let
-        fun assoc' ls =
-            case ls of
-                [] => None
-              | (y, z) :: ls =>
-                if x = y then
-                    Some z
-                else
-                    assoc' ls
-    in
-        assoc'
-    end
-
 fun search [a] [b] f =
     let
         fun search' ls =
@@ -183,3 +179,22 @@
     in
         app'
     end
+
+fun assoc [a] [b] (_ : eq a) (x : a) =
+    let
+        fun assoc' (ls : list (a * b)) =
+            case ls of
+                [] => None
+              | (y, z) :: ls =>
+                if x = y then
+                    Some z
+                else
+                    assoc' ls
+    in
+        assoc'
+    end
+
+fun assocAdd [a] [b] (_ : eq a) (x : a) (y : b) (ls : t (a * b)) =
+    case assoc x ls of
+        None => (x, y) :: ls
+      | Some _ => ls
--- a/lib/ur/list.urs	Sun Jun 07 16:45:00 2009 -0400
+++ b/lib/ur/list.urs	Tue Jun 09 11:12:34 2009 -0400
@@ -2,6 +2,8 @@
 
 val show : a ::: Type -> show a -> show (list a)
 
+val foldl : a ::: Type -> b ::: Type -> (a -> b -> b) -> b -> t a -> b
+
 val rev : a ::: Type -> t a -> t a
 
 val revAppend : a ::: Type -> t a -> t a -> t a
@@ -30,11 +32,16 @@
 val foldlMap : a ::: Type -> b ::: Type -> c ::: Type
                -> (a -> b -> c * b) -> b -> t a -> t c * b
 
-val assoc : a ::: Type -> b ::: Type -> eq a -> a -> t (a * b) -> option b
-
 val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b
 
 val all : a ::: Type -> (a -> bool) -> t a -> bool
 
 val app : m ::: (Type -> Type) -> monad m -> a ::: Type
           -> (a -> m unit) -> t a -> m unit
+
+
+(** Association lists *)
+
+val assoc : a ::: Type -> b ::: Type -> eq a -> a -> t (a * b) -> option b
+
+val assocAdd : a ::: Type -> b ::: Type -> eq a -> a -> b -> t (a * b) -> t (a * b)
--- a/src/settings.sml	Sun Jun 07 16:45:00 2009 -0400
+++ b/src/settings.sml	Tue Jun 09 11:12:34 2009 -0400
@@ -83,6 +83,7 @@
                            "new_client_source",
                            "get_client_source",
                            "set_client_source",
+                           "current",
                            "alert",
                            "new_channel",
                            "send",