[MLton-commit] r6501

Vesa Karvonen vesak at mlton.org
Tue Mar 25 03:45:34 PST 2008


Changed to use function composition rather than a list to collect unlink
effects.  Apparently this allows MLton to optimize better in some cases,
because it speeded up toy benchmarks using the library.

Also some indentation changes; I've switched from indent by 3 columns to 1
columns for function arguments.

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

U   mltonlib/trunk/com/ssh/async/unstable/detail/async.sml

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

Modified: mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/detail/async.sml	2008-03-23 07:14:21 UTC (rev 6500)
+++ mltonlib/trunk/com/ssh/async/unstable/detail/async.sml	2008-03-25 11:45:33 UTC (rev 6501)
@@ -16,16 +16,14 @@
 
    structure Handler = struct
       datatype 'a t =
-         T of {unlink : Unit.t Effect.t List.t Ref.t, effect : 'a Effect.t}
-      fun new () = T {unlink = ref [], effect = id}
+         T of {unlink : Unit.t Effect.t Ref.t, effect : 'a Effect.t}
+      fun new () = T {unlink = ref Effect.nop, effect = id}
       fun prepend f (T t) = T {unlink = #unlink t, effect = #effect t o f}
-      fun pushFront ul (h as T t) =
-          (List.push (#unlink t) (UnlinkableList.pushFront ul h)
-         ; false)
+      fun pushFront ul (h as T {unlink, ...}) =
+          (unlink := !unlink o UnlinkableList.pushFront ul h ; false)
       val handlers : Unit.t Effect.t Queue.t = Queue.new ()
       fun schedule a (T {unlink, effect}) =
-          (app (pass ()) (!unlink)
-         ; Queue.enque handlers (fn () => effect a))
+          (!unlink () ; Queue.enque handlers (fn () => effect a))
       fun runAll () = Queue.appClear (pass ()) handlers
    end
 
@@ -33,17 +31,16 @@
       datatype 'a t = E of ('a Handler.t UnPr.t, 'a) Sum.t Thunk.t
       fun on (E t) f =
           E (fn () =>
-                INL (fn h => let
-                           val h = Handler.prepend f h
-                        in
-                           case t ()
-                            of INL ef => ef h
-                             | INR v =>
-                               (Handler.schedule
-                                   ()
-                                   (Handler.prepend (const v) h)
-                              ; true)
-                        end))
+                INL (fn h =>
+                        case Handler.prepend f h
+                         of h =>
+                            case t ()
+                             of INL ef => ef h
+                              | INR v =>
+                                (Handler.schedule
+                                  ()
+                                  (Handler.prepend (const v) h)
+                               ; true)))
       fun (E l) <|> (E r) =
           E (fn () =>
                 case l ()
@@ -77,16 +74,16 @@
          val rs = Array.array (!n, NONE)
       in
          List.appi
-            (fn (i, e) =>
-                when e (fn v =>
-                           (Array.update (rs, i, SOME v)
-                          ; n := !n - 1
-                          ; if 0 = !n
-                            then done (Stream.toList
-                                          (Stream.map
-                                              valOf (Stream.fromArray rs)))
-                            else ())))
-            es
+          (fn (i, e) =>
+              when e (fn v =>
+                         (Array.update (rs, i, SOME v)
+                        ; n := !n - 1
+                        ; if 0 = !n
+                          then done (Stream.toList
+                                      (Stream.map
+                                        valOf (Stream.fromArray rs)))
+                          else ())))
+          es
       end
    end
 
@@ -108,10 +105,9 @@
                 case UnlinkableList.popBack ts
                  of SOME th => (Handler.schedule v th ; INR ())
                   | NONE =>
-                    INL (fn h as Handler.T t =>
-                            (List.push (#unlink t)
-                                       (UnlinkableList.pushFront
-                                           gs {handler = h, value = v})
+                    INL (fn h as Handler.T {unlink, ...} =>
+                            (unlink := !unlink o UnlinkableList.pushFront
+                                                  gs {handler = h, value = v}
                            ; false)))
    end
 




More information about the MLton-commit mailing list