mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
fixing iset cursors to do proper in-order traversal
This commit is contained in:
parent
06d82e5695
commit
034601a02b
5 changed files with 21 additions and 20 deletions
|
@ -73,5 +73,5 @@
|
||||||
iset-union iset-union! iset-intersection iset-intersection!
|
iset-union iset-union! iset-intersection iset-intersection!
|
||||||
iset-difference iset-difference!
|
iset-difference iset-difference!
|
||||||
iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node
|
iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node
|
||||||
iset-map iset->list iset-size
|
iset-map iset->list iset-size iset= iset<= iset>=
|
||||||
iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset?))
|
iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset?))
|
||||||
|
|
|
@ -35,11 +35,6 @@
|
||||||
(define (iset-copy-node iset)
|
(define (iset-copy-node iset)
|
||||||
(%make-iset (iset-start iset) (iset-end iset) (iset-bits iset) #f #f))
|
(%make-iset (iset-start iset) (iset-end iset) (iset-bits iset) #f #f))
|
||||||
|
|
||||||
(define (iset-set-node! a b)
|
|
||||||
(iset-start-set! a (iset-start b))
|
|
||||||
(iset-end-set! a (iset-end b))
|
|
||||||
(iset-bits-set! a (iset-bits b)))
|
|
||||||
|
|
||||||
(define (iset-max-end iset)
|
(define (iset-max-end iset)
|
||||||
(cond ((iset-right iset) => iset-max-end)
|
(cond ((iset-right iset) => iset-max-end)
|
||||||
(else (iset-end iset))))
|
(else (iset-end iset))))
|
||||||
|
@ -67,7 +62,7 @@
|
||||||
|
|
||||||
(define (iset-squash-bits! iset)
|
(define (iset-squash-bits! iset)
|
||||||
(let ((bits (iset-bits iset)))
|
(let ((bits (iset-bits iset)))
|
||||||
(if (= bits (range->bits (iset-start iset) (iset-end iset)))
|
(if (and bits (= bits (range->bits (iset-start iset) (iset-end iset))))
|
||||||
(iset-bits-set! iset #f))))
|
(iset-bits-set! iset #f))))
|
||||||
|
|
||||||
(define (iset-adjoin1! iset n)
|
(define (iset-adjoin1! iset n)
|
||||||
|
|
|
@ -6,4 +6,6 @@
|
||||||
iset iset-copy list->iset list->iset! iset-map
|
iset iset-copy list->iset list->iset! iset-map
|
||||||
iset-adjoin iset-adjoin! iset-delete iset-delete!
|
iset-adjoin iset-adjoin! iset-delete iset-delete!
|
||||||
iset-union iset-union! iset-intersection iset-intersection!
|
iset-union iset-union! iset-intersection iset-intersection!
|
||||||
iset-difference iset-difference!))
|
iset-difference iset-difference!
|
||||||
|
;; low-level
|
||||||
|
iset-copy-node iset-squash-bits! iset-insert-left! iset-insert-right!))
|
||||||
|
|
|
@ -17,25 +17,27 @@
|
||||||
|
|
||||||
;; Create a new iset cursor pointing to the first element of iset,
|
;; Create a new iset cursor pointing to the first element of iset,
|
||||||
;; with an optional stack argument.
|
;; with an optional stack argument.
|
||||||
(define (iset-cursor iset . o)
|
(define (%iset-cursor iset . o)
|
||||||
(iset-cursor-advance
|
(iset-cursor-advance
|
||||||
(make-iset-cursor iset
|
(make-iset-cursor iset
|
||||||
(or (iset-bits iset) (iset-start iset))
|
(or (iset-bits iset) (iset-start iset))
|
||||||
(if (pair? o) (car o) '()))))
|
(if (pair? o) (car o) '()))))
|
||||||
|
|
||||||
|
(define (iset-cursor iset . o)
|
||||||
|
(let ((stack (if (pair? o) (car o) '())))
|
||||||
|
(if (iset-left iset)
|
||||||
|
(iset-cursor (iset-left iset) (cons iset stack))
|
||||||
|
(%iset-cursor iset stack))))
|
||||||
|
|
||||||
;; Continue to the next node in the search stack.
|
;; Continue to the next node in the search stack.
|
||||||
(define (iset-cursor-pop cur)
|
(define (iset-cursor-pop cur)
|
||||||
(let ((node (iset-cursor-node cur))
|
(let ((node (iset-cursor-node cur))
|
||||||
(stack (iset-cursor-stack cur)))
|
(stack (iset-cursor-stack cur)))
|
||||||
(cond
|
(cond
|
||||||
((iset-left node)
|
|
||||||
(iset-cursor
|
|
||||||
(iset-left node)
|
|
||||||
(if (iset-right node) (cons (iset-right node) stack) stack)))
|
|
||||||
((iset-right node)
|
((iset-right node)
|
||||||
(iset-cursor (iset-right node) stack))
|
(iset-cursor (iset-right node) stack))
|
||||||
((pair? stack)
|
((pair? stack)
|
||||||
(iset-cursor (car stack) (cdr stack)))
|
(%iset-cursor (car stack) (cdr stack)))
|
||||||
(else
|
(else
|
||||||
cur))))
|
cur))))
|
||||||
|
|
||||||
|
@ -44,9 +46,10 @@
|
||||||
(define (iset-cursor-advance cur)
|
(define (iset-cursor-advance cur)
|
||||||
(let ((node (iset-cursor-node cur))
|
(let ((node (iset-cursor-node cur))
|
||||||
(pos (iset-cursor-pos cur)))
|
(pos (iset-cursor-pos cur)))
|
||||||
(if (if (iset-bits node) (zero? pos) (> pos (iset-end node)))
|
(cond
|
||||||
(iset-cursor-pop cur)
|
((if (iset-bits node) (zero? pos) (> pos (iset-end node)))
|
||||||
cur)))
|
(iset-cursor-pop cur))
|
||||||
|
(else cur))))
|
||||||
|
|
||||||
(define (iset-cursor-next iset cur)
|
(define (iset-cursor-next iset cur)
|
||||||
(iset-cursor-advance
|
(iset-cursor-advance
|
||||||
|
@ -76,7 +79,6 @@
|
||||||
(and (if (iset-bits node)
|
(and (if (iset-bits node)
|
||||||
(zero? (iset-cursor-pos cur))
|
(zero? (iset-cursor-pos cur))
|
||||||
(> (iset-cursor-pos cur) (iset-end node)))
|
(> (iset-cursor-pos cur) (iset-end node)))
|
||||||
(not (iset-left node))
|
|
||||||
(not (iset-right node))
|
(not (iset-right node))
|
||||||
(null? (iset-cursor-stack cur)))))
|
(null? (iset-cursor-stack cur)))))
|
||||||
|
|
||||||
|
@ -90,7 +92,9 @@
|
||||||
((end-of-iset? cur2) #f)
|
((end-of-iset? cur2) #f)
|
||||||
((= (iset-ref is1 cur1) (iset-ref is2 cur2))
|
((= (iset-ref is1 cur1) (iset-ref is2 cur2))
|
||||||
(lp (iset-cursor-next is1 cur1) (iset-cursor-next is2 cur2)))
|
(lp (iset-cursor-next is1 cur1) (iset-cursor-next is2 cur2)))
|
||||||
(else #f))))
|
(else
|
||||||
|
(write `(not (= ,(iset-ref is1 cur1) ,(iset-ref is2 cur2)))) (newline)
|
||||||
|
#f))))
|
||||||
|
|
||||||
(define (iset2<= is1 is2)
|
(define (iset2<= is1 is2)
|
||||||
(let lp ((cur1 (iset-cursor is1))
|
(let lp ((cur1 (iset-cursor is1))
|
||||||
|
|
|
@ -4,6 +4,6 @@
|
||||||
(include "iterators.scm")
|
(include "iterators.scm")
|
||||||
(export
|
(export
|
||||||
iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node
|
iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node
|
||||||
iset->list iset-size
|
iset->list iset-size iset= iset<= iset>=
|
||||||
;; low-level cursors
|
;; low-level cursors
|
||||||
iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset?))
|
iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset?))
|
||||||
|
|
Loading…
Add table
Reference in a new issue