Changeset 29479 in project


Ignore:
Timestamp:
08/02/13 08:54:20 (6 years ago)
Author:
Ivan Raikov
Message:

byte-blob-stream: added tests from byte-blob

Location:
release/4/byte-blob-stream/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/byte-blob-stream/trunk/byte-blob-stream.scm

    r19563 r29479  
    33;; byte blobs.
    44;;
    5 ;; Copyright 2009-2010 Ivan Raikov and the Okinawa Institute of
     5;; Copyright 2009-2013 Ivan Raikov and the Okinawa Institute of
    66;; Science and Technology.
    77;;
     
    185185              (byte-blob-stream-ref (stream-cdr sb) (- i len)))))))
    186186
    187 ;; Fast sub-sequence search, based on work by Boyer, Moore, Horspool,
    188 ;; Sunday, and Lundh.
    189 ;;
    190 ;; Based on code from the Haskell text library by Tom Harper and Bryan
    191 ;; O'Sullivan. http://hackage.haskell.org/package/text
    192 
    193 (define (subsequence-search needle haystack)
    194   (let* ((nlen    (byte-blob-length needle))
    195          (nlast   (- nlen 1))
    196          (nindex  (lambda (i) (byte-blob-ref needle i))))
    197     (let* ((z    (nindex nlast))
    198            (tbl  (make-table nlast nindex nlen z)))
    199       (let-values
    200        (((mask skip)  (tbl 0 0 (- nlen 2))))
    201        (cond ((zero? nlen)
    202               '())
    203              ((= 1 nlen) 
    204               (scan1 (nindex 0) 0 haystack))
    205              (else
    206               ((scan mask skip nlen nlast nindex z) 0 0 haystack)))))))
    207 
    208 
    209187
    210188(define swizzle
    211     (foreign-lambda* int ((integer k))
     189    (foreign-lambda* unsigned-int ((unsigned-int k))
    212190#<<END
    213      int result;
    214 
    215      result = 1 << (k & 0x3F);
     191     unsigned int result;
     192
     193     result = (k & 0x1F);
    216194
    217195     C_return(result);
    218196END
    219197))
     198
     199
     200(define initmask
     201    (foreign-lambda* void ((blob m))
     202#<<END
     203    memset (m, 0, 4);
     204END
     205))
     206
     207(define setbit!
     208    (foreign-lambda* void ((blob m) (unsigned-int i))
     209#<<END
     210     unsigned int w;
     211     w = i / 8;
     212
     213     m[w] = m[w] | ((1 << i) >> (8*w));
     214END
     215))
     216
     217(define bitset?
     218    (foreign-lambda* bool ((blob m) (unsigned-int i))
     219#<<END
     220     unsigned int w, result;
     221     w = i / 8;
     222
     223     result = m[w] & ((1 << i) >> (8*w));
     224END
     225))
     226 
    220227
    221228
     
    224231    (let loop ((i i) (msk msk) (skp skp))
    225232      (cond ((>= i nlast) 
    226              (values (bitwise-ior msk (swizzle z)) skp))
     233             (begin
     234               (setbit! msk (swizzle z))
     235               (values msk skp)))
    227236            (else         
    228237             (let* ((c    (nindex i))
    229238                    (skp1 (cond ((= c z)  (- nlen i 2))
    230239                                (else     skp))))
    231                (loop (+ 1 i) (bitwise-ior msk (swizzle c)) skp1)))))))
     240               (setbit! msk (swizzle c))
     241               (loop (+ 1 i) msk skp1)
     242               ))
     243            ))
     244    ))
    232245
    233246
     
    251264  (define (lacking-hay? q sb)
    252265    (let loop ((p 0) (sb sb))
     266
    253267      (let* ((b    (stream-car sb))
    254268             (len  (byte-blob-length b))
    255269             (p1   (+ p len)))
    256         (and (<= p1 q) (cond ((stream-null? (stream-cdr sb)) #t)
    257                             (else  (loop p1 (stream-cdr sb))))))))
     270        (and (<= p1 q)
     271             (cond ((stream-null? (stream-cdr sb)) #t)
     272                   (else  (loop p1 (stream-cdr sb))))))))
    258273
    259274 
     
    271286             (m      (byte-blob-length b)))
    272287
    273         (cond ((>= i m)   
     288        (cond ((> i m)   
    274289               (if (stream-null? (stream-cdr sb))
    275290                   (reverse ax) 
    276291                   (loop g (- i m) (stream-cdr sb) ax)))
    277292
    278               ((lacking-hay? (+ i nlen) sb)
     293              ((lacking-hay? (+ i nlen) sb)
    279294               (reverse ax))
    280295
    281296              (else
    282                (let ((c      (byte-blob-stream-ref sb (+ i nlast))))
     297               (let ((c (byte-blob-stream-ref sb (+ i nlast))))
    283298                 (if (and (= c z) (candidate-match sb i 0))
    284299                     (loop (+ g nlen) (+ i nlen) sb (cons g ax))
    285300                     (let* ((next-in-pattern?
    286                              (zero? (bitwise-and mask (swizzle (byte-blob-stream-ref sb (+ i nlen))))))
     301                             (not (bitset? mask (swizzle (byte-blob-stream-ref sb (+ i nlen))))))
    287302                            (delta (cond (next-in-pattern? (+ 1 nlen))
    288303                                         ((= c z)  (+ 1 skip))
     
    292307              ))))
    293308  )
     309
     310
     311;; Fast sub-sequence search, based on work by Boyer, Moore, Horspool,
     312;; Sunday, and Lundh.
     313;;
     314;; Based on code from the Haskell text library by Tom Harper and Bryan
     315;; O'Sullivan. http://hackage.haskell.org/package/text
     316
     317(define (subsequence-search needle haystack)
     318  (let* ((nlen    (byte-blob-length needle))
     319         (nlast   (- nlen 1))
     320         (nindex  (lambda (i) (byte-blob-ref needle i))))
     321    (let* ((z    (nindex nlast))
     322           (tbl  (make-table nlast nindex nlen z))
     323           (m    (make-blob 4))
     324           )
     325      (initmask m)
     326      (let-values
     327       (((mask skip)  (tbl 0 m (- nlen 2))))
     328       (cond ((zero? nlen)
     329              '())
     330             ((= 1 nlen) 
     331              (scan1 (nindex 0) 0 haystack))
     332             (else
     333              ((scan mask skip nlen nlast nindex z) 0 0 haystack)))))))
     334
     335
    294336
    295337;;
  • release/4/byte-blob-stream/trunk/tests/run.scm

    r24420 r29479  
    202202                   )
    203203
     204
     205            ;; test case contributed by dthedens (Trac issue #1037)
     206            (test (sprintf "byte-blob-stream-find" )
     207                   `((0) (((1 31 3) (1 31 3))))
     208                   (let ((r (byte-blob-stream-find
     209                             (list->byte-blob (list 1 31))
     210                             (list->byte-blob-stream (list 0 1 31 3)))))
     211                     (list (byte-blob-stream->list (car r))
     212                           (map (lambda (x) (map byte-blob-stream->list x)) (cadr r)))))
     213
     214            ;; test case contributed by dthedens (Trac issue #1038)
     215            (test (sprintf "byte-blob-stream-find" )
     216                   `((0 1) (((2 3) (2 3))))
     217                   (let ((r (byte-blob-stream-find
     218                             (list->byte-blob (list 2 3))
     219                             (list->byte-blob-stream (list 0 1 2 3)))))
     220                     (list (byte-blob-stream->list (car r))
     221                           (map (lambda (x) (map byte-blob-stream->list x)) (cadr r)))))
     222
     223           
     224
    204225)
    205226
Note: See TracChangeset for help on using the changeset viewer.