(defpackage :interval-sequence
  (:use :common-lisp)
  (:export :below :interval-sequence :interval))

(in-package :interval-sequence)

;;; Interval sequence class

(defclass interval-sequence (sequence standard-object)
  ((minimum :reader minimum :initform 0 :initarg :minimum)
   (length  :reader sequence:length :initarg :length)))

(defmethod print-object ((object interval-sequence) stream)
  (print-unreadable-object (object stream :type t :identity nil)
    (if (minimum object)
        (format stream "[~A,~A)" 
                (minimum object) 
                (+ (minimum object) (length object)))
        (format stream "uninitialized"))))

;;; Constructors
  
(defun below (n)
  (unless (>= n 0)
    (error 'type-error
           :datum n
           :expected-type '(integer 0)))
  (make-instance 'interval-sequence :length n))

(defun interval (min max)
  (unless (<= min max)
    (error "Interval minimum must be less than or equal to maximum"))
  (make-instance 'interval-sequence :minimum min :length (- max min)))

;;; Core sequence protocol

(defmethod sequence:elt ((interval interval-sequence) index)
  (with-slots (minimum length) interval
    (unless minimum
      (error "Attempt to read from an uninitialized interval"))
    (when (or (< index 0) (>= index length))
      (error 'type-error
             :datum index
             :expected-type `(integer 0 ,(1- length))))
    (+ index minimum)))

(defmethod (setf sequence:elt) (new-value
                                (interval interval-sequence)
                                index)
  (with-slots (minimum length) interval
    (cond
      ((or (< index 0) (>= index length))
       (error 'type-error
              :datum index
              :expected-type `(integer 0 ,(1- length))))
      ((null minimum)
       (setf minimum (- new-value index))
       new-value)
      ((/= new-value (+ minimum index))
       (error "Incompatible setf of interval element - expected ~A, got ~A"
              (+ minimum index) new-value))
      (t new-value))))


(defmethod sequence:adjust-sequence ((interval interval-sequence) length 
                                     &key initial-element initial-contents)
  (declare (ignore interval length initial-element initial-contents))
  (error "Interval sequences are immutable"))

(defmethod sequence:make-sequence-like 
    ((interval interval-sequence) length
     &key (initial-element nil iep) (initial-contents nil icp))
  (declare (ignore initial-element initial-contents))
  (when (or iep icp)
    (error "Can't create intervals using initial-element/initial-contents."))
  (make-instance 'interval-sequence :minimum nil :length length))

;;; Optional; sequence utilties which are interesting for intervals:

(defmethod sequence:subseq ((interval interval-sequence) start &optional end)
  (with-slots (minimum length) interval
    (when (or (< start 0)
              (> start (or end length))
              (and end (> end length)))
      (error "Invalid bounding indices ~A and ~A" start end))
    (make-instance 'interval-sequence 
                   :minimum (+ minimum start)
                   :length (if end
                               (- end start)
                               (- length start)))))

(defmethod sequence:search
    ((sequence-1 interval-sequence)
     (sequence-2 interval-sequence)
     &key from-end test test-not key (start1 0) (start2 0)
     (end1 (length sequence-1))
     (end2 (length sequence-2)))
  (declare (ignore from-end))
  (when (or (< start1 0)
            (> start1 (or end1 (length sequence-1)))
            (and end1 (> end1 (length sequence-1))))
    (error "Invalid bounding indices ~A and ~A for ~A" 
           start1 end1 sequence-1))
  (when (or (< start2 0)              
            (> start2 (or end2 (length sequence-2)))
            (and end2 (> end2 (length sequence-2))))
    (error "Invalid bounding indices ~A and ~A for ~A" 
           start2 end2 sequence-2))
  (if (or test test-not key)
      (call-next-method)
      (let* ((min1 (+ (minimum sequence-1) start1))
             (max1 (+ (minimum sequence-1) end1))
             (min2 (+ (minimum sequence-2) start2))
             (max2 (+ (minimum sequence-2) end2)))
        (and (>= min1 min2)
             (<= max1 max2)
             (- min1 (minimum sequence-2))))))

(defmethod sequence:find (item (sequence interval-sequence)
                          &key from-end test test-not key 
                          (start 0) (end (length sequence)))
  (declare (ignore from-end))
  (cond
    ((or test test-not key) (call-next-method))
    ((or (< start 0)
         (> start (or end (length sequence)))
         (and end (> end (length sequence))))
     (error "Invalid bounding indices ~A and ~A" start end))
    ((not (typep item 'integer)) nil)
    ((and (>= item (+ (minimum sequence) start))
          (< item (+ (minimum sequence) end)))
     item)
    (t nil)))

(defmethod sequence:position (item (sequence interval-sequence)
                              &key from-end test test-not key 
                              (start 0) (end (length sequence)))
  (declare (ignore from-end))
  (cond
    ((or test test-not key) (call-next-method))
    ((or (< start 0)
         (> start (or end (length sequence)))
         (and end (> end (length sequence))))
     (error "Invalid bounding indices ~A and ~A" start end))
    ((not (typep item 'integer)) nil)
    ((and (>= item (+ (minimum sequence) start))
          (< item (+ (minimum sequence) end)))
     (- item (minimum sequence)))
    (t nil)))

(defmethod sequence:remove-duplicates
    ((sequence interval-sequence) &key from-end test test-not (start 0) end key)
  (declare (ignore from-end))
  (cond
    ((or test test-not key) (call-next-method))
    ((or (< start 0)
         (> start (or end (length sequence)))
         (and end (> end (length sequence))))
     (error "Invalid bounding indices ~A and ~A" start end))
    (t sequence)))

;;; Other sequence functions and iterator protocol left as an exercise
;;; to the reader.