diff options
| -rw-r--r-- | ccwl/ccwl.scm | 64 | ||||
| -rw-r--r-- | ccwl/cwl.scm | 5 | ||||
| -rw-r--r-- | doc/ccwl.skb | 10 | ||||
| -rw-r--r-- | doc/unseparated-prefix-arguments.scm | 2 | ||||
| -rw-r--r-- | tests/cwl.scm | 2 |
5 files changed, 64 insertions, 19 deletions
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 <input> - (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 <arunisaac@systemreboot.net> +;;; Copyright © 2021, 2023–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; 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") |