Encode any text instead of going through a pretty-printer.

original commit: 42e76eaaf4a34dd439bc34d586144ab6127e7b72

collects/framework/private/bday.rkt

@@ -1,32 +1,34 @@
 #lang s-exp framework/private/decode
 
-      XY9BD
+      TY+9Ds
-      sIgEEWv
+      IwDIT3P
-      8pfMgqRV
+      MWN9hCJA
-          E3Whn
+          hIwAA
-           qXtT
+           +CGN
-            GOjg
+           rGFR
-            AE08
+            UkRW
-            fYWp
+            lA4u
-             62Nu
+            1JaF
-             897D
+             K6ne
-            PMxjx
+            /zz1n
-            heAwtc
+            R0w/v
-           7G3Lzfs
+           3gis73R
-           CN4 d0m
+           j6s8Zto
-          4K0G giGp
+           jxn oU0
-          R+8w JgC4
+          k2Cl yEjX
-         MA0w  rvkk
+          OwFR cmBh
-         XCTR   5GkC
+         mBVA  Dwmg
-         56T    Peux
+         i6lD   RKO0
-        e8Yo    PtsJ
+         gzOj   Pk1l
-        E5X7     jWeY
+        +/Je    XNDZ
-       E74T      1gWf
+        Zr6m     iThT
-       ryiR      4OjH
+       OwM6      glKb
-      y/tK        Waem
+       toML      NyTJ
-      1XMZ        aIU9
+       sPz3       05XJ
-     ttXK         LuXV
+      jZd4        kaCE
-     1hU2          x7WO
+      iot+        UbDD
-     f75G          vdLLj
+     ZhUb          Cp/f
-    9Xuc            CD6A
+     yLxa          YX1Y
-    \\\\             A==
+     8vnh          zCug
+    WvD5            +7J/C
+    +wj/            \wI=;;

collects/framework/private/decode.rkt

@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
-(require (for-syntax scheme/base file/gunzip net/base64))
+(require (for-syntax racket/base file/gunzip net/base64))
-(provide (except-out (all-from-out scheme/base) #%module-begin)
+(provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [module-begin #%module-begin]))
 
 (define-syntax (module-begin stx)

collects/framework/private/encode.rkt

@@ -1,43 +1,34 @@
-#lang scheme/base
+#lang racket/base
-(require scheme/cmdline scheme/string scheme/match scheme/pretty
+(require racket/cmdline racket/string file/gzip file/gunzip net/base64)
-         file/gzip file/gunzip net/base64)
 
-(define (encode-exprs exprs)
+(define do-lang? #f)
-  (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)
+(define (encode/decode-text who lang-from lang-to convert1 convert2)
-  (define mod (parameterize ([read-accept-reader #t]) (read)))
+  (when do-lang?
-  (when (eof-object? mod) (error 'encode-module "missing module"))
+    (let ([l (cadr (or (regexp-match #rx"^ *#lang +(.*[^ ]) *$" (read-line))
-  (match mod
+                       (error who "missing #lang line")))])
-    [(list 'module m 'scheme/base (list '#%module-begin exprs ...))
+      (if (equal? l lang-from)
-     (write-bytes #"#lang s-exp framework/private/decode\n")
+        (printf "#lang ~a\n" lang-to)
-     (write-bytes (regexp-replace* #rx"\r\n" (encode-exprs exprs) #"\n"))]
+        (error who "bad #lang: expected ~s, got ~s" lang-from l))))
-    [else (error 'encode-module "cannot parse module, must use scheme/base")]))
+  (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 (encode-text)
-  (define mod (parameterize ([read-accept-reader #t]) (read)))
+  (encode/decode-text
-  (when (eof-object? mod) (error 'encode-module "missing module"))
+   'encode-text "racket/base" "s-exp framework/private/decode"
-  (match mod
+   deflate base64-encode-stream))
-    [(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")]))
 
-(command-line #:once-any
+(define (decode-text)
-              ["-e" "encode" (encode-module) (exit)]
+  (encode/decode-text
-              ["-d" "decode" (decode-module) (exit)])
+   '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")