commander-s/scheme/comp-cmd.scm

63 lines
1.7 KiB
Scheme

;; compile a command line to a scsh process form
;;
;; ,open signals command-line-lexer command-line-parser command-line-absyn
(define (compile-redirection redir)
(list (redirection-op redir) (redirection-dest redir)))
(define (compile-command cmd)
`(epf
(,(command-executable cmd) ,@(command-args cmd))
,@(map compile-redirection
(command-redirections cmd))))
(define (compile-command-chain chain)
(let ((semicolon (string->symbol ";")))
(let lp ((chain chain) (pf '()))
(if (null? chain)
pf
(let ((combinator (caar chain))
(command (compile-command (cdar chain)))
(next (lambda (pf)
(lp (cdr chain) pf))))
(cond
((eq? combinator 'none)
(next command))
((eq? combinator '|)
(if (and (not (null? pf))
(eq? (car pf) combinator))
(next (append pf (list command)))
(next (list '| pf command))))
((eq? combinator '&&)
(next
`(begin
(let ((status (run ,pf)))
(if (zero? status)
(exit (status:exit-val (run ,command)))
(exit (status:exit-val status)))))))
((eq? combinator '||)
(next
`(begin
(let ((status (run ,pf)))
(if (zero? status)
(exit 0)
(exit (status:exit-val (run ,command))))))))
((eq? combinator semicolon)
(next
`(begin (run ,pf)
(exit (status:exit-val (run ,command))))))
(else
(error "Unknown combinator" combinator))))))))
(define (compile-command-line cmdln)
(let ((pf
(compile-command-chain
(cons
(cons 'none (command-line-first-cmd cmdln))
(command-line-combinator/cmds cmdln)))))
(case (command-line-job-ctrl cmdln)
((&) `(run/bg ,pf))
((&*) `(run/console ,pf))
(else `(run/fg ,pf)))))