94 lines
2.6 KiB
Racket
94 lines
2.6 KiB
Racket
#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))))))
|