1(* ========================================================================= *)
2(* A POSSIBLY-INFINITE STREAM DATATYPE FOR ML                                *)
3(* Copyright (c) 2001-2004 Joe Hurd, distributed under the GNU GPL version 2 *)
4(* ========================================================================= *)
5
6structure Stream :> Stream =
7struct
8
9infixr 0 oo ##;
10
11(* ------------------------------------------------------------------------- *)
12(* Helper functions.                                                         *)
13(* ------------------------------------------------------------------------- *)
14
15val K = Useful.K;
16
17val pair = Useful.pair;
18
19val funpow = Useful.funpow;
20
21(* ------------------------------------------------------------------------- *)
22(* The datatype declaration encapsulates all the primitive operations        *)
23(* ------------------------------------------------------------------------- *)
24
25datatype 'a stream = NIL | CONS of 'a * (unit -> 'a stream);
26
27(* ------------------------------------------------------------------------- *)
28(* Stream constructors                                                       *)
29(* ------------------------------------------------------------------------- *)
30
31fun repeat x = let fun rep () = CONS (x, rep) in rep () end;
32
33fun count n = CONS (n, fn () => count (n + 1));
34
35fun powers f x = CONS (x, fn () => powers f (f x));
36
37(* ------------------------------------------------------------------------- *)
38(* Stream versions of standard list operations: these should all terminate   *)
39(* ------------------------------------------------------------------------- *)
40
41fun cons h t = CONS (h,t);
42
43fun null NIL = true | null (CONS _) = false;
44
45fun hd NIL = raise Empty | hd (CONS (h, _)) = h;
46
47fun tl NIL = raise Empty | tl (CONS (_, t)) = t ();
48
49fun hd_tl s = (hd s, tl s);
50
51fun sing s = CONS (s, K NIL);
52
53fun append NIL s = s ()
54  | append (CONS (h,t)) s = CONS (h, fn () => append (t ()) s);
55
56fun map f =
57    let
58      fun m NIL = NIL
59        | m (CONS (h, t)) = CONS (f h, fn () => m (t ()))
60    in
61      m
62    end;
63
64fun maps f =
65    let
66      fun mm _ NIL = NIL
67        | mm s (CONS (x, xs)) =
68          let
69            val (y, s') = f x s
70          in
71            CONS (y, fn () => mm s' (xs ()))
72          end
73    in
74      mm
75    end;
76
77fun zipwith f =
78    let
79      fun z NIL _ = NIL
80        | z _ NIL = NIL
81        | z (CONS (x,xs)) (CONS (y,ys)) =
82          CONS (f x y, fn () => z (xs ()) (ys ()))
83    in
84      z
85    end;
86
87fun zip s t = zipwith pair s t;
88
89fun take 0 _ = NIL
90  | take n NIL = raise Subscript
91  | take 1 (CONS (x,_)) = CONS (x, K NIL)
92  | take n (CONS (x,xs)) = CONS (x, fn () => take (n - 1) (xs ()));
93
94fun drop n s = funpow n tl s handle Empty => raise Subscript;
95
96(* ------------------------------------------------------------------------- *)
97(* Stream versions of standard list operations: these might not terminate    *)
98(* ------------------------------------------------------------------------- *)
99
100local
101  fun len n NIL = n
102    | len n (CONS (_,t)) = len (n + 1) (t ());
103in
104  fun length s = len 0 s;
105end;
106
107fun exists pred =
108    let
109      fun f NIL = false
110        | f (CONS (h,t)) = pred h orelse f (t ())
111    in
112      f
113    end;
114
115fun all pred = not o exists (not o pred);
116
117fun filter p NIL = NIL
118  | filter p (CONS (x,xs)) =
119    if p x then CONS (x, fn () => filter p (xs ())) else filter p (xs ());
120
121fun foldl f =
122    let
123      fun fold b NIL = b
124        | fold b (CONS (h,t)) = fold (f (h,b)) (t ())
125    in
126      fold
127    end;
128
129fun flatten NIL = NIL
130  | flatten (CONS (NIL, ss)) = flatten (ss ())
131  | flatten (CONS (CONS (x, xs), ss)) =
132    CONS (x, fn () => flatten (CONS (xs (), ss)));
133
134fun partial_map f =
135    let
136      fun mp NIL = NIL
137        | mp (CONS (h,t)) =
138          case f h of
139            NONE => mp (t ())
140          | SOME h' => CONS (h', fn () => mp (t ()))
141    in
142      mp
143    end;
144
145fun partial_maps f =
146    let
147      fun mm _ NIL = NIL
148        | mm s (CONS (x, xs)) =
149          let
150            val (yo, s') = f x s
151            val t = mm s' o xs
152          in
153            case yo of NONE => t () | SOME y => CONS (y, t)
154          end
155    in
156      mm
157    end;
158
159(* ------------------------------------------------------------------------- *)
160(* Stream operations                                                         *)
161(* ------------------------------------------------------------------------- *)
162
163fun memoize NIL = NIL
164  | memoize (CONS (h,t)) = CONS (h, Useful.memoize (fn () => memoize (t ())));
165
166local
167  fun to_lst res NIL = rev res
168    | to_lst res (CONS (x, xs)) = to_lst (x :: res) (xs ());
169in
170  fun to_list s = to_lst [] s;
171end;
172
173fun from_list [] = NIL
174  | from_list (x :: xs) = CONS (x, fn () => from_list xs);
175
176fun to_textfile {filename = f} s =
177    let
178      open TextIO
179      val (h,c) = if f = "-" then (stdOut, K ()) else (openOut f, closeOut)
180      fun to_file NIL = ()
181        | to_file (CONS (x,y)) = (output (h,x); to_file (y ()))
182      val () = to_file s
183    in
184      c h
185    end;
186
187fun from_textfile {filename = f} =
188    let
189      open TextIO
190      val (h,c) = if f = "-" then (stdIn, K ()) else (openIn f, closeIn)
191      fun res () = case inputLine h of NONE => (c h; NIL) | SOME "" => (c h; NIL) | SOME s => CONS (s,res)
192    in
193      memoize (res ())
194    end;
195
196end
197