AAL sources (3 of 8)

[Jonathan Amsterdam]

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-

;;; Streams.
;;; Copyright 1988 by Jonathan Amsterdam. All Rights Reserved.

(provide 'streams)

(defconstant *empty-stream* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Macros.

(defmacro delay (thing)
`#'(lambda () ,thing))

(defmacro dostream ((var stream) &body body)
;; Iterate through the elements of a stream. Syntax is like dolist.
(let ((tempvar (gensym)))
`(do* ((,tempvar ,stream (stream-cdr ,tempvar))
(,var (stream-car ,tempvar) (stream-car ,tempvar)))
((stream-empty? ,tempvar) *empty-stream*)
,@body)))

(defmacro stream-cons (thing stream)
`(cons ,thing (delay ,stream)))

(defmacro stream-append (stream1 stream2)
`(stream-append-func ,stream1 (delay ,stream2)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions.

(defun force (thing)
(funcall thing))

(defun stream-append-func (stream delayed-stream)
(if (stream-empty? stream)
(force delayed-stream)
(stream-cons (stream-car stream)
(stream-append-func (stream-cdr stream) delayed-stream))))

(defun stream-mapcar (function stream)
(if (stream-empty? stream)
*empty-stream*
(stream-cons (funcall function (stream-car stream))
(stream-mapcar function (stream-cdr stream)))))

(defun stream-mapcan (function stream)
(if (stream-empty? stream)
*empty-stream*
(stream-append (funcall function (stream-car stream))
(stream-mapcan function (stream-cdr stream)))))

(defun stream-empty? (stream)
(eq stream *empty-stream*))

(defun stream-car (stream)
(car stream))

(defun stream-cdr (stream)
;; This is the only function besides stream-cons and stream-append that
;; differs from normal list functions.
(force (cdr stream)))

(defun stream->list (stream)
(if (stream-empty? stream)
nil
(cons (stream-car stream)
(stream->list (stream-cdr stream)))))

(defun list->stream (list)
(if (null list)
*empty-stream*
(stream-cons (car list)
(list->stream (cdr list)))))

(defun stream (&rest things)
;; This is like the list function; it returns a stream of its arguments.
(list->stream (copy-list things))) ;Must copy in Symbolics Common Lisp,
;because the rest arg is popped from
;the stack after stream returns.

;;; End streams.lisp.