aliens/tekuti
1
0
Fork 0
Code Activity

base64 efficiency hacks

Browse source 
* tekuti/base64.scm (bytevector-map-n-to-m): Use multiple values.
  (base64-encode): Inline the map-3-to-4 definition, and use multiple
  values.
  (base64-decode): Likewise, with map-4-to-3.
This commit is contained in:
Andy Wingo 2010-10-14 12:03:39 +02:00
parent 1b9e370805
commit d3cf39b5c0
1 changed files with 19 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
tekuti/base64.scm
View file

@ -60,28 +60,27 @@
(lambda (stx)
(syntax-case stx ()
((_ n m)
(with-syntax (((byte-arg ...)
(with-syntax (((byte-in ...)
(map (lambda (x)
#`(bytevector-u8-ref s (+ i #,x)))
(iota (syntax->datum #'n)))))
(iota (syntax->datum #'n))))
((byte-out ...)
(generate-temporaries (iota (syntax->datum #'m))))
((byte-out-idx ...)
(iota (syntax->datum #'m))))
#'(lambda (proc s)
(let* ((len (bytevector-length s))
(out (make-bytevector (* len (/ m n)))))
(let lp ((i 0) (j 0))
(cond
((< i len)
(let inner ((k 0) (bytes (proc byte-arg ...)))
(if (not (null? bytes))
(begin (bytevector-u8-set! out (+ j k) (car bytes))
(inner (+ k 1) (cdr bytes)))))
(call-with-values (lambda () (proc byte-in ...))
(lambda (byte-out ...)
(bytevector-u8-set! out (+ j byte-out-idx) byte-out)
...))
(lp (+ i n) (+ j m)))
(else out))))))))))
(define bytevector-map-3-to-4
(bytevector-map-n-to-m 3 4))
(define bytevector-map-4-to-3
(bytevector-map-n-to-m 4 3))
(define (bytevector-fill-range! bv start end u8)
(do ((i (- end 1) (- i 1)))
((< i start))
@ -95,11 +94,13 @@
(define (base64-encode bv)
(let* ((npad (remainder (- 3 (remainder (bytevector-length bv) 3)) 3))
(out (bytevector-map-3-to-4
(out ((bytevector-map-n-to-m 3 4)
(lambda (x y z)
(let ((n (logior (ash x 16) (ash y 8) z)))
(map int->b64-byte
(list (ash n -18) (ash n -12) (ash n -6) n))))
(values (int->b64-byte (ash n -18))
(int->b64-byte (ash n -12))
(int->b64-byte (ash n -6))
(int->b64-byte n))))
(bytevector-pad bv (+ (bytevector-length bv) npad) 0))))
(bytevector-fill-range! out
(- (bytevector-length out) npad)
@ -124,14 +125,15 @@
(define (base64-decode str)
(let* ((bv (string->utf8 str))
(npad (b64-bv-npad bv))
(out (bytevector-map-4-to-3
(out ((bytevector-map-n-to-m 4 3)
(lambda (w x y z)
(let ((n (logior (ash (b64-byte->int w) 18)
(ash (b64-byte->int x) 12)
(ash (b64-byte->int y) 6)
(b64-byte->int z))))
(list (ash n -16) (logand (ash n -8) 255)
(logand n 255))))
(values (ash n -16)
(logand (ash n -8) 255)
(logand n 255))))
(bytevector-copy/padding bv npad (char->integer #\A))))
(result (make-bytevector (- (bytevector-length out) npad))))
(bytevector-copy! out 0 result 0 (bytevector-length result))