v4-ified preprocessor tools

svn: r8785

collects/preprocessor/mzpp-run.ss

@@ -1,12 +1,10 @@
-(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"
+   #:once-each
-   (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 \"<<\")"
@@ -18,17 +16,16 @@
    [("--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)])
+    (set! run-cmd cmd)]
-   (help-labels "   (see the documentation for this option)")
+   #:help-labels "   (see the documentation for this option)"
-   (multi
+   #:multi
    [("-E" "--eval") expr "evaluates <expr> before processing starts"
     (parameterize ([read-case-sensitive #t])
-       (add-eval (read (open-input-string expr))))])
+      (add-eval (read (open-input-string expr))))]
-   (once-each
+   #:once-each
    [("--debug") "show preprocessed Scheme code (for debugging)"
-     (debug? #t)])
+    (debug? #t)]
-   (=> (lambda (_ . files) (run preprocess run-cmd output files))
+   #:handlers
+   (lambda (_ . files) (run preprocess run-cmd output files))
    '("input-file")
-       (more-help 'mzpp "a MzScheme-based preprocessor"))))
+   (more-help 'mzpp "a MzScheme-based preprocessor")))
-
-)

collects/preprocessor/mzpp.ss

@@ -1,7 +1,7 @@
-(module mzpp mzscheme
+#lang scheme/base
 
-(require preprocessor/pp-utils)
+(require preprocessor/pp-utils scheme/promise)
-(provide (all-from preprocessor/pp-utils))
+(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))
-
-)

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"
+   #:once-each
-   (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)])
+    (set! run-cmd cmd)]
-   (help-labels "   (see the documentation for this option)")
+   #:help-labels "   (see the documentation for this option)"
-   (multi
+   #:multi
    [("-E" "--eval") expr "evaluates <expr> before processing starts"
     (parameterize ([read-case-sensitive #t])
-       (add-eval (read (open-input-string expr))))])
+      (add-eval (read (open-input-string expr))))]
-   (=> (lambda (_ . files) (run preprocess run-cmd output files))
+   #:handlers
+   (lambda (_ . files) (run preprocess run-cmd output files))
    '("input-file")
-       (more-help 'mztext "a MzScheme-based preprocessing language"))))
+   (more-help 'mztext "a MzScheme-based preprocessing language")))
-
-)

collects/preprocessor/mztext.ss

@@ -1,7 +1,8 @@
-(module mztext mzscheme
+#lang scheme/base
 
-(require mzlib/string mzlib/port preprocessor/pp-utils)
+(require preprocessor/pp-utils scheme/port scheme/promise
-(provide (all-from preprocessor/pp-utils))
+         (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
+     (let ([m (regexp-try-match
                (if (get-arg-reads-word?) #rx"[^ \t\r\n]+" #rx"[^ \t\r\n]")
-             (stdin))
+               (stdin))])
-            => car]
+       (if m (car m) eof)))))
-           [else 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))))
-
-)

collects/preprocessor/pp-run.ss

@@ -1,4 +1,4 @@
-(module pp-run mzscheme
+#lang scheme/base
 
 (require mzlib/process)
 
@@ -53,5 +53,3 @@
        (when run-cmd (do-run-subst output))]
       [else (apply preprocess files)])
     (exit exit-code)))
-
-)

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))))
-)