suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

half the size of the previous version

Browse Source 
svn: r17233
This commit is contained in:
Eli Barzilay 2009-12-07 05:21:09 +00:00
parent b4ec71329f
commit 2f4d146ee8
1 changed files with 15 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/framework/private/decode.ss
View File

@ -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)]))