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