/* stream.q: a lazy list data structure
   $Id: stream.q,v 1.9 2005/07/13 00:49:47 agraef Exp $ */

/* originally written by Klaus Barthelmann and Albert Graef April 1993 */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

include stdlib, cond, lambda;

public type Stream = special const nil, bin X Xs;

public isstream X;

isstream _:Stream	= true;
isstream _		= false otherwise;

/* convert between lists and streams: */

public stream Xs, ::list Xs;

stream []		= nil;
stream [X|Xs]		= bin X (stream Xs);

list nil		= [];
list (bin X Xs)		= [X|list Xs];

/* The following definitions implement stream versions of the corresponding
   list operations. Of course, you don't want to apply operations like #,
   last, etc. to infinite streams; it will take them an infinite time to
   compute the result, since the stream will be unfolded completely. This also
   happens with foldl; foldr on an infinite stream works, though, provided
   that the folded function doesn't evaluate its second argument. */

#nil			= 0;
#bin X Xs		= 1+#Xs;

(bin X Xs)!0		= X;
(bin X Xs)!N:Int	= Xs!(N-1) if N>0;

nil++Xs:Stream		= Xs;
(bin X Xs)++Ys:Stream	= bin X (Xs++Ys);

all P nil		= true;
all P (bin X Xs)	= P X and then all P Xs;

any P nil		= false;
any P (bin X Xs)	= P X or else any P Xs;

append nil Y		= bin Y nil;
append (bin X Xs) Y	= bin X (append Xs Y);

cons X Xs:Stream	= bin X Xs;

do F nil		= ();
do F (bin X Xs)		= F X || do F Xs;

drop N:Int nil		= nil;
drop N:Int (bin X Xs)	= drop (N-1) Xs if N>0;
			= bin X Xs otherwise;

dropwhile P nil		= true;
dropwhile P (bin X Xs)	= dropwhile P Xs if P X;
			= bin X Xs otherwise;

filter P nil		= nil;
filter P (bin X Xs)	= bin X (filter P Xs) if P X;
			= filter P Xs otherwise;

foldl F A nil		= A;
foldl F A (bin X Xs)	= foldl F (F A X) Xs;

foldl1 F (bin X Xs)	= foldl F X Xs;

foldr F A nil		= A;
foldr F A (bin X Xs)	= F X (foldr F A Xs);

foldr1 F (bin X Xs)	= X if null Xs;
			= F X (foldr1 F Xs) otherwise;

hd (bin X Xs)		= X;

hds nil			= nil;
hds (bin Xs Xss)	= hds Xss if null Xs;
			= bin (hd Xs) (hds Xss) otherwise;

init (bin X Xs)		= nil if null Xs;
			= bin X (init Xs) otherwise;

null nil		= true;
null _:Stream		= false otherwise;

last (bin X Xs)		= X if null Xs;
			= last Xs otherwise;

map F nil		= nil;
map F (bin X Xs)	= bin (F X) (map F Xs);

pop (bin X Xs)		= Xs;

prd Xs:Stream		= foldl (*) 1 Xs;

push Xs:Stream X	= bin X Xs;

reverse Xs:Stream	= foldl push nil Xs;

scanl F A nil		= bin A nil;
scanl F A (bin X Xs)	= bin A (scanl F (F A X) Xs);

scanl1 F nil		= nil;
scanl1 F (bin X Xs)	= scanl F X Xs;

/* Scanr. There's a little optimization here, namely that we force evaluation
   of the F X Y term since we want to avoid unevaluated applications piling up
   in the heads of the stream, which would lead to quadratic time and space
   complexity. Also note that this operation is intrinsically "strict" because
   we can't know the head of the result stream before all of its tails have
   been computed. */

scanr F A nil		= bin A nil;
scanr F A (bin X Xs)	= bin ~(F X Y) Ys
			    where Ys = scanr F A Xs, bin Y _ = Ys;

scanr1 F nil		= nil;
scanr1 F (bin X Xs)	= bin X nil if null Xs;
			= bin ~(F X Y) Ys
			    where Ys = scanr1 F Xs, bin Y _ = Ys;

sum Xs:Stream		= foldl (+) 0 Xs;

take N:Int nil		= nil;
take N:Int (bin X Xs)	= bin X (take (N-1) Xs) if N>0;
			= nil otherwise;

takewhile P nil		= nil;
takewhile P (bin X Xs)	= bin X (takewhile P Xs) if P X;
			= nil otherwise;

tl (bin X Xs)		= Xs;

tls nil			= nil;
tls (bin Xs Xss)	= tls Xss if null Xs;
			= bin (tl Xs) (tls Xss) otherwise;

top (bin X Xs)		= X;

transpose nil		= nil;
transpose (bin Xs Xss)	= transpose Xss if null Xs;
			= bin (bin (hd Xs) (hds Xss))
			  (transpose (bin (tl Xs) (tls Xss)))
			      otherwise;

/* Unzip. This function poses a problem since we want to avoid that the
   (possibly infinite) input stream is unfolded completely. To these ends, we
   defer the recursive unzip invokations, employing lambda constructs
   responsible for producing the tails of the output streams when they are
   needed. */

// prevent warnings about undeclared free variables in lambda constructs
var Xs, Ys, Zs;

unzip (bin U Us)	= (bin X (lambda (Xs,Ys) Xs (unzip Us)),
			   bin Y (lambda (Xs,Ys) Ys (unzip Us)))
			    where (X,Y) = U;
unzip nil		= (nil,nil);

unzip3 (bin U Us)	= (bin X (lambda (Xs,Ys,Zs) Xs (unzip3 Us)),
			   bin Y (lambda (Xs,Ys,Zs) Ys (unzip3 Us)),
			   bin Z (lambda (Xs,Ys,Zs) Zs (unzip3 Us)))
			    where (X,Y,Z) = U;
unzip3 nil		= (nil,nil,nil);

zip (bin X Xs) (bin Y Ys)
			= bin (X,Y) (zip Xs Ys);
zip _:Stream _:Stream	= nil otherwise;

zip3 (bin X Xs) (bin Y Ys) (bin Z Zs)
			= bin (X,Y,Z) (zip3 Xs Ys Zs);
zip3 _:Stream _:Stream _:Stream
			= nil otherwise;

zipwith F (bin X Xs) (bin Y Ys)
			= bin (F X Y) (zipwith F Xs Ys);
zipwith F _:Stream _:Stream
			= nil otherwise;

zipwith3 F (bin X Xs) (bin Y Ys) (bin Z Zs)
			= bin (F X Y Z) (zipwith3 F Xs Ys Zs);
zipwith3 F _:Stream _:Stream _:Stream
			= nil otherwise;

/* Lazy stream concatenation. The streamcat function concatenates a stream (or
   list) of streams and/or lists in a fully lazy manner. (That is, you can
   concatenate an infinite stream of potentially infinite streams; note that
   folding the (++) operation cannot handle this situation, since (++) is not
   a special form.) The result is always a stream. */

public streamcat Xs;

/* This is a bit tricky if we want to do it efficiently. The fastest way seems
   to be the following double recursion, which descends into the first
   substream using an auxiliary function `catr' (for "cat-recurse"). */

private special catr ~Xs Yss;

streamcat []		= nil;
streamcat [Xs|Yss]	= catr Xs Yss;

streamcat nil		= nil;
streamcat (bin Xs Yss)	= catr Xs Yss;

catr [] Yss		= streamcat Yss;
catr [X|Xs] Yss		= bin X (catr Xs Yss);

catr nil Yss		= streamcat Yss;
catr (bin X Xs) Yss	= bin X (catr Xs Yss);

/* Stream generation functions: */

public iterate F A;
iterate F A		= bin A (iterate F (F A));

public numstream N;
numstream N:Num		= iterate (+1) N;

public numstreamby K N;
numstreamby K:Num N:Num	= iterate (+K) N;

public mkstream X;
mkstream X		= bin X (mkstream X);

/* Stream comprehensions (analogous to the listof operation (list.q)): */

public type StreamComp : Lambda = special streamof A Cs;

private special streamofx A Cs;

lambdax (streamof A Cs)	= streamofx A Cs;

streamof A Cs		= `(streamofx A Cs);

streamofx A ()		= '(bin A nil);
streamofx A (X in Xs|Cs)
			= '(streamcat (map (lambda X `(streamofx A Cs))
				       (filter (matchp X) Xs)));
streamofx A (X in Xs)	= '(streamcat (map (lambda X (bin A nil))
				       (filter (matchp X) Xs)));
streamofx A (P|Cs)	= '(ifelse P `(streamofx A Cs) nil);
streamofx A P		= '(ifelse P (bin A nil) nil);

/* Lexicographic stream comparison: */

(nil = nil)		= true;
(nil = bin _ _)		= false;
(bin _ _ = nil)		= false;
(bin X Xs = bin Y Ys)	= (X=Y) and then (Xs=Ys);

nil <> nil		= false;
nil <> bin _ _		= true;
bin _ _ <> nil		= true;
bin X Xs <> bin Y Ys	= (X<>Y) or else (Xs<>Ys);

nil < nil		= false;
nil < bin _ _		= true;
bin _ _ < nil		= false;
bin X Xs < bin Y Ys	= (X<Y) or else (X=Y) and then (Xs<Ys);

nil > nil		= false;
nil > bin _ _		= false;
bin _ _ > nil		= true;
bin X Xs > bin Y Ys	= (X>Y) or else (X=Y) and then (Xs>Ys);

nil <= nil		= true;
nil <= bin _ _		= true;
bin _ _ <= nil		= false;
bin X Xs <= bin Y Ys	= (X<Y) or else (X=Y) and then (Xs<=Ys);

nil >= nil		= true;
nil >= bin _ _		= false;
bin _ _ >= nil		= true;
bin X Xs >= bin Y Ys	= (X>Y) or else (X=Y) and then (Xs>=Ys);