transform: rewrite io-redirection.
This commit is contained in:
parent
96d55d0985
commit
b89ca17134
|
@ -179,9 +179,14 @@
|
|||
(end (peg:end match))
|
||||
(tree (peg:tree match)))
|
||||
(when (> %debug-level 0)
|
||||
(format #t "parse tree:\n")
|
||||
(pretty-print tree))
|
||||
(if (eq? (string-length input) end)
|
||||
tree
|
||||
(let ((script (transform tree)))
|
||||
(when (> %debug-level 0)
|
||||
(format #t "script:\n")
|
||||
(pretty-print script))
|
||||
script)
|
||||
(if match
|
||||
(begin
|
||||
(format (current-error-port) "parse error: at offset: ~a\n" end)
|
||||
|
@ -220,3 +225,18 @@
|
|||
indent
|
||||
(format-peg (cadar args)))
|
||||
(exit 1))))))
|
||||
|
||||
(define (transform o)
|
||||
(match o
|
||||
(('command word ... ('io-redirect ('io-here "<<" ('io-here-document string))))
|
||||
`(pipeline (cut display ,string) (command ,@word)))
|
||||
(('command word ... ('io-redirect filedes ... ('io-file ">" file-name)))
|
||||
(cond ((or (null? filedes) (equal? filedes '("1")))
|
||||
`(with-output-to-file ,file-name (command ,@word)))
|
||||
((equal? filedes '("2"))
|
||||
`(with-error-to-file ,file-name (command ,@word)))
|
||||
(else (error (format #f "TODO: output to filedes=~a\n" filedes)))))
|
||||
(('command word ... ('io-redirect ('io-file "<" file-name)))
|
||||
`(with-input-from-file ,file-name (command ,@word)))
|
||||
((h t ...) (map transform o))
|
||||
(_ o)))
|
||||
|
|
|
@ -74,7 +74,7 @@
|
|||
(('pipeline command) (pke 'background: `(pipeline+ #f ,command)))
|
||||
(_ term)))
|
||||
|
||||
(define (exec-command . args)
|
||||
(define (command . args)
|
||||
(define (exec command)
|
||||
(cond ((procedure? command) command)
|
||||
((assoc-ref %functions (car command))
|
||||
|
@ -177,28 +177,6 @@
|
|||
(define-syntax-rule (substitution commands)
|
||||
(string-trim-right (with-output-to-string (lambda _ commands))))
|
||||
|
||||
;; (define (substitution . command)
|
||||
;; (if (string? (car command)) (warn (parse-string (string-join command)))
|
||||
;; (pipeline->string (list command))
|
||||
;; (warn 'substitution: command '=> ))
|
||||
;; )
|
||||
|
||||
(define-syntax command
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ word ... (io-redirect (io-file "<" file-name)))
|
||||
#'(with-input-from-file file-name (command word ...)))
|
||||
((_ word ... (io-redirect (io-file ">" file-name)))
|
||||
#'(with-output-to-file file-name (command word ...)))
|
||||
((_ word ... (io-redirect "1" (io-file ">" file-name)))
|
||||
#'(with-output-to-file file-name (command word ...)))
|
||||
((_ word ... (io-redirect "2" (io-file ">" file-name)))
|
||||
#'(with-error-to-file file-name (command word ...)))
|
||||
((_ word ... (io-redirect (io-here "<<" (io-here-document string))))
|
||||
#'(pipeline (cut display string) (command word ...)))
|
||||
((_ word ...)
|
||||
#'(exec-command word ...)))))
|
||||
|
||||
(define-syntax-rule (ignore-error o)
|
||||
(let ((errexit (shell-opt? "errexit")))
|
||||
(when errexit
|
||||
|
|
Loading…
Reference in New Issue