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