summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/analyzer/set-queue.scm33
1 files changed, 18 insertions, 15 deletions
diff --git a/module/analyzer/set-queue.scm b/module/analyzer/set-queue.scm
index 89a6afa0c..2539f9579 100644
--- a/module/analyzer/set-queue.scm
+++ b/module/analyzer/set-queue.scm
@@ -1,35 +1,38 @@
(define-module (analyzer set-queue)
+ #:use-module (srfi srfi-9)
#:export (make-set-queue
+ set-queue?
set-queue-insert!
set-queue-remove!
set-queue-empty?
emptying-set-queue!))
+(define-record-type set-queue-type
+ (%make-set-queue elts)
+ set-queue?
+ (elts sq-elts set-sq-elts!))
+
;; The following are helper functions for using list-based set-queues:
;; queues where an element is only inserted if it is not already in
;; the queue.
(define (make-set-queue)
- (cons '() '()))
+ (%make-set-queue '()))
(define (set-queue-insert! sq elt)
- (cond ((null? (car sq))
- (set-car! sq (list elt))
- (set-cdr! sq (car sq)))
- ((memq elt (car sq)))
- (else
- (let ((new-pair (list elt)))
- (set-cdr! (cdr sq) new-pair)
- (set-cdr! sq new-pair)))))
+ (if (null? (sq-elts sq))
+ (set-sq-elts! sq (list elt))
+ (let loop ((this (sq-elts sq)))
+ (cond ((eq? (car this) elt))
+ ((null? (cdr this)) (set-cdr! this (list elt)))
+ (else (loop (cdr this)))))))
(define (set-queue-remove! sq)
- (let ((res (car sq)))
- (set-car! sq (cdr (car sq)))
- (if (eq? (cdr sq) res)
- (set-cdr! sq '()))
- (car res)))
+ (let ((old-list (sq-elts sq)))
+ (set-sq-elts! sq (cdr old-list))
+ (car old-list)))
(define (set-queue-empty? sq)
- (null? (car sq)))
+ (null? (sq-elts sq)))
(define (emptying-set-queue! sq func)
(if (not (set-queue-empty? sq))