Changeset 39726 in project


Ignore:
Timestamp:
03/16/21 22:23:30 (8 weeks ago)
Author:
Kon Lovett
Message:

add limited-cursor

File:
1 edited

Legend:

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

    r39725 r39726  
    7575
    7676(define-inline (%queue-unlimited-push-back! q v)
     77  (%queue-unlimited-add! q v)
     78  #; ;why bother
    7779  (let ((newlist (cons v (%queue-unlimited-first-pair q))))
    7880    (%queue-unlimited-first-pair-set! q newlist)
     
    8284
    8385(define-inline (%queue-unlimited-push-back-list! q ls)
     86  (for-each (lambda (v) (%queue-unlimited-add! q v)) (reverse ls))
     87  #; ;why bother
    8488  (let ((newlist (append! (list-copy ls) (%queue-unlimited-first-pair q))))
    8589    (%queue-unlimited-first-pair-set! q newlist)
     
    150154; dec i: (i + (n-1))  mod n
    151155
    152 (define-inline (%queue-limited-peek q i)
    153   (vector-ref (%queue-limited-vector q) i) )
    154 
    155 (define-inline (%queue-limited-poke! q i v)
    156   (vector-set! (%queue-limited-vector q) i v) )
     156(define-inline (%queue-limited-peek q i)    (vector-ref (%queue-limited-vector q) i))
     157(define-inline (%queue-limited-poke! q i v) (vector-set! (%queue-limited-vector q) i v))
    157158
    158159(define-inline (%queue-limited-limit q)
    159   (vector-length (%queue-limited-vector q)) )
    160 
    161 (define-inline (%queue-limited-index-add1 q i)
     160  (fx- (vector-length (%queue-limited-vector q)) 1) )
     161
     162(define-inline (%queue-limited-index-inc q i)
    162163  (fxmod (fx+ i 1) (%queue-limited-limit q)) )
     164
     165(define-inline (%queue-limited-index-dec q i)
     166  (fxmod (fx+ i (fx- (vector-length (%queue-limited-vector q)) 2)) (%queue-limited-limit q)) )
    163167
    164168(define-inline (%queue-limited-limit-set! q v)
     
    184188(define-inline (%queue-limited-add! q v)
    185189  (%queue-limited-poke! q (%queue-limited-end q) v)
    186   (%queue-limited-end-set! q (%queue-limited-index-add1 q (%queue-limited-end q))) )
     190  (%queue-limited-end-set! q (%queue-limited-index-inc q (%queue-limited-end q))) )
    187191
    188192(define-inline (%queue-limited-remove! q)
    189193  (let ((v (%queue-limited-peek q (%queue-limited-start q))))
    190     (%queue-limited-start-set! q (%queue-limited-index-add1 q (%queue-limited-start q)))
     194    (%queue-limited-start-set! q (%queue-limited-index-inc q (%queue-limited-start q)))
    191195    v ) )
    192196
    193197(define-inline (%queue-limited-push-back! q v)
    194   (error '%queue-limited-push-back! "unsupported" q v) )
     198  (%queue-limited-add! q v) )
    195199
    196200(define-inline (%queue-limited-push-back-list! q ls)
    197   (error '%queue-limited-push-back-list! "unsupported" q ls) )
     201  (for-each (lambda (v) (%queue-limited-add! q v)) (reverse ls)) )
    198202
    199203;index
    200 (define-inline (%make-queue-limited-cursor) (void))
    201 (define-inline (%queue-limited-cursor? c) #f)
     204(define-inline (%make-queue-limited-cursor) (cons -1 (void)))
     205(define-inline (%queue-limited-cursor? c) (pair? c))
     206(define-inline (%queue-limited-index c) (car c))
     207(define-inline (%queue-limited-index-set! c v) (set-car! c v))
    202208
    203209(define-inline (%queue-limited-cursor-winding? q c)
    204   (error '%queue-limited-cursor-winding? "unsupported" q c) )
     210  (fx<= 0 (%queue-limited-index c)) )
    205211
    206212(define-inline (%queue-limited-cursor-unwound? q c)
    207   (error '%queue-limited-cursor-unwound? "unsupported" q c) )
     213  (fx= (%queue-limited-end q) (%queue-limited-index c)) )
    208214
    209215(define-inline (%queue-limited-cursor-start! q c)
    210   (error '%queue-limited-cursor-start! "unsupported" q c) )
     216  (%queue-limited-index-set! c (%queue-limited-start q)) )
    211217
    212218;#!eof | *
    213219(define-inline (%queue-limited-cursor-next! q c)
    214   (error '%queue-limited-cursor-next! "unsupported" q c) )
     220  (cond
     221    ((%queue-limited-cursor-unwound? q c)  #!eof)
     222    (else
     223      (let ((v (%queue-limited-peek q (%queue-limited-index c))))
     224        (%queue-limited-index-set! c (%queue-limited-index-inc q (%queue-limited-index c)))
     225        v ) ) ) )
    215226
    216227(define-inline (%queue-limited-cursor-continue! q c)
    217   (error '%queue-limited-cursor-continue! "unsupported" q c) )
     228  #; ;assert index is end - 1
     229  (%queue-limited-index-set! c (%queue-limited-index-dec q (%queue-limited-end q)))
     230  (void) )
    218231
    219232(define-inline (%queue-limited-cursor-rewind! q c)
    220   (error '%queue-limited-cursor-rewind! "unsupported" q c) )
     233  (%queue-limited-index-set! c -1) )
    221234
    222235(define-inline (%queue-limited-cursor-extract! q c)
    223   (error '%queue-limited-cursor-extract! "unsupported" q c) )
     236  ;unless 'mailbox-cursor-next' has been called don't remove
     237  (when (%queue-limited-cursor-winding? q c)
     238    ;move "up" from i-1 to i until i = start
     239    (let loop ((i (%queue-limited-index-dec q (%queue-limited-index c))))
     240      (let ((i-1 (%queue-limited-index-dec q i)))
     241        (%queue-limited-poke! q i (%queue-limited-peek q i-1))
     242        (if (fx= (%queue-limited-start q) i-1)
     243          (%queue-limited-start-set! q i)
     244          (loop i-1) ) ) ) ) )
    224245
    225246;; Queue Unbuffered
     
    264285
    265286(define-inline (%queue-unbuffered-push-back-list! q ls)
    266   (%queue-unbuffered-add! q (car ls)) )
     287  (for-each (lambda (v) (%queue-unbuffered-add! q v)) (reverse ls)) )
    267288
    268289(define-inline (%make-queue-unbuffered-cursor) (cons -1 (void)))
    269 (define-inline (%queue-unbuffered-cursor? c) (pair c))
     290(define-inline (%queue-unbuffered-cursor? c) (pair? c))
    270291(define-inline (%queue-unbuffered-index c) (car c))
    271292(define-inline (%queue-unbuffered-index-set! c v) (set-car! c v))
Note: See TracChangeset for help on using the changeset viewer.