<!-- -*-jfw-sgml-*- -->
<!doctype manpage public "-//JFW//DTD Manpage//EN"[
<!ENTITY % remark "ignore" >
<!ENTITY % bmod "IGNORE"   -- Bigloo module clause   -- >
<!ENTITY % scminc "IGNORE" -- scheme include file    -- >
<!ENTITY % scmprg "IGNORE" -- scheme program code    -- >
<!ENTITY % v.d "IGNORE"    -- version using "delay"  -- >
<!ENTITY % v.l "IGNORE"    -- version using "lambda" -- >
]>

<manpage
  date="20. 6. 1996"
  author="J&oe;rg Wittenberger"
  inst="TU Dresden"
>
Stream
<short>
A stream implementation
<synopsis><verb></verb>
<descript>

<!--{{{ description -->
The stream module comes in two flavors. One using the stream
inplementation as in R4RS and one using lambda expressions and a
more complicated tail operation.

This is the version, which implements the
<![ %v.d [ R4RS like implementation using <code/delay/ ]]>
<![ %v.l [ version using lambda expressions to implement the tail. ]]>

<note>
The second version is faster for the <code/bigloo/ Scheme compiler.
</note>

The implementation consists of two files stream.sch and stream.scm.

<!--}}}-->
<!--{{{ module declaration -->

<sect1>The module

the module implements the following operations (which go into the scm
file).

<![ %bmod [
<literate file="stream.scm">
<verb>
;{{{ module stream

(module stream
	(include "stream.sch")
	(export
	 ; (cons-stream hd tl)
	 (inline stream-empty? stream)
	 empty-stream
	 (stream . elements)
	 (inline head stream)
	 (inline tail stream)
	 (inline stream-tail stream n)
	 (accumulate combiner null stream)
	 (stream->list s)
	 (stream-map proc stream) 
	 (stream-for-each proc stream)
	 (stream-through stream . procs)
	 (stream-filter predicate stream)
	 (stream-append s1 . so)
	 (stream2-append s1 . so)
	 (stream-memq element stream)
	 (substream stream after)
	 (stream-insert s . elements)
	 (stream-cute pred action stream)
	 (stream-finde pred action stream)

	 (stream-dbg-watch msg stream)
	 )
)

;}}}
</verb</>
]]>

<!--}}}-->
<!--{{{ include file -->

<sect1>stream.sch

This is to be included in other files using the module. It constains
the definition of <code/cons-stream/.

<![ %scminc [
  <![ %v.d [
  <literate file="stream.sch">
<verb>

(define-macro (cons-stream hd tl)
  `(cons ,hd (delay ,tl)))

(define-macro (tail-macro stream)
  `(force (cdr ,stream)))

(define-macro (stream->list-macro s)
  `(accumulate cons '() ,s))

</verb</>
  ]]>
  <![ %v.l [
  <literate file="stream.sch">
<verb>

(define-macro (cons-stream hd tl)
  `(cons ,hd (lambda () ,tl)))

(define-macro (tail-macro stream)
  `(let ((v (cdr ,stream)))
     (if (procedure? v)
	 (let ((nv (v)))
	   (set-cdr! ,stream nv)
	   nv)
	 v)))

(define-macro (stream->list-macro s)
  `(let loop ((r ,s))
     (if (stream-empty? r)
	 ,s
	 (loop (tail r)))))

</verb</>
  ]]>
]]>

<!--}}}-->
<!--{{{ program code -->

<sect1>main module

<![ %scmprg [
<literate file="stream.scm" >
<verb>

(define-inline (stream-empty? s) (null? s))

(define empty-stream '())

(define (stream . elements)
  (if (null? elements)
      empty-stream
      (cons-stream (car elements) (apply stream (cdr elements)))))

(define-inline (head stream) (car stream))

</verb>

<![ %v.d [
<verb>

(define-inline (tail stream) (force (cdr stream)))

</verb>
]]><![ %v.l [
<verb>

(define-inline (tail stream)
  (let ((v (cdr	stream)))
     (if (procedure? v)
	 (let ((nv (v)))
	   (set-cdr! stream nv)
	   nv)
	 v)))

</verb>
]]>
<verb>

(define-inline (stream-tail stream n)
  (if (eqv? n 0) stream (stream-tail (tail stream) (- n 1))))

(define (accumulate combiner null stream)
  (if (stream-empty? stream)
      null
      (combiner (head stream) (accumulate combiner null (tail stream)))))

</verb>
<![ %v.d [
<verb>

(define (stream->list s)
  (accumulate cons '() s))

</verb>
]]><![ %v.l [
<verb>

(define (stream->list s)
  (let loop ((r s))
    (if (stream-empty? r)
	s
	(loop (tail r)))))

</verb>
]]>
<verb>

(define (stream-map proc stream)
  (if (stream-empty? stream)
      stream
      (cons-stream (proc (head stream)) (stream-map proc (tail stream)))))

(define (stream-for-each proc stream)
  (if (stream-empty? stream)
      empty-stream
      (begin
	(proc (head stream))
	(stream-for-each proc (tail stream)))))

(define (stream-through stream . procs)
  (if (null? procs)
      stream
      ((car procs) (apply stream-through stream (cdr procs)))))

(define (stream-cond-map start? end? proc stream)
  (letrec
      ((mi
	(lambda (inside start? end? proc stream)
	  (if stream
	      (let ((rs ((if inside end? start?) stream)))
		(if rs
		    (mi (not inside) start? end? proc rs)
		    (cons-stream
		     (if inside (proc (head stream)) (head stream))
		     (mi inside start? end? proc (tail stream)))))))))
    (mi #f start? end? proc stream)))

(define (stream-filter predicate stream)
  (cond
   ((stream-empty? stream) stream)
   ((predicate (head stream))
    (cons-stream (head stream) (stream-filter predicate (tail stream))))
   (else (stream-filter predicate (tail stream)))))

(define (stream-append s1 . so)
  (if (stream-empty? s1)
      (if (null? so) empty-stream (apply stream-append so))
      (cons-stream (head s1) (apply stream-append (tail s1) so))))

(define (stream2-append s1 . so)
  (if (stream-empty? s1)
      (if (null? so)
	  empty-stream
	  (apply stream2-append (force (car so)) (cdr so)))
      (cons-stream (head s1) (apply stream2-append (tail s1) so))))

(define (substream stream after)
  (cond
   ((not stream) #f)
   ((eq? stream after) #f)
   (else (cons-stream (head stream) (substream (tail stream) after)))))

(define (stream-insert stream . elements)
  (if (null? elements)
      stream
      (cons-stream (car elements)
		   (apply stream-insert stream (cdr elements)))))

(define (stream-finde pred action stream)
  (cond
   ((stream-empty? stream) empty-stream)
   ((pred (head stream)) (action stream))
   (else (stream-finde pred action (tail stream)))))

(define (stream-cute pred action stream) ; the name: pun intended
  (cond
   ((stream-empty? stream) empty-stream)
   ((pred (head stream)) (action stream))
   (else (cons-stream (head stream)
		      (stream-cute pred action (tail stream))))))

(define (stream-memq element stream)
  (cond
   ((not stream) #f)
   ((eq? element (head stream)) stream)
   (else (stream-memq element (tail stream)))))

;{{{ Debugging Aid

(define (stream-dbg-watch msg stream)
  (display msg (current-error-port))
  (if (stream-empty? stream)
      (begin
	(display #" it's EMPTY now." (current-error-port))
	empty-stream)
   (begin
     (write (head stream) (current-error-port))
     (cons-stream (head stream) (stream-dbg-watch msg (tail stream))))))

;}}}

</verb>
</literate>
<!-- end of %scmprg marked section -->
]]>

<!--}}}-->

<options>

Compile time options:
<desc

<dt/bmod/ include the bigloo module clause

<dt/scminc/ create a include file

<dt/scmprg/ create the main code

<dt/v.d/ version using <code/delay/

<dt/v.l/ version using <code/lambda/

</desc>

<notes>

<diag>
Use <code/(stream-dbg-watch msg stream)/ for that.