aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-11-07 23:17:02 +0000
committerArun Isaac2023-11-14 22:07:43 +0000
commita6755fe41e3f3f09dd7b08adb3e63209e8a2ba0f (patch)
tree0f99fad19d6ea497fc916f8f4237153abee191b9
parente78eee575051bf9506b2362997a2dc7c73f148dd (diff)
downloadccwl-a6755fe41e3f3f09dd7b08adb3e63209e8a2ba0f.tar.gz
ccwl-a6755fe41e3f3f09dd7b08adb3e63209e8a2ba0f.tar.lz
ccwl-a6755fe41e3f3f09dd7b08adb3e63209e8a2ba0f.zip
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.
-rw-r--r--ccwl/ccwl.scm41
-rw-r--r--ccwl/cwl.scm8
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)))