andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

transform: rewrite io-redirection.

This commit is contained in:
Jan Nieuwenhuizen 2018-11-17 08:33:13 +01:00
parent 96d55d0985
commit b89ca17134
2 changed files with 22 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gash/grammar.scm
View File

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

24
gash/script.scm
View File

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