[MLton-commit] r5388

Vesa Karvonen vesak at mlton.org
Sat Mar 3 09:05:44 PST 2007


Renamed the failing function to raising and introduced new functions
failing and fail.  Renamed a few type constructors to better reflect their
meaning.  Moved some functionality from the extended-basis Fn module and
the misc-util Basic module to a new extended-basis module Basic.

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

U   mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/basic.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/promise.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/tie.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
A   mltonlib/trunk/com/ssh/extended-basis/unstable/public/basic.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig
U   mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/basic.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/cache.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/compare.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/dummy.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/eq.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/infixes.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache-test.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/type-util.sml
U   mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml

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

Modified: mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/detail/async.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/async/unstable/detail/async.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -104,7 +104,7 @@
               NONE => ()
             | SOME th =>
               case Queue.deque vs of
-                 NONE => raise Fail "impossible"
+                 NONE => fail "impossible"
                | SOME v => Handler.schedule v th)
    end
 

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/basic.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/basic.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/basic.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -0,0 +1,14 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Basic :> BASIC = struct
+   fun fail m = raise Fail m
+   fun failing m _ = fail m
+   fun raising e _ = raise e
+   fun recur x = Fn.flip Fn.fix x
+   fun repeat f n x = if n = 0 then x else repeat f (n-1) (f x)
+   fun undefined _ = fail "undefined"
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/basic.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -8,15 +8,12 @@
    open Fn
    fun const x _ = x
    fun curry f x y = f (x, y)
-   fun failing e _ = raise e
    fun fix f x = f (fix f) x
    fun flip f x y = f y x
    fun id x = x
    fun map (f, g) h = g o h o f
    fun pass x f = f x
-   fun recur x = flip fix x
    fun uncurry f (x, y) = f x y
-   fun undefined _ = raise Fail "undefined"
    val op o = op o
    fun op <\ (x, f) y = f (x, y)
    fun op \> (f, y) = f y

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/promise.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/promise.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/promise.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -30,7 +30,7 @@
 
    fun toThunk promise =
        case !(!promise) of
-          EAGER s => Sum.sum (Fn.failing, Fn.const) s
+          EAGER s => Sum.sum (Basic.raising, Fn.const) s
         | LAZY _ => fn () => force promise
 
    fun tie s k =
@@ -40,5 +40,5 @@
 
    fun Y ? =
        Tie.tier (fn () => Pair.map (Fn.id, tie)
-                                   (Sq.mk (lazy (Fn.failing Fix.Fix)))) ?
+                                   (Sq.mk (lazy (Basic.raising Fix.Fix)))) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -9,11 +9,11 @@
 
    infix >>=
 
-   type 'a monad_d = Univ.t and 'a monad_r = ('a * Univ.t) Option.t
+   type 'a monad_dom = Univ.t and 'a monad_cod = ('a * Univ.t) Option.t
 
    structure Monad =
       MkMonadP
-         (type 'a monad = 'a monad_d -> 'a monad_r
+         (type 'a monad = 'a monad_dom -> 'a monad_cod
           fun return a s = SOME (a, s)
           fun aM >>= a2bM = Option.mapPartial (Fn.uncurry a2bM) o aM
           fun zero _ = NONE

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm	2007-03-03 17:05:32 UTC (rev 5388)
@@ -8,6 +8,7 @@
    group(funs.cm)
    source(-)
 is
+   ../../public/basic.sig
    ../../public/concept/bitwise.sig
    ../../public/concept/cstringable.sig
    ../../public/concept/flags.sig

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm	2007-03-03 17:05:32 UTC (rev 5388)
@@ -13,6 +13,7 @@
    ../../public/lazy/promise.sig
    ../array-slice.sml
    ../array.sml
+   ../basic.sml
    ../bin-fn.sml
    ../bin-op.sml
    ../bin-pr.sml

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/tie.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/tie.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/tie.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -5,9 +5,9 @@
  *)
 
 structure Tie :> TIE = struct
-   type 'a t_domain = Unit.t
-   type 'a t_range = 'a * 'a UnOp.t
-   type 'a t = 'a t_domain -> 'a t_range
+   type 'a t_dom = Unit.t
+   type 'a t_cod = 'a * 'a UnOp.t
+   type 'a t = 'a t_dom -> 'a t_cod
    fun fix a f = let val (a, ta) = a () in ta (f a) end
    val pure = Fn.id
    fun tier th = (fn (a, ta) => (a, Fn.const a o ta)) o th
@@ -19,5 +19,5 @@
    fun fromRef rf x = !rf x
    fun function ? =
        tier (fn () => Pair.map (fromRef, Fn.curry op :=)
-                               (Sq.mk (ref (Fn.failing Fix.Fix)))) ?
+                               (Sq.mk (ref (Basic.raising Fix.Fix)))) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -7,8 +7,8 @@
 structure Writer :> WRITER = struct
    open Writer
 
-   type 'a func_d = 'a * Univ.t and 'a func_r = Univ.t
-   type 'a func = 'a func_d -> 'a func_r
+   type 'a func_dom = 'a * Univ.t and 'a func_cod = Univ.t
+   type 'a func = 'a func_dom -> 'a func_cod
    fun map b2a wA = wA o Pair.map (b2a, Fn.id)
 
    fun polymorphically uA2uB = let

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2007-03-03 17:05:32 UTC (rev 5388)
@@ -50,6 +50,11 @@
 
          basis Void = bas public/void.sig end
          basis Fn = bas public/fn/fn.sig detail/fn.sml end
+         basis Basic = let
+            open Fn
+         in
+            bas public/basic.sig detail/basic.sml end
+         end
          basis Unit = bas public/data/unit.sig end
          basis Sq = bas public/data/sq.sig detail/sq.sml end
          basis BinFn = let
@@ -138,7 +143,7 @@
             bas public/generic/iso.sig detail/iso.sml end
          end
          basis Tie = let
-            open Fix Fn Iso Products Sq
+            open Basic Fix Fn Iso Products Sq
          in
             bas public/generic/tie.sig detail/tie.sml end
          end
@@ -218,7 +223,7 @@
             detail/$(SML_COMPILER)/texts.sml
          end
          basis Promise = let
-            open Exn Fix Fn Products Sq Sum Tie
+            open Basic Exn Fix Fn Products Sq Sum Tie
          in
             bas public/lazy/promise.sig detail/promise.sml end
          end
@@ -231,7 +236,7 @@
             bas detail/mk-word-flags.fun end
          end
 
-         open BinFn BinOp BinPr Bool Buffer
+         open Basic BinFn BinOp BinPr Bool Buffer
          open Cmp
          open Effect Emb Exit Exn
          open Fix Fn

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2007-03-03 17:05:32 UTC (rev 5388)
@@ -24,6 +24,7 @@
         "detail/"^compiler^"/extensions.use",
         "public/void.sig",
         "public/fn/fn.sig", "detail/fn.sml",
+        "public/basic.sig", "detail/basic.sml",
         "public/data/unit.sig",
         "public/data/sq.sig", "detail/sq.sml",
         "public/fn/bin-fn.sig", "detail/bin-fn.sml",

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/basic.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/basic.sig	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/basic.sig	2007-03-03 17:05:32 UTC (rev 5388)
@@ -0,0 +1,29 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(** Basic utilities. *)
+signature BASIC = sig
+   val fail : String.t -> 'a
+   (** {fail m} is equivalent to {raise Fail m}. *)
+
+   val failing : String.t -> 'a -> 'b
+   (** A failing function; {failing m} is equivalent to {raising (Fail m)}. *)
+
+   val raising : Exn.t -> 'a -> 'b
+   (**
+    * Returns a function that raises the given exception when called.
+    * {raising e} is equivalent to {let val e = e in fn _ => raise e end}.
+    *)
+
+   val recur : 'a -> ('a -> 'b) UnOp.t -> 'b
+   (** {recur} is same as {Fn.flip Fn.fix}. *)
+
+   val repeat : 'a UnOp.t -> Int.t -> 'a UnOp.t
+   (** {repeat f n x} repeats {f} {n}-times starting with {x}. *)
+
+   val undefined : 'a -> 'b
+   (** An undefined function equivalent to {failing "undefined"}. *)
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/basic.sig
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -25,6 +25,7 @@
 
 signature ARRAY = ARRAY
 signature ARRAY_SLICE = ARRAY_SLICE
+signature BASIC = BASIC
 signature BIN_FN = BIN_FN
 signature BIN_OP = BIN_OP
 signature BIN_PR = BIN_PR
@@ -88,6 +89,7 @@
 
 structure Array : ARRAY = Array
 structure ArraySlice : ARRAY_SLICE = ArraySlice
+structure Basic : BASIC = Basic
 structure BinFn : BIN_FN = BinFn
 structure BinOp : BIN_OP = BinOp
 structure BinPr : BIN_PR = BinPr

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -6,13 +6,23 @@
 
 (** == Top-Level Bindings == *)
 
-(** === Datatypes === *)
+(** === Types === *)
 
 datatype product = datatype Product.product
 datatype sum = datatype Sum.sum
+type void = Void.t
 
-(** === Functions === *)
+(** === Values === *)
 
+(** ==== Basic ==== *)
+
+val fail = Basic.fail
+val failing = Basic.failing
+val raising = Basic.raising
+val recur = Basic.recur
+val repeat = Basic.repeat
+val undefined = Basic.undefined
+
 (** ==== Exn ==== *)
 
 val finally = Exn.finally
@@ -22,13 +32,11 @@
 
 val const = Fn.const
 val curry = Fn.curry
-val failing = Fn.failing
 val flip = Fn.flip
 val id = Fn.id
 val pass = Fn.pass
-val recur = Fn.recur
 val uncurry = Fn.uncurry
-val undefined = Fn.undefined
+
 val op /> = Fn./>
 val op </ = Fn.</
 val op <\ = Fn.<\
@@ -50,6 +58,7 @@
 
 (** ==== UnPr ==== *)
 
+val negate = UnPr.negate
+
 val op andAlso = UnPr.andAlso
-val negate = UnPr.negate
 val op orElse = UnPr.orElse

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig	2007-03-03 17:05:32 UTC (rev 5388)
@@ -21,12 +21,6 @@
    val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c
    (** Currying ({curry f x y = f (x, y)}). *)
 
-   val failing : exn -> 'a -> 'b
-   (**
-    * A failing function; {failing e} is equivalent to {fn _ => raise e},
-    * assuming {e} is a variable.
-    *)
-
    val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
    (** Flip the order of arguments ({flip f x y = f y x}). *)
 
@@ -42,15 +36,6 @@
    val pass : 'a -> ('a -> 'b) -> 'b
    (** Pass to continuation ({pass x f = f x}). *)
 
-   val recur : 'a -> ('a -> 'b) UnOp.t -> 'b
-   (** {recur} is same as {flip fix}. *)
-
-   val undefined : 'a -> 'b
-   (**
-    * An undefined function.  This is equivalent to {failing (Fail
-    * "undefined")}.
-    *)
-
    val <\ : 'a * ('a * 'b -> 'c) -> 'b -> 'c
    (** Left section ({(x <\ f) y = f (x, y)}). *)
 

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-03-03 17:05:32 UTC (rev 5388)
@@ -20,14 +20,13 @@
  * See also: http://mlton.org/Fixpoints
  *)
 signature TIE = sig
-   type 'a t_domain
-   type 'a t_range
-   type 'a t = 'a t_domain -> 'a t_range
+   type 'a t_dom and 'a t_cod
+   type 'a t = 'a t_dom -> 'a t_cod
    (**
     * The type of fixpoint tiers.
     *
-    * The type constructors {t_domain} and {t_range} are used to expose
-    * the arrow {->} type constructor (to allow eta-expansion) while
+    * The type constructors {t_dom} and {t_cod} are used to expose the
+    * arrow {->} type constructor (to allow eta-expansion) while
     * preventing clients from actually applying tiers.
     *)
 

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig	2007-03-03 17:05:32 UTC (rev 5388)
@@ -10,8 +10,8 @@
 
    (** == Monad Interface == *)
 
-   type 'a monad_d and 'a monad_r
-   include MONADP_CORE where type 'a monad = 'a monad_d -> 'a monad_r
+   type 'a monad_dom and 'a monad_cod
+   include MONADP_CORE where type 'a monad = 'a monad_dom -> 'a monad_cod
    structure Monad : MONADP where type 'a monad = 'a monad
 
    val polymorphically : ('a monad -> 'b monad) -> ('a, 's) t -> ('b, 's) t

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig	2007-03-03 17:05:32 UTC (rev 5388)
@@ -10,8 +10,8 @@
 
    (** == Functor Interface == *)
 
-   type 'a func_d and 'a func_r
-   include CFUNC where type 'a func = 'a func_d -> 'a func_r
+   type 'a func_dom and 'a func_cod
+   include CFUNC where type 'a func = 'a func_dom -> 'a func_cod
 
    val polymorphically : ('a func -> 'b func) -> ('a, 's) t -> ('b, 's) t
 end

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -139,7 +139,7 @@
            typ = Typ.--> (aTyp, bTyp)}
 
    val exn = let val e = Fail "Arbitrary.exn not supported yet"
-             in IN {gen = failing e, cog = failing e, typ = Typ.exn}
+             in IN {gen = raising e, cog = raising e, typ = Typ.exn}
              end
    fun regExn _ _ = ()
 

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/basic.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/basic.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/basic.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -9,8 +9,7 @@
  * in the language standard library or prelude.
  *)
 structure Basic :> sig
-   val repeat : 'a UnOp.t -> Int.t -> 'a UnOp.t
-   (** {repeat f n x} repeats {f} {n}-times starting with {x}. *)
+   include BASIC (** From the Extended Basis *)
 
    val += : (Int.t Ref.t * Int.t) Effect.t
    (** {c += n} is equivalent to {c := !c + n}. *)
@@ -18,7 +17,7 @@
    val -= : (Int.t Ref.t * Int.t) Effect.t
    (** {c -= n} is equivalent to {c := !c - n}. *)
 end = struct
-   fun repeat f n x = if n = 0 then x else repeat f (n-1) (f x)
+   open Basic
 
    fun c += n = c := !c + n
    fun c -= n = c := !c - n

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/cache.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/cache.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/cache.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -52,7 +52,7 @@
    fun access action (IN {table, ...}) key =
        T.access table (keyToWord key) action
 
-   fun get ? = access (A.get {none = failing NotFound, some = A.return}) ?
-   fun use ? = access (A.get {none = failing NotFound, some = A.remove}) ?
-   fun rem ? = access (A.peek {none = failing NotFound, some = A.remove}) ?
+   fun get ? = access (A.get {none = raising NotFound, some = A.return}) ?
+   fun use ? = access (A.get {none = raising NotFound, some = A.remove}) ?
+   fun rem ? = access (A.peek {none = raising NotFound, some = A.remove}) ?
 end

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/compare.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/compare.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/compare.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -53,14 +53,14 @@
    local
       val e = Fail "Compare.--> not supported"
    in
-      fun _ --> _ = failing e
+      fun _ --> _ = raising e
    end
 
    (* XXX It is also possible to implement exn so that compare provides
     * a reasonable answer as long as at least one of the exception
     * variants (involved in a comparison) has been registered.
     *)
-   val exn : exn t ref = ref TypeUtil.failExnSq
+   val exn : Exn.t t Ref.t = ref TypeUtil.failExnSq
    fun regExn t (_, prj) =
        Ref.modify (fn exn =>
                       fn (l, r) =>

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/dummy.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/dummy.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/dummy.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -75,7 +75,7 @@
    local
       val e = Fail "Dummy.-->"
    in
-      fun _ --> _ = SOME (failing e)
+      fun _ --> _ = SOME (raising e)
    end
 
    val exn = SOME Empty

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/eq.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/eq.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -53,10 +53,10 @@
    local
       val e = Fail "Eq.--> not supported"
    in
-      fun _ --> _ = failing e
+      fun _ --> _ = raising e
    end
 
-   val exn : exn t ref = ref TypeUtil.failExnSq
+   val exn : Exn.t t Ref.t = ref TypeUtil.failExnSq
    fun regExn t (_, prj) =
        Ref.modify (fn exn =>
                       fn (l, r) =>

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/infixes.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/infixes.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/infixes.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -7,7 +7,7 @@
 (*
  * Global operator precedence table.
  *
- * We assume here the modified precedence table of the extended basis library.
+ * We assume here the modified precedence table of the Extended Basis library.
  *)
 
 (* ************************************************************************** *)
@@ -20,7 +20,7 @@
 infixr 6 ! <$> <$$>  !
          ! </> <//>  !
 (* ========================================================================== *)
-infix  1 ! <-        ! += -=
+infix  1 ! <-        !
 (* ************************************************************************** *)
 
 nonfix ! (* We just used ! above as a visual separator. *)

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache-test.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache-test.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache-test.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -18,7 +18,7 @@
                    val () = eq (0, size c)
                    val k5 = put c 5
                    val () = (eq (1, size c)
-                           ; notFound (fn () => putWith c (failing NotFound))
+                           ; notFound (fn () => putWith c (raising NotFound))
                            ; eq (1, size c)
                            ; eq (5, get c k5))
                    val k2 = put c 2

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -41,7 +41,7 @@
           ; nUnused += 1 ; nUsed -= 1
           ; while !nUsed < !nUnused do
                case pop () of
-                  NONE => raise Fail "bug"
+                  NONE => fail "bug"
                 | SOME k => C.free' k
          end
       end

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/type-util.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/type-util.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/type-util.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -13,7 +13,7 @@
    val failExnSq : Exn.t Sq.t -> 'a
 end = struct
    val ` = Exn.name
-   fun failCat ss = raise Fail (concat ss)
+   fun failCat ss = fail (concat ss)
    fun failExn e = failCat ["unregistered exn ", `e]
    fun failExnSq (l, r) = failCat ["unregistered exns ", `l, " and ", `r]
 end

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-03-03 14:35:33 UTC (rev 5387)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-03-03 17:05:32 UTC (rev 5388)
@@ -235,7 +235,7 @@
              else if ty = multiSz  then MULTI_SZ o toMultiSz
              else if ty = qword    then QWORD o Word64.fromLittleBytes
              else if ty = sz       then SZ o toSz
-             else raise Fail "Unsupported RegQueryValueEx functionality"
+             else fail "Unsupported RegQueryValueEx functionality"
 
          val toBin =
           fn BINARY x => (binary, x)
@@ -365,8 +365,7 @@
                            (fn () => F name [A (lst ptr) (map #1 ws),
                                              A (opt time) t])
                      else
-                        raise Fail "Unsupported WaitForMultipleObjects\
-                                   \ functionality"
+                        fail "Unsupported WaitForMultipleObjects functionality"
                   end))
       end
 




More information about the MLton-commit mailing list