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

verder aangehaakt

This commit is contained in:
Jan Nieuwenhuizen 2018-07-14 09:26:57 +02:00
parent 20196ccaf0
commit ff985aa083
3 changed files with 41 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gash/gash.scm
View File

@ -77,7 +77,8 @@ copyleft.
"))
(define global-variables (list (cons "SHELLOPTS" "")))
(define global-variables (list (cons "SHELLOPTS" "")
(cons "?" 0)))
(define (main args)
(map (lambda (key-value)
@ -364,34 +365,6 @@ mostly works, pipes work, some redirections work.
((_ o) (transform o)) ;; peel the onion: (symbol (...)) -> (...)
(_ ast))) ;; done
(define (DEAD-sh-exec ast)
(define (exec cmd)
(when (> %debug-level 0)
(format (current-error-port) "sh-exec:exec cmd=~s\n" cmd))
(let* ((job (local-eval cmd (the-environment)))
(stati (cond ((job? job) (map status:exit-val (job-status job)))
((boolean? job) (list (if job 0 1)))
((number? job) (list job))
(else (list 0))))
(status (if (shell-opt? "pipefail") (or (find (negate zero?) stati) 0)
(car stati)))
(pipestatus (string-append
"("
(string-join
(map (lambda (s i)
(format #f "[~a]=\"~a\"" s i))
stati
(iota (length stati))))
")")))
(set! global-variables (assoc-set! global-variables "PIPESTATUS" pipestatus))
(set! global-variables (assoc-set! global-variables "?" (number->string status)))
(when (and (not (zero? status))
(shell-opt? "errexit"))
(exit status))))
(match ast
('script #t) ;; skip
(_ (for-each exec ast))))
(define prompt
(let* ((l (string #\001))
(r (string #\002))

42
gash/peg.scm
View File

@ -10,14 +10,16 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (gash gash)
#:use-module (gash io)
#:use-module (gash job)
#:use-module (gash util)
#:export (parse peg-trace?))
(define (wrap-parser-for-users for-syntax parser accumsym s-syn)
#`(lambda (str strlen pos)
(when (> (@ (gash gash) %debug-level) 0)
(when (> (@ (gash gash) %debug-level) 1)
(format (current-error-port) "~a ~a : ~s\n"
(make-string (- pos (or (string-rindex str #\newline 0 pos) 0)) #\space)
'#,s-syn
@ -184,16 +186,48 @@
(format (current-error-port) "parse error: no match\n")
#f)))))
(define (sh-exec ast)
(define (exec cmd)
(when (> %debug-level 0)
(format (current-error-port) "sh-exec:exec cmd=~s\n" cmd))
(let* ((job (warn 'job (local-eval cmd (the-environment))))
(stati (cond ((job? job) (map status:exit-val (warn 'job-status (job-status job))))
((boolean? job) (list (if job 0 1)))
((number? job) (list job))
(else (list 0))))
(status (if (shell-opt? "pipefail") (or (find (negate zero?) stati) 0)
(car stati)))
(pipestatus (string-append
"("
(string-join
(map (lambda (s i)
(format #f "[~a]=\"~a\"" s i))
stati
(iota (length stati))))
")")))
(set! global-variables (assoc-set! global-variables "PIPESTATUS" pipestatus))
(set! global-variables (assoc-set! global-variables "?" (number->string status)))
(when (and (not (zero? status))
(shell-opt? "errexit"))
(exit status))))
(when (> %debug-level 1)
(format (current-error-port) "sh-exec:exec ast=~s\n" ast))
(match ast
('script #t) ;; skip
(('pipeline command ...) (exec ast))
(_ (for-each exec ast))))
(define (parse input)
(let* ((pt (parse- input))
(foo (pretty-print pt))
(ast (transform (keyword-flatten '(pipeline) pt)))
(foo (pretty-print ast))
)
(foo (pretty-print ast)))
(cond ((error? ast)
(stderr "error:") (pretty-print ast (current-error-port)) #f)
(else
(map (cut local-eval <> (the-environment)) ast)
(map sh-exec ast)
;;(map (cut local-eval <> (the-environment)) ast)
ast))))
(define (transform ast)

2
gash/pipe.scm
View File

@ -100,7 +100,7 @@
(job (new-job))
(debug-id (job-debug-id job))
(commands
(if (zero? %debug-level) commands
(if (< %debug-level 3) commands
(fold-right (lambda (command id lst)
(let ((file (string-append debug-id "." id)))
(cons* command `("tee" ,file) lst)))