Mercurial repository: https://bitbucket.org/rivo/bitstring/ PATCH diff -r d31e2fd6b53e bitstring.egg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bitstring.egg Thu Dec 13 15:05:30 2018 +0100 @@ -0,0 +1,7 @@ +((license "BSD") + (category parsing) + (dependencies srfi-1) + (test-dependencies test) + (author "rivo") + (synopsis "Binary pattern matching") + (components (extension bitstring))) diff -r d31e2fd6b53e bitstring.scm --- a/bitstring.scm Mon Jun 15 13:30:23 2015 +0300 +++ b/bitstring.scm Thu Dec 13 15:05:30 2018 +0100 @@ -47,8 +47,7 @@ double->bitstring list->bitstring) - (import scheme chicken extras foreign) - (require-extension srfi-1 srfi-4) + (import scheme (chicken base) (chicken bitwise) (chicken blob) (chicken condition) (chicken fixnum) (chicken foreign) (chicken format) srfi-1 srfi-4) (define-syntax symbol?? (er-macro-transformer @@ -583,7 +582,7 @@ (byte-index (quotient index 8)) (bit-index (- 7 (remainder index 8)))) (if (and (<= start index) (< index end)) - (bit-set? (bitstring-load-byte bs byte-index) bit-index) + (bit->boolean (bitstring-load-byte bs byte-index) bit-index) (error "out of range" start end n))))) (define (bitstring->integer-big bs) @@ -778,9 +777,11 @@ (let ((required (bitstring-length src)) (position (bitstring-end dest)) (reserved (bitstring-buffer-size dest))) + (print (list required: required position: position reserved: reserved)) (when (< (- reserved position) required) (bitstring-buffer-resize dest (+ reserved (inexact->exact (* 0.50 reserved)) required))) + (print (list new-buffer: (bitstring-buffer-size dest))) (bitstring-fold (lambda (value nbits acc) (bitstring-append-safe! acc (fxshl value (- 8 nbits)) nbits)) @@ -791,6 +792,7 @@ (let* ((position (bitstring-end bs)) (index (quotient position 8)) (drift (remainder position 8))) + (print (list value: value nbits: nbits position: position index: index drift: drift)) (if (zero? drift) ; store aligned (begin diff -r d31e2fd6b53e tests/run.scm --- a/tests/run.scm Mon Jun 15 13:30:23 2015 +0300 +++ b/tests/run.scm Thu Dec 13 15:05:30 2018 +0100 @@ -1,4 +1,4 @@ -(use srfi-4 bitstring test) +(import srfi-1 srfi-4 bitstring test) (current-test-epsilon .01)