/usr/share/scsh-0.6/big/queue.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Queues
; Richard's code with Jonathan's names.
;
; Richard's names: Jonathan's names (modified by popular demand):
; make-empty-queue make-queue
; add-to-queue! enqueue!
; remove-from-queue! dequeue!
(define-record-type queue :queue
(really-make-queue uid head tail)
queue?
(uid queue-uid)
(head queue-head set-queue-head!)
(tail queue-tail set-queue-tail!))
(define *queue-uid* 0)
(define (make-queue)
(let ((uid *queue-uid*))
(set! *queue-uid* (+ uid 1)) ;potential synchronization screw
(really-make-queue uid '() '())))
; The procedures for manipulating queues.
(define (queue-empty? q)
;; (debug-message "queue-empty?" (queue? q))
(null? (queue-head q)))
(define (enqueue! q v)
;; (debug-message "enqueue!" (queue? q))
(let ((p (cons v '())))
(if (null? (queue-head q)) ;(queue-empty? q)
(set-queue-head! q p)
(set-cdr! (queue-tail q) p))
(set-queue-tail! q p)))
(define (queue-front q)
;; (debug-message "queue-front" (queue? q))
(if (queue-empty? q)
(error "queue is empty" q)
(car (queue-head q))))
(define (dequeue! q)
;; (debug-message "dequeue!" (queue? q))
(let ((pair (queue-head q)))
(cond ((null? pair) ;(queue-empty? q)
(error "empty queue" q))
(else
(let ((value (car pair))
(next (cdr pair)))
(set-queue-head! q next)
(if (null? next)
(set-queue-tail! q '())) ; don't retain pointers
value)))))
; Same again, except that we return #F if the queue is empty.
; This is a simple way of avoiding a race condition if the queue is known
; not to contain #F.
(define (maybe-dequeue! q)
;; (debug-message "maybe-dequeue!" (queue? q))
(let ((pair (queue-head q)))
(cond ((null? pair) ;(queue-empty? q)
#f)
(else
(let ((value (car pair))
(next (cdr pair)))
(set-queue-head! q next)
(if (null? next)
(set-queue-tail! q '())) ; don't retain pointers
value)))))
(define (on-queue? v q)
;; (debug-message "on-queue!" (queue? q))
(memq v (queue-head q)))
; This removes the first occurrence of V from Q.
(define (delete-from-queue! q v)
(delete-from-queue-if! q (lambda (x) (eq? x v))))
(define (delete-from-queue-if! q pred)
;; (debug-message "delete-from-queue-if!" (queue? q))
(let ((list (queue-head q)))
(cond ((null? list)
#f)
((pred (car list))
(set-queue-head! q (cdr list))
(if (null? (cdr list))
(set-queue-tail! q '())) ; don't retain pointers
#t)
((null? (cdr list))
#f)
(else
(let loop ((list list))
(let ((tail (cdr list)))
(cond ((null? tail)
#f)
((pred (car tail))
(set-cdr! list (cdr tail))
(if (null? (cdr tail))
(set-queue-tail! q list))
#t)
(else
(loop tail)))))))))
(define (queue->list q) ;For debugging
(map (lambda (x) x)
(queue-head q)))
(define (queue-length q)
(length (queue-head q)))
|