aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-11-23 15:52:08 +0000
committerArun Isaac2023-11-23 19:02:58 +0000
commit704bea74e954c44e22442ca7d28f20fd0e553194 (patch)
tree864dc02c02abc29356e02e821403b1bbaacc3a5c
parentdaa27fa0bce1ec7801bd17a422e2f8f7e0c1015d (diff)
downloadccwl-704bea74e954c44e22442ca7d28f20fd0e553194.tar.gz
ccwl-704bea74e954c44e22442ca7d28f20fd0e553194.tar.lz
ccwl-704bea74e954c44e22442ca7d28f20fd0e553194.zip
ccwl: Parse run arguments recursively.
Parsing run arguments recursively allows us to share code between different pattern matchers. For example, the input matcher and the (prefix input) matcher can share code. This will come in handy as our pattern matchers grow more complex. * ccwl/ccwl.scm (run-args): Parse run arguments recursively.
-rw-r--r--ccwl/ccwl.scm82
1 files changed, 39 insertions, 43 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 9b5132f..d251409 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -351,49 +351,45 @@ RUN-ARGS. If such an input is not present in RUN-ARGS, return #f."
"Return a list of run arguments specified in @var{run}
syntax. @var{defined-input-identifiers} is the list of input
identifiers defined in the commands."
- (let ((ensure-input-is-defined
- ;; Ensure that specified input is defined in #:inputs of
- ;; command definition.
- (lambda (input)
- (unless (memq (syntax->datum input)
- defined-input-identifiers)
- (raise-exception
- (condition (ccwl-violation input)
- (formatted-message "Undefined input ~a"
- (syntax->datum input))))))))
- (append-map (lambda (x)
- (syntax-case x ()
- ;; Replace input symbol with quoted symbol.
- (input (identifier? #'input)
- (begin
- (ensure-input-is-defined #'input)
- (list #''input)))
- ;; Leave string as is.
- (string-arg (string? (syntax->datum #'string-arg))
- (list #'string-arg))
- ;; Replace prefixed input symbol with quoted symbol.
- ((prefix input) (and (string? (syntax->datum #'prefix))
- (identifier? #'input))
- (begin
- (ensure-input-is-defined #'input)
- (list #''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))
- ;; Prefixes that are not strings
- ((prefix _)
- (raise-exception
- (condition (ccwl-violation #'prefix)
- (formatted-message "Invalid prefix ~a. Prefixes must be strings."
- (syntax->datum #'prefix)))))
- (_
- (raise-exception
- (condition (ccwl-violation x)
- (formatted-message "Invalid command element ~a. Command elements must either be input identifiers or literal strings."
- (syntax->datum x)))))))
- run)))
+ (define (syntax->run-arg x)
+ (syntax-case x ()
+ ;; Replace input symbol with quoted symbol.
+ (input (identifier? #'input)
+ ;; Ensure that specified input is defined in #:inputs of
+ ;; command definition.
+ (begin
+ (unless (memq (syntax->datum #'input)
+ defined-input-identifiers)
+ (raise-exception
+ (condition (ccwl-violation #'input)
+ (formatted-message "Undefined input ~a"
+ (syntax->datum #'input)))))
+ (list #''input)))
+ ;; Leave string as is.
+ (string-arg (string? (syntax->datum #'string-arg))
+ (list #'string-arg))
+ ;; 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))
+ ;; Recurse on prefixed inputs.
+ ((prefix input) (string? (syntax->datum #'prefix))
+ (syntax->run-arg #'input))
+ ;; Prefixes that are not strings
+ ((prefix _)
+ (raise-exception
+ (condition (ccwl-violation #'prefix)
+ (formatted-message "Invalid prefix ~a. Prefixes must be strings."
+ (syntax->datum #'prefix)))))
+ (_
+ (raise-exception
+ (condition (ccwl-violation x)
+ (formatted-message "Invalid command element ~a. Command elements must either be input identifiers or literal strings."
+ (syntax->datum x)))))))
+
+ (append-map syntax->run-arg
+ run))
;; TODO: Add fine-grained syntax checking.
(define-syntax command