bitstring port pasted by Kooda on Thu Dec 13 15:05:47 2018

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)
[ permalink | raw ]

test case added by Kooda on Thu Dec 13 15:23:06 2018

(import srfi-4 bitstring)

(define bs (->bitstring (u8vector)))
(bitstring-append! bs (integer->bitstring-big #b100 3))
(bitstring-append! bs (integer->bitstring-big #b10 2))
(bitstring-append! bs (integer->bitstring-big #b1 1))
(bitstring-append! bs (integer->bitstring-big #b0101 4))
[ permalink | raw ]