diff --git a/gash/grammar.scm b/gash/grammar.scm index 941d940..eff4e53 100644 --- a/gash/grammar.scm +++ b/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))) diff --git a/gash/script.scm b/gash/script.scm index bcdcc9a..ebb2802 100644 --- a/gash/script.scm +++ b/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))