From 22977baf000ff18941eb78dcc300d115667e5ec8 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 17 Aug 2021 16:00:23 +0530
Subject: ccwl: Define output objects using a macro instead of a function.

This allows us to do sophisticated syntax checking at an early stage,
very close to the user interface. That way error messages from ccwl
will make a lot more sense.

* ccwl/ccwl.scm (output): Re-implement as macro.
(command): Use the new macro interface.
* doc/capture-output-file-with-parameter-reference.scm,
doc/capture-output-file.scm, doc/capture-stdout.scm, doc/checksum.scm,
doc/decompress-compile-run.scm: Use new quoting syntax for output
types.
---
 ccwl/ccwl.scm                                      | 22 ++++++++++------------
 ...apture-output-file-with-parameter-reference.scm |  2 +-
 doc/capture-output-file.scm                        |  2 +-
 doc/capture-stdout.scm                             |  2 +-
 doc/checksum.scm                                   |  6 +++---
 doc/decompress-compile-run.scm                     |  6 +++---
 6 files changed, 19 insertions(+), 21 deletions(-)

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 48c2d50..f3ffffd 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -78,9 +78,15 @@
   (source output-source set-output-source)
   (other output-other))
 
-(define* (output id #:key (type 'File) binding source (other '()))
-  "Build and return an <output> object."
-  (make-output id type binding source other))
+(define (output output-spec)
+  "Return syntax to build an <output> object from OUTPUT-SPEC."
+  (syntax-case output-spec ()
+    ((id args ...) (identifier? #'id)
+     (apply (syntax-lambda** (id #:key (type #'File) binding source #:key* other)
+              #`(make-output '#,id '#,type #,binding #,source '#,other))
+            #'(id args ...)))
+    (id (identifier? #'id) (output #'(id)))
+    (_ (error "Invalid output:" (syntax->datum output-spec)))))
 
 (define (filter-alist alist)
   "Filter ALIST removing entries with #f as the value. If the
@@ -161,15 +167,7 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f."
                                                             #,(run-arg-position id run))
                                         #,(run-arg-prefix id run))))
                                  inputs))
-                   (list #,@(map (lambda (x)
-                                   ;; Instantiate <output> object.
-                                   (syntax-case x ()
-                                     ((id args ...) (identifier? #'id)
-                                      #'(output 'id args ...))
-                                     (id (identifier? #'id) #'(output 'id))
-                                     (_ (error "Invalid output:"
-                                               (syntax->datum x)))))
-                                 outputs))
+                   (list #,@(map output outputs))
                    (list #,@(map (lambda (x)
                                    (syntax-case x ()
                                      ;; Replace input symbol with quoted symbol.
diff --git a/doc/capture-output-file-with-parameter-reference.scm b/doc/capture-output-file-with-parameter-reference.scm
index 88d17ad..fb32fc8 100644
--- a/doc/capture-output-file-with-parameter-reference.scm
+++ b/doc/capture-output-file-with-parameter-reference.scm
@@ -2,7 +2,7 @@
   (command #:inputs (archive #:type File) (extractfile #:type string)
            #:run "tar" "--extract" "--file" archive extractfile
            #:outputs (extracted-file
-                      #:type 'File
+                      #:type File
                       #:binding '((glob . "$(inputs.extractfile)")))))
 
 (workflow ((archive #:type File) (extractfile #:type string))
diff --git a/doc/capture-output-file.scm b/doc/capture-output-file.scm
index ddeb218..2993c48 100644
--- a/doc/capture-output-file.scm
+++ b/doc/capture-output-file.scm
@@ -2,7 +2,7 @@
   (command #:inputs (archive #:type File)
            #:run "tar" "--extract" "--file" archive
            #:outputs (extracted-file
-                      #:type 'File
+                      #:type File
                       #:binding '((glob . "hello.txt")))))
 
 (workflow ((archive #:type File))
diff --git a/doc/capture-stdout.scm b/doc/capture-stdout.scm
index 1aed277..b9b6774 100644
--- a/doc/capture-stdout.scm
+++ b/doc/capture-stdout.scm
@@ -1,7 +1,7 @@
 (define print
   (command #:inputs (message #:type string)
            #:run "echo" message
-           #:outputs (printed-message #:type 'stdout)))
+           #:outputs (printed-message #:type stdout)))
 
 (workflow ((message #:type string))
   (print #:message message))
diff --git a/doc/checksum.scm b/doc/checksum.scm
index e746779..297ac14 100644
--- a/doc/checksum.scm
+++ b/doc/checksum.scm
@@ -1,17 +1,17 @@
 (define md5sum
   (command #:inputs (file #:type File)
            #:run "md5sum" file
-           #:outputs (md5 #:type 'stdout)))
+           #:outputs (md5 #:type stdout)))
 
 (define sha1sum
   (command #:inputs (file #:type File)
            #:run "sha1sum" file
-           #:outputs (sha1 #:type 'stdout)))
+           #:outputs (sha1 #:type stdout)))
 
 (define sha256sum
   (command #:inputs (file #:type File)
            #:run "sha256sum" file
-           #:outputs (sha256 #:type 'stdout)))
+           #:outputs (sha256 #:type stdout)))
 
 (workflow ((file #:type File))
   (tee (md5sum #:file file)
diff --git a/doc/decompress-compile-run.scm b/doc/decompress-compile-run.scm
index 4e916b2..00ad392 100644
--- a/doc/decompress-compile-run.scm
+++ b/doc/decompress-compile-run.scm
@@ -1,19 +1,19 @@
 (define decompress
   (command #:inputs (compressed #:type File)
            #:run "gzip" "--stdout" "--decompress" compressed
-           #:outputs (decompressed #:type 'stdout)))
+           #:outputs (decompressed #:type stdout)))
 
 (define compile
   (command #:inputs (source #:type File)
            #:run "gcc" "-x" "c" source
            #:outputs (executable
-                      #:type 'File
+                      #:type File
                       #:binding '((glob . "a.out")))))
 
 (define run
   (command #:inputs executable
            #:run executable
-           #:outputs (stdout #:type 'stdout)))
+           #:outputs (stdout #:type stdout)))
 
 (workflow ((compressed-source #:type File))
   (pipe (decompress #:compressed compressed-source)
-- 
cgit v1.2.3