diff options
| author | Arun Isaac | 2023-11-21 14:40:26 +0000 |
|---|---|---|
| committer | Arun Isaac | 2023-11-21 14:40:26 +0000 |
| commit | 34f17df25d52f2ea8ac914d01a300da6c3c78a33 (patch) | |
| tree | 09de7756a2cee4ca47ee3fa4787872719bf7231e /ccwl | |
| parent | 3caf3c6379496b12a5725fbe32282e6f2f130348 (diff) | |
| download | ccwl-34f17df25d52f2ea8ac914d01a300da6c3c78a33.tar.gz ccwl-34f17df25d52f2ea8ac914d01a300da6c3c78a33.tar.lz ccwl-34f17df25d52f2ea8ac914d01a300da6c3c78a33.zip | |
ccwl: Reimplement rename recursively.
With recursion, we no longer need an explicit call to map, and the
code is less deeply nested. This is good for clarity.
* ccwl/ccwl.scm (collect-steps): Reimplement rename recursively.
Diffstat (limited to 'ccwl')
| -rw-r--r-- | ccwl/ccwl.scm | 51 |
1 files changed, 29 insertions, 22 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index cdae1c5..b9ee81f 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -608,28 +608,35 @@ represented by <step> objects." ((tee expressions ...) (append-mapn (cut collect-steps <> input-keys) #'(expressions ...))) - ;; rename keys - ((rename mapping ...) - (values (map (lambda (key) - (or (any (match-lambda - ((new . old) - (unless (keyword? (syntax->datum new)) - (raise-exception - (condition (ccwl-violation new) - (formatted-message "Expected keyword (for example: #:foo, #:bar)")))) - (unless (memq (syntax->datum old) - (map key-name input-keys)) - (raise-exception - (condition (ccwl-violation old) - (formatted-message "Unknown key ~a. Known keys at this step are ~a." - (syntax->datum old) - (map key-name input-keys))))) - (and (eq? (syntax->datum old) (key-name key)) - (set-key-name key (keyword->symbol (syntax->datum new)))))) - (pairify #'(mapping ...))) - key)) - input-keys) - (list))) + ;; rename keys (base case) + ((rename new-key old-key) + (begin + ;; Error out on non-keyword arguments. + (unless (keyword? (syntax->datum #'new-key)) + (raise-exception + (condition (ccwl-violation #'new-key) + (formatted-message "Expected keyword (for example: #:foo, #:bar)")))) + ;; Ensure old key exists. + (unless (memq (syntax->datum #'old-key) + (map key-name input-keys)) + (raise-exception + (condition (ccwl-violation #'old-key) + (formatted-message "Unknown key ~a. Known keys at this step are ~a." + (syntax->datum #'old-key) + (map key-name input-keys))))) + (values (map (lambda (key) + ;; Rename one key. Pass the rest through. + (or (and (eq? (syntax->datum #'old-key) + (key-name key)) + (set-key-name key (keyword->symbol (syntax->datum #'new-key)))) + key)) + input-keys) + (list)))) + ;; rename keys (recurse) + ((rename new-key old-key other-mappings ...) + (collect-steps #'(pipe (rename new-key old-key) + (rename other-mappings ...)) + input-keys)) ;; TODO: Support cross product scatter methods. ((scatter _ ...) (collect-scatter-step x input-keys 'dotproduct)) |