[MLton-commit] r5364

[Vesa Karvonen]

Simplification.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/misc-util/unstable/node.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/queue.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/word-table.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/node.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/node.sml	2007-02-28 13:34:55 UTC (rev 5363)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/node.sml	2007-02-28 13:52:11 UTC (rev 5364)
@@ -59,10 +59,11 @@
     * the list.  Otherwise does nothing.
     *)
 
-   val clearWith : 'a Effect.t -> 'a t Effect.t
+   val appClear : 'a Effect.t -> 'a t UnOp.t
    (**
     * Takes all elements of the imperative list of nodes one-by-one and
-    * performs the given effect on the removed elements.
+    * performs the given effect on the removed elements.  Returns the
+    * last, and always empty, node of the remaining list.
     *)
 
    val fromList : 'a List.t -> 'a t
@@ -160,10 +161,10 @@
    fun drop t =
        ignore (take t)
 
-   fun clearWith e t =
-       case take t of
-          NONE => ()
-        | SOME x => (e x : unit ; clearWith e t)
+   fun appClear e t =
+       case get t of
+          NONE => t
+        | SOME (x, t') => (e x : unit ; t <- get t' ; appClear e t)
 
    fun foldl f x t =
        case get t of

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/queue.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/queue.sml	2007-02-28 13:34:55 UTC (rev 5363)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/queue.sml	2007-02-28 13:52:11 UTC (rev 5364)
@@ -15,7 +15,6 @@
    include QUEUE
    val filter : 'a UnPr.t -> 'a t Effect.t
    val filterOut : 'a UnPr.t -> 'a t Effect.t
-   val foldClear : ('a * 's -> 's) -> 's -> 'a t -> 's
    val appClear : 'a Effect.t -> 'a t Effect.t
 end = struct
    structure N = Node
@@ -49,19 +48,12 @@
           NONE => NONE
         | SOME (a, n) => (front := n ; SOME a)
 
-   fun filter p (q as IN {back, front}) =
-       case N.get (!front) of
-          NONE => ()
-        | SOME (v, n) => if p v then back := Node.filter p n
-                         else (front := n ; filter p q)
+   fun filter p (IN {back, front}) =
+       back := N.filter p (!front)
 
    fun filterOut p =
        filter (negate p)
 
-   fun foldClear f s q =
-       case deque q of
-          NONE => s
-        | SOME v => foldClear f (f (v, s)) q
-
-   fun appClear ef = foldClear (ef o #1) ()
+   fun appClear ef (IN {back, front}) =
+       back := N.appClear ef (!front)
 end

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/word-table.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/word-table.sml	2007-02-28 13:34:55 UTC (rev 5363)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/word-table.sml	2007-02-28 13:52:11 UTC (rev 5364)
@@ -46,7 +46,8 @@
          (* Theoretically speaking, it should be possible to
           * execute the following code in constant space.
           *)
-       ; V.app (N.clearWith
+       ; V.app (ignore o
+                N.appClear
                    (fn entry as (key, _) => putAt t (keyToIdx t key) entry))
                oldTable
       end