drop toplevel ->>, set->>, given; add if->

2 files changed, 85 insertions, 43 deletions

diff --git a/mew.scm b/mew.scm
index b4335c8..ec27927 100644
--- a/mew.scm
+++ b/mew.scm
@@ -5,7 +5,7 @@
      dec def div
      empty? eof esc
      fin final for fun*
-     gen generic-for-each genumerate get gfix giterate given gmatch group-by-accumulator gslice-when gsplit gwindow
+     gen generic-for-each genumerate get gfix giterate gmatch group-by-accumulator gslice-when gsplit gwindow
      inc inject into
      keys
      len loc
@@ -19,7 +19,7 @@
      while
      until
      vals
-     -> ->> fun-> fun->> set-> set->>
+     -> fun-> fun->> set->
      <>?
      ~?)
 
@@ -357,22 +357,75 @@
   (define (final g)
     (generator-fold (lambda (x a) x) (if #f #f) g))
 
-  (define-syntax ->
+  (define-syntax and-apply
     (syntax-rules ()
-      ((_ rest ...)
-       (->chunk () () (rest ...)))))
+      ((_ x f args ...)
+       (let ((v x))
+         (if v
+           (f v args ...)
+           #f)))))
 
-  (define-syntax ->>
+  (define-syntax and-apply-last
+    (syntax-rules ()
+      ((_ x f args ...)
+       (let ((v x))
+         (if v
+           (f args ... v)
+           #f)))))
+
+  (define-syntax if-apply
+    (syntax-rules ()
+      ((_ expr bool (then . then-rest) (else . else-rest))
+       (let ((val expr))
+         (if bool
+           (then val . then-rest)
+           (else val . else-rest))))
+      ((_ expr bool (then . then-rest) else)
+       (if-apply expr bool (then . then-rest) (else)))
+      ((_ expr bool then (else . else-rest))
+       (if-apply expr bool (then) (else . else-rest)))
+      ((_ expr bool then else)
+       (if-apply expr bool (then) (else)))
+      ((_ expr bool then)
+       (if-apply expr bool then ((op))))
+      ))
+
+  (define-syntax if-apply-last
+    (syntax-rules ()
+      ((_ expr bool (then then-rest ...) (else else-rest ...))
+       (let ((val expr))
+         (if bool
+           (then then-rest ... val)
+           (else else-rest ... val))))
+      ((_ expr bool (then . then-rest) else)
+       (if-apply-last expr bool (then . then-rest) (else)))
+      ((_ expr bool then (else . else-rest))
+       (if-apply-last expr bool (then) (else . else-rest)))
+      ((_ expr bool then else)
+       (if-apply-last expr bool (then) (else)))
+      ((_ expr bool then)
+       (if-apply-last expr bool then ((op))))
+      ))
+
+  (define-syntax ->
     (syntax-rules ()
       ((_ rest ...)
        (->chunk () () (rest ...)))))
 
   (define-syntax ->chunk
-    (syntax-rules (-> ->>)
+    (syntax-rules (-> ->> and-> and->> if-> if->>)
       ((_ (result ...) (current ...) (-> rest ...))
        (->chunk (result ... (current ...)) (->) (rest ...)))
       ((_ (result ...) (current ...) (->> rest ...))
        (->chunk (result ... (current ...)) (->>) (rest ...)))
+      ((_ (result ...) (current ...) (and-> rest ...))
+       (->chunk (result ... (current ...)) (-> and-apply) (rest ...)))
+      ((_ (result ...) (current ...) (and->> rest ...))
+       (->chunk (result ... (current ...)) (-> and-apply-last) (rest ...)))
+      ((_ (result ...) (current ...) (if-> rest ...))
+       (->chunk (result ... (current ...)) (-> if-apply) (rest ...)))
+      ((_ (result ...) (current ...) (if->> rest ...))
+       (->chunk (result ... (current ...)) (-> if-apply-last) (rest ...)))
       ((_ (result ...) (current ...) (a rest ...))
        (->chunk (result ...) (current ... a) (rest ...)))
       ((_ ((x) result ...) (current ...) ())
@@ -397,43 +450,25 @@
   (define-syntax fun->>
     (syntax-rules ()
       ((_ rest ...)
-       (lambda (x) (->> x ->> rest ...)))))
+       (lambda (x) (-> x ->> rest ...)))))
 
   (define-syntax set->
-    (syntax-rules (-> ->>)
+    (syntax-rules (-> ->> and-> and->> if-> if->>)
       ((_ location -> rest ...)
        (set! location (-> location -> rest ...)))
       ((_ location ->> rest ...)
        (set! location (-> location ->> rest ...)))
-      ((_ location rest ...)
+      ((_ location and-> rest ...)
+       (set! location (-> location and-> rest ...)))
+      ((_ location and->> rest ...)
+       (set! location (-> location and->> rest ...)))
+      ((_ location if-> rest ...)
+       (set! location (-> location if-> rest ...)))
+      ((_ location if->> rest ...)
+       (set! location (-> location if->> rest ...)))
+      ((_ location rest ...)            ; default to ->
        (set! location (-> location -> rest ...)))))
 
-  (define-syntax set->>
-    (syntax-rules (-> ->>)
-      ((_ location -> rest ...)
-       (set! location (->> location -> rest ...)))
-      ((_ location ->> rest ...)
-       (set! location (->> location ->> rest ...)))
-      ((_ location rest ...)
-       (set! location (->> location ->> rest ...)))))
-
-  (define-syntax given
-    (syntax-rules ()
-      ((_ expr bool (then . then-rest) (else . else-rest))
-       (let ((val expr))
-         (if bool
-           (then val . then-rest)
-           (else val . else-rest))))
-      ((_ expr bool (then . then-rest) else)
-       (given expr bool (then . then-rest) (else)))
-      ((_ expr bool then (else . else-rest))
-       (given expr bool (then) (else . else-rest)))
-      ((_ expr bool then else)
-       (given expr bool (then) (else)))
-      ((_ expr bool then)
-       (given expr bool then ((op))))
-      ))
-
   (define (~? str pat)
     (let ((data (irregex-search pat str)))
       (if data
diff --git a/mew.svnwiki b/mew.svnwiki
index 1f6a963..a9c7ee4 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -331,16 +331,18 @@ When the pattern {{<irx>}} uses match data, the result is unspecified.
 == Special syntax
 
 <syntax>(-> a -> b c -> d e f)</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))}}.
+{{(-> 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))}}.
+{{(-> a -> b c ->> d e f)}} expands to {{(d e f (b a c))}}.
+
+Nesting macros must start off with a {{->}}.
 
 <syntax>(fun-> b c -> d e f)</syntax>
 <syntax>(fun->> b c ->> d e f)</syntax>
@@ -348,15 +350,20 @@ You can mix {{->}} and {{->>}} macros:
 Nesting lambdas: like {{->}} but the nesting starts with the argument
 of the lambda.
 {{(fun-> b c -> d e f)}} expands to {{(lambda (x) (-> x -> b c -> d e f))}}.
-{{(fun->> b c ->> d e f)}} expands to {{(lambda (x) (->> x ->> b c ->> d e f))}}.
+{{(fun->> b c ->> d e f)}} expands to {{(lambda (x) (-> x ->> b c ->> d e f))}}.
 
-<syntax>(set-> loc -> ...)</syntax>
-<syntax>(set->> loc ->> ...)</syntax>
+<syntax>(set-> loc ...)</syntax>
 
 Mutation with nesting macros: shortcut for {{(set loc (-> loc ...))}}.
 
-<syntax>(given <val> <cond> <then> <else>?)<syntax>
+<syntax>(-> ... if-> <val> <cond> <then> <else>?)<syntax>
 
 Evaluate {{<val>}}.  Then, when {{<cond>}} is not false, behaves like
 {{(-> <val> -> <then>}}, otherwise like {{(-> <val> -> <else>)}}
 (or just {{<val>}} if no {{<else>}} was passed).
+
+<syntax>(-> ... and-> ...)<syntax>
+<syntax>(-> ... and->> ...)<syntax>
+
+Like {{->}}/{{->>}} but skips nesting the code if the nested
+expression is false.