diff options
author | Leah Neukirchen <leah@vuxu.org> | 2022-10-13 22:28:53 +0200 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2022-10-13 22:28:53 +0200 |
commit | 124dc273e9661bea8c0fe8a2b7ccb298a605872d (patch) | |
tree | 515e8b7be4357d627ace705d36e7930008d3db56 | |
parent | d0a2c47a11aeb37075b99b47d451d467fdb41f1d (diff) | |
download | mew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.tar.gz mew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.tar.xz mew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.zip |
add nesting macros -> and ->>
-rw-r--r-- | mew.el | 3 | ||||
-rw-r--r-- | mew.scm | 43 | ||||
-rw-r--r-- | mew.svnwiki | 15 |
3 files changed, 60 insertions, 1 deletions
diff --git a/mew.el b/mew.el index ab9c986..1d141cf 100644 --- a/mew.el +++ b/mew.el @@ -9,3 +9,6 @@ (put 'if 'scheme-indent-function 1) (put 'match 'scheme-indent-function 1) + +(put '-> 'scheme-indent-function #'(lambda (_ _ _) 1)) +(put '->> 'scheme-indent-function #'(lambda (_ _ _) 1)) diff --git a/mew.scm b/mew.scm index e1684d3..7ff1f49 100644 --- a/mew.scm +++ b/mew.scm @@ -1,4 +1,6 @@ -(module mew (at dec def div empty? eof esc fin for generic-for-each get gfix giterate inc keys keyvals last len loc mod nth op prn puts rep str tbl while until vals) +(module mew (at dec def div empty? eof esc fin for generic-for-each get gfix giterate inc keys keyvals last len loc mod nth op prn puts rep str tbl while until vals -> ->>) + (import-for-syntax matchable) + (import scheme (rename (chicken base) (print puts)) @@ -222,4 +224,43 @@ (define (last g) (generator-fold (lambda (x a) x) (if #f #f) g)) + + (define-syntax -> + (er-macro-transformer + (lambda (expr rename compare) + + (define (->? sym) + (compare sym (rename '->))) + + (define (->>? sym) + (compare sym (rename '->>))) + + (define (pass1 a b v) + (match v + ('() + (reverse (cons (reverse b) a))) + (((and (or (? ->?) (? ->>?)) arr) . rest) + (pass1 (cons (reverse b) a) `(,arr) rest)) + ((other . rest) + (pass1 a (cons other b) rest)))) + + (define (pass2 a v) + (match v + ('() + a) + ((((? ->?) h . t) . rest) + (pass2 `(,h ,a ,@t) rest)) + ((((? ->>?) . t) . rest) + (pass2 `(,@t ,a) rest)))) + + (let ((r (pass1 '() '() (cdr expr)))) + (pass2 (if (= (length (car r)) 1) + (caar r) + (car r)) + (cdr r)))))) + + (define-syntax ->> + (syntax-rules () + ((_ . rest) + (-> . rest)))) ) diff --git a/mew.svnwiki b/mew.svnwiki index 5329267..2e8026e 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -193,3 +193,18 @@ a value {{equal?}} to the preceding one, then stops. <procedure>(last <gen>)</procedure> Run the generator {{<gen>}} until it stops and return the last value. + + +== Special syntax + +<syntax>(-> a -> b c -> d e f)</syntax> +<syntax>(->> a ->> b c ->> d e f)</syntax> + +Nesting macros: {{->}} inserts the previous part as the second argument: +{{(-> a -> b c -> d e f)}} expands to {{(d (b a c) e f)}}. + +{{->>}} inserts the previous part as the last argument: +{{(->> a ->> b c ->> d e f)}} expands to {{(d e f (b c a))}}. + +You can mix {{->}} and {{->>}} macros: +{{(->> a -> b c ->> d e f)}} expands to {{(d e f (b a c))}}. |