diff --git a/collects/framework/private/bday.rkt b/collects/framework/private/bday.rkt index 42dabb81..7f6e6890 100644 --- a/collects/framework/private/bday.rkt +++ b/collects/framework/private/bday.rkt @@ -1,32 +1,34 @@ #lang s-exp framework/private/decode - 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== + TY+9Ds + IwDIT3P + MWN9hCJA + hIwAA + +CGN + rGFR + UkRW + lA4u + 1JaF + K6ne + /zz1n + R0w/v + 3gis73R + j6s8Zto + jxn oU0 + k2Cl yEjX + OwFR cmBh + mBVA Dwmg + i6lD RKO0 + gzOj Pk1l + +/Je XNDZ + Zr6m iThT + OwM6 glKb + toML NyTJ + sPz3 05XJ + jZd4 kaCE + iot+ UbDD + ZhUb Cp/f + yLxa YX1Y + 8vnh zCug + WvD5 +7J/C + +wj/ \wI=;; diff --git a/collects/framework/private/decode.rkt b/collects/framework/private/decode.rkt index 0944528e..6f21e079 100644 --- a/collects/framework/private/decode.rkt +++ b/collects/framework/private/decode.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require (for-syntax scheme/base file/gunzip net/base64)) -(provide (except-out (all-from-out scheme/base) #%module-begin) +#lang racket/base +(require (for-syntax racket/base file/gunzip net/base64)) +(provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [module-begin #%module-begin])) (define-syntax (module-begin stx) diff --git a/collects/framework/private/encode.rkt b/collects/framework/private/encode.rkt index 4e3c455c..31b876d4 100644 --- a/collects/framework/private/encode.rkt +++ b/collects/framework/private/encode.rkt @@ -1,43 +1,34 @@ -#lang scheme/base -(require scheme/cmdline scheme/string scheme/match scheme/pretty - file/gzip file/gunzip net/base64) +#lang racket/base +(require racket/cmdline racket/string file/gzip file/gunzip net/base64) -(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 do-lang? #f) -(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 (encode/decode-text who lang-from lang-to convert1 convert2) + (when do-lang? + (let ([l (cadr (or (regexp-match #rx"^ *#lang +(.*[^ ]) *$" (read-line)) + (error who "missing #lang line")))]) + (if (equal? l lang-from) + (printf "#lang ~a\n" lang-to) + (error who "bad #lang: expected ~s, got ~s" lang-from l)))) + (define O (open-output-bytes)) + (convert1 (current-input-port) O) + (convert2 (open-input-bytes (get-output-bytes O)) (current-output-port)) + (flush-output)) -(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-text) + (encode/decode-text + 'encode-text "racket/base" "s-exp framework/private/decode" + deflate base64-encode-stream)) -(command-line #:once-any - ["-e" "encode" (encode-module) (exit)] - ["-d" "decode" (decode-module) (exit)]) +(define (decode-text) + (encode/decode-text + 'decode-text "s-exp framework/private/decode" "racket/base" + base64-decode-stream inflate)) + +(command-line + #:once-each + ["-l" "translate lang line" (set! do-lang? #t)] + #:once-any + ["-e" "encode" (encode-text) (exit)] + ["-d" "decode" (decode-text) (exit)]) (printf "Use `-h' for help\n")