half the size of the previous version

svn: r17233

collects/framework/private/decode.ss

@@ -1,43 +1,20 @@
 #lang scheme/base
-(require (for-syntax mzlib/inflate
+(require (for-syntax file/gunzip scheme/base))
-                     scheme/base))
-
 (provide decode)
 
 (define-syntax (decode stx)
+  (define (decode stxs)
+    (define str
+      (apply string-append (map (λ (x) (symbol->string (syntax-e x))) stxs)))
+    (define loc
+      (if (even? (string-length str))
+        (for/list ([i (in-range 0 (string-length str) 2)])
+          (string->number (substring str i (+ i 2)) 16))
+        (error 'decode "missing digit somewhere")))
+    (define-values (p-in p-out) (make-pipe))
+    (inflate (open-input-bytes (apply bytes loc)) p-out)
+    (read p-in))
   (syntax-case stx ()
-    [(_ arg ...)
+    [(_ x ...)
-     (andmap identifier? (syntax->list (syntax (arg ...))))
+     (andmap identifier? (syntax->list #'(x ...)))
-     (let ()
+     (datum->syntax stx (decode (syntax->list #'(x ...))) stx)]))
-       (define (decode-sexp str)
-         (let* ([loc 
-                 (let loop ([chars (string->list str)])
-                   (cond
-                     [(null? chars) '()]
-                     [(null? (cdr chars)) (error 'to-sexp "missing digit somewhere")]
-                     [else (let ([fst (to-digit (car chars))]
-                                 [snd (to-digit (cadr chars))])
-                             (cons
-                              (+ (* fst 16) snd)
-                              (loop (cddr chars))))]))])
-           (let-values ([(p-in p-out) (make-pipe)])
-             (inflate (open-input-bytes (apply bytes loc)) p-out)
-             (read p-in))))
-       
-       (define (to-digit char)
-         (cond
-           [(char<=? #\0 char #\9) 
-            (- (char->integer char)
-               (char->integer #\0))]
-           [(char<=? #\a char #\f) 
-            (+ 10 (- (char->integer char)
-                     (char->integer #\a)))]))
-       
-       (define decoded
-         (decode-sexp 
-          (apply 
-           string-append
-           (map (λ (x) (symbol->string (syntax-e x)))
-                (syntax->list (syntax (arg ...)))))))
-       
-       (datum->syntax stx decoded stx))]))