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

v4-ified preprocessor tools

Browse Source 
svn: r8785
This commit is contained in:
Eli Barzilay 2008-02-24 21:05:28 +00:00
parent 31a9f69df5
commit c2f1773ea2
6 changed files with 94 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/preprocessor/mzpp-run.ss
View File

@ -1,34 +1,31 @@
(module mzpp-run mzscheme
#lang scheme/base
(require preprocessor/mzpp preprocessor/pp-run mzlib/cmdline mzlib/process)
(require preprocessor/mzpp preprocessor/pp-run scheme/cmdline)
(let ([output #f] [run-cmd #f])
(command-line
"mzpp"
(current-command-line-arguments)
(once-each
[("-o" "--output") file "output file (defaults to standard output)"
(set! output file)]
[("-b" "--begin-mark") beg "Scheme beginning marker (defaults to \"<<\")"
(beg-mark beg)]
[("-e" "--end-mark") end "Scheme ending marker (defaults to \">>\")"
(end-mark end)]
[("-s" "--skip-to") skip "skip processing to a line with only this string"
(skip-to skip)]
[("--no-spaces") "disable \"smart\" handling of spaces"
(no-spaces? #t)]
[("--run") cmd "run the command string on a single preprocessed input file"
(set! run-cmd cmd)])
(help-labels " (see the documentation for this option)")
(multi
[("-E" "--eval") expr "evaluates <expr> before processing starts"
(parameterize ([read-case-sensitive #t])
(add-eval (read (open-input-string expr))))])
(once-each
[("--debug") "show preprocessed Scheme code (for debugging)"
(debug? #t)])
(=> (lambda (_ . files) (run preprocess run-cmd output files))
'("input-file")
(more-help 'mzpp "a MzScheme-based preprocessor"))))
)
#:once-each
[("-o" "--output") file "output file (defaults to standard output)"
(set! output file)]
[("-b" "--begin-mark") beg "Scheme beginning marker (defaults to \"<<\")"
(beg-mark beg)]
[("-e" "--end-mark") end "Scheme ending marker (defaults to \">>\")"
(end-mark end)]
[("-s" "--skip-to") skip "skip processing to a line with only this string"
(skip-to skip)]
[("--no-spaces") "disable \"smart\" handling of spaces"
(no-spaces? #t)]
[("--run") cmd "run the command string on a single preprocessed input file"
(set! run-cmd cmd)]
#:help-labels " (see the documentation for this option)"
#:multi
[("-E" "--eval") expr "evaluates <expr> before processing starts"
(parameterize ([read-case-sensitive #t])
(add-eval (read (open-input-string expr))))]
#:once-each
[("--debug") "show preprocessed Scheme code (for debugging)"
(debug? #t)]
#:handlers
(lambda (_ . files) (run preprocess run-cmd output files))
'("input-file")
(more-help 'mzpp "a MzScheme-based preprocessor")))

13
collects/preprocessor/mzpp.ss
View File

@ -1,7 +1,7 @@
(module mzpp mzscheme
#lang scheme/base
(require preprocessor/pp-utils)
(provide (all-from preprocessor/pp-utils))
(require preprocessor/pp-utils scheme/promise)
(provide (all-from-out preprocessor/pp-utils))
(provide beg-mark end-mark skip-to no-spaces? debug?)
(define beg-mark (make-parameter "<<"))
@ -167,13 +167,10 @@
[cd (cd)])
(run files)))
(define-namespace-anchor nsa)
(provide preprocess)
(define (preprocess . files)
(read-case-sensitive #t)
(current-namespace (namespace-anchor->namespace nsa))
(namespace-require 'scheme/base)
(namespace-require 'preprocessor/mzpp)
(do-evals)
(run files))
)

39
collects/preprocessor/mztext-run.ss
View File

@ -1,25 +1,22 @@
(module mztext-run mzscheme
#lang scheme/base
(require preprocessor/mztext preprocessor/pp-run mzlib/cmdline)
(require preprocessor/mztext preprocessor/pp-run scheme/cmdline)
(let ([output #f] [run-cmd #f])
(command-line
"mztext"
(current-command-line-arguments)
(once-each
[("-o" "--output") file "output file (defaults to standard output)"
(set! output file)]
[("-c" "--command-marker") marker "command marker (defaults to \"@\")"
(command-marker marker)]
[("--run") cmd "run the command string on a single preprocessed input file"
(set! run-cmd cmd)])
(help-labels " (see the documentation for this option)")
(multi
[("-E" "--eval") expr "evaluates <expr> before processing starts"
(parameterize ([read-case-sensitive #t])
(add-eval (read (open-input-string expr))))])
(=> (lambda (_ . files) (run preprocess run-cmd output files))
'("input-file")
(more-help 'mztext "a MzScheme-based preprocessing language"))))
)
#:once-each
[("-o" "--output") file "output file (defaults to standard output)"
(set! output file)]
[("-c" "--command-marker") marker "command marker (defaults to \"@\")"
(command-marker marker)]
[("--run") cmd "run the command string on a single preprocessed input file"
(set! run-cmd cmd)]
#:help-labels " (see the documentation for this option)"
#:multi
[("-E" "--eval") expr "evaluates <expr> before processing starts"
(parameterize ([read-case-sensitive #t])
(add-eval (read (open-input-string expr))))]
#:handlers
(lambda (_ . files) (run preprocess run-cmd output files))
'("input-file")
(more-help 'mztext "a MzScheme-based preprocessing language")))

24
collects/preprocessor/mztext.ss
View File

@ -1,7 +1,8 @@
(module mztext mzscheme
#lang scheme/base
(require mzlib/string mzlib/port preprocessor/pp-utils)
(provide (all-from preprocessor/pp-utils))
(require preprocessor/pp-utils scheme/port scheme/promise
(only-in mzlib/string read-from-string-all))
(provide (all-from-out preprocessor/pp-utils))
;;=============================================================================
;; Composite port
@ -113,7 +114,7 @@
(define (dispatch dispatcher continue failure . copy?)
(let ([m (if (and (pair? copy?) (car copy?))
(regexp-match (car dispatcher) (stdin) 0 #f (stdout))
(regexp-match/fail-without-reading (car dispatcher) (stdin)))])
(regexp-try-match (car dispatcher) (stdin)))])
(if m
(ormap (lambda (x y) (and x (y x continue))) (cdr m) (cdr dispatcher))
(failure))))
@ -184,7 +185,7 @@
((if (andmap (lambda (x) (or (not x) (void? x))) vs)
(begin (swallow-newline) cont)
(value->cont vs cont))))))
(cond [(regexp-match/fail-without-reading (command-marker-here-re) (stdin))
(cond [(regexp-try-match (command-marker-here-re) (stdin))
=> (lambda (here) (display (car here)) (cont))]
[else (let ((r (read))) (do-thunk (lambda () (eval r))))]))
@ -232,11 +233,10 @@
(arg-dispatcher)
#f
(lambda ()
(cond [(regexp-match/fail-without-reading
(if (get-arg-reads-word?) #rx"[^ \t\r\n]+" #rx"[^ \t\r\n]")
(stdin))
=> car]
[else eof]))))
(let ([m (regexp-try-match
(if (get-arg-reads-word?) #rx"[^ \t\r\n]+" #rx"[^ \t\r\n]")
(stdin))])
(if m (car m) eof)))))
(provide get-arg*)
(define (get-arg*)
@ -254,7 +254,7 @@
(provide swallow-newline)
(define (swallow-newline)
;; careful: if there's no match, we don't want to consume the input
(regexp-match/fail-without-reading #rx"^[ \t]*\r?\n" (stdin))
(regexp-try-match #rx"^[ \t]*\r?\n" (stdin))
(void))
(define (string->substlist args str)
@ -346,5 +346,3 @@
(unless (null? files)
(parameterize ([stdin (make-composite-input)])
(apply include files))))
)

66
collects/preprocessor/pp-run.ss
View File

@ -1,4 +1,4 @@
(module pp-run mzscheme
#lang scheme/base
(require mzlib/process)
@ -21,37 +21,35 @@
(set! exit-code (system/exit-code (regexp-replace
#rx"\\*" run-cmd (format "~s" f)))))
(cond
[(and run-cmd (not (regexp-match #rx"\\*" run-cmd)))
(when output
(error 'mzpp "cannot run a command with piped stdin when an ~a"
"output name is specified"))
(let ([p (process/ports (current-output-port) #f (current-error-port)
run-cmd)])
(parameterize ([current-output-port (list-ref p 1)])
(apply preprocess files))
(close-output-port (list-ref p 1))
((list-ref p 4) 'wait)
(set! exit-code ((list-ref p 4) 'exit-code)))]
[(and run-cmd (not (or (= 1 (length files)) output)))
(error 'mzpp "cannot run a command that expects a filename with ~a"
"multiple input files and no output name")]
[(and run-cmd (not output))
(let* ([file (car files)]
[temp (format "~a-mzpp-temporary" file)])
(when (file-exists? temp)
(error 'mzpp "~s already exists!" temp))
(dynamic-wind
(lambda () (rename-file-or-directory file temp))
(lambda ()
(with-output-to-file file (lambda () (preprocess temp)))
(do-run-subst file))
(lambda ()
(delete-file file)
(rename-file-or-directory temp file))))]
[output
(with-output-to-file output (lambda () (apply preprocess files)) 'replace)
(when run-cmd (do-run-subst output))]
[else (apply preprocess files)])
[(and run-cmd (not (regexp-match #rx"\\*" run-cmd)))
(when output
(error 'mzpp "cannot run a command with piped stdin when an ~a"
"output name is specified"))
(let ([p (process/ports (current-output-port) #f (current-error-port)
run-cmd)])
(parameterize ([current-output-port (list-ref p 1)])
(apply preprocess files))
(close-output-port (list-ref p 1))
((list-ref p 4) 'wait)
(set! exit-code ((list-ref p 4) 'exit-code)))]
[(and run-cmd (not (or (= 1 (length files)) output)))
(error 'mzpp "cannot run a command that expects a filename with ~a"
"multiple input files and no output name")]
[(and run-cmd (not output))
(let* ([file (car files)]
[temp (format "~a-mzpp-temporary" file)])
(when (file-exists? temp)
(error 'mzpp "~s already exists!" temp))
(dynamic-wind
(lambda () (rename-file-or-directory file temp))
(lambda ()
(with-output-to-file file (lambda () (preprocess temp)))
(do-run-subst file))
(lambda ()
(delete-file file)
(rename-file-or-directory temp file))))]
[output
(with-output-to-file output (lambda () (apply preprocess files)) 'replace)
(when run-cmd (do-run-subst output))]
[else (apply preprocess files)])
(exit exit-code)))
)

3
collects/preprocessor/pp-utils.ss
View File

@ -1,4 +1,4 @@
(module pp-utils mzscheme
#lang scheme/base
(provide stdin stdout stderr cd)
(define stdin current-input-port)
@ -13,4 +13,3 @@
(define evals (make-parameter '()))
(define (add-eval expr) (evals (cons expr (evals))))
(define (do-evals) (for-each eval (reverse (evals))))
)