1(*****************************************************************************) 2(* FILE : streams.sml *) 3(* DESCRIPTION : Datatype and functions for streams (lazy lists). *) 4(* *) 5(* READS FILES : <none> *) 6(* WRITES FILES : <none> *) 7(* *) 8(* AUTHOR : R.J.Boulton, University of Cambridge *) 9(* DATE : 20th April 1991 *) 10(* *) 11(* TRANSLATOR : R.J.Boulton, University of Cambridge *) 12(* DATE : 16th February 1993 *) 13(* *) 14(* LAST MODIFIED : R.J.Boulton *) 15(* DATE : 16th February 1993 *) 16(*****************************************************************************) 17 18structure Streams :> Streams = 19struct 20 open Arbint 21 val op << = String.< 22 23 24open Portable; 25infix ##; 26 27(*---------------------------------------------------------------------------*) 28(* Datatype for lazy lists *) 29(*---------------------------------------------------------------------------*) 30 31datatype 'a stream = Stream of 'a * (unit -> 'a stream); 32 33exception end_of_stream; 34 35fun empty_stream() = raise end_of_stream 36 37(*---------------------------------------------------------------------------*) 38(* stream_map : ('a -> 'b) -> (unit -> 'a stream) -> (unit -> 'b stream) *) 39(*---------------------------------------------------------------------------*) 40 41fun stream_map f s () = 42 case s () 43 of (Stream (x,s')) => (Stream (f x,stream_map f s')); 44 45(*---------------------------------------------------------------------------*) 46(* stream_append : (unit -> 'a stream) -> *) 47(* (unit -> 'a stream) -> *) 48(* (unit -> 'a stream) *) 49(*---------------------------------------------------------------------------*) 50 51fun stream_append s1 s2 () = 52 (case s1 () 53 of (Stream (x,s1')) => (Stream (x,stream_append s1' s2))) 54 handle end_of_stream => s2 (); 55 56fun stream_append_list x = List.foldr (uncurry stream_append) empty_stream x 57 58(*---------------------------------------------------------------------------*) 59(* stream_flat : (unit -> (unit -> 'a stream) stream) -> unit -> 'a stream *) 60(*---------------------------------------------------------------------------*) 61 62fun stream_flat ss () = 63 case ss () 64 of (Stream (s,ss')) => (stream_append s (stream_flat ss') ()); 65 66(*---------------------------------------------------------------------------*) 67(* permutations : 'a list -> unit -> 'a list stream *) 68(*---------------------------------------------------------------------------*) 69 70fun permutations l () = 71 let fun remove_el n l = 72 if ((null l) orelse (n < one)) 73 then raise end_of_stream 74 else if (n = one) 75 then (hd l,tl l) 76 else let val (x,l') = remove_el (n - one) (tl l) 77 in (x,(hd l)::l') 78 end 79 fun one_smaller_subsets l = 80 let fun one_smaller_subsets' l n () = 81 if (null l) 82 then raise end_of_stream 83 else Stream (remove_el n l,one_smaller_subsets' l (n + one)) 84 in one_smaller_subsets' l one 85 end 86 in 87 if (null l) then raise end_of_stream 88 else if (null (tl l)) then Stream ([hd l],fn () => raise end_of_stream) 89 else let val oss = one_smaller_subsets l 90 val subperms = stream_map (I ## permutations) oss 91 in stream_flat 92 (stream_map (fn (x,sofl) => stream_map (fn l => x::l) sofl) 93 subperms) () 94 end 95 end; 96 97end 98