transform: if-clause->if.

gash/grammar.scm

@@ -108,8 +108,8 @@
      do-group         <-- do-keyword ws+ compound done-keyword#
 
      if-clause        <-- if-keyword sp+ compound then-keyword# ws+ compound else-part? fi-keyword#
-     else-part        <-- else-keyword ws+ compound /
-                          elif-keyword ws+ compound then-keyword# ws+ compound else-part?
+     else-part        <-- else-keyword ws+ compound / elif
+     elif             <-- elif-keyword ws+ compound then-keyword# ws+ compound else-part?
 
      while-clause     <--  while-keyword compound do-group
 
@@ -232,6 +232,19 @@
     (('script command) (transform command))
     (('script command ...) `(begin ,@(map transform command)))
 
+    ;; FIXME: cannot remove pipeline even if it's a single command
+    ;; `pipeline' is what executes commands and evaluates them
+    ;; (set -e)
+    ;; (('pipeline pipeline) (transform pipeline))
+    ;; or it results in ((if ...)); which won't work either
+    ;; (('pipeline pipeline) (let ((x (transform pipeline)))
+    ;;                         (match x
+    ;;                           (('command command ...) (list x))
+    ;;                           (_ x))))
+
+    (('compound compound) (transform compound))
+    (('compound compound ...) `(begin ,@(map transform compound)))
+
     (('command word ... ('io-redirect ('io-here "<<" ('io-here-document string))))
      `(pipeline (cut display ,string) (command ,@word)))
     (('command word ... ('io-redirect filedes ... ('io-file ">" file-name)))
@@ -243,5 +256,22 @@
     (('command word ... ('io-redirect ('io-file "<" file-name)))
      `(with-input-from-file ,file-name (command ,@word)))
 
+    (('command ('if-clause if-clause ...))
+     (transform `(if-clause ,@if-clause)))
+    (('if-clause expr then)
+     `(if (true? ,(transform expr)) ,(transform then) 0))
+    (('if-clause expr then ('else-part else))
+     `(if (true? ,(transform expr)) ,(transform then) ,(transform else)))
+    (('if-clause expr then ..1)
+     `(if (true? ,(transform expr)) (begin ,@(map transform then)) 0))
+    (('if-clause expr then ..1 ('else-part else))
+     `(if (true? ,(transform expr)) (begin ,@(map transform then)) ,(transform else)))
+    (('if-clause expr then ('else-part else ..1))
+     `(if (true? ,(transform expr)) ,(transform then) ,@(map transform else)))
+    (('if-clause expr then ..1 ('else-part else ..1))
+     `(if (true? ,(transform expr)) (begin ,@(map transform then)) (begin ,@(map transform else))))
+
+    (('elif elif ...) (transform `(if-clause ,@elif)))
+
     ((h t ...) (map transform o))
     (_ o)))

gash/script.scm

@@ -51,7 +51,6 @@
             do-group
             expression
             glob
-            if-clause
             ignore-error
             literal
             or-terms
@@ -140,8 +139,12 @@
   (let ((glob (append-map glob (apply append args))))
     glob))
 
-(define (run ast)
-  (map (cut local-eval <> (the-environment)) ast))
+(define (run script)
+  ;; fixme: work towards simple eval -- must remove begin for now
+  (match script
+    (('begin script ...)
+     (last (map (cut local-eval <> (the-environment)) script)))
+    (_ (local-eval script (the-environment)))))
 
 (define (script-status)
   ((compose string->number variable) "?"))
@@ -183,28 +186,19 @@
         (set-shell-opt! " errexit" #t))
       r)))
 
-(define-syntax if-clause
+(define-syntax true?
   (lambda (x)
     (syntax-case x ()
-      ((_ expr then)
+      ((_ pipeline)
        (with-syntax ((it (datum->syntax x 'it)))
-         #'(let ((it (ignore-error expr)))
-             (if (zero? it) then))))
-      ((_ expr then else)
-       (with-syntax ((it (datum->syntax x 'it)))
-         #'(let ((it (ignore-error expr)))
-             (if (zero? it) then else)))))))
+         #'(let ((it (ignore-error pipeline)))
+             (status->bool it)))))))
 
-(define-syntax else-part
-  (lambda (x)
-    (syntax-case x ()
-      ((_ else)
-       (with-syntax ((it (datum->syntax x 'it)))
-         #'else))
-      ((_ expr then else)
-       (with-syntax ((it (datum->syntax x 'it)))
-         #'(let ((it (ignore-error expr)))
-             (if (zero? it) then else)))))))
+(define (status->bool o)
+  (match o
+    (#t #t)
+    ((? number?) (zero? o))
+    (_ #f)))
 
 (define-syntax expression
   (lambda (x)
@@ -258,8 +252,10 @@
       (assignment "?" (number->string status))
       (when (and (not (zero? status))
                  (shell-opt? "errexit"))
+        (when (> %debug-level 0)
+          (format (current-error-port) "set -e: exiting\n"))
         (exit status))
-      status))
+      (status->bool status)))
   (let ((commands (filter (lambda (x) (not (eq? x *unspecified*))) commands)))
     (when (> %debug-level 1)
       (format (current-error-port) "pijp: commands=~s\n" commands))