From a6755fe41e3f3f09dd7b08adb3e63209e8a2ba0f Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 7 Nov 2023 23:17:02 +0000
Subject: ccwl: Introduce syntax for array types.

* ccwl/ccwl.scm (<array-type>): New type.
(memoize, make-array-type, construct-type-syntax): New functions.
(input, output): Use construct-type-syntax.
* ccwl/cwl.scm (output->cwl-scm, input->cwl-scm): Render array types.
---
 ccwl/ccwl.scm | 41 +++++++++++++++++++++++++++++++++++++++--
 ccwl/cwl.scm  |  8 +++++++-
 2 files changed, 46 insertions(+), 3 deletions(-)

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 03e1264..2ece5d9 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -73,6 +73,8 @@
             output-binding
             output-source
             output-other
+            array-type?
+            array-type-member-type
             step?
             step-id
             step-run
@@ -92,6 +94,27 @@
   (stage? input-stage?)
   (other input-other))
 
+(define (memoize proc)
+  "Return a memoized version of @var{proc}. Arguments to @var{proc} are
+compared using @code{equal?}."
+  (let ((memoized-results (list)))
+    (lambda args
+      (unless (assoc args memoized-results)
+        (set! memoized-results
+              (acons args (apply proc args)
+                     memoized-results)))
+      (assoc-ref memoized-results args))))
+
+(define-immutable-record-type <array-type>
+  (-make-array-type member-type)
+  array-type?
+  (member-type array-type-member-type))
+
+;; We memoize the <array-type> constructor to enable easy comparison
+;; using eq?.
+(define make-array-type
+  (memoize -make-array-type))
+
 (define-immutable-record-type <unspecified-default>
   (make-unspecified-default)
   unspecified-default?)
@@ -105,6 +128,16 @@
      (condition (ccwl-violation tree)
                 (formatted-message "#:other parameter not serializable to YAML")))))
 
+(define (construct-type-syntax type-spec)
+  "Return syntax to build a type from @var{type-spec}."
+  ;; TODO: Does CWL support arrays of arrays? If so, support such
+  ;; recursive type definitions.
+  (syntax-case type-spec (array)
+    ((array member-type)
+     #'(make-array-type 'member-type))
+    (primitive-type
+     #''primitive-type)))
+
 (define (input input-spec)
   "Return syntax to build an <input> object from INPUT-SPEC."
   (syntax-case input-spec ()
@@ -149,7 +182,9 @@
                 (ensure-yaml-serializable other)
                 (let ((position #f)
                       (prefix #f))
-                  #`(make-input '#,id '#,type #,label
+                  #`(make-input '#,id
+                                #,(construct-type-syntax type)
+                                #,label
                                 #,(if (unspecified-default? default)
                                       #'(make-unspecified-default)
                                       default)
@@ -203,7 +238,9 @@
                              (formatted-message "Output has no identifier")))))))
        (apply (syntax-lambda** (id #:key (type #'File) binding source (other #'()))
                 (ensure-yaml-serializable other)
-                #`(make-output '#,id '#,type #,binding #,source '#,other))
+                #`(make-output '#,id
+                               #,(construct-type-syntax type)
+                               #,binding #,source '#,other))
               #'(id args ...))))
     (id (identifier? #'id) (output #'(id)))
     (_ (error "Invalid output:" (syntax->datum output-spec)))))
diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm
index f032211..e57cc79 100644
--- a/ccwl/cwl.scm
+++ b/ccwl/cwl.scm
@@ -94,6 +94,9 @@ association list."
   `(,(output-id output)
     ,@(or (filter-alist
            `(,@(cond
+                ((array-type? (output-type output))
+                 `((type . ((type . array)
+                            (items . ,(array-type-member-type (output-type output)))))))
                 ;; In workflows, convert stdout outputs to File
                 ;; outputs.
                 ((and workflow?
@@ -120,7 +123,10 @@ CWL YAML specification."
 (define (input->cwl-scm input)
   "Render @var{input}, a @code{<input>} object, into a CWL tree."
   `(,(input-id input)
-    (type . ,(input-type input))
+    ,@(if (array-type? (input-type input))
+          `((type . ((type . array)
+                     (items . ,(array-type-member-type (input-type input))))))
+          `((type . ,(input-type input))))
     ,@(or (filter-alist
            `((label . ,(input-label input))
              (default . ,(and (not (unspecified-default? (input-default input)))
-- 
cgit v1.2.3