[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