#| 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.
 |#

(define-record-type <iterator-implementation>
  (make-iterator-implementation start end
                                start? end?
                                advance
                                ref
                                to-index from-index
                                comparator)
  iterator-implementation?
  (start get-start)
  (end get-end)
  (start? get-start-predicate)
  (end? get-end-predicate)
  (advance get-advance)
  (ref get-ref)
  (to-index get-to-index-procedure)
  (from-index get-from-index-procedure)
  (comparator get-comparator))

(define-record-type <iterator>
  (make-iterator implementation data)
  iterator?
  (implementation get-implementation)
  (data get-data))

;;; Define a function that invokes a field of the iterator on the data
;;; object inside the iterator and any other arguments supplied to the
;;; function.
(define-syntax define-invoke-field-of-iterator
  (syntax-rules ()
    ((define-invoker name field-accessor emsg args ...)
     (define (name iterator args ...)
       (let ((proc (field-accessor (get-implementation iterator))))
         (if (not proc)
             (error emsg iterator)
             (proc (get-data iterator) args ...)))))))

;;; Define a constructor (something that makes an iterator from something
;;; that is not an iterator).
;;; 
;;; The constructor can take as arguments either
;;; 
;;; 1) The implementation and any data objects necessary to make the
;;;    iterator, or
;;; 2) The iterator and any objects necessary to make the iterator, where
;;;    the data in the iterator is the first such object.
;;; 
;;; This is implemented as a macro to catch arity issues.
(define-syntax define-constructor-for-iterator-or-implementation
  (syntax-rules ()
    ((_ name field emsg args ...)
     (define name
       (case-lambda
         ((iterator args ...)
          (name (get-implementation iterator)
                (get-data iterator)
                args ...))
         ((implementation data args ...)
          (let ((constructor (field implementation)))
            (if (not constructor)
                (error emsg implementation data args ...)
                (constructor data args ...)))))))))

(define-constructor-for-iterator-or-implementation iterator-at-start
  get-start
  "no start constructor")

(define-constructor-for-iterator-or-implementation iterator-at-end
  get-end
  "no end")

(define-invoke-field-of-iterator iterator-at-start?
  get-start-predicate
  "no start predicate")
(define-invoke-field-of-iterator iterator-at-end?
  get-end-predicate
  "no end predicate")

(define-invoke-field-of-iterator iterator-advance
  get-advance
  "no procedure to move iterator"
  spaces)

(define-invoke-field-of-iterator iterator-ref
  get-ref
  "no procedure to access value at iterator")

(define-invoke-field-of-iterator iterator->index
  get-to-index-procedure
  "no procedure to convert iterator->index")

(define-constructor-for-iterator-or-implementation index->iterator
  get-from-index-procedure
  "no procedure to convert index->iterator"
  index)

;;; Create a procedure that calls COMPARISON on all (ITER1 . ITER-REST).
;;; COMPARATOR-TYPE? is a predicate against the comparator, and if the
;;; comparator fails the predicate an error message with string EMSG
;;; will thrown.
(define (generate-comparison comparison comparator-type? emsg)
  (lambda (iter1 . iter-rest)
    (let ((comparator (get-comparator (get-implementation iter1))))
      (if (not (comparator-type? comparator))
          (apply error emsg iter1 iter-rest)
          (apply comparison comparator
                 (map get-data (cons iter1 iter-rest)))))))

(define iterator=?
  (generate-comparison =? comparator? "no comparator"))

(define iterator<?
  (generate-comparison <? comparator-ordered? "no ordered comparator"))
(define iterator>?
  (generate-comparison >? comparator-ordered? "no ordered comparator"))

(define iterator<=?
  (generate-comparison <=? comparator-ordered? "no ordered comparator"))
(define iterator>=?
  (generate-comparison >=? comparator-ordered? "no ordered comparator"))