|
From: Vesa K. <ve...@ml...> - 2007-01-12 04:29:37
|
Initial commit of a lib of misc utils to be refactored. ---------------------------------------------------------------------- A mltonlib/trunk/com/ssh/misc-util/unstable/node.sml ---------------------------------------------------------------------- Added: mltonlib/trunk/com/ssh/misc-util/unstable/node.sml =================================================================== --- mltonlib/trunk/com/ssh/misc-util/unstable/node.sml 2007-01-12 12:29:12 UTC (rev 5037) +++ mltonlib/trunk/com/ssh/misc-util/unstable/node.sml 2007-01-12 12:29:27 UTC (rev 5038) @@ -0,0 +1,159 @@ +(* 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. + *) + +(* + * Imperative singly linked list node. This is useful and often more + * convenient than a functional list when implementing imperative data + * structures. + * + * Note that imperative lists may form cycles and, unless otherwise + * specified, procedures specified in this module are not specifically + * designed to work with cyclic lists. + *) + +structure Node :> sig + eqtype 'a t + + val new : 'a t Thunk.t + (** Allocates a new empty node. *) + + val get : 'a t -> ('a * 'a t) Option.t + (** Returns the contents of the node. *) + + val <- : ('a t * ('a * 'a t) Option.t) Effect.t + (** Sets the contents of the node. *) + + val isEmpty : 'a t UnPr.t + (** Returns true iff the imperative list is empty. *) + + val hd : 'a t -> 'a + (** + * Returns the first element of the imperative list. Raises {Empty} if + * the list is empty. + *) + + val tl : 'a t -> 'a t + (** + * Returns the next node of the imperative list. Raises {Empty} if the + * list is empty. + *) + + val push : 'a t -> 'a Effect.t + (** + * Inserts the given element into the imperative list after the given + * node. + *) + + val take : 'a t -> 'a Option.t + (** + * If the imperative list is non-empty, removes the first element {v} + * of the list and returns {SOME v}. Otherwise returns {NONE}. + *) + + val drop : 'a t Effect.t + (** + * If the imperative list is non-empty, removes the first element of + * the list. Otherwise does nothing. + *) + + val clearWith : 'a Effect.t -> 'a t Effect.t + (** + * Takes all elements of the imperative list of nodes one-by-one and + * performs the given effect on the removed elements. + *) + + val fromList : 'a List.t -> 'a t + (** Constructs an imperative list from a functional list. *) + + val app : 'a Effect.t -> 'a t Effect.t + (** + * Applies the given effect to all elements of the imperative list. + * {app} is to be implemented tail recursively. + *) + + val find : 'a UnPr.t -> 'a t -> ('a t, 'a t) Sum.t + (** + * Returns {INR n} where {n} is first node containing an element + * satisfying the given predicate or {INL n} where {n} is the last node + * in the imperative list. {find} is to be implemented tail + * recursively. + *) + + val foldl : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b + (** + * Folds the imperative lists with the given function and starting + * value. {foldl} is to be implemented tail recursively. + *) +end = struct + datatype 'a t = IN of ('a * 'a t) Option.t Ref.t + fun new () = IN (ref NONE) + fun get (IN t) = !t + fun (IN r) <- t = r := t + + (* The following only use the operations {new}, {get}, and {<-}. *) + + fun fromList l = let + val h = new () + fun lp ([], _) = () + | lp (x::xs, t) = let + val t' = new () + in + t <- SOME (x, t') + ; lp (xs, t') + end + in + lp (l, h) + ; h + end + + fun isEmpty t = + not (isSome (get t)) + + local + fun eat t = + case get t of + NONE => raise Empty + | SOME x => x + in + fun hd t = #1 (eat t) + fun tl t = #2 (eat t) + end + + fun push t x = let + val n = new () + in + n <- get t + ; t <- SOME (x, n) + end + + fun take t = + case get t of + NONE => NONE + | SOME (x, t') => (t <- get t' ; SOME x) + + fun drop t = + ignore (take t) + + fun clearWith e t = + case take t of + NONE => () + | SOME x => (e x : unit ; clearWith e t) + + fun foldl f x t = + case get t of + NONE => x + | SOME (y, t) => + foldl f (f (y, x)) t + + fun app e = + foldl (e o #1) () + + fun find p t = + case get t of + NONE => INL t + | SOME (x, t') => + if p x then INR t else find p t' +end Property changes on: mltonlib/trunk/com/ssh/misc-util/unstable/node.sml ___________________________________________________________________ Name: svn:eol-style + native |