(defpackage #:nocandy-stream
  (:use #:cl #:arnesi #:iterate))

(in-package #:nocandy-stream)

(enable-sharp-l-syntax)

;;;; Utilities

(defun span (pred list)
  (iter (for rest on list)
        (for (elt) = rest)
	(while (funcall pred elt))
	(collect elt into head)
	(finally (return (values head rest)))))

(defmacro with-body ((doc decls body) body-var &body inner-body)
  (check-type body-var symbol)
  `(let* ((,body ,body-var)
	  (,doc (if (stringp (car ,body))
		   (pop ,body)
		   nil)))
     (multiple-value-bind (,decls ,body)
	 (span #L(typep !1 '(cons (eql declare) cons)) ,body)
       ,@inner-body)))

;;;; SRFI-41 iterative-suspension promises

(export '(lazy eager delay force))

(defstruct box
  (it nil :type promise))

(defstruct promise
  (eager? nil :type boolean)
  it)

(defmacro lazy (exp)
  `(make-box :it (make-promise :it (lambda () ,exp))))

(defun eager (value)
  (make-box :it (make-promise :eager? t :it value)))

(defmacro delay (exp)
  `(lazy (eager ,exp)))

(declaim (inline force))
(defun force (promise)
  (declare (type box promise))
  (tagbody
   restart
     (let ((promise-data (box-it promise)))
       (if (promise-eager? promise-data)
	   (return-from force (promise-it promise-data))
	   (let* ((inner-promise (funcall (the function (promise-it promise-data))))
		  (promise-data (box-it promise))
		  (inner-promise-data (box-it inner-promise)))
	     (declare (type box inner-promise))
	     (unless (promise-eager? promise-data)
	       (setf (promise-eager? promise-data)
		     (promise-eager? inner-promise-data)
		     (promise-it promise-data)
		     (promise-it inner-promise-data)
		     (box-it inner-promise) promise-data))
	     (go restart))))))
(declaim (notinline force))

;;;; Stream constructors and destructurers

(defstruct stream-cons
  car
  cdr)

(defvar *stream-null* (eager (list '*stream-null*))
  "A promise that forces to the unique end-of-stream.")

(defmacro stream-cons (elt stream)
  `(delay (make-stream-cons :car ,elt :cdr (lazy ,stream))))

(defun stream-car (cons)
  (stream-cons-car (the stream-cons (force cons))))

(defun stream-cdr (cons)
  (stream-cons-cdr (the stream-cons (force cons))))

(defun stream-null? (stream)
  (eql *stream-null* stream))

(defmacro stream-lambda (lambda-list &body body-forms)
  (with-body (doc decls body) body-forms
    `(lambda ,lambda-list ,@(and doc (list doc))
       ,@decls
       (lazy (progn . ,body)))))

(defmacro defun-stream (name lambda-list &body body-forms)
  (with-body (doc decls body) body-forms
    `(defun ,name ,lambda-list
       ,@(and doc (list doc))
       ,@decls
       (lazy (progn . ,body)))))

(defun-stream list->stream (list)
  (if (endp list)
      *stream-null*
      (stream-cons (first list) (list->stream (rest list)))))

(defun stream->list (stream)
  (iter (for rest initially stream then (stream-cdr stream))
	(until (stream-null? rest))
	(collect (stream-car rest))))

;;; stream.lisp ends here