63 lines
1.7 KiB
Scheme
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)))))
|
||
|
|
|