From b89ca17134ee9c44bc0b44cc88ec361946c7cec4 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 17 Nov 2018 08:33:13 +0100
Subject: [PATCH] transform: rewrite io-redirection.

---
 gash/grammar.scm | 22 +++++++++++++++++++++-
 gash/script.scm  | 24 +-----------------------
 2 files changed, 22 insertions(+), 24 deletions(-)

diff --git a/gash/grammar.scm b/gash/grammar.scm
index 6a464c5..757b608 100644
--- a/gash/grammar.scm
+++ b/gash/grammar.scm
@@ -179,9 +179,14 @@
              (end (peg:end match))
              (tree (peg:tree match)))
         (when (> %debug-level 0)
+          (format #t "parse tree:\n")
           (pretty-print tree))
         (if (eq? (string-length input) end)
-            tree
+            (let ((script (transform tree)))
+              (when (> %debug-level 0)
+                (format #t "script:\n")
+                (pretty-print script))
+              script)
             (if match
                 (begin
                   (format (current-error-port) "parse error: at offset: ~a\n" end)
@@ -220,3 +225,18 @@
                   indent
                   (format-peg (cadar args)))
           (exit 1))))))
+
+(define (transform o)
+  (match o
+    (('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)))
+     (cond ((or (null? filedes) (equal? filedes '("1")))
+            `(with-output-to-file ,file-name (command ,@word)))
+           ((equal? filedes '("2"))
+            `(with-error-to-file ,file-name (command ,@word)))
+           (else (error (format #f "TODO: output to filedes=~a\n" filedes)))))
+    (('command word ... ('io-redirect ('io-file "<" file-name)))
+     `(with-input-from-file ,file-name (command ,@word)))
+    ((h t ...) (map transform o))
+    (_ o)))
diff --git a/gash/script.scm b/gash/script.scm
index da7b4e8..01de558 100644
--- a/gash/script.scm
+++ b/gash/script.scm
@@ -74,7 +74,7 @@
     (('pipeline command) (pke 'background: `(pipeline+ #f ,command)))
     (_ term)))
 
-(define (exec-command . args)
+(define (command . args)
   (define (exec command)
     (cond ((procedure? command) command)
           ((assoc-ref %functions (car command))
@@ -177,28 +177,6 @@
 (define-syntax-rule (substitution commands)
   (string-trim-right (with-output-to-string (lambda _ commands))))
 
-;; (define (substitution . command)
-;;   (if (string? (car command)) (warn (parse-string (string-join command)))
-;;       (pipeline->string (list command))
-;;       (warn 'substitution: command '=> ))
-;;   )
-
-(define-syntax command
-  (lambda (x)
-    (syntax-case x ()
-      ((_ word ... (io-redirect (io-file "<" file-name)))
-       #'(with-input-from-file file-name (command word ...)))
-      ((_ word ... (io-redirect (io-file ">" file-name)))
-       #'(with-output-to-file file-name (command word ...)))
-      ((_ word ... (io-redirect "1" (io-file ">" file-name)))
-       #'(with-output-to-file file-name (command word ...)))
-      ((_ word ... (io-redirect "2" (io-file ">" file-name)))
-       #'(with-error-to-file file-name (command word ...)))
-      ((_ word ... (io-redirect (io-here "<<" (io-here-document string))))
-       #'(pipeline (cut display string) (command word ...)))
-      ((_ word ...)
-       #'(exec-command word ...)))))
-
 (define-syntax-rule (ignore-error o)
   (let ((errexit (shell-opt? "errexit")))
     (when errexit