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