From 4f757fc0a4d4af067e0d22ad4020c1b18cc3fd24 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Fri, 19 Dec 2025 19:46:27 +0000
Subject: ccwl: Add #:separate? argument to prefixed arguments.
---
ccwl/ccwl.scm | 64 ++++++++++++++++++++++++++----------
ccwl/cwl.scm | 5 +++
doc/ccwl.skb | 10 +++++-
doc/unseparated-prefix-arguments.scm | 2 ++
tests/cwl.scm | 2 +-
5 files changed, 64 insertions(+), 19 deletions(-)
create mode 100644 doc/unseparated-prefix-arguments.scm
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 07797fa..4480314 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -72,6 +72,7 @@
input-default
input-position
input-prefix
+ input-separate?
input-separator
input-stage?
input-other
@@ -93,7 +94,7 @@
unspecified-default?))
(define-immutable-record-type
- (make-input id type label default position prefix separator stage? other)
+ (make-input id type label default position prefix separate? separator stage? other)
input?
(id input-id)
(type input-type)
@@ -101,6 +102,7 @@
(default input-default set-input-default)
(position input-position set-input-position)
(prefix input-prefix set-input-prefix)
+ (separate? input-separate? set-input-separate?)
(separator input-separator set-input-separator)
(stage? input-stage?)
(other input-other))
@@ -206,7 +208,7 @@ compared using @code{equal?}."
#,(if (unspecified-default? default)
#'(make-unspecified-default)
default)
- #,position #,prefix #f
+ #,position #,prefix #f #f
#,stage? '#,other)))
#'(id args ...))))
(id (identifier? #'id) (input #'(id)))
@@ -372,6 +374,25 @@ input, return #f."
#'prefix)
(_ #f)))
+(define (validate-separate? separate?)
+ "Validate @var{separate?} and raise an exception if it is not valid."
+ (unless (boolean? separate?)
+ (raise-exception
+ (condition (ccwl-violation separate?)
+ (formatted-message "Invalid #:separate? flag ~a. #:separate? flag must be a boolean."
+ (syntax->datum separate?))))))
+
+(define (run-arg-separate? run-arg)
+ "Return the separate? specified in @var{run-arg} syntax. If not a
+prefixed input, return #f."
+ (syntax-case run-arg (array)
+ ((prefix _ args ...) (string? (syntax->datum #'prefix))
+ (apply (syntax-lambda** (#:key (separate? #'#t))
+ (validate-separate? (syntax->datum separate?))
+ separate?)
+ #'(args ...)))
+ (_ #f)))
+
(define (run-arg-separator run-arg)
"Return the item separator specified in @var{run-arg} syntax."
(syntax-case run-arg (array)
@@ -417,9 +438,15 @@ identifiers defined in the commands."
(syntax->run-arg #'input))
;; Flatten prefixed string arguments. They have no
;; special meaning.
- ((prefix string-arg _ ...) (and (string? (syntax->datum #'prefix))
- (string? (syntax->datum #'string-arg)))
- (list #'prefix #'string-arg))
+ ((prefix string-arg args ...) (and (string? (syntax->datum #'prefix))
+ (string? (syntax->datum #'string-arg)))
+ (apply (syntax-lambda** (#:key (separate? #'#t))
+ (validate-separate? (syntax->datum separate?))
+ (if (syntax->datum separate?)
+ (list #'prefix #'string-arg)
+ (list #`#,(string-append (syntax->datum #'prefix)
+ (syntax->datum #'string-arg)))))
+ #'(args ...)))
;; Recurse on prefixed inputs.
((prefix input _ ...) (string? (syntax->datum #'prefix))
(syntax->run-arg #'input))
@@ -484,18 +511,21 @@ identifiers defined in the commands."
(let* ((id (input-spec-id input-spec))
(run-arg (find-run-arg id run)))
#`(set-input-separator
- (set-input-prefix
- (set-input-position
- #,(input input-spec)
- ;; `run-args' returns inputs as quoted symbols.
- ;; So, we add quote.
- #,(list-index (match-lambda
- (`(quote ,input)
- (eq? input id))
- (_ #f))
- (syntax->datum flattened-args)))
+ (set-input-separate?
+ (set-input-prefix
+ (set-input-position
+ #,(input input-spec)
+ ;; `run-args' returns inputs as quoted symbols.
+ ;; So, we add quote.
+ #,(list-index (match-lambda
+ (`(quote ,input)
+ (eq? input id))
+ (_ #f))
+ (syntax->datum flattened-args)))
+ #,(and run-arg
+ (run-arg-prefix run-arg)))
#,(and run-arg
- (run-arg-prefix run-arg)))
+ (run-arg-separate? run-arg)))
#,(and run-arg
(run-arg-separator run-arg)))))
inputs))
@@ -602,7 +632,7 @@ identifiers defined in the commands."
((id . type)
(with-syntax ((id (datum->syntax #f id))
(type (datum->syntax #f type)))
- #`(make-input 'id 'type #f #f #f #f #f #f '()))))
+ #`(make-input 'id 'type #f #f #f #f #f #f #f '()))))
(parameters->id+type (assoc-ref yaml "inputs"))))
(list #,@(map (match-lambda
((id . type)
diff --git a/ccwl/cwl.scm b/ccwl/cwl.scm
index d07bc3b..f954f08 100644
--- a/ccwl/cwl.scm
+++ b/ccwl/cwl.scm
@@ -169,6 +169,11 @@ CWL YAML specification."
'()))
(prefix . ,(or (input-prefix input)
'()))
+ ;; separate? has a meaningful value only with prefix.
+ (separate . ,(if (input-prefix input)
+ (and (input-separate? input)
+ '())
+ '()))
(itemSeparator . ,(or (input-separator input)
'())))
,@(input-other input)))))
diff --git a/doc/ccwl.skb b/doc/ccwl.skb
index 9001f20..7096711 100644
--- a/doc/ccwl.skb
+++ b/doc/ccwl.skb
@@ -1,5 +1,5 @@
;;; ccwl --- Concise Common Workflow Language
-;;; Copyright © 2021, 2023–2024 Arun Isaac
+;;; Copyright © 2021, 2023–2025 Arun Isaac
;;;
;;; This file is part of ccwl.
;;;
@@ -363,6 +363,14 @@ prefix. For example, in the following example, we associate the input
,(code "output_filename") to the prefix ,(code "-o"). Notice the
parentheses around ,(code "-o output_filename").]
(scheme-source "doc/prefix-arguments.scm")))
+ (section :title [Unseparated prefix arguments]
+ :ident "section-unseparated-prefix-arguments"
+ (p [Some programs don't like it when you separate arguments from
+their prefixes. You can specify this using the ,(code [#:separate?])
+flag.]
+ (scheme-source "doc/unseparated-prefix-arguments.scm")
+ [This is executed as ,(samp [gcc foo.c -ofoo]), rather than
+as ,(samp [gcc foo.c -o foo]).]))
(section :title [Array types]
:ident "section-array-types"
(p [ccwl supports array types using the following syntax.]
diff --git a/doc/unseparated-prefix-arguments.scm b/doc/unseparated-prefix-arguments.scm
new file mode 100644
index 0000000..9e1e767
--- /dev/null
+++ b/doc/unseparated-prefix-arguments.scm
@@ -0,0 +1,2 @@
+(command #:inputs (source #:type File) (output_filename #:type string)
+ #:run "gcc" source ("-o" output_filename #:separate? #f))
diff --git a/tests/cwl.scm b/tests/cwl.scm
index f5eeb44..ae8fa6b 100644
--- a/tests/cwl.scm
+++ b/tests/cwl.scm
@@ -53,6 +53,6 @@
(default . #f)
(label . "foo"))
(input->cwl-scm
- (make-input "foo" 'boolean "foo" #f #f #f #f #f '())))
+ (make-input "foo" 'boolean "foo" #f #f #f #t #f #f '())))
(test-end "cwl")
--
cgit 1.4.1