#lang racket/base
;;
;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones <tonyg@ccs.neu.edu>
;;;
;;; This file is part of marketplace-ssh.
;;;
;;; marketplace-ssh is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; marketplace-ssh is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with marketplace-ssh. If not, see
;;; <http://www.gnu.org/licenses/>.

(provide make-queue
	 queue?
	 enqueue
	 enqueue-all
	 dequeue
	 list->queue
	 queue->list
	 queue-length
	 queue-empty?
	 queue-append
	 queue-extract)

(struct queue (head tail) #:transparent)

(define (make-queue)
  (queue '() '()))

(define (enqueue q v)
  (queue (queue-head q)
	 (cons v (queue-tail q))))

(define (enqueue-all q v)
  (queue (queue-head q)
	 (append (reverse v) (queue-tail q))))

(define (shuffle q)
  (if (null? (queue-head q))
      (queue (reverse (queue-tail q)) '())
      q))

(define (dequeue q)
  (let ((q1 (shuffle q)))
    (values (car (queue-head q1))
	    (queue (cdr (queue-head q1)) (queue-tail q1)))))

(define (list->queue xs)
  (queue xs '()))

(define (queue->list q)
  (append (queue-head q) (reverse (queue-tail q))))

(define (queue-length q)
  (+ (length (queue-head q))
     (length (queue-tail q))))

(define (queue-empty? q)
  (and (null? (queue-head q))
       (null? (queue-tail q))))

(define (queue-append q1 q2)
  (queue (append (queue-head q1)
		 (reverse (queue-tail q1))
		 (queue-head q2))
	 (queue-tail q2)))

(define (queue-extract q predicate [default-value #f])
  (let search-head ((head (queue-head q))
		    (rejected-head-rev '()))
    (cond
     ((null? head) (let search-tail ((tail (reverse (queue-tail q)))
				     (rejected-tail-rev '()))
		     (cond
		      ((null? tail) (values default-value q))
		      ((predicate (car tail)) (values (car tail)
						      (queue (queue-head q)
							     (append (reverse (cdr tail))
								     rejected-tail-rev))))
		      (else (search-tail (cdr tail) (cons (car tail) rejected-tail-rev))))))
     ((predicate (car head)) (values (car head)
				     (queue (append (reverse rejected-head-rev)
						    (cdr head))
					    (queue-tail q))))
     (else (search-head (cdr head) (cons (car head) rejected-head-rev))))))