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

add raco read

Browse Source
This commit is contained in:
Matthew Flatt 2015-06-03 11:53:11 -06:00
parent 00893cbd3f
commit 3da4b863cf
4 changed files with 45 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
compiler-lib/compiler/commands/expand.rkt
View File

@ -1,33 +1,42 @@
#lang racket/base
(require racket/cmdline
raco/command-name
racket/pretty)
(define source-files
(command-line
#:program (short-program+command-name)
#:once-each
[("--columns" "-n") n "Format for <n> columns"
(let ([num (string->number n)])
(unless (exact-positive-integer? num)
(raise-user-error (string->symbol (short-program+command-name))
"not a valid column count: ~a" n))
(pretty-print-columns num))]
#:args source-file
source-file))
(module expand racket/base
(require racket/cmdline
raco/command-name
racket/pretty)
(provide show-program)
(define (show-program expand)
(define source-files
(command-line
#:program (short-program+command-name)
#:once-each
[("--columns" "-n") n "Format for <n> columns"
(let ([num (string->number n)])
(unless (exact-positive-integer? num)
(raise-user-error (string->symbol (short-program+command-name))
"not a valid column count: ~a" n))
(pretty-print-columns num))]
#:args source-file
source-file))
(for ([src-file source-files])
(let ([src-file (path->complete-path src-file)])
(let-values ([(base name dir?) (split-path src-file)])
(parameterize ([current-load-relative-directory base]
[current-namespace (make-base-namespace)]
[read-accept-reader #t])
(call-with-input-file*
src-file
(lambda (in)
(port-count-lines! in)
(let loop ()
(let ([e (read-syntax src-file in)])
(unless (eof-object? e)
(pretty-write (syntax->datum (expand e)))
(loop))))))))))))
(require (submod "." expand))
(show-program expand)
(for ([src-file source-files])
(let ([src-file (path->complete-path src-file)])
(let-values ([(base name dir?) (split-path src-file)])
(parameterize ([current-load-relative-directory base]
[current-namespace (make-base-namespace)]
[read-accept-reader #t])
(call-with-input-file*
src-file
(lambda (in)
(port-count-lines! in)
(let loop ()
(let ([e (read-syntax src-file in)])
(unless (eof-object? e)
(pretty-write (syntax->datum (expand e)))
(loop))))))))))

1
compiler-lib/compiler/commands/info.rkt
View File

@ -8,6 +8,7 @@
("decompile" compiler/commands/decompile "decompile bytecode" #f)
("test" compiler/commands/test "run tests associated with files/directories" 15)
("expand" compiler/commands/expand "macro-expand source" #f)
("read" compiler/commands/read "read and pretty-print source" #f)
("distribute" compiler/commands/exe-dir "prepare executable(s) in a directory for distribution" #f)
("demodularize" compiler/demodularizer/batch "produce a whole program from a single module" #f)))

4
compiler-lib/compiler/commands/read.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang racket/base
(require (submod "expand.rkt" expand))
(show-program (lambda (e) e))

2
compiler-lib/info.rkt
View File

@ -13,4 +13,4 @@
(define pkg-authors '(mflatt))
(define version "1.2")
(define version "1.3")