Changeset 16143 in project


Ignore:
Timestamp:
10/07/09 09:08:24 (10 years ago)
Author:
Ivan Raikov
Message:

an improvement to byte-blob-append

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

Legend:

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

    r16141 r16143  
    6565        (import scheme chicken foreign posix)
    6666
    67         (require-extension lolevel )
     67        (require-extension srfi-1 lolevel )
    6868
    6969
     
    161161  (byte-blob-copy b (+ 1 (byte-blob-offset b))))
    162162
    163 (define (byte-blob-append a b)
    164   (let* ((alen  (byte-blob-size a))
    165          (blen  (byte-blob-size b))
    166          (ablen (+ alen blen))
    167          (ab    (make-blob ablen)))
    168     (move-memory! (byte-blob-object a) ab alen (byte-blob-offset a) 0)
    169     (move-memory! (byte-blob-object b) ab blen (byte-blob-offset b) alen)
    170     (make-byte-blob ab 0)))
     163(define (byte-blob-append a . rst)
     164  (if (null? rst) a
     165      (let* ((rlen  (map byte-blob-size (cons a rst)))
     166             (clen  (fold fx+ 0 rlen))
     167             (c     (make-blob clen)))
     168        (let loop ((pos 0) (lst (cons a rst)) (len rlen))
     169          (if (null? lst) (make-byte-blob c 0)
     170              (let ((x (car lst))
     171                    (xlen (car len)))
     172                (move-memory! (byte-blob-object x) c xlen (byte-blob-offset x) pos)
     173                (loop (fx+ pos xlen) (cdr lst) (cdr len)))))
     174        )))
     175
    171176   
    172177
  • release/4/byte-blob/trunk/tests/run.scm

    r16139 r16143  
    2626
    2727            (test (sprintf "byte-blob-append" )
    28                    '(1 2 3 4) (byte-blob->list (byte-blob-append a b)))
     28                   '(1 2 3 4 7 8 9) (byte-blob->list (byte-blob-append a b c)))
    2929
    3030            (test (sprintf "byte-blob-map" )
Note: See TracChangeset for help on using the changeset viewer.