1(* ========================================================================= *)
2(* A POSSIBLY-INFINITE STREAM DATATYPE FOR ML                                *)
3(* Copyright (c) 2001 Joe Hurd, distributed under the BSD License            *)
4(* ========================================================================= *)
5
6structure Stream :> Stream =
7struct
8
9val K = Useful.K;
10
11val pair = Useful.pair;
12
13val funpow = Useful.funpow;
14
15(* ------------------------------------------------------------------------- *)
16(* The stream type.                                                          *)
17(* ------------------------------------------------------------------------- *)
18
19datatype 'a stream =
20    Nil
21  | Cons of 'a * (unit -> 'a stream);
22
23(* ------------------------------------------------------------------------- *)
24(* Stream constructors.                                                      *)
25(* ------------------------------------------------------------------------- *)
26
27fun repeat x = let fun rep () = Cons (x,rep) in rep () end;
28
29fun count n = Cons (n, fn () => count (n + 1));
30
31fun funpows f x = Cons (x, fn () => funpows f (f x));
32
33(* ------------------------------------------------------------------------- *)
34(* Stream versions of standard list operations: these should all terminate.  *)
35(* ------------------------------------------------------------------------- *)
36
37fun cons h t = Cons (h,t);
38
39fun null Nil = true
40  | null (Cons _) = false;
41
42fun hd Nil = raise Empty
43  | hd (Cons (h,_)) = h;
44
45fun tl Nil = raise Empty
46  | tl (Cons (_,t)) = t ();
47
48fun hdTl s = (hd s, tl s);
49
50fun singleton s = Cons (s, K Nil);
51
52fun append Nil s = s ()
53  | append (Cons (h,t)) s = Cons (h, fn () => append (t ()) s);
54
55fun map f =
56    let
57      fun m Nil = Nil
58        | m (Cons (h,t)) = Cons (f h, m o t)
59    in
60      m
61    end;
62
63fun maps f g =
64    let
65      fun mm s Nil = g s
66        | mm s (Cons (x,xs)) =
67          let
68            val (y,s') = f x s
69          in
70            Cons (y, mm s' o xs)
71          end
72    in
73      mm
74    end;
75
76fun zipwith f =
77    let
78      fun z Nil _ = Nil
79        | z _ Nil = Nil
80        | z (Cons (x,xs)) (Cons (y,ys)) =
81          Cons (f x y, fn () => z (xs ()) (ys ()))
82    in
83      z
84    end;
85
86fun zip s t = zipwith pair s t;
87
88fun take 0 _ = Nil
89  | take n Nil = raise Subscript
90  | take 1 (Cons (x,_)) = Cons (x, K Nil)
91  | take n (Cons (x,xs)) = Cons (x, fn () => take (n - 1) (xs ()));
92
93fun drop n s = funpow n tl s handle Empty => raise Subscript;
94
95(* ------------------------------------------------------------------------- *)
96(* Stream versions of standard list operations: these might not terminate.   *)
97(* ------------------------------------------------------------------------- *)
98
99local
100  fun len n Nil = n
101    | len n (Cons (_,t)) = len (n + 1) (t ());
102in
103  fun length s = len 0 s;
104end;
105
106fun exists pred =
107    let
108      fun f Nil = false
109        | f (Cons (h,t)) = pred h orelse f (t ())
110    in
111      f
112    end;
113
114fun all pred = not o exists (not o pred);
115
116fun filter p Nil = Nil
117  | filter p (Cons (x,xs)) =
118    if p x then Cons (x, fn () => filter p (xs ())) else filter p (xs ());
119
120fun foldl f =
121    let
122      fun fold b Nil = b
123        | fold b (Cons (h,t)) = fold (f (h,b)) (t ())
124    in
125      fold
126    end;
127
128fun concat Nil = Nil
129  | concat (Cons (Nil, ss)) = concat (ss ())
130  | concat (Cons (Cons (x, xs), ss)) =
131    Cons (x, fn () => concat (Cons (xs (), ss)));
132
133fun mapPartial f =
134    let
135      fun mp Nil = Nil
136        | mp (Cons (h,t)) =
137          case f h of
138            NONE => mp (t ())
139          | SOME h' => Cons (h', fn () => mp (t ()))
140    in
141      mp
142    end;
143
144fun mapsPartial f g =
145    let
146      fun mp s Nil = g s
147        | mp s (Cons (h,t)) =
148          let
149            val (h,s) = f h s
150          in
151            case h of
152              NONE => mp s (t ())
153            | SOME h => Cons (h, fn () => mp s (t ()))
154          end
155    in
156      mp
157    end;
158
159fun mapConcat f =
160    let
161      fun mc Nil = Nil
162        | mc (Cons (h,t)) = append (f h) (fn () => mc (t ()))
163    in
164      mc
165    end;
166
167fun mapsConcat f g =
168    let
169      fun mc s Nil = g s
170        | mc s (Cons (h,t)) =
171          let
172            val (l,s) = f h s
173          in
174            append l (fn () => mc s (t ()))
175          end
176    in
177      mc
178    end;
179
180(* ------------------------------------------------------------------------- *)
181(* Stream operations.                                                        *)
182(* ------------------------------------------------------------------------- *)
183
184fun memoize Nil = Nil
185  | memoize (Cons (h,t)) = Cons (h, Lazy.memoize (fn () => memoize (t ())));
186
187fun concatList [] = Nil
188  | concatList (h :: t) = append h (fn () => concatList t);
189
190local
191  fun toLst res Nil = List.rev res
192    | toLst res (Cons (x, xs)) = toLst (x :: res) (xs ());
193in
194  fun toList s = toLst [] s;
195end;
196
197fun fromList [] = Nil
198  | fromList (x :: xs) = Cons (x, fn () => fromList xs);
199
200fun listConcat s = concat (map fromList s);
201
202fun toString s = String.implode (toList s);
203
204fun fromString s = fromList (String.explode s);
205
206fun toTextFile {filename = f} s =
207    let
208      val (h,close) =
209          if f = "-" then (TextIO.stdOut, K ())
210          else (TextIO.openOut f, TextIO.closeOut)
211
212      fun toFile Nil = ()
213        | toFile (Cons (x,y)) = (TextIO.output (h,x); toFile (y ()))
214
215      val () = toFile s
216    in
217      close h
218    end;
219
220fun fromTextFile {filename = f} =
221    let
222      val (h,close) =
223          if f = "-" then (TextIO.stdIn, K ())
224          else (TextIO.openIn f, TextIO.closeIn)
225
226      fun strm () =
227          case TextIO.inputLine h of
228            NONE => (close h; Nil)
229          | SOME s => Cons (s,strm)
230    in
231      memoize (strm ())
232    end;
233
234end
235