[MLton-commit] r5450

Vesa Karvonen vesak at mlton.org
Mon Mar 19 05:29:13 PST 2007


Better type for Window.find.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
U   mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig

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

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-03-19 08:32:46 UTC (rev 5449)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-03-19 13:29:12 UTC (rev 5450)
@@ -77,6 +77,18 @@
    fun raiseOnNull ? = raiseOn C.Ptr.isNull' id ?
    fun raiseOnFalse ? = raiseOn (0 <\ op =) ignore ?
 
+   fun raiseOnNullIfErrorElseNone call f x = let
+      val r = f x
+   in
+      if C.Ptr.isNull' r
+      then let
+            val e = getLastError ()
+         in
+            if e = success then NONE else raiseError call e
+         end
+      else SOME r
+   end
+
    fun ptrToBool name f h = raiseOnFalse (fn () => F name [A ptr h]) f h
 
    fun withAlloc alloc = around alloc C.free'
@@ -472,7 +484,7 @@
       fun find {class, window} =
           one (withOptZs class >>& withOptZs window)
               (fn c & w =>
-                  raiseOnNull
+                  raiseOnNullIfErrorElseNone
                      (fn () => F"Window.find"
                                 [A (opt str) class, A (opt str) window])
                      F_win_FindWindow.f' (c, w))

Modified: mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig	2007-03-19 08:32:46 UTC (rev 5449)
+++ mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig	2007-03-19 13:29:12 UTC (rev 5450)
@@ -100,7 +100,8 @@
    structure Window : sig
       type t
 
-      val find : {class : String.t Option.t, window : String.t  Option.t} -> t
+      val find : {class : String.t Option.t,
+                  window : String.t Option.t} -> t Option.t
 
       structure SW : sig
          type t




More information about the MLton-commit mailing list