130 lines
4.6 KiB
Scheme
130 lines
4.6 KiB
Scheme
;;; Meta-arg argv processor in Scheme.
|
|
;;; Copyright (c) 1995 by Olin Shivers.
|
|
;;;
|
|
;;; This is a Scheme analog of the proc2.c meta-arg expander.
|
|
|
|
;;; Syntax of the line 2 argument line:
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; Arguments are white-space separated. The only special character is \,
|
|
;;; the knock-down character. \nnn, for three octal digits n, reads as the
|
|
;;; char whose ASCII code is nnn. \n is newline. \ followed by anything else
|
|
;;; is just that character -- including \, space, tab, and newline. It is an
|
|
;;; error if \ is followed by just 1 or 2 octal digits: \3Q doesn't mean
|
|
;;; "3Q" -- it's an error. A backslash-encoded char is always an argument
|
|
;;; constituent unless it is the nul char (\000).
|
|
;;;
|
|
;;; The argument line is terminated by newline or end-of-file.
|
|
;;;
|
|
;;; Nul bytes & empty strings -- completeness at all costs:
|
|
;;; Not that it is very useful, but how does one get empty arguments ("")
|
|
;;; with this syntax? Well, ASCII nuls are taken to terminate arguments
|
|
;;; -- this is a fairly deeply-embedded property of UNIX. Each nul
|
|
;;; encountered on the argument line immediately terminates the current
|
|
;;; argument. So, three nuls surrounded by whitespace produces 3 empty
|
|
;;; arguments in series. This nul termination happens after \nnn processing,
|
|
;;; so you can use a line like
|
|
;;; #!/bin/interpreter \
|
|
;;; foo \000bar \000\000baz\000 quux
|
|
;;; to generate the arg list ("foo" "" "bar" "" "" "baz" "quux").
|
|
;;; The rule is: a run of whitespace terminates an argument,
|
|
;;; but *each* individual nul terminates an argument.
|
|
;;;
|
|
;;; \ followed by a nul is an error (it's not possible to knock-down nul
|
|
;;; in UNIX).
|
|
|
|
;;; (meta-arg-process-arglist args)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; Expand out meta-args in argument lists.
|
|
;;;
|
|
;;; ARGS is an argument list -- a list of strings. If the first two elements
|
|
;;; are of the form ("\\" <filename> ...), then parse secondary arguments
|
|
;;; from line two of file <filename>, change the argument list to
|
|
;;; (,@<secondary-args> <filename> ...)
|
|
;;; and loop.
|
|
|
|
(define (meta-arg-process-arglist args)
|
|
(let lp ((args args))
|
|
(if (and (pair? args)
|
|
(string=? (car args) "\\"))
|
|
(lp (append (read-files-secondary-args (cadr args))
|
|
(cdr args)))
|
|
args)))
|
|
|
|
;;; (read-files-secondary-args fname)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; Open file FNAME, skip the first line, and read secondary args off of
|
|
;;; line two. Return these as a list of strings.
|
|
|
|
(define read-files-secondary-args
|
|
(let ((non-newline (char-set-invert (char-set #\newline))))
|
|
(lambda (fname)
|
|
(call-with-input-file fname
|
|
(lambda (port)
|
|
(skip-char-set non-newline port) ; Skip the first
|
|
(read-char port) ; line of text.
|
|
(read-secondary-args port))))))
|
|
|
|
|
|
;;; Read in a line of secondary args from PORT.
|
|
|
|
(define (read-secondary-args port)
|
|
(let lp ((args '()))
|
|
(skip-char-set char-set:meta-arg-separators port)
|
|
(let ((c (peek-char port)))
|
|
(if (or (eof-object? c) (char=? c #\newline))
|
|
(reverse args)
|
|
(lp (cons (read-secondary-arg port) args))))))
|
|
|
|
|
|
;;; Read in one secondary arg.
|
|
|
|
(define (read-secondary-arg port)
|
|
(let lp ((chars '()))
|
|
(let ((c (peek-char port)))
|
|
(cond ((or (eof-object? c)
|
|
(char-set-contains? char-set:whitespace c))
|
|
(apply string (reverse chars))) ; Leave C in stream.
|
|
|
|
((char=? c ascii/nul)
|
|
(read-char port) ; Consume C.
|
|
(apply string (reverse chars)))
|
|
|
|
((char=? c #\\)
|
|
(read-char port)
|
|
(let ((c (read-backslash-sequence port)))
|
|
(if (char=? c ascii/nul)
|
|
(apply string (reverse chars))
|
|
(lp (cons c chars)))))
|
|
|
|
(else (lp (cons (read-char port) chars)))))))
|
|
|
|
(define (read-backslash-sequence port)
|
|
(let ((c1 (read-char port))
|
|
(eof-lose (lambda () (error "Premature EOF within backslash-sequence in meta-arg"))))
|
|
(cond ((eof-object? c1) (eof-lose))
|
|
|
|
((char=? c1 #\n) #\newline)
|
|
|
|
((char=? c1 ascii/nul)
|
|
(error "Cannot backslash nul byte in meta-arg"))
|
|
|
|
((char-set-contains? char-set:octal-digits c1)
|
|
(let ((c2 (read-char port)))
|
|
(if (eof-object? c2) (eof-lose)
|
|
(let ((c3 (read-char port)))
|
|
(if (eof-object? c3) (eof-lose)
|
|
(ascii->char (+ (octet->int c3)
|
|
(* 8 (+ (octet->int c2)
|
|
(* 8 (octet->int c1)))))))))))
|
|
|
|
|
|
(else c1))))
|
|
|
|
(define (octet->int c) (- (char->ascii c) (char->ascii #\0)))
|
|
|
|
(define ascii/nul (ascii->char 0))
|
|
|
|
(define char-set:octal-digits (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
|
|
|
|
(define char-set:meta-arg-separators (string->char-set " \t"))
|