diff --git a/collects/algol60/bd-tool.ss b/collects/algol60/bd-tool.ss index 2e95304066..5d04df0aed 100644 --- a/collects/algol60/bd-tool.ss +++ b/collects/algol60/bd-tool.ss @@ -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== diff --git a/collects/framework/private/bday.ss b/collects/framework/private/bday.ss index 72b3d33c00..42dabb813e 100644 --- a/collects/framework/private/bday.ss +++ b/collects/framework/private/bday.ss @@ -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== diff --git a/collects/framework/private/decode.ss b/collects/framework/private/decode.ss index 8639bb05d9..47fdae061a 100644 --- a/collects/framework/private/decode.ss +++ b/collects/framework/private/decode.ss @@ -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))])) diff --git a/collects/framework/private/encode.ss b/collects/framework/private/encode.ss index 45084ac28c..4e3c455c02 100644 --- a/collects/framework/private/encode.ss +++ b/collects/framework/private/encode.ss @@ -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") diff --git a/collects/htdp/show-queen.ss b/collects/htdp/show-queen.ss index c1df747447..bde960a47f 100644 --- a/collects/htdp/show-queen.ss +++ b/collects/htdp/show-queen.ss @@ -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