diff --git a/gash/builtins.scm b/gash/builtins.scm index 851dd14..3f2200b 100644 --- a/gash/builtins.scm +++ b/gash/builtins.scm @@ -513,8 +513,8 @@ Options: ((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))) + (status (if (shell-opt? "pipefail") (or (find (negate zero?) stati) 0) + (car stati))) (pipestatus (string-append "(" (string-join diff --git a/gash/environment.scm b/gash/environment.scm index f1a32e7..a3dccfe 100644 --- a/gash/environment.scm +++ b/gash/environment.scm @@ -46,7 +46,8 @@ #t) (define (variable name) - (or (assoc-ref %global-variables (string-drop name 1)) "")) + (let ((name (if (string-prefix? "$" name) (string-drop name 1) name))) + (or (assoc-ref %global-variables name) ""))) (define (set-shell-opt! name set?) (let* ((shell-opts (variable "SHELLOPTS")) diff --git a/gash/io.scm b/gash/io.scm index e14eebe..d947369 100644 --- a/gash/io.scm +++ b/gash/io.scm @@ -1,8 +1,9 @@ (define-module (gash io) #:use-module (srfi srfi-1) + #:use-module (gash gash) - #:export (stdout stderr)) + #:export (pke stdout stderr)) (define (output port o) (map (lambda (o) (display o port)) o) @@ -16,3 +17,10 @@ (define (stderr . o) (output (current-error-port) o) (last o)) + +(define (pke . stuff) + (newline (current-error-port)) + (display ";;; " (current-error-port)) + (write stuff (current-error-port)) + (newline (current-error-port)) + (car (last-pair stuff))) diff --git a/gash/peg.scm b/gash/peg.scm index 9cbbb3d..1691f5c 100644 --- a/gash/peg.scm +++ b/gash/peg.scm @@ -188,9 +188,9 @@ (define (parse input) (let* ((pt (parse- input)) - (foo (pretty-print pt)) + (foo (when (> %debug-level 0) (pretty-print pt))) (ast (transform (keyword-flatten '(pipeline) pt))) - (foo (pretty-print ast))) + (foo (when (> %debug-level 0) (pretty-print ast)))) (cond ((error? ast) (stderr "error:") (pretty-print ast (current-error-port)) #f) ((eq? ast 'script) @@ -202,13 +202,34 @@ (define (unspecified? o) (eq? o *unspecified*)) +(define (trace commands) + (when (shell-opt? "xtrace") + (for-each + (lambda (o) + (match o + (('command (and command (? string?)) ...) + (format (current-error-port) "+ ~a\n" (string-join command))) + (_ (format (current-error-port) "+ ~s \n" o)))) + (reverse commands))) + commands) + (define (transform ast) - (when (> %debug-level -1) + (when (> %debug-level 1) (format (current-error-port) "transform ast=~s\n" ast)) (match ast (('script o ...) `(script ,@(map transform o))) - (('pipeline o) (pk `(pipeline ,(transform o)))) - (('pipeline h t) (pk `(pipeline ,(transform h) ,@(map transform t)))) + (('pipeline o) + (let ((commands (list (transform o)))) + (trace commands) + `(pipeline ,@commands))) + (('pipeline h (and t ('command _ ...) ...)) + (let ((commands (list (transform h) (transform t)))) + (trace commands) + `(pipeline ,@commands))) + (('pipeline h (and t (('command _ ...) ...))) + (let ((commands (cons (transform h) (map transform t)))) + (trace commands) + `(pipeline ,@commands))) (('command o ...) `(command ,@(map transform o))) (('literal o) (transform o)) (('name o) o)