summary refs log tree commit diff
diff options
context:
space:
mode:
authorLeah Neukirchen <leah@vuxu.org>2022-10-13 22:28:53 +0200
committerLeah Neukirchen <leah@vuxu.org>2022-10-13 22:28:53 +0200
commit124dc273e9661bea8c0fe8a2b7ccb298a605872d (patch)
tree515e8b7be4357d627ace705d36e7930008d3db56
parentd0a2c47a11aeb37075b99b47d451d467fdb41f1d (diff)
downloadmew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.tar.gz
mew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.tar.xz
mew-124dc273e9661bea8c0fe8a2b7ccb298a605872d.zip
add nesting macros -> and ->>
-rw-r--r--mew.el3
-rw-r--r--mew.scm43
-rw-r--r--mew.svnwiki15
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))}}.