Changeset 39710 in project


Ignore:
Timestamp:
03/14/21 21:31:18 (6 weeks ago)
Author:
Kon Lovett
Message:

queue keeps explicit count

Location:
release/5/mailbox/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/inline-queue.scm

    r39700 r39710  
    1414(define queue 'queue)
    1515(define-record-type-variant queue (unsafe unchecked inline)
    16   (%make-queue hd tl)
     16  (%make-queue ln hd tl)
    1717  (%queue?)
     18  (ln %queue-count %queue-count-set!)
    1819  (hd %queue-first-pair %queue-first-pair-set!)
    1920  (tl %queue-last-pair %queue-last-pair-set!) )
    2021
    21 (define-inline (%make-empty-queue) (%make-queue '() '()))
     22(define-inline (%queue-count-inc! q) (%queue-count-set! q (add1 (%queue-count q))))
     23(define-inline (%queue-count-dec! q) (%queue-count-set! q (sub1 (%queue-count q))))
    2224
    23 (define-inline (%queue-empty? q) (null? (%queue-first-pair q)))
    24 (define-inline (%queue-count q) (length (%queue-first-pair q)))
     25(define-inline (%make-empty-queue) (%make-queue 0 '() '()))
     26
     27(define-inline (%queue-empty? q) (zero? (%queue-count q)))
    2528
    2629;; Operations
     
    3336      (%queue-first-pair-set! q new-pair)
    3437      (set-cdr! (%queue-last-pair q) new-pair) )
    35     (%queue-last-pair-set! q new-pair) ) )
     38    (%queue-last-pair-set! q new-pair) )
     39  (%queue-count-inc! q) )
    3640
    3741(define-inline (%queue-remove! q)
     
    3943         (next-pair (cdr first-pair)))
    4044    (%queue-first-pair-set! q next-pair)
    41     (when (null? next-pair) (%queue-last-pair-empty! q) )
     45    (when (null? next-pair) (%queue-last-pair-empty! q))
     46    (%queue-count-dec! q)
    4247    (car first-pair) ) )
    4348
     
    4550  (let ((newlist (cons item (%queue-first-pair q))))
    4651    (%queue-first-pair-set! q newlist)
    47     (when (null? (%queue-last-pair q)) (%queue-last-pair-set! q newlist) ) ) )
     52    (when (null? (%queue-last-pair q)) (%queue-last-pair-set! q newlist) ) )
     53  (%queue-count-inc! q) )
    4854
    4955(define-inline (%queue-push-back-list! q itemlist)
     
    5258    (if (null? newlist)
    5359      (%queue-last-pair-empty! q)
    54       (%queue-last-pair-set! q (last-pair newlist) ) ) ) )
     60      (%queue-last-pair-set! q (last-pair newlist) ) ) )
     61  (%queue-count-set! q (+ (length itemlist) (%queue-count q))) )
    5562
    5663(define-inline (%queue-extract-pair! q targ-pair)
     
    7380          ;when the cut pair is the last item update the last pair ref.
    7481          (when (eq? this-pair (%queue-last-pair q))
    75             (%queue-last-pair-set! q prev-pair)) ) )
     82            (%queue-last-pair-set! q prev-pair)) )
     83        (%queue-count-dec! q) )
    7684      ;not found
    7785      (else
  • release/5/mailbox/trunk/mailbox.egg

    r39702 r39710  
    55((synopsis "Thread-safe queues with timeout")
    66 (category hell)
    7  (version "3.3.8")
     7 (version "3.3.9")
    88 (author "[[felix winkelman]] and [[kon lovett]]")
    99 (license "BSD")
Note: See TracChangeset for help on using the changeset viewer.