diff options
| author |  Peter McGoron
| 2025-06-19 22:02:30 -0400 |
|---|---|---|
| committer | Peter McGoron
| 2025-06-19 22:02:30 -0400 |
| commit | 311debc76d7655fb560d4aa261d70535cc32c0c4 (patch) | |
| tree | 02233226878f9c07c74867b7c54fff73b8277d09 /multisyntax/pattern | |
| parent | Rework PNL calculations in pattern producer, fix producer test (diff) | |
add support for multiple ellipses in a sequence in producers
Adopts behavior such that
x ... ... => {append ((x ...) ...}
x ... ... ... => {append {append (((x ...) ...) ...)}}
where `{append ...}` occurs at the meta-level after expanding the
patterns. (In the code this is done with an accumulator.)
Diffstat (limited to 'multisyntax/pattern')
| -rw-r--r-- | multisyntax/pattern/producer.scm | 27 |
1 files changed, 17 insertions, 10 deletions
diff --git a/multisyntax/pattern/producer.scm b/multisyntax/pattern/producer.scm index 3fcfb52..9c652b4 100644 --- a/multisyntax/pattern/producer.scm +++ b/multisyntax/pattern/producer.scm @@ -314,13 +314,20 @@ ;; x ... ... => {append ((x ...) ...)} ;; x ... ... ... => {append {append (((x ...) ...) ...)}} ;; and so on where `append` is meta-level. - (values (lambda (bindings) - (do ((iterated (open-bindings open-identifiers bindings) - (next-binding iterated)) - (patterns (list-accumulator))) - ((bindings-finished? iterated) - (patterns (eof-object))) - (let ((subbindings (union/current-bindings bindings - iterated))) - (patterns (produce-part subbindings))))) - open-identifiers-to-return))) + (letrec ((iterate + (lambda (bindings acc level) + (if (= level number-of-ellipses) + (acc (produce-part bindings)) + (do ((iterated (open-bindings open-identifiers bindings) + (next-binding iterated))) + ((bindings-finished? iterated)) + (let ((subbindings (union/current-bindings bindings + iterated))) + (iterate subbindings + acc + (+ level 1)))))))) + (values (lambda (bindings) + (let ((patterns (list-accumulator))) + (iterate bindings patterns 0) + (patterns (eof-object)))) + open-identifiers-to-return)))) |