;;; file: lazy.lisp. CP 07.05.03 18.20 h

;;; class lazy-list

(defclass lazy-list 
  () ;no superclasses
  () ;no slots
  (:documentation "the superclass of all lazy lists"))

;;; interface

(defgeneric lazy-nil (subclass)
  (:documentation "Returns a new empty lazy list of class subclass."))

(defgeneric lazy-null ((l lazy-list)) 
  (:documentation "Just as null but for lazy lists"))

(defgeneric lazy-car ((l lazy-list)) 
  (:documentation "Just as car but for lazy lists"))

(defgeneric lazy-cdr ((l lazy-list)) 
  (:documentation 
"Just as cdr but for lazy lists. 
Moreover, (lazy-cdr (lazy-nil subclass)) = (lazy-nil subclass)."))

(defgeneric lazy-nthcdr (n (l lazy-list)) 
  (:documentation 
"Just as nthcdr but for lazy lists.
Moreover (lazy-car (lazy-nil subclass)) = nil."))

(defgeneric lazy-cons (a (l lazy-list)) 
  (:documentation "Just as cons but for lazy lists"))

(defgeneric lazy-set-all-slots ((k lazy-list) (l lazy-list))
  (:documentation 
"Sets all slots of k to the values of the slots of l and returns k then."))

(defgeneric lazy-copy ((l lazy-list))
  (:documentation "returns a copy of l"))

(defgeneric lazy-make-nil ((l lazy-list))
  (:documentation "Sets l to the empty lazy list and then returns l."))

(defgeneric lazy-welldefinedp ((l lazy-list)) 
  (:method-combination and)
  (:documentation "Checks for welldefinedness."))

;;; implementation

(defmethod lazy-nthcdr (n (l lazy-list)) 
  (if (zerop n)
    l
    (lazy-nthcdr (1- n) (lazy-cdr l))))

(defmethod lazy-copy ((l lazy-list))
  (lazy-set-all-slots
    (make-instance (type-of l))
    l))

(defmethod lazy-nil (subclass)
  (lazy-make-nil (make-instance subclass)))

(defmethod lazy-set-all-slots 
  ((k lazy-list) 
   (l lazy-list))
  k)
;slots must be set by :before methods!!!

;;; class lazy-list-with-explicit-start

(defclass lazy-list-with-explicit-start
  (lazy-list)                  ;a single direct superclass
  ((start :accessor lazy-start
	  :type     list)
   (last :type cons))
  (:documentation "If start is nil, this represents the empty lazy list.
If start is non-nil, it contains the start of the lazy list as a list
and (car last) is the last cons of this list.
The indirection of storing the last cons of the list in the cons cell is
necessary for destructive updating."))

(defgeneric lazy-force ((l lazy-list-with-explicit-start))
  (:documentation 
"If (null (lazy-start l)), this function is undefined. If start is not nil,
lazy-force returns l after some destructive change of representation. 
If start does not change, then start already contained the complete list. 
Otherwise at least one new element is added to start."))

(defmethod 
  lazy-set-all-slots 
  :before
  ((k lazy-list-with-explicit-start) 
   (l lazy-list-with-explicit-start))
  (setf (slot-value k 'start)
        (slot-value l 'start)
        (slot-value k 'last)
        (slot-value l 'last)))

(defmacro lazy-last (l)
  `(car (slot-value ,l 'last)))

(defmethod lazy-welldefinedp 
  and
  ((l lazy-list)) 
  (eq (lazy-last l) 
      (last (lazy-start l))))

(defmethod lazy-null ((l lazy-list-with-explicit-start))
  (null (lazy-start l)))

(defmethod lazy-car ((l lazy-list-with-explicit-start))
  (car (lazy-start l)))

(defmethod lazy-cdr ((l lazy-list-with-explicit-start))
  (let ((s (lazy-start l)))
    (if s
      (let ((cdrs (cdr s))
            (c    (lazy-copy l)))
        (unless cdrs
          (lazy-force l)
          (setq cdrs (cdr s)))
        ;if cdrs is still nil, then l has only one element!
        (setf (lazy-start c)
	      cdrs)
        c)        
      l)))

(defmethod lazy-cons (a (l lazy-list-with-explicit-start))
  (let ((n (lazy-copy l)))
    (setf (lazy-start n)
	  (cons a (lazy-start l)))
    n))

(defmethod lazy-make-nil ((l lazy-list-with-explicit-start))
  (setf (lazy-start l)
	nil)
  l)

;;; class lazy-list-with-explicit-start-and-eval

(defclass lazy-list-with-explicit-start-and-eval
  (lazy-list-with-explicit-start)
  () ;no new slots anymore
  (:documentation
"When start is not nil, (cdr last) represents the rest of the
lazy-list-with-explicit-start comming after start.
When evaluated, this rest returns a lazy-list-with-explicit-start-and-eval
representing still the same list.
The indirection of storing the rest of the list in the (cdr last) is
necessary for destructive updating."))

;; no new slots anymore!
;(defmethod
;  lazy-set-all-slots
;  :before
;  ((k lazy-list-with-explicit-start-and-eval) 
;   (l lazy-list-with-explicit-start-and-eval)))

(defmacro lazy-eval (l)
  `(cdr (slot-value ,l 'last)))

(defun make-lazy-list-with-explicit-start-and-eval (s e)
  (let ((n (make-instance 'lazy-list-with-explicit-start-and-eval)))
    (setf (lazy-start n)
	  s
	  (slot-value n 'last)
	  (cons (last s)
                e))
    n))

(defmethod lazy-force ((l lazy-list-with-explicit-start-and-eval))
  (let ((rest (eval (lazy-eval l))))
    (unless (lazy-null rest)
      (setf 
        (cdr (lazy-last l)) 
        (lazy-start rest)
        (lazy-last l)
        (lazy-last rest)
	(lazy-eval l)
	(lazy-eval rest))))
  l)

(defun from-list-to-lazy-list-with-explicit-start-and-eval (l)
  (make-lazy-list-with-explicit-start-and-eval
    l
    '(lazy-nil 'lazy-list-with-explicit-start-and-eval)))

(defmethod print-object ((l lazy-list-with-explicit-start-and-eval) stream)
  (print
    (if (lazy-null l)
      :lazy-nil
      (list
        :lazy-start
        (lazy-start l)
	:lazy-eval
	(lazy-eval l)))
    stream))
   
(defun naturals-eval (i)
  (make-lazy-list-with-explicit-start-and-eval
    (list i)
    `(naturals-eval ,(1+ i))))

;;; class lazy-list-with-explicit-start-and-funcall

(defclass lazy-list-with-explicit-start-and-funcall
  (lazy-list-with-explicit-start)
  () ;no new slots anymore
  (:documentation
"When start is not nil, (cdr last) represents the rest of the
lazy-list-with-explicit-start comming after start.
When called as function, 
this rest returns a lazy-list-with-explicit-start-and-funcall
representing still the same list.
The indirection of storing the rest of the list in the (cdr last) is
necessary for destructive updating."))

;; no new slots anymore!
;(defmethod
;  lazy-set-all-slots
;  :before
;  ((k lazy-list-with-explicit-start-and-funcall) 
;   (l lazy-list-with-explicit-start-and-funcall)))

(defmacro lazy-funcall (l)
  `(cdr (slot-value ,l 'last)))

(defun make-lazy-list-with-explicit-start-and-funcall (s e)
  (let ((n (make-instance 'lazy-list-with-explicit-start-and-funcall)))
    (setf (lazy-start n)
	  s
	  (slot-value n 'last)
	  (cons (last s)
                e))
    n))

(defmethod lazy-force ((l lazy-list-with-explicit-start-and-funcall))
  (let ((rest (funcall (lazy-funcall l))))
    (unless (lazy-null rest)
      (setf 
        (cdr (lazy-last l)) 
        (lazy-start rest)
        (lazy-last l)
        (lazy-last rest)
	(lazy-funcall l)
	(lazy-funcall rest))))
  l)

(defun from-list-to-lazy-list-with-explicit-start-and-funcall (l)
  (make-lazy-list-with-explicit-start-and-funcall
    l
    #'(lambda () (lazy-nil 'lazy-list-with-explicit-start-and-funcall))))

(defmethod print-object ((l lazy-list-with-explicit-start-and-funcall) stream)
  (print
    (if (lazy-null l)
      :lazy-nil
      (list
        :lazy-start
        (lazy-start l)
	:lazy-funcall
	(lazy-funcall l)))
    stream))
   
(defun naturals-funcall (i)
  (make-lazy-list-with-explicit-start-and-funcall
    (list i)
    #'(lambda () (naturals-funcall (1+ i)))))