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