Factor out common code from the read-sh functions
* geesh/parser.scm (make-lexer): Remove the read-sh/bracketed and read-sh/backquoted parameters. (parse): New function. (->command-list): New function. (read-sh/bracketed, read-sh/backquoted, read-sh, read-sh-all): Simplify by using the new functions.
This commit is contained in:
parent
c64d16f428
commit
8774eec56a
109
geesh/parser.scm
109
geesh/parser.scm
|
@ -131,11 +131,8 @@ pair in @var{op+ends}."
|
||||||
#:quoted? (not (eq? end end*))))))
|
#:quoted? (not (eq? end end*))))))
|
||||||
op+ends))
|
op+ends))
|
||||||
|
|
||||||
(define (make-lexer port read-sh/bracketed read-sh/backquoted)
|
(define (make-lexer port)
|
||||||
"Make a lexer thunk that reads tokens from @var{port}. When the lexer
|
"Make a lexer thunk that reads tokens from @var{port}."
|
||||||
needs to read subcommands, it uses @var{read-sh/bracketed} to read
|
|
||||||
bracketed subcommands and @var{read-sh/backquoted} to read backquoted
|
|
||||||
subcommands."
|
|
||||||
(define next-tokens '())
|
(define next-tokens '())
|
||||||
(define here-ends '())
|
(define here-ends '())
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -724,6 +721,39 @@ the same number of times.)"
|
||||||
#f)
|
#f)
|
||||||
(throw 'syntax-error #f message #f token #f)))
|
(throw 'syntax-error #f message #f token #f)))
|
||||||
|
|
||||||
|
(define* (parse port #:key (lex-hook (lambda (lex) (lex)))
|
||||||
|
(command-hook noop)
|
||||||
|
(open-bracket-hook noop)
|
||||||
|
(close-bracket-hook noop))
|
||||||
|
"Parse a Shell script from @var{port}. There are several hooks that
|
||||||
|
can be installed while parsing. The procedure @var{lex-hook} is
|
||||||
|
called before reading each token. It must take a thunk (which it can
|
||||||
|
use to invoke the normal lexer) and return a token. The
|
||||||
|
@var{command-hook} thunk is called after parsing each complete
|
||||||
|
command. Its return value is ignored. The @var{open-bracket-hook}
|
||||||
|
and @var{close-bracket-hook} thunks are called for each opening
|
||||||
|
bracket and closing bracket respectively. Their return values are
|
||||||
|
ignored."
|
||||||
|
|
||||||
|
(define lex
|
||||||
|
(let ((pre-lex (make-lexer port)))
|
||||||
|
(lambda ()
|
||||||
|
(lex-hook pre-lex))))
|
||||||
|
|
||||||
|
(define %parse
|
||||||
|
(make-parser #:command-hook command-hook
|
||||||
|
#:open-bracket-hook open-bracket-hook
|
||||||
|
#:close-bracket-hook close-bracket-hook))
|
||||||
|
|
||||||
|
(%parse lex syntax-error))
|
||||||
|
|
||||||
|
(define (->command-list code)
|
||||||
|
"Make the Shell syntax tree @var{code} a list of commands."
|
||||||
|
(match code
|
||||||
|
((? eof-object?) '())
|
||||||
|
(((? symbol? tag) . rest) `((,tag . ,rest)))
|
||||||
|
(code code)))
|
||||||
|
|
||||||
(define (call-with-backquoted-input-port port proc)
|
(define (call-with-backquoted-input-port port proc)
|
||||||
"Call @var{proc} with a wrapped version of @var{port} that will
|
"Call @var{proc} with a wrapped version of @var{port} that will
|
||||||
return the end-of-file object upon encountering an unescaped backquote
|
return the end-of-file object upon encountering an unescaped backquote
|
||||||
|
@ -751,58 +781,43 @@ return the end-of-file object upon encountering an unescaped backquote
|
||||||
(define (read-sh/bracketed port)
|
(define (read-sh/bracketed port)
|
||||||
"Read Shell code from @var{port} until the first unmatched closing
|
"Read Shell code from @var{port} until the first unmatched closing
|
||||||
bracket."
|
bracket."
|
||||||
(let* ((bracket-depth 0)
|
|
||||||
(incr-bracket-depth! (lambda ()
|
(define bracket-depth 0)
|
||||||
(set! bracket-depth (1+ bracket-depth))))
|
(define (incr-bracket-depth!) (set! bracket-depth (1+ bracket-depth)))
|
||||||
(decr-bracket-depth! (lambda ()
|
(define (decr-bracket-depth!) (set! bracket-depth (1- bracket-depth)))
|
||||||
(set! bracket-depth (1- bracket-depth))))
|
|
||||||
(balanced? (lambda () (= 0 bracket-depth)))
|
(define (stop-if-balanced lex)
|
||||||
(pre-lex (make-lexer port read-sh/bracketed read-sh/backquoted))
|
(let ((token (lex)))
|
||||||
(lex (lambda ()
|
(if (and (= 0 bracket-depth)
|
||||||
(let ((token (pre-lex)))
|
(lexical-token? token)
|
||||||
(if (and (balanced?)
|
(eq? (lexical-token-category token) 'RPAREN))
|
||||||
(lexical-token? token)
|
(begin
|
||||||
(eq? (lexical-token-category token) 'RPAREN))
|
(unget-char port #\))
|
||||||
(begin
|
'*eoi*)
|
||||||
(unget-char port #\))
|
token)))
|
||||||
'*eoi*)
|
|
||||||
token))))
|
(->command-list (parse port #:lex-hook stop-if-balanced
|
||||||
(parse (make-parser #:open-bracket-hook incr-bracket-depth!
|
#:open-bracket-hook incr-bracket-depth!
|
||||||
#:close-bracket-hook decr-bracket-depth!)))
|
#:close-bracket-hook decr-bracket-depth!)))
|
||||||
(match (parse lex syntax-error)
|
|
||||||
((? eof-object?) '())
|
|
||||||
(((? symbol? tag) . rest) `((,tag . ,rest)))
|
|
||||||
(code code))))
|
|
||||||
|
|
||||||
(define (read-sh/backquoted port)
|
(define (read-sh/backquoted port)
|
||||||
"Read Shell code from @var{port} until the first unescaped backquote."
|
"Read Shell code from @var{port} until the first unescaped backquote."
|
||||||
(call-with-backquoted-input-port port
|
(call-with-backquoted-input-port port
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(let ((lex (make-lexer port read-sh/bracketed read-sh/backquoted))
|
(->command-list (parse port)))))
|
||||||
(parse (make-parser)))
|
|
||||||
(match (parse lex syntax-error)
|
|
||||||
((? eof-object?) '())
|
|
||||||
(((? symbol? tag) . rest) `((,tag . ,rest)))
|
|
||||||
(code code))))))
|
|
||||||
|
|
||||||
(define* (read-sh #:optional (port #f))
|
(define* (read-sh #:optional (port #f))
|
||||||
"Read a complete Shell command from @var{port} (or the current input
|
"Read a complete Shell command from @var{port} (or the current input
|
||||||
port if @var{port} is unspecified)."
|
port if @var{port} is unspecified)."
|
||||||
(let* ((port (or port (current-output-port)))
|
|
||||||
(stop? #f)
|
(define stop? #f)
|
||||||
(stop! (lambda () (set! stop? #t)))
|
(define (stop!) (set! stop? #t))
|
||||||
(pre-lex (make-lexer port read-sh/bracketed read-sh/backquoted))
|
|
||||||
(lex (lambda () (if stop? '*eoi* (pre-lex))))
|
(let* ((port (or port (current-output-port))))
|
||||||
(parse (make-parser #:command-hook stop!)))
|
(parse port #:lex-hook (lambda (lex) (if stop? '*eoi* (lex)))
|
||||||
(parse lex syntax-error)))
|
#:command-hook stop!)))
|
||||||
|
|
||||||
(define* (read-sh-all #:optional (port #f))
|
(define* (read-sh-all #:optional (port #f))
|
||||||
"Read all complete Shell commands from @var{port} (or the current
|
"Read all complete Shell commands from @var{port} (or the current
|
||||||
input port if @var{port} is unspecified)."
|
input port if @var{port} is unspecified)."
|
||||||
(let* ((port (or port (current-input-port)))
|
(->command-list (parse (or port (current-input-port)))))
|
||||||
(lex (make-lexer port read-sh/bracketed read-sh/backquoted))
|
|
||||||
(parse (make-parser)))
|
|
||||||
(match (parse lex syntax-error)
|
|
||||||
((? eof-object?) '())
|
|
||||||
(((? symbol? tag) . rest) `((,tag . ,rest)))
|
|
||||||
(x x))))
|
|
||||||
|
|
Loading…
Reference in New Issue