diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2024-06-28 01:03:51 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2024-06-28 01:03:51 -0700 |
| commit | d1ecf1d92d8162bc37b17b7050199a2a41b676c7 (patch) | |
| tree | f6e4dff885e1c9c24ea6ecf15ca96caa56d3f0a8 /stdlib | |
| parent | fb3de91f6a24e32641a017c3f49ebb3e93bb1ddc (diff) | |
| download | txr-d1ecf1d92d8162bc37b17b7050199a2a41b676c7.tar.gz txr-d1ecf1d92d8162bc37b17b7050199a2a41b676c7.tar.bz2 txr-d1ecf1d92d8162bc37b17b7050199a2a41b676c7.zip | |
match: new @(scan-all) operator.
This is like @(scan) but collects all matches over the
suffixes of the list.
* autoload.c (match_set_entries): Intern scan-all symbol.
* stdlib/match.tl (compile-scan-all-match): New function.
(compile-match): Dispatch compile-scan-all-match on scan-all
symbol.
* tests/011/patmatch.tl: Tests for scanall and also missing
tests for scan.
* txr.1: Documented.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/match.tl | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/stdlib/match.tl b/stdlib/match.tl index eb283771..a382a5e6 100644 --- a/stdlib/match.tl +++ b/stdlib/match.tl @@ -571,6 +571,33 @@ obj-var obj-var guard-chain (list guard)))))) +(defun compile-scan-all-match (scan-syntax obj-var var-list) + (mac-param-bind *match-form* (t pattern) scan-syntax + (with-gensyms (iter) + (let* ((in-vars var-list.vars) + (cm (compile-match pattern iter var-list)) + (cm-vars cm.(get-vars)) + (collect-vars (diff cm-vars in-vars)) + (collect-gens [mapcar gensym collect-vars]) + (loop ^(for ((,iter ,obj-var)) + (,iter t) + ((set ,iter (cdr ,iter))) + ,cm.(wrap-guards + ^(progn ,*(mapcar (ret ^(push ,@1 ,@2)) + collect-vars + collect-gens))))) + (guard (new match-guard + vars cm-vars + temps collect-gens + test-expr ^(progn + ,loop + ,*(mapcar (ret ^(set ,@1 (nreverse ,@2))) + collect-vars collect-gens))))) + (new compiled-match + pattern scan-syntax + obj-var obj-var + guard-chain (list guard)))))) + (defun compile-exprs-match (exprs-syntax uexprs var-list) (let ((upats (cdr exprs-syntax)) (utemps (mapcar (ret (gensym)) uexprs))) @@ -609,6 +636,7 @@ (not (compile-not-match exp obj-var var-list)) (hash (compile-hash-match exp obj-var var-list)) (usr:scan (compile-scan-match exp obj-var var-list)) + (usr:scan-all (compile-scan-all-match exp obj-var var-list)) (exprs (compile-exprs-match exp obj-var var-list)) (sys:quasi (compile-match exp obj-var var-list)) (t (iflet ((xfun [*match-macro* op])) |