resurrect set -x

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

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

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

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 <FIXME>\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)