[MLton-commit] r4893
Vesa Karvonen
vesak at mlton.org
Fri Dec 1 04:32:19 PST 2006
Added scoped resource management combinators.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/basis.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.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
A mltonlib/trunk/com/ssh/extended-basis/unstable/detail/with.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export.sml
A mltonlib/trunk/com/ssh/extended-basis/unstable/public/with.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/basis.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/basis.use 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/basis.use 2006-12-01 12:32:07 UTC (rev 4893)
@@ -4,4 +4,8 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
+(* The use files of this library assume that they are used from the root
+ * directory of this library (the directory of this file).
+ *)
+
val () = use "extensions.use"
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml 2006-12-01 12:32:07 UTC (rev 4893)
@@ -50,3 +50,4 @@
structure BinPr = struct type 'a t = 'a Sq.t UnPr.t end
structure Emb = struct type ('a, 'b) t = ('a -> 'b) * ('b -> 'a Option.t) end
structure Iso = struct type ('a, 'b) t = ('a -> 'b) * ('b -> 'a) end
+structure With = struct type ('a, 'b) t = ('a -> 'b) -> 'b end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/sigs.cm 2006-12-01 12:32:07 UTC (rev 4893)
@@ -51,6 +51,7 @@
../../public/univ.sig
../../public/vector-slice.sig
../../public/vector.sig
+ ../../public/with.sig
../../public/word.sig
../../public/writer.sig
funs.cm
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/unsealed.cm 2006-12-01 12:32:07 UTC (rev 4893)
@@ -47,6 +47,7 @@
../univ.sml
../vector-slice.sml
../vector.sml
+ ../with.sml
../writer.sml
ext.sml
sigs.cm
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/with.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/with.sml 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/with.sml 2006-12-01 12:32:07 UTC (rev 4893)
@@ -0,0 +1,28 @@
+(* Copyright (C) 2006 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 With :> WITH = struct
+ open With
+
+ infix >>= >>&
+
+ val return = Fn.pass
+ fun (wA >>= a2wB) f = wA (fn a => a2wB a f)
+
+ fun alloc g a f = f (g a)
+ fun free ef x f = (f x handle e => (ef x ; raise e)) before ef x
+
+ fun (wA >>& wB) f = wA (fn a => wB (fn b => f (Product.& (a, b))))
+ fun around new del = alloc new () >>= free del
+ fun entry ef = alloc ef ()
+ fun exit ef = free ef ()
+ local
+ fun `f x () = f x
+ in
+ fun calling {entry, exit} v = around (`entry v) (`exit v)
+ fun passing ef {entry, exit} = around (`ef entry) (`ef exit)
+ end
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/with.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2006-12-01 12:32:07 UTC (rev 4893)
@@ -76,6 +76,11 @@
detail/product.sml
end
end
+ basis With = let
+ open Fn Products
+ in
+ bas public/with.sig detail/with.sml end
+ end
basis Sum = let open Fn in bas public/sum.sig detail/sum.sml end end
basis Exn = let
open Effect Ext Sum
@@ -186,7 +191,7 @@
open Scalars Seqs Sq Sum
open Thunk Tie
open Unit Univ UnOp UnPr
- open Writer
+ open With Writer
in
public/export-$(SML_COMPILER).sml
public/export.sml
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2006-12-01 12:32:07 UTC (rev 4893)
@@ -34,6 +34,7 @@
"detail/pair.sml",
"public/product.sig",
"detail/product.sml",
+ "public/with.sig", "detail/with.sml",
"public/sum.sig", "detail/sum.sml",
"public/exn.sig", "detail/exn.sml",
"public/emb.sig", "detail/emb.sml",
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export.sml 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export.sml 2006-12-01 12:32:07 UTC (rev 4893)
@@ -50,6 +50,7 @@
signature UN_PR = UN_PR
signature VECTOR = VECTOR
signature VECTOR_SLICE = VECTOR_SLICE
+signature WITH = WITH
signature WORD = WORD
signature WRITER = WRITER
@@ -99,6 +100,7 @@
structure Univ : UNIV = Univ
structure Vector : VECTOR = Vector
structure VectorSlice : VECTOR_SLICE = VectorSlice
+structure With : WITH = With
structure Word : WORD = Word
structure Word8 : WORD = Word8
structure Word8Array : MONO_ARRAY = Word8Array
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/with.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/with.sig 2006-12-01 09:50:48 UTC (rev 4892)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/with.sig 2006-12-01 12:32:07 UTC (rev 4893)
@@ -0,0 +1,83 @@
+(* Copyright (C) 2006 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.
+ *)
+
+(** Scoped resource management combinators. *)
+signature WITH = sig
+ type ('a, 'b) t = ('a -> 'b) -> 'b
+ (**
+ * Type for a form of continuation-passing style.
+ *
+ * In this context, a function of type {('a -> 'b) -> 'b} is referred
+ * to as a "with -procedure", and a continuation, of type {'a -> 'b},
+ * given to a with -procedure is called a "block".
+ *)
+
+ (** == Monad Interface == *)
+
+ val return : 'a -> ('a, 'r) t
+ (** Calls the block with the specified value. Also see {alloc}. *)
+
+ val >>= : ('a, 'r) t * ('a -> ('b, 'r) t) -> ('b, 'r) t
+ (**
+ * Composes two with -procedures, passing any value produced by the
+ * first as an argument to the second.
+ *)
+
+ (** == Primitives == *)
+
+ val alloc : ('a -> 'b) -> 'a -> ('b, 'r) t
+ (**
+ * Apply the given function with the given value just before entry to
+ * the block.
+ *
+ * This is basically a lazy version of {return}. Specifically, {alloc
+ * g a} is equivalent to {fn f => f (g a)}, assuming {g} and {a} are
+ * variables.
+ *)
+
+ val free : 'a Effect.t -> 'a -> ('a, 'r) t
+ (**
+ * Performs the effect with the given value after exit from the block.
+ * This is basically a variation of {finally}. Specifically, {free ef
+ * x f} is equivalent to {finally (fn () => f x, fn () => ef x)}.
+ *)
+
+ (** == Useful Combinations == *)
+
+ val >>& : ('a, 'r) t * ('b, 'r) t -> (('a, 'b) Product.t, 'r) t
+ (** Product combinator. *)
+
+ val around : 'a Thunk.t -> 'a Effect.t -> ('a, 'r) t
+ (**
+ * Allocate resources with given thunk before entry to the block and
+ * release the resource with given effect after exit from the block.
+ * {around new del} is equivalent to {alloc new () >>= free del}.
+ *)
+
+ val entry : Unit.t Effect.t -> (Unit.t, 'r) t
+ (**
+ * Perform given effect before entry to the block.
+ *
+ * Note that the identifier {before} is already used in the Standard ML
+ * Basis Library.
+ *)
+
+ val exit : Unit.t Effect.t -> (Unit.t, 'r) t
+ (** Perform given effect after exit from the block. *)
+
+ val calling :
+ {entry : 'a Effect.t, exit : 'a Effect.t} -> 'a -> (Unit.t, 'r) t
+ (**
+ * Call given effects with the given value before entry to and after
+ * exit from the block.
+ *)
+
+ val passing : 'a Effect.t -> {entry : 'a, exit : 'a} -> (Unit.t, 'r) t
+ (**
+ * Call given effect with a given values before entry to and after exit
+ * from the block.
+ *)
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/with.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list