Commits

Anonymous committed 3759c2b

change naming style
introduce bitstring->u8vector

  • Participants
  • Parent commits 3f10ac2

Comments (0)

Files changed (2)

File bitstring.scm

    make-bitstring
    bitstring?
    bitstring-length
-   bitstring-of-any
-   bitstring-of-vector
+   ->bitstring
+   vector->bitstring
+   u8vector->bitstring
+   string->bitstring
    bitstring-read
    bitstring-share
    bitstring=?
    bitstring-create
    bitstring->list
    bitstring->blob
+   bitstring->u8vector
    bitstring->integer
    bitstring->integer-big
    bitstring->integer-little
   (syntax-rules ()
     ((_ value patterns ...)
       ;; invoke user code with captured variables
-      ((let ((bstr (bitstring-of-any value)))
+      ((let ((bstr (->bitstring value)))
         (or (bitmatch-pattern-list bstr patterns ...)))))))
 
 (define-syntax bitmatch-pattern-list
   (syntax-rules ()
     ((_ bstr handler pattern ...)
       ; share bitstring instance
-      (let ((stream (bitstring-of-any bstr)))
+      (let ((stream (->bitstring bstr)))
         (bitstring-pattern "read" stream handler pattern ...)))))
 
 (define-syntax bitstring-pattern
 (define-syntax bitstring-pattern-expand
   (syntax-rules ()
     ((_ "write" stream name continuation)
-      (and-let* ((tmp (bitstring-of-any name)))
+      (and-let* ((tmp (->bitstring name)))
         ;(print "write-expand:" `stream " name:" `name)
       	(bitstring-append! stream tmp)
       	continuation))
     ((_ tmp bits bitstring)
       (if (bitstring? tmp)
       	tmp
-      	(bitstring-of-any tmp)))
+      	(->bitstring tmp)))
     ((_ tmp 16 float)
       (half->bitstring tmp))
     ((_ tmp 32 float)
       bitstring-default-getter
       bitstring-default-setter)))
 
-(define (bitstring-of-string s)
+(define (string->bitstring s)
   (make-bitstring 0 (* 8 (string-length s)) s 
     (lambda (str index) (char->integer (string-ref str index)))
     (lambda (str index byte) (string-set! str index (integer->char byte)))))
 
-(define (bitstring-of-vector v)
+(define (vector->bitstring v)
   (make-bitstring 0 (* 8 (vector-length v)) v
     (lambda (vec index) (vector-ref vec index))
     (lambda (vec index byte) (vector-set! vec index byte))))
 
-(define (bitstring-of-u8vector v)
+(define (u8vector->bitstring v)
   (make-bitstring 0 (* 8 (u8vector-length v)) v
     bitstring-default-getter
     bitstring-default-setter))
 
-(define (bitstring-of-any x)
+(define (->bitstring x)
   (cond
     ((bitstring? x)
       (bitstring-share x (bitstring-offset x) (bitstring-numbits x)))
     ((u8vector? x)
-      (bitstring-of-u8vector x))
+      (u8vector->bitstring x))
     ((string? x)
-      (bitstring-of-string x))
+      (string->bitstring x))
     ((vector? x)
-      (bitstring-of-vector x))
+      (vector->bitstring x))
     ((blob? x)
-      (bitstring-of-u8vector (blob->u8vector/shared x)))
+      (u8vector->bitstring (blob->u8vector/shared x)))
     (else
       (error "bitstring-invalid-value" x))))
 
 (define (bitstring->blob bs)
   ;NOTE: optimize me! 
   (u8vector->blob (list->u8vector (bitstring->list bs 8))))
-    
+
+(define (bitstring->u8vector bs)
+  (list->u8vector (bitstring->list bs 8)))
+  
 (define (bitstring->list bs #!optional (bits 1) (endian 'big))
   (if (= bits 8)
     (bitstring->list8 bs)
           (cons (bitstring->integer value endian)
                 acc)))
       (((rest-value bitstring))
-        (loop (bitstring-of-any "")
+        (loop (->bitstring "")
           (cons (bitstring->integer rest-value endian)
                 acc))))))
 
 (define (single->bitstring value)
     (let ((buf (make-u8vector 4)))
         (float->uint32 buf value)
-        (bitstring-of-any buf)))
+        (->bitstring buf)))
 
 (define (double->bitstring value)
     (let ((buf (make-u8vector 8)))
         (double->uint64 buf value)
-        (bitstring-of-any buf)))
+        (->bitstring buf)))
 
 (define (bitstring->single bs)
     (uint32->float (bitstring->blob bs)))
 
 ; create empty bitstring and reserve 16 bytes
 (define (bitstring-create)
-  (let ((tmp (bitstring-of-u8vector (make-u8vector 16 0))))
+  (let ((tmp (u8vector->bitstring (make-u8vector 16 0))))
     (bitstring-numbits-set! tmp 0)
     tmp))
 

File tests/run.scm

 (test-end)
 
 (test-begin "integer attributes")
-(define bstr (bitstring-of-any "\xff"))
+(define bstr (->bitstring "\xff"))
 (test -127 (bitmatch bstr ((x signed) -> x)))
 (test 255 (bitmatch bstr ((x unsigned) -> x)))
 (test -127 (bitmatch bstr ((x 8 signed) -> x)))
 (test-end)
 
 (test-begin "bitstring->list")
-(define bstr (bitstring-of-any "\xff"))
+(define bstr (->bitstring "\xff"))
 (test (make-list 8 1) (bitstring->list bstr 1 'big))
 (test (make-list 8 1) (bitstring->list bstr 1 'little))
 (test (make-list 8 1) (bitstring->list bstr 1 'host))
 (test foo (list->bitstring (bitstring->list foo 8 'host) 8 'host))
 (test-end)
 
+(test-begin "bitstring <-> u8vector")
+(define x (u8vector 1 2 3))
+(test x (bitstring->u8vector (u8vector->bitstring x)))
+(test-end)
+
 (test-begin "bytestring")
-(define bstr (bitstring-of-any (u8vector 1 3 5)))
+(define bstr (->bitstring (u8vector 1 3 5)))
 (define bstr23 (bitmatch bstr ((x 1) (rest bitstring) -> rest)))
 (test #t (bytestring? bstr))
 (test #f (bytestring? bstr23))
 (test-begin "append")
 ; append aligned
 (define bs (bitstring-create))
-(bitstring-append! bs (bitstring-of-any "A"))
-(bitstring-append! bs (bitstring-of-any "B"))
-(bitstring-append! bs (bitstring-of-any "\x20"))
-(test #t (bitstring=? bs (bitstring-of-any "AB\x20")))
+(bitstring-append! bs (->bitstring "A"))
+(bitstring-append! bs (->bitstring "B"))
+(bitstring-append! bs (->bitstring "\x20"))
+(test #t (bitstring=? bs (->bitstring "AB\x20")))
 ; test immutable append
-(define a (bitstring-of-any "A"))
-(define b (bitstring-of-any "B"))
+(define a (->bitstring "A"))
+(define b (->bitstring "B"))
 (define c (bitstring-append a b))
 (test #t (bitstring=? (bitconstruct ("AB")) c))
 (test #t (bitstring=? (bitconstruct ("A")) a))
 (let ((a "Is There Love")
       (b "in Space?")
       (c "Nobody knows."))
-  (bitstring-append! bs (bitstring-of-any a))
-  (bitstring-append! bs (bitstring-of-any b))
-  (test #t (bitstring=? (bitstring-of-any (string-append a b)) bs))
-  (bitstring-append! bs (bitstring-of-any c))
-  (test #t (bitstring=? (bitstring-of-any (string-append a b c)) bs)))
+  (bitstring-append! bs (->bitstring a))
+  (bitstring-append! bs (->bitstring b))
+  (test #t (bitstring=? (->bitstring (string-append a b)) bs))
+  (bitstring-append! bs (->bitstring c))
+  (test #t (bitstring=? (->bitstring (string-append a b c)) bs)))
 (test-end)
 
 (test-begin "bitpacket")
     (((PacketZ bitpacket)) (+ 3 ValueZ))))
 (test-end)
 
-(test-begin "bitstring-of-any")
+(test-begin "->bitstring")
 (test 'ok (bitmatch "ABC" ((("A") (66) (#\C)) 'ok)))
 (test 'ok (bitmatch "ABC" ((("AB") (#\C)) 'ok)))
 (test 'ok (bitmatch `#( 65 66 67 ) ( (("A") (66) (#\C)) 'ok)))
 (test-end)
 
 (test-begin "read")
-(define bs (bitstring-of-vector `#(65 66 67)))
+(define bs (vector->bitstring `#(65 66 67)))
 (test #f (bitstring-share bs 0 100))
 (test 2 (bitstring->integer-big (bitstring-share bs 0 3)))
 (test 5 (bitstring->integer-big (bitstring-share bs 3 10)))
 (test 5 (bitstring->integer-big (bitstring-read bs 7)))
 (test 579 (bitstring->integer-big (bitstring-read bs 14)))
 (test #f (bitstring-read bs 1))
-(define bs (bitstring-of-vector `#( #x8F )))
+(define bs (vector->bitstring `#( #x8F )))
 (test 1 (bitstring->integer-big (bitstring-share bs 0 1)))
 (test 15 (bitstring->integer-big (bitstring-share bs 1 8)))
-(define bs (bitstring-of-vector `#( #x7C #x00)))
+(define bs (vector->bitstring `#( #x7C #x00)))
 (test 0 (bitstring->integer-big (bitstring-share bs 0 1)))
 (test 31 (bitstring->integer-big (bitstring-share bs 1 6)))
 (test-end)
 (test-end)
 
 (test-begin "half")
-(test +inf.0 (bitstring->half (bitstring-of-vector `#( #x7C #x00))))
-(test -inf.0 (bitstring->half (bitstring-of-vector `#( #xFC #x00))))
-(test 0. (bitstring->half (bitstring-of-vector `#( #x00 #x00))))
-(test -0. (bitstring->half (bitstring-of-vector `#( #x80 #x00))))
-(test 0.5 (bitstring->half (bitstring-of-vector `#( #x38 #x00))))
-(test 1. (bitstring->half (bitstring-of-vector `#( #x3C #x00))))
-(test 25. (bitstring->half (bitstring-of-vector `#( #x4E #x40))))
-(test 0.099976 (bitstring->half (bitstring-of-vector `#( #x2E #x66))))
-(test -0.122986 (bitstring->half (bitstring-of-vector `#( #xAF #xDF))))
+(test +inf.0 (bitstring->half (vector->bitstring `#( #x7C #x00))))
+(test -inf.0 (bitstring->half (vector->bitstring `#( #xFC #x00))))
+(test 0. (bitstring->half (vector->bitstring `#( #x00 #x00))))
+(test -0. (bitstring->half (vector->bitstring `#( #x80 #x00))))
+(test 0.5 (bitstring->half (vector->bitstring `#( #x38 #x00))))
+(test 1. (bitstring->half (vector->bitstring `#( #x3C #x00))))
+(test 25. (bitstring->half (vector->bitstring `#( #x4E #x40))))
+(test 0.099976 (bitstring->half (vector->bitstring `#( #x2E #x66))))
+(test -0.122986 (bitstring->half (vector->bitstring `#( #xAF #xDF))))
 ;-124.0625
 (test-end)
 
 (test-begin "single")
-(test +inf.0 (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x80 #x7F))))
-(test -inf.0 (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x80 #xFF))))
-;(test +nan.0 (bitstring->single (bitstring-of-vector `#( #x7F #xC0 #x00 #x00))))
-(test 0. (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x00 #x00))))
-(test -0. (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x00 #x80))))
-(test #t (equal? 1. (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x80 #x3f)))))
-(test 0.5 (bitstring->single (bitstring-of-vector `#( #x00 #x00 #x00 #x3f))))
-(test 25. (bitstring->single (bitstring-of-vector `#( #x00 #x00 #xc8 #x41))))
-(test 0.1 (bitstring->single (bitstring-of-vector `#( #xcd #xcc #xcc #x3d))))
-(test -0.123 (bitstring->single (bitstring-of-vector `#( #xE7 #x6D #xFB #xBD))))
+(test +inf.0 (bitstring->single (vector->bitstring `#( #x00 #x00 #x80 #x7F))))
+(test -inf.0 (bitstring->single (vector->bitstring `#( #x00 #x00 #x80 #xFF))))
+;(test +nan.0 (bitstring->single (vector->bitstring `#( #x7F #xC0 #x00 #x00))))
+(test 0. (bitstring->single (vector->bitstring `#( #x00 #x00 #x00 #x00))))
+(test -0. (bitstring->single (vector->bitstring `#( #x00 #x00 #x00 #x80))))
+(test #t (equal? 1. (bitstring->single (vector->bitstring `#( #x00 #x00 #x80 #x3f)))))
+(test 0.5 (bitstring->single (vector->bitstring `#( #x00 #x00 #x00 #x3f))))
+(test 25. (bitstring->single (vector->bitstring `#( #x00 #x00 #xc8 #x41))))
+(test 0.1 (bitstring->single (vector->bitstring `#( #xcd #xcc #xcc #x3d))))
+(test -0.123 (bitstring->single (vector->bitstring `#( #xE7 #x6D #xFB #xBD))))
 (test `(0 32 #u8( #x00 #x00 #x00 #x3f)) (get-fields (single->bitstring 0.5)))
 (test `(0 32 #u8( #x6D #xE7 #xFB #xBD)) (get-fields (single->bitstring -0.123)))
 (test-end)