Using a language makes this much cuter. Also use base64.
svn: r17240
This commit is contained in:
Eli Barzilay
parent
7f47018c47
commit
539519bdad
|
|
@ -1,35 +1,12 @@
|
|||
(module bd-tool mzscheme
|
||||
(require framework/private/decode)
|
||||
(decode 05c1dd6edc460c06d057f9226301b2e86c5c23690103a9835c
|
||||
e53a0f50602852d2ecce8f324379adb7ef3924b6a60aeaf6fb
|
||||
48dd403909a6d24daf634c984a379d189493609a731ce33ac6
|
||||
c4a09c04d351935fc79818949360f2d6f2758c0993f6316f56
|
||||
6c6206a92da91a7a133983683cdf40d91c440a1a36b7aa23fc
|
||||
abd10d341fbd5bf5306c6e550733332856057d0369740ba555
|
||||
dfa08c7f18f40da4d12d683ca18c17666690da92aa41d21aa4
|
||||
806255f4267206d178be814abc5b6872b3d921c94bdc2f2039
|
||||
52d6b047df4073cbd9664fad863dfa8629e6b5e5bf9f27c624
|
||||
7abdedebc4cc0c525b5235e4e49e2d4801c5aae84de40ca2f1
|
||||
7c0365f33f40240554e2dd42939bcd0e495ee27e017d060dab
|
||||
0a496b9082d53c3c92fac6f8c2a0cfa0615521690d52b09a87
|
||||
cdd2ba39e30b338374069578b7d0e466b3439297b8079d2f90
|
||||
c2cca06155a13386791873cc86e7ebcb573c5f5fbe32685855
|
||||
e80cedf1112479893b24ad410a9ef1cca06155a133867990e4
|
||||
25ee785a18529819b4f7f69ed4e0ade5ef0c525b52b570d4e4
|
||||
f0d6f277502a7beb0eed63deacd8abb796ff63907decad3bb4
|
||||
8f79b362afde5a0ef6b1b7eee33f06a92da91af62d0efb0bef
|
||||
2d2983d496540dfb1687bde0bd256590da92aa814abc5ba8f6
|
||||
08474d1e961e8b5d308eddfa8541738e63601cbbf50b28d5cd
|
||||
7a72ace6410ef756c31eab65068d63b71e521d1eaba7e80662
|
||||
06a92da91ae4706f1594eaf0583d4537c8e1deea0594937bb6
|
||||
2005b49a0739dc5b0d7bac96199463118d2039dc5b85bd3b83
|
||||
b239881454e2dd42939bcd0e4d31b7f582e967dcf7133f52f7
|
||||
4de3f9277e3591f3d384a785994125de2d34b9d9ec2836465c
|
||||
ed02496b9002655089770b4d6e363be4706ff582e967dcf713
|
||||
3f52f74de3895f4de4fc3441413916d108121883865585626c
|
||||
ed81a78519f4fb686e20695dad333368585528c6d61e787266
|
||||
66d0f0331be8f7d1dc406ad9dc94999941c3aa8256f320877b
|
||||
ab618fd53263de625d2dcc5bcadaad82722ca211941934b73a
|
||||
20877babc8cccc0c7a6c56d19bc81944e3f906d23ee6cd8abd
|
||||
aee69fedc3adeaab7db8550d474d1e961e8ba1c4bb856a8f70
|
||||
d4e461e9b1d8054f0b33f3ff))
|
||||
#lang s-exp framework/private/decode
|
||||
bVTbjtsgEP2VqatIdlWyadSLtFIv6lOf+wErgZkYthi8gJPN33cAO3GyfonjM2fOXDi49vgy
|
||||
ao9QGy2g6j3KbQhV+Vc1E9waHkLCZ2C0Oi7fo3Om5EkfWoU9Vg3FJB60RfBOiDMTkp9/Eh8j
|
||||
1LWEOmDrrAzsh+SR6rej92gjm+CmSQLcEvE7CRGF9c5GBbKBb80VJNEE7Qt/Kih0x0Rf0m+K
|
||||
9/wfMieesY1Eij0fNlCLURvJBk7ideuMoaB2tgAVN50zX3c0aSXk9nnoqptKRsdocL0YTfqB
|
||||
Rk2x1boPaQeUNHXbYWQnLaNq4HOzGlWoOxVTOHfQruky2W5A9JmR84kWKDe03CDstvsv+WcR
|
||||
lZ6fWEmei+1gd5c+xd8fmll88O6oJUI6+l+XhbDkjIJBrfvB+QizJR4T/ERUfH2LswKGp+tu
|
||||
B8UDfoKj0/IO3N+BZQ8WT7k8O3je4wbCOKDfECvbd3qlrqxCT02mjYoxxnzUFk2aOFGYtiFy
|
||||
G3W25dJVmZwErvGCbdI1uBhhRdjwnkyRrJYl8BibxU1YnqLU3LhuA9UfPgxn+K19VGSnj/A3
|
||||
WetdlY4g9bTM6TEE3tHE0/HJu/jc5J3mRVIuGgS8nDwE5U65HtQvo0vbEM5L9AtzTZxYLkWI
|
||||
ZzLZTJZIE6Jsmit/ZTet4rZD1iq6hPQBuLaS9kafgjDv3UxCJ0Wsm4t2MRKpP+BrpEqP5bHw
|
||||
A6x6JG/zPw==
|
||||
|
|
|
|||
|
|
@ -1,40 +1,32 @@
|
|||
#lang scheme/base
|
||||
(require "decode.ss")
|
||||
(decode
|
||||
\5d8f4
|
||||
\10ec22010
|
||||
\45aff297b02
|
||||
\0 \69d544
|
||||
\5da867
|
||||
\299da9
|
||||
\360a3
|
||||
\5404db
|
||||
\cbde0b
|
||||
\4b571f
|
||||
\7798f6
|
||||
\13ecaf
|
||||
\2b5f75
|
||||
\0cf30bc
|
||||
\7a62b8d0
|
||||
\194bcdfb
|
||||
\023787789
|
||||
\f02\5b091a
|
||||
\8ab \8eb3d4
|
||||
\3a9 \02e040
|
||||
\3ac \307a74
|
||||
\ca8 \495944
|
||||
\6e0 \74fd1
|
||||
\9ce5 \d88e21
|
||||
\b04 \f66c25
|
||||
\a97f \b8d27a
|
||||
\813 \be13c6
|
||||
\0d3e \dd50a2
|
||||
\86d3 \3f5ede
|
||||
\174a \3235ad9
|
||||
\ecb40 \2aecb1
|
||||
\ad56 \76292fb
|
||||
\6aeb0 \39ae75f
|
||||
\8f335 \ea955
|
||||
\e7e \2c7
|
||||
#lang s-exp framework/private/decode
|
||||
|
||||
||\6||\8||\7||\4||\3||\d||\e||\f||\c||\0||\1)
|
||||
XY9BD
|
||||
sIgEEWv
|
||||
8pfMgqRV
|
||||
E3Whn
|
||||
qXtT
|
||||
GOjg
|
||||
AE08
|
||||
fYWp
|
||||
62Nu
|
||||
897D
|
||||
PMxjx
|
||||
heAwtc
|
||||
7G3Lzfs
|
||||
CN4 d0m
|
||||
4K0G giGp
|
||||
R+8w JgC4
|
||||
MA0w rvkk
|
||||
XCTR 5GkC
|
||||
56T Peux
|
||||
e8Yo PtsJ
|
||||
E5X7 jWeY
|
||||
E74T 1gWf
|
||||
ryiR 4OjH
|
||||
y/tK Waem
|
||||
1XMZ aIU9
|
||||
ttXK LuXV
|
||||
1hU2 x7WO
|
||||
f75G vdLLj
|
||||
9Xuc CD6A
|
||||
\\\\ A==
|
||||
|
|
|
|||
|
|
@ -1,20 +1,19 @@
|
|||
#lang scheme/base
|
||||
(require (for-syntax file/gunzip scheme/base))
|
||||
(provide decode)
|
||||
(require (for-syntax scheme/base file/gunzip net/base64))
|
||||
(provide (except-out (all-from-out scheme/base) #%module-begin)
|
||||
(rename-out [module-begin #%module-begin]))
|
||||
|
||||
(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))
|
||||
(define-syntax (module-begin stx)
|
||||
(syntax-case stx ()
|
||||
[(_ x ...)
|
||||
(andmap identifier? (syntax->list #'(x ...)))
|
||||
(datum->syntax stx (decode (syntax->list #'(x ...))) stx)]))
|
||||
(andmap (lambda (x) (or identifier? (integer? (syntax-e x))))
|
||||
(syntax->list #'(x ...)))
|
||||
(let* ([data (format "~a" (syntax->datum #'(x ...)))]
|
||||
[data (substring data 1 (sub1 (string-length data)))]
|
||||
[data (string->bytes/utf-8 data)]
|
||||
[in (open-input-bytes (base64-decode data))]
|
||||
[out (open-output-string)]
|
||||
[out (begin (inflate in out) (get-output-string out))]
|
||||
[exprs (read (open-input-string (string-append "(" out ")")))]
|
||||
[exprs (datum->syntax stx exprs stx)])
|
||||
#`(#%module-begin #,@exprs))]))
|
||||
|
|
|
|||
|
|
@ -1,67 +1,43 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/deflate
|
||||
mzlib/match
|
||||
mzlib/pretty)
|
||||
(require (for-syntax mzlib/inflate
|
||||
mzlib/string))
|
||||
(require scheme/cmdline scheme/string scheme/match scheme/pretty
|
||||
file/gzip file/gunzip net/base64)
|
||||
|
||||
(provide encode-sexp
|
||||
encode-module)
|
||||
(define (encode-exprs exprs)
|
||||
(define in
|
||||
(open-input-string
|
||||
(string-join (map (lambda (x) (format "~s" x)) exprs) " ")))
|
||||
(define out (open-output-bytes))
|
||||
(deflate in out)
|
||||
(base64-encode (get-output-bytes out)))
|
||||
|
||||
(define (encode-module in-filename out-filename)
|
||||
(call-with-input-file in-filename
|
||||
(λ (port)
|
||||
(let ([mod (read port)])
|
||||
(unless (eof-object? (read port))
|
||||
(error 'encode-module "found an extra expression"))
|
||||
(match mod
|
||||
[`(module ,m mzscheme ,@(bodies ...))
|
||||
(call-with-output-file out-filename
|
||||
(λ (oport)
|
||||
(let ([chopped (chop-up (encode-sexp `(begin ,@bodies)))])
|
||||
(fprintf oport "(module ~a mzscheme\n" m)
|
||||
(fprintf oport " (require framework/private/decode)\n")
|
||||
(fprintf oport " (decode ~a" (car chopped))
|
||||
(for-each (lambda (chopped)
|
||||
(fprintf oport "\n ~a" chopped))
|
||||
(cdr chopped))
|
||||
(fprintf oport "))\n")))
|
||||
'truncate 'text)]
|
||||
[else (error 'encode-module "cannot parse module")])))))
|
||||
(define (encode-module)
|
||||
(define mod (parameterize ([read-accept-reader #t]) (read)))
|
||||
(when (eof-object? mod) (error 'encode-module "missing module"))
|
||||
(match mod
|
||||
[(list 'module m 'scheme/base (list '#%module-begin exprs ...))
|
||||
(write-bytes #"#lang s-exp framework/private/decode\n")
|
||||
(write-bytes (regexp-replace* #rx"\r\n" (encode-exprs exprs) #"\n"))]
|
||||
[else (error 'encode-module "cannot parse module, must use scheme/base")]))
|
||||
|
||||
(define (chop-up sym)
|
||||
(let ([chopping-point 50])
|
||||
(let loop ([str (symbol->string sym)])
|
||||
(cond
|
||||
[(<= (string-length str) chopping-point)
|
||||
(list (string->symbol str))]
|
||||
[else
|
||||
(cons (string->symbol (substring str 0 chopping-point))
|
||||
(loop (substring str chopping-point (string-length str))))]))))
|
||||
(define (decode-module)
|
||||
(define mod (parameterize ([read-accept-reader #t]) (read)))
|
||||
(when (eof-object? mod) (error 'encode-module "missing module"))
|
||||
(match mod
|
||||
[(list 'module m 'framework/private/decode
|
||||
(list '#%module-begin exprs ...))
|
||||
(write-bytes #"#lang scheme/base\n")
|
||||
(let* ([data (format "~a" exprs)]
|
||||
[data (substring data 1 (sub1 (string-length data)))]
|
||||
[data (string->bytes/utf-8 data)]
|
||||
[in (open-input-bytes (base64-decode data))]
|
||||
[out (open-output-string)]
|
||||
[out (begin (inflate in out) (get-output-string out))]
|
||||
[exprs (read (open-input-string (string-append "(" out ")")))])
|
||||
(for ([expr (in-list exprs)])
|
||||
(pretty-print expr)))]
|
||||
[else (error 'decode-module "cannot parse module, must use scheme/base")]))
|
||||
|
||||
(define (encode-sexp sexp)
|
||||
(define (str->sym string)
|
||||
(string->symbol
|
||||
(apply
|
||||
string-append
|
||||
(map
|
||||
(λ (x)
|
||||
(to-hex x))
|
||||
(bytes->list string)))))
|
||||
|
||||
(define (to-hex n)
|
||||
(let ([digit->hex
|
||||
(λ (d)
|
||||
(cond
|
||||
[(<= d 9) d]
|
||||
[else (integer->char (+ d -10 (char->integer #\a)))]))])
|
||||
(cond
|
||||
[(< n 16) (format "0~a" (digit->hex n))]
|
||||
[else (format "~a~a"
|
||||
(digit->hex (quotient n 16))
|
||||
(digit->hex (modulo n 16)))])))
|
||||
|
||||
(let ([in (open-input-string (format "~s" sexp))]
|
||||
[out (open-output-bytes)])
|
||||
(deflate in out)
|
||||
(str->sym (get-output-bytes out))))
|
||||
(command-line #:once-any
|
||||
["-e" "encode" (encode-module) (exit)]
|
||||
["-d" "decode" (decode-module) (exit)])
|
||||
(printf "Use `-h' for help\n")
|
||||
|
|
|
|||
|
|
@ -1 +1,22 @@
|
|||
(module show-queen mzscheme (require framework/private/decode) (decode ad56db8ee3360cfd15368b05eca6eecc60fbb05834cd1f14e81714b2cd444a65c923cbb9ec43bfbda464d97226b3e8167db2c5cb21451d512c6a3c2a0385c3d751398442ab1a369dc3f6e761d8c4bf4d39891b2d8681e525497a67cfaa4518a4bd54af23a221618b0765107a876765c7a13a38d1217c382caae6231401071a61ce62a0e541a16ea13857b515ae850fcf05e30fea2bc273397b3ef563ad55038532ca4330652bf43f40f2a42c075ffd76c6c65b0745277a5849a25399dc428422ea2a8de6e86582621b6baa5e28e3f3149c3a0b4f4e47f4a0e054ceee0e0fabff94922ac9aae4a4253aca9b1cab462b34be0ae179dd36e55c844ec56a7527fe2e91ed199de372735a78267fc0b3277d630db915bcdf01e997a4d0d1c998e3becc44e440f159c88749d9170589af99056772652d2d6e77f21bcb0f76346d650deea7d40eb457148dac06dab7b2c4222dbaba15b45b38c1156ee0a51aaa4bfc48f2b848242bc119ffba238b98c296fea225a392e20631876d8290cba1e559f0fe47a391c8144189c442efe9643a55ceab1374a7d99deaabe6ff5338c1e59c439409308bb38e61ac8ff0e167851c4e2e4187c51df652558d229d512c0a1d202174a7ef817bc48da84f67dc3681ab4cb1ff766203f3d56aeb0620ac4dad45f317b505ad8ed21f9db86d12c948db3a7121f2375e98a3c66f1060b93d8a6e8d970ee952196cabfab68f5598d4ef449f7ad23b5aeb283e6ecafbcc506bd50f18f9563ca5dc3eb321332d896414fd980c3e3dfdb22c6558962b2ec78c8b5de2dd2ea7dca30c8f8ebae59bcafdaff9ad0832b7ad37e77f884ca9ce428f480c2f8a0bf039ddb5a972e91a976af0d843f13a5acf7ab840b48042deab24ac9cb5b5a425aa3d93e04a1df740809d6d476d33946b6cfae9ce7155832a2530ed3a50e72b3abb870855424a6d9bfe5ecafbd8a710fbb68e2de7d8b7fbd8a707b1651efb36c596736cb98a7d80f76e56cc684bda97f211e23314d5b460b0bb6e586608ea0ee19a235c57084ba34d1419c61e5d65f09211e69eb87df8853a7c32dab255cfb72008bc445e55fce402c150f7745513ee76b09a505e22416870b05aa5d778c1abdd38c80c31ac1f6246cb98d43d66b6956fb497ecf232c42ebd0ebbf434ecb882d1b69ada73946e27e93649f3900f869e30eaac44c53237cdc3cca4fa934a348d65ab97878bb09f8d49c403cedcc1afe5caecba98d4d6d27363584659cef30d3d1a59e1b2296e83d79efa03b620c2fc04f6307f27ac01683bcaf4a3ff098ed67f81bf71b320c7d66846ad9774df8f46a71ca1a01b29488d14360e4f17451399088f2547e7425293dc64cd48f17ee3e4b60c7759d1de546807b94f56907f550f4e7572a55af0ca8e3457c5ea780b9df08d04eeb049cfd6d20f69a98c99cc87b785cbbaac41a26b1874c3981118b5bc3a9936ce448170e47489bf1f79cf356ad8fc0e7ff01e067e6c68e394f7a767ee8012f9010f8b798099481a60784aef85e3269e62a77b3a99ada6f0b7599161cc8a0bc9931afb9f6db89cff00))
|
||||
#lang s-exp framework/private/decode
|
||||
rVbbjqQ2EP2VSq9WgnTIzGjzsFql038QKV8QGSja7oDNGNOXfci3p8rGYJieVTbKE7gup8rl
|
||||
43JlFl9HZRGyVpWw6yzWPw/DLvzt8klctWIYWJ6TpLfmomqEQZpr8ToiahLW2CiN0Fu8KDMO
|
||||
RWNFh/ChWVTVR8g8DlRCX8RAy0ZhW0N2KUojbA0fMoYf1FeE53x2fOrHslUVZEorB96SrdD9
|
||||
ANGRkhxc8dsFK2csZJ3oYSUJTnl08xGyoCta1CcnIxTbGF30QmmXpmDVRThyOqEDBed8drfY
|
||||
rP5jSionq5yTlmgpb3IsqlahdoUPz+u6yucadCoUqzvzd4lsLmgtV5vTwgv5A14c6SujyS3j
|
||||
/Q5IvySFjg5Gn455IiIHis9CPkvKPstIfEssOJMba2lx38jvLG/MqOvCaDxOqTW0VxSVLAba
|
||||
tzKagEVX1oJ2C2e4wR2cVENxDR9JHleJZCU4418PZBFS2NNfsGRUUtwh5LCPEHI5tDQL3v+o
|
||||
WyQuBVDisGiPdDKdyufVGbrz7E71VfP/2Z/gcs4+ygSYxFnH0MYFeP+zQvYnF6H9YoO9VLVF
|
||||
Ec8oFIUOkBC68/fAPeJG0MczrivPVabYfzuxgflqWmMHIKxd2YrqL+oKrTpJd7LivoskI21t
|
||||
xZXIXzmhTy1+gwDL7VF0a5y0SJdKY12U92OowqR+J/rUkt7RGkvxcZdvM8O2Vf2AgW/ZU8zt
|
||||
Mxsy06JIBtGP0eDT0y/LUvplvuJyyDg7RN4dUso9yvBkqVm+qdz/mt+KIHPbenP+TWBKcRHt
|
||||
iMTwLLsCn9OmTeVL17gWg8MestfRONbDFYIFZHKrkrBybo0hLVHtmQQ36rgNAXamHluToNxC
|
||||
0493jqvqVTGBadeeOl/RmiMEqBxiavv495JvY5997Ps6tpxj37exzw9iyzT2fYot59hyFbuB
|
||||
925WyGhP2pf8EeIzZMW0YLBNN8wTBLVBuKUItxXC0mgjRYaxR1tovCaE2RK3979Q+k9CW7bq
|
||||
+RZ4gZPIq4KfXCAY6p62qPzd9lYTyksgCM0NplXxNV7wSjsOMkH064eYwTIktcVMtvKN9pJc
|
||||
XoY4xNfhEJ+GA1cw2BZTew7S/STdR2ka8sHM4yedlShbxqZ5mJlUf1KJSjwpvXl5uAjH2ZhE
|
||||
PODMHfyWr8xui0lpDD03mmWU5Tzf0KORFC4Z4nZ466k/YA3Cz09gmvk7YQ1A21G6H91PcDLu
|
||||
C/yNuwU5tEY9tu2S7vvR6JQDFHQjBSmRwobh6apoIhP+seToXEhqkrukGSneb5jcluEuKdqb
|
||||
Ch0g9UkK8q/qwalOrlQLXpmR5qpQHWegE66SwB026tlauiEuldaT+fC2cEmX1Uh09YOuHzM8
|
||||
o5ZXJ9GGmcgTjpyu4fcj77nEFna/wx+8h4EfG9o45f3pmTugRH7A/WIeYCaSehge0nthuYnH
|
||||
2PGeTmarKfxtVmQYsuJC8qTG/hfDl/Mf
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user