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