Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-15 08:57:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Simplifying iset-adjoin1! to use node adjoining.

Browse source
This commit is contained in:
Alex Shinn 2014-04-18 22:58:37 +09:00
parent 9fd0d6ac7a
commit 48f075528c
1 changed files with 2 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
lib/chibi/iset/constructors.scm
View file

@ -65,53 +65,8 @@
(if (and bits (= 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! is n)
(cond (iset-adjoin-node! is (%make-iset n n #f #f #f)))
((iset-empty? iset)
(iset-start-set! iset n)
(iset-end-set! iset n)
(iset-bits-set! iset #f))
(else
(let ((start (iset-start iset))
(end (iset-end iset))
(bits (iset-bits iset)))
(cond
((< n start)
(let ((s-diff (- start n)))
(if (let* ((left (iset-left iset))
(m-end (and left (iset-max-end left))))
(and m-end
(or (<= n m-end)
(< (- n m-end) s-diff))))
(iset-adjoin1! (iset-left iset) n)
(cond
((and (< s-diff bits-thresh)
(< (- end n) bits-max))
(iset-start-set! iset n)
(let ((bits2 (arithmetic-shift (or bits (range->bits start end))
s-diff)))
(iset-bits-set! iset (+ bits2 1))
(iset-squash-bits! iset)))
(else (iset-insert-left! iset (make-iset n)))))))
((> n end)
(let ((e-diff (- n end)))
(if (let* ((right (iset-right iset))
(m-start (and right (iset-min-start right))))
(and m-start
(or (>= n m-start)
(> (- n m-start) e-diff))))
(iset-adjoin1! (iset-right iset) n)
(cond
((and (< e-diff bits-thresh)
(< (- n start) bits-max))
(iset-end-set! iset n)
(iset-bits-set! iset (bit-set (or bits (range->bits start end))
(- n start)))
(iset-squash-bits! iset))
(else (iset-insert-right! iset (make-iset n)))))))
(bits
(iset-bits-set! iset (bit-set (iset-bits iset) (- n start)))
(iset-squash-bits! iset)))))))
(define (iset-adjoin-node! a b) (define (iset-adjoin-node! a b)
(cond (cond