Commit | Line | Data |
---|---|---|
6a4d3cfd JB |
1 | ;;;; q.scm --- Queues |
2 | ;;;; | |
cd5fea8d | 3 | ;;;; Copyright (C) 1995, 2001, 2004, 2006 Free Software Foundation, Inc. |
64705682 | 4 | ;;;; |
73be1d9e MV |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
73be1d9e MV |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
a6401ee0 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
a482f2cc | 18 | ;;;; |
a6401ee0 | 19 | |
64705682 | 20 | ;;; Commentary: |
6a4d3cfd | 21 | |
64705682 | 22 | ;;; Q: Based on the interface to |
a6401ee0 | 23 | ;;; |
64705682 | 24 | ;;; "queue.scm" Queues/Stacks for Scheme |
a6401ee0 | 25 | ;;; Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992. |
a6401ee0 | 26 | |
a6401ee0 JB |
27 | ;;; {Q} |
28 | ;;; | |
1168a720 JB |
29 | ;;; A list is just a bunch of cons pairs that follows some constrains, |
30 | ;;; right? Association lists are the same. Hash tables are just | |
31 | ;;; vectors and association lists. You can print them, read them, | |
32 | ;;; write them as constants, pun them off as other data structures | |
33 | ;;; etc. This is good. This is lisp. These structures are fast and | |
34 | ;;; compact and easy to manipulate arbitrarily because of their | |
35 | ;;; simple, regular structure and non-disjointedness (associations | |
36 | ;;; being lists and so forth). | |
a6401ee0 | 37 | ;;; |
64705682 | 38 | ;;; So I figured, queues should be the same -- just a "subtype" of cons-pair |
a6401ee0 JB |
39 | ;;; structures in general. |
40 | ;;; | |
41 | ;;; A queue is a cons pair: | |
42 | ;;; ( <the-q> . <last-pair> ) | |
43 | ;;; | |
1168a720 JB |
44 | ;;; <the-q> is a list of things in the q. New elements go at the end |
45 | ;;; of that list. | |
a6401ee0 | 46 | ;;; |
1168a720 | 47 | ;;; <last-pair> is #f if the q is empty, and otherwise is the last |
64705682 | 48 | ;;; pair of <the-q>. |
a6401ee0 | 49 | ;;; |
1168a720 JB |
50 | ;;; q's print nicely, but alas, they do not read well because the |
51 | ;;; eq?-ness of <last-pair> and (last-pair <the-q>) is lost by read. | |
52 | ;;; | |
53 | ;;; All the functions that aren't explicitly defined to return | |
54 | ;;; something else (a queue element; a boolean value) return the queue | |
55 | ;;; object itself. | |
64705682 TTN |
56 | |
57 | ;;; Code: | |
58 | ||
1a179b03 MD |
59 | (define-module (ice-9 q) |
60 | :export (sync-q! make-q q? q-empty? q-empty-check q-front q-rear | |
61 | q-remove! q-push! enq! q-pop! deq! q-length)) | |
64705682 TTN |
62 | |
63 | ;;; sync-q! | |
64 | ;;; The procedure | |
1168a720 | 65 | ;;; |
a6401ee0 JB |
66 | ;;; (sync-q! q) |
67 | ;;; | |
64705682 | 68 | ;;; recomputes and resets the <last-pair> component of a queue. |
a6401ee0 | 69 | ;;; |
1a179b03 | 70 | (define (sync-q! q) |
1168a720 JB |
71 | (set-cdr! q (if (pair? (car q)) (last-pair (car q)) |
72 | #f)) | |
73 | q) | |
a6401ee0 JB |
74 | |
75 | ;;; make-q | |
76 | ;;; return a new q. | |
77 | ;;; | |
1a179b03 | 78 | (define (make-q) (cons '() #f)) |
a6401ee0 JB |
79 | |
80 | ;;; q? obj | |
81 | ;;; Return true if obj is a Q. | |
1168a720 JB |
82 | ;;; An object is a queue if it is equal? to '(() . #f) |
83 | ;;; or it is a pair P with (list? (car P)) | |
84 | ;;; and (eq? (cdr P) (last-pair (car P))). | |
a6401ee0 | 85 | ;;; |
1a179b03 | 86 | (define (q? obj) |
1168a720 JB |
87 | (and (pair? obj) |
88 | (if (pair? (car obj)) | |
89 | (eq? (cdr obj) (last-pair (car obj))) | |
90 | (and (null? (car obj)) | |
91 | (not (cdr obj)))))) | |
a6401ee0 JB |
92 | |
93 | ;;; q-empty? obj | |
64705682 | 94 | ;;; |
1a179b03 | 95 | (define (q-empty? obj) (null? (car obj))) |
a6401ee0 JB |
96 | |
97 | ;;; q-empty-check q | |
98 | ;;; Throw a q-empty exception if Q is empty. | |
1a179b03 | 99 | (define (q-empty-check q) (if (q-empty? q) (throw 'q-empty q))) |
a6401ee0 | 100 | |
a6401ee0 JB |
101 | ;;; q-front q |
102 | ;;; Return the first element of Q. | |
1a179b03 | 103 | (define (q-front q) (q-empty-check q) (caar q)) |
a6401ee0 JB |
104 | |
105 | ;;; q-rear q | |
106 | ;;; Return the last element of Q. | |
1a179b03 | 107 | (define (q-rear q) (q-empty-check q) (cadr q)) |
a6401ee0 JB |
108 | |
109 | ;;; q-remove! q obj | |
110 | ;;; Remove all occurences of obj from Q. | |
1a179b03 | 111 | (define (q-remove! q obj) |
1168a720 JB |
112 | (set-car! q (delq! obj (car q))) |
113 | (sync-q! q)) | |
a6401ee0 JB |
114 | |
115 | ;;; q-push! q obj | |
116 | ;;; Add obj to the front of Q | |
1a179b03 | 117 | (define (q-push! q obj) |
1168a720 | 118 | (let ((h (cons obj (car q)))) |
a6401ee0 | 119 | (set-car! q h) |
1168a720 JB |
120 | (or (cdr q) (set-cdr! q h))) |
121 | q) | |
a6401ee0 JB |
122 | |
123 | ;;; enq! q obj | |
124 | ;;; Add obj to the rear of Q | |
1a179b03 | 125 | (define (enq! q obj) |
1168a720 JB |
126 | (let ((h (cons obj '()))) |
127 | (if (null? (car q)) | |
128 | (set-car! q h) | |
129 | (set-cdr! (cdr q) h)) | |
130 | (set-cdr! q h)) | |
131 | q) | |
a6401ee0 JB |
132 | |
133 | ;;; q-pop! q | |
134 | ;;; Take the front of Q and return it. | |
1a179b03 | 135 | (define (q-pop! q) |
a6401ee0 JB |
136 | (q-empty-check q) |
137 | (let ((it (caar q)) | |
138 | (next (cdar q))) | |
b41478a1 | 139 | (if (null? next) |
a6401ee0 JB |
140 | (set-cdr! q #f)) |
141 | (set-car! q next) | |
142 | it)) | |
143 | ||
144 | ;;; deq! q | |
145 | ;;; Take the front of Q and return it. | |
1a179b03 | 146 | (define deq! q-pop!) |
a6401ee0 JB |
147 | |
148 | ;;; q-length q | |
149 | ;;; Return the number of enqueued elements. | |
150 | ;;; | |
1a179b03 | 151 | (define (q-length q) (length (car q))) |
64705682 TTN |
152 | |
153 | ;;; q.scm ends here |