diff --git a/collects/preprocessor/mzpp-run.ss b/collects/preprocessor/mzpp-run.ss index 7362152a5f..553414726b 100644 --- a/collects/preprocessor/mzpp-run.ss +++ b/collects/preprocessor/mzpp-run.ss @@ -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 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 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"))) diff --git a/collects/preprocessor/mzpp.ss b/collects/preprocessor/mzpp.ss index 5e3af4711d..57cda6d565 100644 --- a/collects/preprocessor/mzpp.ss +++ b/collects/preprocessor/mzpp.ss @@ -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)) - -) diff --git a/collects/preprocessor/mztext-run.ss b/collects/preprocessor/mztext-run.ss index 07d9e20d15..fc56a9e18e 100644 --- a/collects/preprocessor/mztext-run.ss +++ b/collects/preprocessor/mztext-run.ss @@ -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 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 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"))) diff --git a/collects/preprocessor/mztext.ss b/collects/preprocessor/mztext.ss index d84110229b..d4e55c3cf3 100644 --- a/collects/preprocessor/mztext.ss +++ b/collects/preprocessor/mztext.ss @@ -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)))) - -) diff --git a/collects/preprocessor/pp-run.ss b/collects/preprocessor/pp-run.ss index 3708e89945..706fa71f6a 100644 --- a/collects/preprocessor/pp-run.ss +++ b/collects/preprocessor/pp-run.ss @@ -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))) - -) diff --git a/collects/preprocessor/pp-utils.ss b/collects/preprocessor/pp-utils.ss index 0b6bdac7a6..e55d82b526 100644 --- a/collects/preprocessor/pp-utils.ss +++ b/collects/preprocessor/pp-utils.ss @@ -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)))) -)