#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |-------------------------------------------------------------------------
 | This is a list iterator that allows for mutation list and improper
 | lists.
 |
 | The list iterator is made up of
 | * the `signifier`: the head of the list.
 | * the `previous` values, which is a list of all cons cells prior to the
 |   current cons cell, in reverse.
 | * the index, which is the index of the current element in the list. This
 |   is updated internally but not used internally, so the root index does
 |   not have to be 0.
 | * the `next` list, which is either empty or has as it's car the current
 |   item.
 |#

;;; TODO: handle IMPROPER-REST? properly
(define (forward num signifier previous idx rest)
  (cond
    ((= num 0)
     (make-list-iterator signifier previous idx rest))
    ((not (pair? rest)) #f)
    (else
     (forward (- num 1) (cons rest previous) (+ idx 1) (cdr rest)))))

(define (backward num signifier previous idx rest)
  (cond
    ((= num 0)
     (make-list-iterator signifier previous idx rest))
    ((not (pair? rest)) #f)
    (else
     (backward (+ num 1) (cdr previous) (- idx 1) (car previous)))))

(define (list-iterator? itr)
  (eq? (iterator-type itr) 'list-iterator))

(define-invocation list-iterator-signifier)

(define (make-list-iterator signifier previous idx rest)
  (if (not (or (pair? rest) (null? rest)))
      (list-iterator signifier (cdr previous) idx (car previous) #t)
      (list-iterator signifier previous idx rest #f)))

(define-iterator-implementation (list-iterator signifier
                                               previous
                                               idx
                                               rest
                                               improper-rest?)
  self
  ((iterator-at-start?) (null? previous))
  ((iterator-at-end?) (or improper-rest? (null? rest)))
  ((iterator-advance spaces)
   (cond
     ((not (integer? spaces))
      (raise (non-integer-movement-exception spaces)))
     ((negative? spaces)
      (backward spaces signifier previous idx rest))
     (else (forward spaces signifier previous idx rest))))
  ((iterator-ref)
   (cond
     ((null? rest)
      (raise (ref-at-end-exception self)))
     (improper-rest? (cdr rest))
     (else (car rest))))
  ((iterator-set! x)
   (cond
     ((null? rest)
      (raise (ref-at-end-exception self)))
     (improper-rest? (set-cdr! rest x))
     (else (set-car! rest x))))
  ((iterator->index) idx)
  ((get-signifier) signifier)
  ((get-iterator-comparator)
   (make-comparator
    (lambda (x)
      (and (list-iterator? itr)
           (eq? signifier (list-iterator-signifier x))))
    (lambda (x y)
      (= (iterator->index x) (iterator->index y)))
    (lambda (x y)
      (< (iterator->index x) (iterator->index y)))
    #f)))

(define-syntax define-with-list-or-iterator
  (syntax-rules ()
    ((_ (name first rest ...) body ...)
     (define (name first rest ...)
       (let ((first (cond
                      ((pair? first) first)
                      ((list-iterator? first)
                       (list-iterator-signifier first))
                      (else (raise (list-constructor-exception
                                    first))))))
         body ...)))))

(define (list-constructor-exception obj)
  (make-iterator-exception #f
                           'list-constructor
                           (list (cons 'obj obj))))

(define-with-list-or-iterator (list-iterator-start lst)
  (make-list-iterator lst '() 0 lst))

(define (list-iterator-to-end itr)
  (if (iterator-end? itr)
      itr
      (list-iterator-to-end (iterator-next itr))))

(define (list-iterator-end obj)
  (list-iterator-to-end (list-iterator-start obj)))