From 2f4d146ee8482f7462b682c1e44154159b0d41c1 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Mon, 7 Dec 2009 05:21:09 +0000
Subject: [PATCH] half the size of the previous version

svn: r17233
---
 collects/framework/private/decode.ss | 53 ++++++++--------------------
 1 file changed, 15 insertions(+), 38 deletions(-)

diff --git a/collects/framework/private/decode.ss b/collects/framework/private/decode.ss
index da5f086199..8639bb05d9 100644
--- a/collects/framework/private/decode.ss
+++ b/collects/framework/private/decode.ss
@@ -1,43 +1,20 @@
 #lang scheme/base
-(require (for-syntax mzlib/inflate
-                     scheme/base))
-
+(require (for-syntax file/gunzip 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 ...)
-     (andmap identifier? (syntax->list (syntax (arg ...))))
-     (let ()
-       (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))]))
+    [(_ x ...)
+     (andmap identifier? (syntax->list #'(x ...)))
+     (datum->syntax stx (decode (syntax->list #'(x ...))) stx)]))