;;;; inline-queue.scm
;;;; Kon Lovett, Jun '10

;;; Requires (include "chicken-primitive-object-inlines")

;; Support

(define-inline (%make-queue) (%make-structure 'queue '() '()))
(define-inline (%queue? obj) (%structure-instance? obj 'queue))
(define-inline (%queue-first-pair q) (%structure-ref q 1))
(define-inline (%queue-last-pair q) (%structure-ref q 2))

(define-inline (%valid-queue? obj)
  (and #;(%queue? obj) ;Assume Checked
       (%fx= 3 (%structure-length obj))
       (%list? (%queue-first-pair obj))
       (%list? (%queue-last-pair obj)) ) )

(define-inline (%queue-empty? q) (%null? (%queue-first-pair q)))
(define-inline (%queue-count q) (%length (%queue-first-pair q)))
(define-inline (%queue-first-pair-set! q v) (%structure-set!/mutate  q 1 v))
(define-inline (%queue-last-pair-set! q v) (%structure-set!/mutate q 2 v))

;; Operations

(define-inline (%queue-last-pair-empty! q) (%structure-set!/immediate q 2 '()))

(define-inline (%queue-add! q datum)
  (let ((new-pair (%cons datum '())))
    (if (%null? (%queue-first-pair q)) (%queue-first-pair-set! q new-pair)
        (%set-cdr!/mutate (%queue-last-pair q) new-pair) )
    (%queue-last-pair-set! q new-pair) ) )

(define-inline (%queue-remove! q)
  (let* ((first-pair (%queue-first-pair q))
         (next-pair (%cdr first-pair)))
    (%queue-first-pair-set! q next-pair)
    (when (%null? next-pair) (%queue-last-pair-empty! q) )
    (%car first-pair) ) )

(define-inline (%queue-push-back! q item)
  (let ((newlist (%cons item (%queue-first-pair q))))
    (%queue-first-pair-set! q newlist)
    (when (%null? (%queue-last-pair q)) (%queue-last-pair-set! q newlist) ) ) )

(define-inline (%queue-push-back-list! q itemlist)
  (let ((newlist (%append! (%list-copy itemlist) (%queue-first-pair q))))
    (%queue-first-pair-set! q newlist)
    (if (%null? newlist) (%queue-last-pair-empty! q)
        (%queue-last-pair-set! q (%last-pair newlist) ) ) ) )

(define-inline (%queue-extract-pair! q targ-pair)
  ; Scan queue list until we find the item to remove
  (let scanning ((this-pair (%queue-first-pair q)) (prev-pair '()))
    ; Keep scanning until found
    (if (not (%eq? this-pair targ-pair)) (scanning (%cdr this-pair) this-pair)
        ;found so cut out the pair
        (let ((next-pair (%cdr this-pair)))
          ; At the head of the list, or in the body?
          (if (%null? prev-pair) (%queue-first-pair-set! q next-pair)
              (%set-cdr!/mutate prev-pair next-pair) )
          ; When the cut pair is the last item update the last pair ref.
          (when (%eq? this-pair (%queue-last-pair q)) (%queue-last-pair-set! q prev-pair)) ) ) ) )